Automatic creation of 'All Posts' post index based on existing MD files at application init

.gitignore

@@ -5,8 +5,7 @@
 Dockerfile
 WD
 bin/
-data/posts
+data/posts/*.md
-data/base
 dist*
 docker-stack.yml
 result

README.md

@@ -15,12 +15,10 @@ Therefore, `la sampu cu sampu lo ka samtci`!
 - [Haskell](https://www.haskell.org)
 - [Twain](https://github.com/alexmingoia/twain)
 - [Lucid2](https://chrisdone.com/posts/lucid2)
-- [HTMX](https://htmx.org/)
 
 ## Goal
 
-Provide a simple blog engine that is easily customizable via HTML fragments
+Provide a simple blog engine that is easily customizable via HTML fragments.
-and straightforward HTMX integration for dynamic server-driven content.
 
 ## Deployment
 

data/assets/public/style.css

@@ -1,21 +1,32 @@
 html{font-family:Monospace;background-color:#f1f6f0;color:#222323}
-body{margin:1% 2% ;font-size:20px;font-weight:300;text-align:left}
 a{text-decoration:none}
 h2{text-transform:uppercase}
 h3{margin:0.25em 0 0.25em 0}
 p{margin:0.4em 0 0.4em 0}
 a{color:#6D92AD}
-.main{margin:1em auto;max-width:75%}
+
-.htmx-indicator{display:none}::placeholder{color:#222323;opacity:1}
+body {
-.logo{margin:4% 3% 0 0;font-size:1.2vw;color:#435F5D;text-align:center}
+  margin: 1% 2%;
+  font-size: 1.25em;
+  font-weight: 300;
+  text-align: left
+}
+
+body li {
+  list-style-type: "~> ";
+}
+
+.main {
+  margin: 1em auto;
+  max-width: 60%;
+}
 
 .navContainer {
   width: 100%;
   text-align: center;
 }
 
-.mainNav{
+.mainNav {
-  list-style-type: none;
   margin: 0 auto;
   padding: 0;
   overflow: hidden;
@@ -23,6 +34,10 @@ a{color:#6D92AD}
   display: inline-flex;
 }
 
+.mainNav li {
+  list-style-type: none;
+}
+
 .mainNav li a {
   display: block;
   text-align: center;
@@ -38,5 +53,9 @@ a{color:#6D92AD}
 .notFound h1 {
   font-size: 500%;
   font-weight: 200;
-  color:#6D92AD}
+  color:#6D92AD
+}
+
+.postList {
+  font-size: 1.5em;
 }

data/posts/contact.md.example

@@ -0,0 +1,3 @@
+# Contact Me
+
+You can reach me at [YOUREMAIL@EXAMPLE.LOCAL](mailto:YOUREMAIL@EXAMPLE.LOCAL)

data/posts/home.md.example

@@ -0,0 +1,5 @@
+# Your Name Here
+
+### A blog about YOUR_INTERESTS_HERE
+
+I really love to blog about _____, _____, and _____!

src/Core/HTTP.hs

@@ -15,16 +15,14 @@ import           Web.Twain
 
 -- Get the port to listen on from the ENV and start the webserver
 main :: [FilePath] -> IO ()
-main mdFiles = do
+main postNames = do
   port <- Conf.appPort
-  run (read port :: Int) $
+  let app = preProcessors 
-    foldr ($) (notFound Handle.missing) (app mdFiles)
+            ++ (routes postNames)
-  where
+            ++ (buildMdRoutes postNames)
-    app mdFiles = preProcessors 
+            ++ postProcessors
-       ++ routes 
+  run (read port) $ 
-       ++ (map mdFileToRoute mdFiles)
+    foldr ($) (notFound Handle.missing) app
-       ++ postProcessors
-    
 
 -- These Middlewares are executed before any routes are reached
 preProcessors :: [Middleware]
@@ -37,9 +35,17 @@ postProcessors :: [Middleware]
 postProcessors = []
 
 -- The application's core routes expressed as a list of WAI Middlewares
-routes :: [Middleware]
+routes :: [FilePath] -> [Middleware]
-routes =
+routes postNames =
-  [ get "/" Handle.index ]
+  [ get "/"        Handle.index 
+  , get "/posts" $ Handle.postsIndex postNames
+  , get "/contact" Handle.contact
+  , get "/feed"    Handle.feed
+  ]
 
+-- Takes a post's name extracted from the filepath and returns a valid route
 mdFileToRoute :: FilePath -> Middleware
-mdFileToRoute fp = get (fromString $ "/posts/" ++ fp) (Handle.posts fp)
+mdFileToRoute postName = get (fromString $ "/posts/" ++ postName) (Handle.posts postName)
+
+buildMdRoutes :: [FilePath] -> [Middleware]
+buildMdRoutes postNames = map mdFileToRoute postNames

src/Core/Handlers.hs

@@ -11,24 +11,31 @@ import           Web.Twain
 
 index :: ResponderM a
 index = do 
-  -- Probably going to want to add ReaderT to the stack for this instead
   title  <- liftIO Conf.appTitle
-  -- Probably going to want to do this file reading and processing at app init
+  homeMd <- liftIO $ mdFileToLucid "./data/posts/home.md"
-  homeMd <- liftIO $ mdFileToLucid "./data/base/home.md"
+  sendLucidFragment $ basePage title (baseHome homeMd)
-  sendLucidFragment 
+
-    $ baseDoc title 
+postsIndex :: [FilePath] -> ResponderM a
-    $ baseNav 
+postsIndex postNames = do
-   <> baseHome homeMd
+  title <- liftIO Conf.appTitle
+  sendLucidFragment $ basePage title (postIndex postNames)
 
 posts :: FilePath -> ResponderM a 
-posts fp = do
+posts postName = do
   title <- liftIO Conf.appTitle
-  postMd <- liftIO $ mdFileToLucid 
+  postMd <- liftIO $ mdFileToLucid ("./data/posts/" ++ postName ++ ".md")
-                   $ "./data/posts/" ++ fp ++ ".md"
+  sendLucidFragment $ basePage title (basePost postMd)
-  sendLucidFragment
+
-    $ baseDoc title
+contact :: ResponderM a
-    $ baseNav
+contact = do
-    <> postMd
+  title <- liftIO Conf.appTitle
+  contactMd <- liftIO $ mdFileToLucid "./data/posts/contact.md"
+  sendLucidFragment $ basePage title (baseContact contactMd)
+
+feed :: ResponderM a
+feed = do
+  title <- liftIO Conf.appTitle
+  sendLucidFragment $ basePage title baseFeed
   
 missing :: ResponderM a
 missing = sendLucidFragment pageNotFound

src/Fragments/Base.hs

@@ -22,8 +22,30 @@ baseNav = div_ [class_ "navContainer"] $ do
     li_ $ a_ [href_ "/contact"] "Contact"
     li_ $ a_ [href_ "/feed"]    "Feed"
 
+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
+
+postIndex :: [FilePath] -> Html ()
+postIndex postNames = div_ [class_ "main"] $ do
+  h1_ [class_ "title"] "All Posts"
+  ul_ [class_ "postList"] $ do
+    mapM_
+      (\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

@@ -17,7 +17,10 @@ main = do
   HTTP.main mdFiles
 
 getMdFilePaths :: FilePath -> IO [FilePath]
-getMdFilePaths fp = find isVisible (isMdFile &&? isVisible) fp
+getMdFilePaths fp = find isVisible fileFilter fp
   where
     isMdFile  = extension ==? ".md"
     isVisible = fileName  /~? ".?*"
+    isHome = fileName  /~? "home.md"
+    isContact = fileName  /~? "contact.md"
+    fileFilter = isMdFile &&? isVisible &&? isHome &&? isContact