remove IO current time dependence and so now derivation is pure

mstksg · Dec 29, 2023 · f68adef · f68adef
1 parent f1cdddd
commit f68adef
Show file tree

Hide file tree

Showing 10 changed files with 24 additions and 15 deletions.
diff --git a/app/site.hs b/app/site.hs
@@ -6,10 +6,10 @@
 
 import           Blog.App
 import           Blog.Types
-import           Data.Time.LocalTime
 import           Dhall
 import           Dhall.Pretty
 import           Hakyll
+import Data.Time.Zones
 import           System.IO
 import qualified Data.Text                     as T
 import qualified Prettyprinter                 as PP
@@ -20,8 +20,6 @@ configPath = "./config/site-data.dhall"
 
 main :: IO ()
 main = do
-    znow <- getZonedTime
-
     c <- input interpretConfig configPath
     let ?config = c
 
@@ -33,4 +31,5 @@ main = do
 
     putStrLn ""
 
-    hakyllWith (defaultConfiguration { inMemoryCache = False}) $ app znow
+    tz <- loadTZFromDB (T.unpack $ confEntryTZ ?config)
+    hakyllWith (defaultConfiguration { inMemoryCache = False}) $ app tz
diff --git a/config/site-data.dhall b/config/site-data.dhall
@@ -6,6 +6,7 @@
     ''
 , authorInfo =
     ./site-data/author-info.dhall
+, entryTZ = "America/Los_Angeles"
 , copyright =
     "2020 Justin Le"
 , license =

diff --git a/flake.nix b/flake.nix
@@ -38,7 +38,6 @@
           purescript = pkgs.purifix { src = ./purescript; };
           haskell = haskellFlake.packages."inCode:exe:inCode-build";
           web = pkgs.stdenv.mkDerivation {
-            impure = true;
             name = "inCode";
             buildInputs = [ haskell ] ++ lib.attrValues purescript;
             srcs = [

diff --git a/inCode.cabal b/inCode.cabal
@@ -72,6 +72,7 @@ library
     , text
     , time
     , transformers
+    , tz
     , xml-conduit
     , xml-types
     , yaml
@@ -85,20 +86,21 @@ executable inCode-build
   build-depends:
       aeson
     , base ==4.*
-    , inCode
     , bytestring
     , containers
     , data-default
     , dhall
     , filepath
     , hakyll >=4.8
+    , inCode
     , lens
     , pandoc
     , prettyprinter
     , prettyprinter-ansi-terminal
     , text
     , time
     , transformers
+    , tz
     , yaml
   default-language: Haskell2010
 

diff --git a/src/Blog/App.hs b/src/Blog/App.hs
@@ -43,12 +43,13 @@ 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
+import Data.Time.Zones
 
 
 app :: (?config :: Config)
-    => ZonedTime
+    => TZ
     -> Rules ()
-app (ZonedTime _ tz) = do
+app tz = do
     match "static/**" $ do
       route   $ gsubRoute "static/" (const "")
       compile copyFileCompiler

diff --git a/src/Blog/Types.hs b/src/Blog/Types.hs
@@ -29,6 +29,7 @@ data Config = Config
     { confTitle         :: !T.Text
     , confDesc          :: !T.Text
     , confAuthorInfo    :: !AuthorInfo
+    , confEntryTZ       :: !T.Text  -- ^ ie: America/Los_Angeles
     , confCopyright     :: !T.Text
     , confLicense       :: !T.Text
     , confLicenseLink   :: !T.Text

diff --git a/src/Blog/Util/Tag.hs b/src/Blog/Util/Tag.hs
@@ -12,7 +12,7 @@ import           Control.Monad
 import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.Maybe
 import           Data.Char
-import           Data.List
+import           Data.List (sortBy)
 import           Data.Maybe
 import           Data.Ord
 import           Data.String

diff --git a/src/Blog/View.hs b/src/Blog/View.hs
@@ -7,7 +7,7 @@ module Blog.View where
 import           Blog.Types
 import           Blog.Util
 import           Data.Foldable
-import           Data.List
+import           Data.List (intersperse)
 import           Data.Maybe
 import           Text.Blaze.Html5            ((!))
 import qualified Data.Text                   as T

diff --git a/src/Blog/View/Archive.hs b/src/Blog/View/Archive.hs
@@ -11,7 +11,7 @@ import           Blog.Util.Tag
 import           Blog.View
 import           Control.Monad
 import           Data.Foldable
-import           Data.List
+import           Data.List (intersperse)
 import           Data.String
 import           Data.Time.LocalTime
 import           System.FilePath

diff --git a/src/Blog/View/Feed.hs b/src/Blog/View/Feed.hs
@@ -10,10 +10,12 @@ import           Data.Default
 import           Data.Maybe
 import           Data.Time.Clock
 import           Data.Time.Format
+import qualified Data.Time.Format.ISO8601 as ISO8601
 import           Data.Time.LocalTime
 import           Text.DublinCore.Types
 import Data.Foldable (toList)
 import           Text.RSS.Export
+import Data.Time.Zones
 import           Text.RSS.Syntax
 import qualified Data.Text             as T
 import qualified Data.Text.Lazy        as TL
@@ -24,7 +26,7 @@ import Data.List.NonEmpty (NonEmpty)
 viewFeed
     :: (?config :: Config)
     => NonEmpty Entry
-    -> TimeZone
+    -> TZ
     -> TL.Text
 viewFeed entries tz = renderElement . xmlRSS $ feedRss entries tz
 
@@ -37,7 +39,7 @@ renderElement e = X.renderText def $
 feedRss
     :: (?config :: Config)
     => NonEmpty Entry
-    -> TimeZone
+    -> TZ
     -> RSS
 feedRss entries tz = (nullRSS feedTitle feedLink)
     { rssChannel = channel
@@ -70,9 +72,13 @@ feedRss entries tz = (nullRSS feedTitle feedLink)
       ]
     makeUrl          = renderUrl
     formatDateRfc    :: LocalTime -> T.Text
-    formatDateRfc    = T.pack . formatTime defaultTimeLocale rfc822DateFormat . localTimeToUTC tz
+    formatDateRfc    = T.pack . formatTime defaultTimeLocale rfc822DateFormat
+                     . localTimeToUTCTZ tz
     formatDateIso    :: LocalTime -> T.Text
-    formatDateIso    = T.pack . formatTime defaultTimeLocale (iso8601DateFormat Nothing) . localTimeToUTC tz
+    formatDateIso    = T.pack
+                     . ISO8601.iso8601Show
+                     . utctDay
+                     . localTimeToUTCTZ tz
     feedTitle        = confTitle <> " — Entries"
     feedLink         = makeUrl "/"
     feedDescription  = confDesc