101 lines
2.9 KiB
Haskell
101 lines
2.9 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 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
|