2021-07-23 21:35:02 -04:00
|
|
|
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
|
2021-07-25 08:48:08 -04:00
|
|
|
import Misc
|
2021-07-23 21:35:02 -04:00
|
|
|
import qualified YAML
|
2024-09-15 11:46:06 -04:00
|
|
|
import YAML ((.:), (.:?), (.!=), (##=))
|
2021-07-23 21:35:02 -04:00
|
|
|
import qualified System.Console.GetOpt as GetOpt
|
|
|
|
import qualified System.FilePath.Find as Find
|
2021-07-25 08:48:08 -04:00
|
|
|
import qualified System.FilePath as Path
|
2021-07-23 21:35:02 -04:00
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
|
|
|
Opts title dir tag out <- getOptions
|
|
|
|
files <- Find.findL True (pure True) (Find.extension Find.==? ".md") dir
|
2021-07-25 08:48:08 -04:00
|
|
|
infos <- filter (checkTag tag) <$> traverse (getInfo dir) files
|
2021-07-23 21:35:02 -04:00
|
|
|
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
|
2024-09-16 11:02:09 -04:00
|
|
|
is = sortBy (flip $ comparing date) is'
|
2021-07-23 21:35:02 -04:00
|
|
|
val = YAML.obj [("title" ##= title), ("posts" ##= is)]
|
|
|
|
|
|
|
|
|
|
|
|
checkTag :: Maybe Text -> PostInfo -> Bool
|
|
|
|
checkTag Nothing _ = True
|
2024-09-16 11:02:09 -04:00
|
|
|
checkTag (Just t) i = t `elem` tags i
|
2021-07-23 21:35:02 -04:00
|
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
2024-09-16 11:02:09 -04:00
|
|
|
|
|
|
|
newtype IsoDate = ID Day deriving (Eq, Ord)
|
|
|
|
|
|
|
|
instance YAML.FromYAML IsoDate where
|
|
|
|
parseYAML = YAML.withStr "YYYY-MM-DD" $
|
|
|
|
fmap ID . parseTimeM True defaultTimeLocale "%F" . Text.unpack
|
|
|
|
|
|
|
|
-- | the front matter info we care about
|
|
|
|
data PostInfo =
|
|
|
|
Info {
|
|
|
|
file :: FilePath,
|
|
|
|
title :: Text,
|
|
|
|
date :: IsoDate,
|
|
|
|
tags :: [Text],
|
|
|
|
summary :: Maybe Text
|
|
|
|
}
|
|
|
|
|
2021-07-25 08:48:08 -04:00
|
|
|
getInfo :: FilePath -> FilePath -> IO PostInfo
|
|
|
|
getInfo dir file = do
|
2021-07-23 21:35:02 -04:00
|
|
|
yaml <- YAML.readHeader file
|
2021-07-25 08:48:08 -04:00
|
|
|
let dirs = Path.splitPath dir
|
|
|
|
let file' = Path.joinPath $ drop (length dirs) $ Path.splitPath file
|
2021-07-23 21:35:02 -04:00
|
|
|
unwrap file $ YAML.parseEither $
|
2024-09-15 11:46:06 -04:00
|
|
|
yaml & YAML.withMap "title, date, tags, summary?" \m ->
|
2021-07-25 08:48:08 -04:00
|
|
|
Info <$> pure file'
|
2024-09-15 11:46:06 -04:00
|
|
|
<*> m .: "title"
|
|
|
|
<*> m .: "date"
|
|
|
|
<*> m .: "tags" .!= []
|
|
|
|
<*> m .:? "summary"
|
2021-07-23 21:35:02 -04:00
|
|
|
|
|
|
|
instance YAML.ToYAML PostInfo where
|
2024-09-16 11:02:09 -04:00
|
|
|
toYAML (Info {..}) = YAML.obj
|
|
|
|
["date" ##= showDate date,
|
|
|
|
"date-rss" ##= rssDate date,
|
|
|
|
"title" ##= title,
|
|
|
|
"tags" ##= tags,
|
|
|
|
"file" ##= htmlFile file,
|
|
|
|
"summary" ##= summary]
|
|
|
|
|
|
|
|
htmlFile :: FilePath -> Text
|
|
|
|
htmlFile f = Text.pack $ Path.replaceExtension f "html"
|
|
|
|
|
|
|
|
rssDate :: IsoDate -> Text
|
|
|
|
rssDate (ID d) =
|
|
|
|
Text.pack $ formatTime defaultTimeLocale "%a, %d %b %Y 00:00:01 UT" d
|
|
|
|
|
|
|
|
showDate :: IsoDate -> Text
|
|
|
|
showDate (ID d) =
|
|
|
|
Text.pack $ toLower <$> formatTime defaultTimeLocale "%a %-d %B %Y" d
|