From f1cdddde91dce62819300ec34addde273aeb1264 Mon Sep 17 00:00:00 2001 From: jle Date: Thu, 28 Dec 2023 09:47:05 -0800 Subject: [PATCH] starting to remove time dep, removed 'now' --- src/Blog/App.hs | 15 +++++++++------ src/Blog/View/Feed.hs | 34 ++++++++++++++++++---------------- 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/src/Blog/App.hs b/src/Blog/App.hs index 2bff36640..8414e18fd 100644 --- 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 index 9d870c699..fe9d3813f 100644 --- 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/"]