Clarify IO usage via Applicative interface in Handlers, whitespace cleanup, remove dedicated source file for 404 view

README.md

@@ -1,6 +1,6 @@
 # the sampu Haskell blog engine
 
-https://eversole.co (not live yet!)
+https://eversole.co
 
 a _work-in-progress_ blog engine using simple flat-file Markdown content storage
 

sampu.cabal

@@ -1,6 +1,6 @@
 cabal-version:   3.0
 name:            sampu
-version:         0.9.1
+version:         0.9.2
 license:         ISC
 author:          James Eversole
 maintainer:      james@eversole.co
@@ -38,6 +38,5 @@ executable sampu
                         Core.HTTP
                         Core.Rendering
                         Fragments.Base
-                        Fragments.NotFound
                         Fragments.Styles
     default-language:   GHC2021

src/Core/Handlers.hs

@@ -4,7 +4,6 @@ import qualified Core.Configuration      as Conf
 import           Core.Feed                  (Post(..), autoFeed, renderFeed)
 import           Core.Rendering
 import           Fragments.Base
-import           Fragments.NotFound
 import           Fragments.Styles        as S
 
 import qualified Text.Atom.Feed          as Atom
@@ -23,12 +22,10 @@ import           Web.Twain           hiding (fileName)
 -- A ResponoderM capable of lifting to IO monad; constructs response to clients
 index :: ResponderM a
 index = do
-  -- Query the system environment for the BLOGTITLE environment variable
-  title    <- liftIO   Conf.title
-  -- Read a Commonmark Markdown file and process it to HTML
-  homeMd   <- liftIO $ mdFileToLucid "./data/posts/home.md"
-  -- Get the Footer content from Markdown
-  footerMd <- liftIO $ mdFileToLucid "./data/posts/footer.md"
+  (title, homeMd, footerMd) <- liftIO $ (,,)
+    <$> Conf.title
+    <*> mdFileToLucid "./data/posts/home.md"
+    <*> mdFileToLucid "./data/posts/footer.md"
   -- Respond to request with fragments compositionally to create a home page
   sendLucidFragment $ basePage title (baseHome homeMd) footerMd
 
@@ -40,9 +37,10 @@ posts = do
   case postValid of
     False  -> missing
     True   -> do
-      title    <- liftIO Conf.title
-      footerMd <- liftIO $ mdFileToLucid "./data/posts/footer.md"
-      postMd   <- liftIO $ mdFileToLucid $ postPath postName
+      (title, footerMd, postMd) <- liftIO $ (,,)
+        <$> Conf.title
+        <*> mdFileToLucid "./data/posts/footer.md"
+        <*> (mdFileToLucid $ postPath postName)
       sendLucidFragment $ basePage title (basePost postMd) footerMd
     where
       postExists :: T.Text -> IO Bool
@@ -54,19 +52,20 @@ posts = do
 -- Builds an index of all posts
 postsIndex :: ResponderM a
 postsIndex = do
-  postNames <- liftIO   mdPostNames
-  title     <- liftIO   Conf.title
-  footerMd  <- liftIO $ mdFileToLucid "./data/posts/footer.md"
+  (postNames, title, footerMd) <- liftIO $ (,,)
+    <$> mdPostNames
+    <*> Conf.title
+    <*> mdFileToLucid "./data/posts/footer.md"
   sendLucidFragment $ basePage title (postIndex postNames) footerMd
 
 -- Generates the XML feed at /feed
 feed :: ResponderM a
 feed = do
-  postNames <- liftIO   mdPostNames
-  title     <- liftIO   Conf.title
-  baseUrl   <- liftIO   Conf.baseUrl
-  time      <- liftIO $ fmap (\x -> timeFormat x) getCurrentTime
-  -- Create Atom [Post] to populate the feed
+  (postNames, title, baseUrl, time) <- liftIO $ (,,,)
+    <$> mdPostNames
+    <*> Conf.title
+    <*> Conf.baseUrl
+    <*> fmap (\x -> timeFormat x) getCurrentTime
   feedData <- liftIO $ mapM (makePost baseUrl) postNames
   -- Send an XML response with an automatically populated Atom feed
   send $ xml $ TLE.encodeUtf8 $ renderFeed
@@ -97,9 +96,10 @@ feed = do
 -- Refer to index comments
 contact :: ResponderM a
 contact = do
-  title     <- liftIO Conf.title
-  contactMd <- liftIO $ mdFileToLucid "./data/posts/contact.md"
-  footerMd  <- liftIO $ mdFileToLucid "./data/posts/footer.md"
+  (title, contactMd, footerMd) <- liftIO $ (,,)
+    <$> Conf.title
+    <*> mdFileToLucid "./data/posts/contact.md"
+    <*> mdFileToLucid "./data/posts/footer.md"
   sendLucidFragment   $ basePage title (baseContact contactMd) footerMd
 
 -- Respond with primary processed CSS

src/Fragments/Base.hs

@@ -44,5 +44,10 @@ postIndex postNames = div_ [class_ "postList"] $ do
       (\x -> li_ $ a_ [href_ (pack $ "/posts/" ++ x)] (fromString x))
       postNames
 
+pageNotFound :: Html ()
+pageNotFound = baseDoc "404" baseNav <>
+  (div_ [class_ "notFound"] $ h1_ "404 NOT FOUND")
+
 none :: Text
 none = mempty
+

src/Fragments/NotFound.hs

@@ -1,9 +0,0 @@
-module Fragments.NotFound where
-
-import Fragments.Base 
-
-import Lucid
-
-pageNotFound :: Html ()
-pageNotFound = baseDoc "404" baseNav <>
-  (div_ [class_ "notFound"] $ h1_ "404 NOT FOUND")