import qualified Data.ByteString.Lazy as LazyBS import Data.Function ((&)) import Data.List (sortBy) import Data.Ord (comparing) import Data.Text (Text) import qualified Data.Text as Text 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 -- | generates a yaml list for a list of posts; either for a given tag, or all -- posts. the posts are in chronological order, newest first. -- -- example (exact yaml layout not guaranteed; whatever @HsYAML@ feels -- like doing): -- -- @ -- --- -- title: "posts tagged ‘ATS’" -- posts: -- - file: fib.html -- title: fibonacci in maude and ats -- date: mon 24 october 2022 -- date-rss: Mon, 24 Oct 2022 00:00:01 UT -- tags: [computer, maude, ATS] -- summary: fibonacci numbers in the languages maude and ATS. -- - file: ats.html -- title: a little ats program -- date: fri 16 september 2022 -- date-rss: Fri, 16 Sep 2022 00:00:01 UT -- tags: [computer, ATS, cool languages] -- summary: > -- a little program in a little-known, little-documented language -- called ATS. -- ... -- @ main :: IO () main = do Opts {..} <- 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 date) is' val = YAML.obj [("title" ##= title), ("posts" ##= is)] -- | whether a post has the given tag checkTag :: Maybe Text -> PostInfo -> Bool checkTag Nothing _ = True checkTag (Just t) i = t `elem` tags i -- | command line options data Options = Opts { -- | first argument: directory containing the .md files dir :: !FilePath, -- | second argument: title for the output page title :: !Text, -- | @-t, --tag@: filter by tag tag :: !(Maybe Text), -- | @-o, --out@: write output to file (otherwise stdout) out :: !(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 {tag = Just $ Text.pack t}) "TAG") "list only posts with the given tag", GetOpt.Option "o" ["out"] (GetOpt.ReqArg (\f o -> o {out = Just f}) "FILE") "write output to FILE"] defOpts :: [String] -> Maybe Options defOpts [dir, Text.pack -> title] = Just $ Opts {dir, title, tag = Nothing, out = Nothing} defOpts _ = Nothing -- | the front matter info we care about data PostInfo = Info { -- | the (input) file name, relative to 'dir' in options file :: FilePath, title :: Text, -- ^ post @title@ date :: IsoDate, -- ^ post @date@ tags :: [Text], -- ^ post @tags@ summary :: Maybe Text -- ^ post @summary@ (optional) } -- | @getInfo dir file@: read the front matter of @dir/file@ -- -- the 'file' field is just the filename, with @dir@ removed 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, summary?" \m -> Info <$> pure file' <*> m .: "title" <*> m .: "date" <*> m .: "tags" .!= [] <*> m .:? "summary" instance YAML.ToYAML PostInfo where toYAML (Info {..}) = YAML.obj ["date" ##= showDate date, "date-rss" ##= rssDate date, "title" ##= title, "tags" ##= tags, "file" ##= htmlFile file, "summary" ##= summary] -- | replace @.md@ (or whatever) extension with @.html@ htmlFile :: FilePath -> Text htmlFile f = Text.pack $ Path.replaceExtension f "html"