starting to remove time dep, removed 'now'

mstksg · Dec 28, 2023 · f1cdddd · f1cdddd
1 parent d2f1d9e
commit f1cdddd
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 22 deletions.
diff --git a/src/Blog/App.hs b/src/Blog/App.hs
@@ -39,6 +39,7 @@ import           System.FilePath
 import           Text.Jasmine
 import           Text.Read                 (readMaybe)
 import qualified Data.Map                  as M
+import qualified Data.List.NonEmpty        as NE
 import qualified Data.Text                 as T
 import qualified Data.Text.Lazy            as TL
 import qualified Data.Text.Lazy.Encoding   as TL
@@ -47,7 +48,7 @@ import qualified Data.Text.Lazy.Encoding   as TL
 app :: (?config :: Config)
     => ZonedTime
     -> Rules ()
-app znow@(ZonedTime _ tz) = do
+app (ZonedTime _ tz) = do
     match "static/**" $ do
       route   $ gsubRoute "static/" (const "")
       compile copyFileCompiler
@@ -237,11 +238,13 @@ app znow@(ZonedTime _ tz) = do
       rulesExtraDependencies [deps] $ do
         route   idRoute
         compile $ do
-          sorted <- traverse (`loadSnapshotBody` "entry")
-                  . take (fromIntegral (prefFeedEntries confBlogPrefs))
-                  . reverse
-                  $ entriesSorted
-          makeItem . TL.unpack $ viewFeed sorted tz (zonedTimeToUTC znow)
+          Just sorted
+            <- fmap NE.nonEmpty
+             . traverse (`loadSnapshotBody` "entry")
+             . take (fromIntegral (prefFeedEntries confBlogPrefs))
+             . reverse
+             $ entriesSorted
+          makeItem . TL.unpack $ viewFeed sorted tz
 
     create ["rss"] $ do
       route   idRoute

diff --git a/src/Blog/View/Feed.hs b/src/Blog/View/Feed.hs
@@ -12,20 +12,21 @@ import           Data.Time.Clock
 import           Data.Time.Format
 import           Data.Time.LocalTime
 import           Text.DublinCore.Types
+import Data.Foldable (toList)
 import           Text.RSS.Export
 import           Text.RSS.Syntax
 import qualified Data.Text             as T
 import qualified Data.Text.Lazy        as TL
 import qualified Data.XML.Types        as XT
 import qualified Text.XML              as X
+import Data.List.NonEmpty (NonEmpty)
 
 viewFeed
     :: (?config :: Config)
-    => [Entry]
+    => NonEmpty Entry
     -> TimeZone
-    -> UTCTime
     -> TL.Text
-viewFeed entries tz now = renderElement . xmlRSS $ feedRss entries tz now
+viewFeed entries tz = renderElement . xmlRSS $ feedRss entries tz
 
 renderElement :: XT.Element -> TL.Text
 renderElement e = X.renderText def $
@@ -35,16 +36,18 @@ renderElement e = X.renderText def $
 
 feedRss
     :: (?config :: Config)
-    => [Entry]
+    => NonEmpty Entry
     -> TimeZone
-    -> UTCTime
     -> RSS
-feedRss entries tz now = (nullRSS feedTitle feedLink)
+feedRss entries tz = (nullRSS feedTitle feedLink)
     { rssChannel = channel
     , rssAttrs   = [dcSpec]
     }
   where
     Config{..} = ?config
+    now = case maximum $ entryPostTime <$> entries of
+      Nothing -> error "No posted entries"
+      Just t -> t
     channel = (nullChannel feedTitle feedLink)
       { rssDescription   = feedDescription
       , rssLanguage      = Just "en"
@@ -54,7 +57,7 @@ feedRss entries tz now = (nullRSS feedTitle feedLink)
       , rssLastUpdate    = Just (formatDateRfc now)
       -- , rssCategories =
       , rssGenerator     = Just "feed-1.0.0.0 (Sigbjorn Finne)"
-      , rssItems         = map rssItem entries
+      , rssItems         = map rssItem (toList entries)
       , rssChannelOther  = map dcItemToXml dcData
       , rssImage         = Just siteLogo
       }
@@ -66,10 +69,10 @@ feedRss entries tz now = (nullRSS feedTitle feedLink)
       , DCItem DC_Description feedDescription
       ]
     makeUrl          = renderUrl
-    formatDateRfc    :: UTCTime -> T.Text
-    formatDateRfc    = T.pack . formatTime defaultTimeLocale rfc822DateFormat
-    formatDateIso    :: UTCTime -> T.Text
-    formatDateIso    = T.pack . formatTime defaultTimeLocale (iso8601DateFormat Nothing)
+    formatDateRfc    :: LocalTime -> T.Text
+    formatDateRfc    = T.pack . formatTime defaultTimeLocale rfc822DateFormat . localTimeToUTC tz
+    formatDateIso    :: LocalTime -> T.Text
+    formatDateIso    = T.pack . formatTime defaultTimeLocale (iso8601DateFormat Nothing) . localTimeToUTC tz
     feedTitle        = confTitle <> " — Entries"
     feedLink         = makeUrl "/"
     feedDescription  = confDesc
@@ -85,20 +88,19 @@ feedRss entries tz now = (nullRSS feedTitle feedLink)
         , rssItemCategories  = map rssCategory categs
         , rssItemGuid        = Just . RSSGuid (Just True) []
                                  $ makeUrl (T.pack entryCanonical)
-        , rssItemPubDate     = formatDateRfc . localTimeToUTC tz <$> entryPostTime
+        , rssItemPubDate     = formatDateRfc <$> entryPostTime
         , rssItemOther       = map dcItemToXml dcItemData
         }
       where
         categs = flip mapMaybe entryTags $ \(tt,t) ->
                    case tt of
                      CategoryTag -> Just t
-                     _           -> Nothing
+                     SeriesTag   -> Nothing
+                     GeneralTag  -> Nothing
         dcItemData =
           [ DCItem DC_Creator feedAuthorName
           , DCItem DC_Subject (T.intercalate ", " categs)
-          ] ++ maybeToList ( DCItem DC_Date . formatDateIso . localTimeToUTC tz
-                         <$> entryPostTime
-                           )
+          ] ++ maybeToList ( DCItem DC_Date . formatDateIso <$> entryPostTime )
     rssCategory = RSSCategory Nothing []
     dcSpec = ( X.Name "dc" Nothing (Just "xmlns")
              , [XT.ContentText "http://purl.org/dc/elements/1.1/"]