blog/blog-meta/post-lists.hs

103 lines
3.1 KiB
Haskell

import qualified Data.ByteString.Lazy as LazyBS
import Data.Char (toLower)
import Data.Function ((&))
import Data.List (sortBy)
import Data.Ord (comparing)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time
import Misc
import qualified YAML
import YAML ((.:), (.!=), (##=))
import qualified System.Console.GetOpt as GetOpt
import qualified System.FilePath.Find as Find
import qualified System.FilePath as Path
main :: IO ()
main = do
Opts title dir tag out <- getOptions
files <- Find.findL True (pure True) (Find.extension Find.==? ".md") dir
infos <- filter (checkTag tag) <$> traverse (getInfo dir) files
let content = makeContent title infos
case out of
Nothing -> LazyBS.putStr content
Just fn -> LazyBS.writeFile fn content
makeContent :: Text -> [PostInfo] -> LazyBS.ByteString
makeContent title is' = "---\n" <> YAML.encode1 val <> "...\n" where
is = sortBy (flip $ comparing infoDate) is'
val = YAML.obj [("title" ##= title), ("posts" ##= is)]
checkTag :: Maybe Text -> PostInfo -> Bool
checkTag Nothing _ = True
checkTag (Just t) i = t `elem` infoTags i
data Options =
Opts {
optsTitle :: !Text,
optsDir :: !FilePath,
optsTag :: !(Maybe Text),
optsOut :: !(Maybe FilePath)
}
getOptions :: IO Options
getOptions = getOptionsWith hdr defOpts optDescrs where
hdr prog = "usage: " <> prog <> " [OPTION...] DIR TITLE\n\
\ --- get info about posts in DIR and use given title"
optDescrs :: [GetOpt.OptDescr (Options -> Options)]
optDescrs =
[GetOpt.Option "t" ["tag"]
(GetOpt.ReqArg (\t o -> o {optsTag = Just $ Text.pack t}) "TAG")
"list only posts with the given tag",
GetOpt.Option "o" ["out"]
(GetOpt.ReqArg (\f o -> o {optsOut = Just f}) "FILE")
"write output to FILE"]
defOpts :: [String] -> Maybe Options
defOpts [dir, title] =
Just $ Opts {optsDir = dir, optsTitle = Text.pack title,
optsTag = Nothing, optsOut = Nothing}
defOpts _ = Nothing
getInfo :: FilePath -> FilePath -> IO PostInfo
getInfo dir file = do
yaml <- YAML.readHeader file
let dirs = Path.splitPath dir
let file' = Path.joinPath $ drop (length dirs) $ Path.splitPath file
unwrap file $ YAML.parseEither $
yaml & YAML.withMap "title, date, tags" \m ->
Info <$> pure file'
<*> m .: "title"
<*> m .: "date"
<*> m .: "tags" .!= []
-- | the front matter info we care about
data PostInfo =
Info {
_nfoFile :: FilePath,
_nfoTitle :: Text,
infoDate :: BlogDate,
infoTags :: [Text]
}
instance YAML.ToYAML PostInfo where
toYAML (Info file title date tags) = YAML.obj
[("date" ##= date),
("title" ##= title),
("tags" ##= tags),
("file" ##= Text.pack (fixup file))]
where fixup f = Path.replaceExtension f "html"
newtype BlogDate = D Day deriving (Eq, Ord)
instance YAML.FromYAML BlogDate where
parseYAML = YAML.withStr "YYYY-MM-DD" $
fmap D . parseTimeM True defaultTimeLocale "%F" . Text.unpack
instance YAML.ToYAML BlogDate where
toYAML (D d) = YAML.str $ Text.pack $ map toLower $
formatTime defaultTimeLocale "%a %-d %B %Y" d