diff --git a/blog-meta/blog-meta.cabal b/blog-meta/blog-meta.cabal index 210554e..566852e 100644 --- a/blog-meta/blog-meta.cabal +++ b/blog-meta/blog-meta.cabal @@ -12,6 +12,7 @@ common deps OverloadedStrings, OverloadedLists, NondecreasingIndentation, + RecordWildCards, ViewPatterns build-depends: base >= 4.14.2.0 && < 4.18, diff --git a/blog-meta/post-lists.hs b/blog-meta/post-lists.hs index 0da03a6..7b18839 100644 --- a/blog-meta/post-lists.hs +++ b/blog-meta/post-lists.hs @@ -25,13 +25,13 @@ main = do makeContent :: Text -> [PostInfo] -> LazyBS.ByteString makeContent title is' = "---\n" <> YAML.encode1 val <> "...\n" where - is = sortBy (flip $ comparing infoDate) is' + is = sortBy (flip $ comparing date) is' val = YAML.obj [("title" ##= title), ("posts" ##= is)] checkTag :: Maybe Text -> PostInfo -> Bool checkTag Nothing _ = True -checkTag (Just t) i = t `elem` infoTags i +checkTag (Just t) i = t `elem` tags i data Options = @@ -63,6 +63,23 @@ defOpts [dir, title] = defOpts _ = Nothing + +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 + } + getInfo :: FilePath -> FilePath -> IO PostInfo getInfo dir file = do yaml <- YAML.readHeader file @@ -76,42 +93,22 @@ getInfo dir file = do <*> m .: "tags" .!= [] <*> m .:? "summary" --- | the front matter info we care about -data PostInfo = - Info { - infoFile :: FilePath, - infoTitle :: Text, - infoDate :: BlogDate, - infoTags :: [Text], - infoSummary :: Maybe Text - } - instance YAML.ToYAML PostInfo where - toYAML (Info file title date tags summary) = YAML.obj - [("date" ##= date), - ("date-rss" ##= toRss date), - ("title" ##= title), - ("tags" ##= tags), - ("file" ##= Text.pack (fixup file)), - ("summary" ##= summary)] - where - fixup f = Path.replaceExtension f "html" - toRss (BD d) = RD d + toYAML (Info {..}) = YAML.obj + ["date" ##= showDate date, + "date-rss" ##= rssDate date, + "title" ##= title, + "tags" ##= tags, + "file" ##= htmlFile file, + "summary" ##= summary] -newtype BlogDate = BD Day deriving (Eq, Ord) -newtype RssDate = RD Day deriving (Eq, Ord) +htmlFile :: FilePath -> Text +htmlFile f = Text.pack $ Path.replaceExtension f "html" -instance YAML.FromYAML RssDate where - parseYAML = YAML.withStr "YYYY-MM-DD" $ - fmap RD . parseTimeM True defaultTimeLocale "%F" . Text.unpack +rssDate :: IsoDate -> Text +rssDate (ID d) = + Text.pack $ formatTime defaultTimeLocale "%a, %d %b %Y 00:00:01 UT" d -instance YAML.ToYAML RssDate where - toYAML (RD d) = YAML.str $ Text.pack $ - formatTime defaultTimeLocale "%a, %d %b %Y 00:00:01 UT" d - -instance YAML.FromYAML BlogDate where - parseYAML = fmap (\(RD d) -> BD d) . YAML.parseYAML - -instance YAML.ToYAML BlogDate where - toYAML (BD d) = YAML.str $ Text.pack $ map toLower $ - formatTime defaultTimeLocale "%a %-d %B %Y" d +showDate :: IsoDate -> Text +showDate (ID d) = + Text.pack $ toLower <$> formatTime defaultTimeLocale "%a %-d %B %Y" d