Cleanup

sampu.cabal

@@ -1,6 +1,6 @@
 cabal-version:   3.0
 name:            sampu
-version:         0.1.0
+version:         0.2.0
 license:         ISC
 author:          James Eversole
 maintainer:      james@eversole.co

src/Core/Configuration.hs

@@ -5,7 +5,7 @@ import Configuration.Dotenv
 import System.Directory   (doesFileExist)
 import System.Environment (getEnv, lookupEnv)
 
--- Load environment variables from dotenv file if required
+-- Load environment variables from dotenv file if any are missing from ENV
 main :: IO ()
 main = do
   reqEnvLookup <- getRequiredEnv

src/Core/HTTP.hs

@@ -13,7 +13,7 @@ import           System.FilePath                      ( takeFileName )
 
 import           Web.Twain
 
--- Get the port to listen on from the ENV and start the webserver
+-- Get the port to listen on from the ENV and start the webserver.
 main :: [FilePath] -> IO ()
 main postNames = do
   port <- Conf.appPort
@@ -24,7 +24,7 @@ main postNames = do
   run (read port) $ 
     foldr ($) (notFound Handle.missing) app
 
--- These Middlewares are executed before any routes are reached
+-- These Middlewares are executed before any routes are reached.
 preProcessors :: [Middleware]
 preProcessors = [ logStdoutDev
                 , staticPolicy $ noDots >-> addBase "data/assets/public"
@@ -34,7 +34,9 @@ preProcessors = [ logStdoutDev
 postProcessors :: [Middleware]
 postProcessors = []
 
--- The application's core routes expressed as a list of WAI Middlewares
+{- The application's core routes expressed as a list of WAI Middlewares.
+   The list of post names is required so that the postsIndex handler can
+   automatically build an index of posts available to view. -}
 routes :: [FilePath] -> [Middleware]
 routes postNames =
   [ get "/"        Handle.index 

src/Core/Handlers.hs

@@ -9,23 +9,6 @@ import           Control.Monad.IO.Class (liftIO)
 import           Lucid                  (Html)
 import           Web.Twain
 
-index :: ResponderM a
-index = do 
-  title  <- liftIO Conf.appTitle
-  homeMd <- liftIO $ mdFileToLucid "./data/posts/home.md"
-  sendLucidFragment $ basePage title (baseHome homeMd)
-
-postsIndex :: [FilePath] -> ResponderM a
-postsIndex postNames = do
-  title <- liftIO Conf.appTitle
-  sendLucidFragment $ basePage title (postIndex postNames)
-
-posts :: FilePath -> ResponderM a 
-posts postName = do
-  title <- liftIO Conf.appTitle
-  postMd <- liftIO $ mdFileToLucid ("./data/posts/" ++ postName ++ ".md")
-  sendLucidFragment $ basePage title (basePost postMd)
-
 contact :: ResponderM a
 contact = do
   title <- liftIO Conf.appTitle
@@ -37,8 +20,26 @@ feed = do
   title <- liftIO Conf.appTitle
   sendLucidFragment $ basePage title baseFeed
   
+index :: ResponderM a
+index = do 
+  title  <- liftIO Conf.appTitle
+  homeMd <- liftIO $ mdFileToLucid "./data/posts/home.md"
+  sendLucidFragment $ basePage title (baseHome homeMd)
+
 missing :: ResponderM a
 missing = sendLucidFragment pageNotFound
 
+posts :: FilePath -> ResponderM a 
+posts postName = do
+  title <- liftIO Conf.appTitle
+  postMd <- liftIO $ mdFileToLucid ("./data/posts/" ++ postName ++ ".md")
+  sendLucidFragment $ basePage title (basePost postMd)
+
+postsIndex :: [FilePath] -> ResponderM a
+postsIndex postNames = do
+  title <- liftIO Conf.appTitle
+  sendLucidFragment $ basePage title (postIndex postNames)
+
+-- Helper function for responding in ResponderM from Html 
 sendLucidFragment :: Html () -> ResponderM a
 sendLucidFragment x = send $ html $ lucidToTwain x

src/Fragments/Base.hs

@@ -6,14 +6,25 @@ import Data.Text
 import Data.String    (fromString)
 import Lucid
 
+baseContact :: Html () -> Html ()
+baseContact content = div_ [class_ "main"] content
+
 baseDoc :: String -> Html () -> Html ()
 baseDoc title bodyContent = doctypehtml_ $ do
   head_ $ do
+    meta_ [ name_ "viewport", content_ "width=device-width, initial-scale=1.0" ]
     title_ $ fromString title
     link_ [rel_ "stylesheet", type_ "text/css", href_ "/style.css"]
-    -- script_ [src_ "/htmx.min.js"] none
   body_ bodyContent
 
+baseFeed :: Html ()
+baseFeed = div_ [class_ "main"] $ do
+  h2_ "Oops, I haven't been implemented yet." 
+  h3_ "Check back in a couple days!"
+
+baseHome :: Html () -> Html ()
+baseHome content = div_ [class_ "main"] content
+
 baseNav :: Html ()
 baseNav = div_ [class_ "navContainer"] $ do
   ul_ [class_ "mainNav"] $ do
@@ -25,9 +36,6 @@ baseNav = div_ [class_ "navContainer"] $ do
 basePage :: String -> Html () -> Html()
 basePage title body = baseDoc title $ baseNav <> body
 
-baseHome :: Html () -> Html ()
-baseHome content = div_ [class_ "main"] content
-
 basePost :: Html () -> Html ()
 basePost content = div_ [class_ "main"] content
 
@@ -39,13 +47,5 @@ postIndex postNames = div_ [class_ "main"] $ do
       (\x -> li_ $ a_ [href_ (pack $ "/posts/" ++ x)] (fromString x))
       postNames
 
-baseContact :: Html () -> Html ()
-baseContact content = div_ [class_ "main"] content
-
-baseFeed :: Html ()
-baseFeed = div_ [class_ "main"] $ do
-  h2_ "Oops, I haven't been implemented yet." 
-  h3_ "Check back in a couple days!"
-  
 none :: Text
 none = mempty

src/Main.hs

@@ -13,9 +13,11 @@ main :: IO ()
 main = do
   Conf.main 
   mdFilePaths <- getMdFilePaths "./data/posts/"
+  -- Pass only the post names extracted from their filepath to HTTP.main
   let mdFiles =  map (dropExtension . takeFileName) mdFilePaths
   HTTP.main mdFiles
 
+-- Return a list of all non-hidden .md files except for home.md and contact.md
 getMdFilePaths :: FilePath -> IO [FilePath]
 getMdFilePaths fp = find isVisible fileFilter fp
   where