simplify date treatment

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,

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