diff --git a/sampu.cabal b/sampu.cabal index a928257..d007206 100644 --- a/sampu.cabal +++ b/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 diff --git a/src/Core/Configuration.hs b/src/Core/Configuration.hs index 45b31d6..e73a516 100644 --- a/src/Core/Configuration.hs +++ b/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 diff --git a/src/Core/HTTP.hs b/src/Core/HTTP.hs index b3019b1..ca75bf4 100644 --- a/src/Core/HTTP.hs +++ b/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 diff --git a/src/Core/Handlers.hs b/src/Core/Handlers.hs index dc64d18..708ba5e 100644 --- a/src/Core/Handlers.hs +++ b/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 diff --git a/src/Fragments/Base.hs b/src/Fragments/Base.hs index 609134e..bf54273 100644 --- a/src/Fragments/Base.hs +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 2f79d93..3ed4d3c 100644 --- a/src/Main.hs +++ b/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