rhi/blog
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

simplify date treatment

Browse source
This commit is contained in:
rhiannon morris 2024-09-16 17:02:09 +02:00
parent 8423cb575d
commit 465cd432c8
2 changed files with 35 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
blog-meta/blog-meta.cabal
View file

@ -12,6 +12,7 @@ common deps
OverloadedStrings, OverloadedStrings,
OverloadedLists, OverloadedLists,
NondecreasingIndentation, NondecreasingIndentation,
RecordWildCards,
ViewPatterns ViewPatterns
build-depends: build-depends:
base >= 4.14.2.0 && < 4.18, base >= 4.14.2.0 && < 4.18,

71
blog-meta/post-lists.hs
View file

@ -25,13 +25,13 @@ main = do
makeContent :: Text -> [PostInfo] -> LazyBS.ByteString makeContent :: Text -> [PostInfo] -> LazyBS.ByteString
makeContent title is' = "---\n" <> YAML.encode1 val <> "...\n" where 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)] val = YAML.obj [("title" ##= title), ("posts" ##= is)]
checkTag :: Maybe Text -> PostInfo -> Bool checkTag :: Maybe Text -> PostInfo -> Bool
checkTag Nothing _ = True checkTag Nothing _ = True
checkTag (Just t) i = t `elem` infoTags i checkTag (Just t) i = t `elem` tags i
data Options = data Options =
@ -63,6 +63,23 @@ defOpts [dir, title] =
defOpts _ = Nothing 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 :: FilePath -> FilePath -> IO PostInfo
getInfo dir file = do getInfo dir file = do
yaml <- YAML.readHeader file yaml <- YAML.readHeader file
@ -76,42 +93,22 @@ getInfo dir file = do
<*> m .: "tags" .!= [] <*> m .: "tags" .!= []
<*> m .:? "summary" <*> 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 instance YAML.ToYAML PostInfo where
toYAML (Info file title date tags summary) = YAML.obj toYAML (Info {..}) = YAML.obj
[("date" ##= date), ["date" ##= showDate date,
("date-rss" ##= toRss date), "date-rss" ##= rssDate date,
("title" ##= title), "title" ##= title,
("tags" ##= tags), "tags" ##= tags,
("file" ##= Text.pack (fixup file)), "file" ##= htmlFile file,
("summary" ##= summary)] "summary" ##= summary]
where
fixup f = Path.replaceExtension f "html"
toRss (BD d) = RD d
newtype BlogDate = BD Day deriving (Eq, Ord) htmlFile :: FilePath -> Text
newtype RssDate = RD Day deriving (Eq, Ord) htmlFile f = Text.pack $ Path.replaceExtension f "html"
instance YAML.FromYAML RssDate where rssDate :: IsoDate -> Text
parseYAML = YAML.withStr "YYYY-MM-DD" $ rssDate (ID d) =
fmap RD . parseTimeM True defaultTimeLocale "%F" . Text.unpack Text.pack $ formatTime defaultTimeLocale "%a, %d %b %Y 00:00:01 UT" d
instance YAML.ToYAML RssDate where showDate :: IsoDate -> Text
toYAML (RD d) = YAML.str $ Text.pack $ showDate (ID d) =
formatTime defaultTimeLocale "%a, %d %b %Y 00:00:01 UT" d Text.pack $ toLower <$> formatTime defaultTimeLocale "%a %-d %B %Y" 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