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 qualified YAML import YAML ((.:), (.!=), (##=)) import qualified System.Console.GetOpt as GetOpt import qualified System.FilePath.Find as Find import Misc import Data.Char (toLower) 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 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 -> IO PostInfo getInfo file = do yaml <- YAML.readHeader file unwrap file $ YAML.parseEither $ yaml & YAML.withMap "title, date, tags" \m -> Info <$> return (Text.pack file) <*> m .: "title" <*> m .: "date" <*> m .: "tags" .!= [] -- | the front matter info we care about data PostInfo = Info { _nfoFile :: Text, _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" ##= file)] 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