Update feed handler to respond with atom+xml Content-Type; nix flake update

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
 
@@ -14,18 +14,46 @@ 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)
+- [Lucid](https://github.com/chrisdone/lucid)
+- [Clay](https://github.com/sebastiaanvisser/clay)
 
 ## Goal
 
 Provide a simple blog engine that is easily customizable via HTML fragments.
 
-## Deployment
+## Build and Deployment
 
-We're not there yet! This project is built and packaged with Nix,
+Only Nix build instructions are provided below.
-so I will provide directions on deploying with Nix as well as via OCI 
-containers once there's something viable to run.
 
+### No Containers
+1) Clone this repository
+2) Build the application (with flakes enabled): `nix build '.#'`
+3) Set the environment variables
+    - File: `cp data/.env.example ./.env; $EDITOR ./.env`
+    - If you want to set them in a different way, you already know how.
+4) Run the application: `./result/bin/sampu`
+
+### Containers
+
+1) Clone this repository
+2) Build the container image (with flakes enabled): `nix build .#sampu-container`
+3) Load the container image: `podman load -i result`
+4) Run the container using your favorite orchestrator or...
+5) Use a NixOS configuration:
+```
+virtualisation.oci-containers.containers.sampu = {
+  image = "sampu";
+  ports = [ "${SAMPUR_EXTERNAL_PORT}:3000" ];
+  volumes = [
+    "/PATH/TO/SAMPU/data:/app/data"
+  ];
+  environment = {
+    SAMPU_PORT = "3000";
+    SAMPU_TITLE = "Your Blog Title Here!";
+    SAMPU_BASEURL = "http://example.public.tld"; 
+  };
+};
+```
 ## Development and Support
 
 Per the permissive ISC license, you are free to do what you wish with this 

data/.env.example

@@ -1,2 +1,3 @@
-APPLICATIONPORT="3000"
+SAMPU_PORT="3000"
-BLOGTITLE="Anon's Blog"
+SAMPU_TITLE="Anon's Blog"
+SAMPU_BASEURL="http://localhost:3000"

data/assets/public/style.css

@@ -1,61 +0,0 @@
-html{font-family:Monospace;background-color:#f1f6f0;color:#222323}
-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}
-
-body {
-  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 {
-  margin: 0 auto;
-  padding: 0;
-  overflow: hidden;
-  box-shadow: 4px 4px 6px #ccc;
-  display: inline-flex;
-}
-
-.mainNav li {
-  list-style-type: none;
-}
-
-.mainNav li a {
-  display: block;
-  text-align: center;
-  padding: 0.25em 0.3em;
-  text-transform: lowercase;
-}
-
-.notFound {
-  margin: 0 auto;
-  text-align: center;
-}
-
-.notFound h1 {
-  font-size: 500%;
-  font-weight: 200;
-  color:#6D92AD
-}
-
-.postList {
-  font-size: 1.5em;
-}

data/posts/footer.md.example

@@ -0,0 +1 @@
+Copyright [Your Name](youremail@address.local)

flake.lock

@@ -2,11 +2,11 @@
   "nodes": {
     "haskell-flake": {
       "locked": {
-        "lastModified": 1707835791,
+        "lastModified": 1728845985,
-        "narHash": "sha256-oQbDPHtver9DO8IJCBMq/TVbscCkxuw9tIfBBti71Yk=",
+        "narHash": "sha256-0KkAWCRBNpno3f+E1rvV9TOr0iuweqncWGn1KtbrGmo=",
         "owner": "srid",
         "repo": "haskell-flake",
-        "rev": "5113f700d6e92199fbe0574f7d12c775bb169702",
+        "rev": "2393b55948866f39afcfa7d8a53893a096bcd284",
         "type": "github"
       },
       "original": {
@@ -33,20 +33,14 @@
     },
     "nixpkgs-lib": {
       "locked": {
-        "dir": "lib",
+        "lastModified": 1727825735,
-        "lastModified": 1706550542,
+        "narHash": "sha256-0xHYkMkeLVQAMa7gvkddbPqpxph+hDzdu1XdGPJR+Os=",
-        "narHash": "sha256-UcsnCG6wx++23yeER4Hg18CXWbgNpqNXcHIo5/1Y+hc=",
+        "type": "tarball",
-        "owner": "NixOS",
+        "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
-        "repo": "nixpkgs",
-        "rev": "97b17f32362e475016f942bbdfda4a4a72a8a652",
-        "type": "github"
       },
       "original": {
-        "dir": "lib",
+        "type": "tarball",
-        "owner": "NixOS",
+        "url": "https://github.com/NixOS/nixpkgs/archive/fb192fec7cc7a4c26d51779e9bab07ce6fa5597a.tar.gz"
-        "ref": "nixos-unstable",
-        "repo": "nixpkgs",
-        "type": "github"
       }
     },
     "parts": {
@@ -54,11 +48,11 @@
         "nixpkgs-lib": "nixpkgs-lib"
       },
       "locked": {
-        "lastModified": 1706830856,
+        "lastModified": 1727826117,
-        "narHash": "sha256-a0NYyp+h9hlb7ddVz4LUn1vT/PLwqfrWYcHMvFB1xYg=",
+        "narHash": "sha256-K5ZLCyfO/Zj9mPFldf3iwS6oZStJcU4tSpiXTMYaaL0=",
         "owner": "hercules-ci",
         "repo": "flake-parts",
-        "rev": "b253292d9c0a5ead9bc98c4e9a26c6312e27d69f",
+        "rev": "3d04084d54bedc3d6b8b736c70ef449225c361b1",
         "type": "github"
       },
       "original": {

sampu.cabal

@@ -1,6 +1,6 @@
 cabal-version:   3.0
 name:            sampu
-version:         0.3.0
+version:         0.10.0
 license:         ISC
 author:          James Eversole
 maintainer:      james@eversole.co
@@ -16,12 +16,14 @@ executable sampu
     ghc-options:        -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
     build-depends:      base
                       , bytestring            >= 0.11.5.0
+                      , clay                  >= 0.14.0
                       , commonmark            >= 0.2.4
                       , directory             >= 1.3.7.0
                       , dotenv                >= 0.11.0.0
                       , feed                  >= 1.3.2.0
                       , filemanip             >= 0.3.6.1
                       , filepath              >= 1.4.2.2
+                      , http-types
                       , lucid                 >= 2.11.0
                       , text                  >= 2.0
                       , time                  >= 1.12.0
@@ -37,5 +39,5 @@ executable sampu
                         Core.HTTP
                         Core.Rendering
                         Fragments.Base
-                        Fragments.NotFound
+                        Fragments.Styles
     default-language:   GHC2021

src/Core/Configuration.hs

@@ -35,11 +35,17 @@ main = do
       ++ "All required environment variables:\n"
       ++  unlines required
 
-appPort :: IO String
+-- The port to run the web server on
-appPort = getEnv "APPLICATIONPORT"
+port :: IO String
+port = getEnv "SAMPU_PORT"
 
-appTitle :: IO String
+-- The site's title; used for HTML title and XML feed title
-appTitle = getEnv "BLOGTITLE"
+title :: IO String
+title = getEnv "SAMPU_TITLE"
+
+-- The site's public-facing base url with no trailing slash
+baseUrl :: IO String
+baseUrl = getEnv "SAMPU_BASEURL"
 
 requiredEnvVars :: [String]
-requiredEnvVars = [ "APPLICATIONPORT", "BLOGTITLE" ]
+requiredEnvVars = [ "SAMPU_PORT", "SAMPU_TITLE", "SAMPU_BASEURL" ]

src/Core/Feed.hs

@@ -11,6 +11,7 @@ import           Text.XML (def, rsPretty)
 
 data Post = Post { _date     :: Text
                  , _url      :: Text
+                 , _title    :: Text
                  , _content  :: Text
                  }
 
@@ -24,4 +25,7 @@ renderFeed = fromJust . Export.textFeedWith def{rsPretty = True} . AtomFeed
 
 -- Convert a Post to an Atom Entry
 toEntry :: Post -> Atom.Entry
-toEntry (Post date url content) = (Atom.nullEntry url (Atom.TextString content) date)
+toEntry (Post date url title content) = (Atom.nullEntry url (Atom.TextString title) date)
+  { Atom.entryLinks = [Atom.nullLink url]
+  , Atom.entryContent = Just (Atom.HTMLContent content)
+  }

src/Core/HTTP.hs

@@ -6,48 +6,41 @@ import qualified Core.Handlers                        as Handle
 import           Control.Monad                        ( mapM_ )
 import           Data.String                          ( fromString )
 import           Network.Wai.Handler.Warp             ( Port, run )
-import           Network.Wai.Middleware.RequestLogger ( logStdoutDev )
+import           Network.Wai.Middleware.RequestLogger ( logStdout, logStdoutDev )
-import           Network.Wai.Middleware.Static
+import           Network.Wai.Middleware.Static        ( staticPolicy, noDots, addBase, (>->) )
 import           System.FilePath                      ( takeFileName )
 
 
 import           Web.Twain
 
 -- Get the port to listen on from the ENV and start the webserver.
-main :: [FilePath] -> IO ()
+main :: IO ()
-main postNames = do
+main = do
-  port <- Conf.appPort
+  port <- Conf.port
-  let app = preProcessors 
+  let app = preProcessors
-         ++ (routes postNames)
+         ++ routes
          ++ postProcessors
-  run (read port) $ 
+  run (read port) $
     foldr ($) (notFound Handle.missing) app
 
 -- These Middlewares are executed before any routes are reached.
 preProcessors :: [Middleware]
-preProcessors = [ logStdoutDev
+preProcessors  = [ logStdoutDev
-                , staticPolicy $ noDots >-> addBase "data/assets/public"
+                 , staticPolicy (noDots >-> addBase "data/assets/public")
-                ]
+                 ]
 
 -- These Middlewares are executed after all other routes are exhausted
 postProcessors :: [Middleware]
-postProcessors = []
+postProcessors  = []
 
-{- The application's core routes expressed as a list of WAI Middlewares.
+-- Core routes expressed as a list of WAI Middlewares.
-   The list of post names is required so that the postsIndex handler can
+routes :: [Middleware]
-   automatically build an index of posts available to view. -}
+routes =
-routes :: [FilePath] -> [Middleware]
+  [ get "/"            Handle.index
-routes postNames  =
+  , get "/style.css"   Handle.theme
-  [ get "/"         Handle.index 
+  , get "/posts"       Handle.postsIndex
-  , get "/posts"  $ Handle.postsIndex postNames
+  , get "/posts/:name" Handle.posts
-  ] ++ (buildMdRoutes postNames) ++ 
+  , get "/contact"     Handle.contact
-  [ get "/contact"  Handle.contact
+  , get "/atom.xml"    Handle.feed
-  , get "/feed"   $ Handle.feed postNames
+  , get "/feed"        Handle.feed
   ]
-
--- Takes a post's name extracted from the filepath and returns a valid route
-mdFileToRoute :: FilePath -> Middleware
-mdFileToRoute postName = get (fromString $ "/posts/" ++ postName) (Handle.posts postName)
-
-buildMdRoutes :: [FilePath] -> [Middleware]
-buildMdRoutes postNames = map mdFileToRoute postNames

src/Core/Handlers.hs

@@ -1,87 +1,139 @@
 module Core.Handlers where
 
 import qualified Core.Configuration      as Conf
-import           Core.Rendering 
+import           Core.Feed                  (Post(..), autoFeed, renderFeed)
-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
-import           Control.Monad.IO.Class  (liftIO)
+import           Control.Monad.IO.Class     (liftIO)
-import           Data.Text
+import           Data.ByteString.Lazy       (ByteString)
-import qualified Data.Text.Lazy.Encoding as LTE
+import qualified Data.Text               as T
-import           Data.Time.Clock         (UTCTime(..), getCurrentTime)
+import qualified Data.Text.Lazy.Encoding as TLE
-import           Data.Time.Format        (formatTime, defaultTimeLocale)
+import           Data.Time.Clock            (UTCTime(..), getCurrentTime)
-import           Lucid                   (Html)
+import           Data.Time.Format           (formatTime, defaultTimeLocale)
-import           System.Directory        (getModificationTime)
+import           Lucid                      (Html)
-import           Web.Twain
+import           Network.HTTP.Types         (status200, hContentType)
+import           System.Directory           (doesFileExist, getModificationTime)
+import           System.FilePath.Find       ( always, extension, fileName, find, (&&?)
+                                            , (/~?), (==?) )
+import           System.FilePath            ( dropExtension, takeFileName )
+import           Web.Twain           hiding (fileName)
 
 -- A ResponoderM capable of lifting to IO monad; constructs response to clients
 index :: ResponderM a
-index = do 
+index = do
-  -- Query the system environment for the BLOGTITLE environment variable
+  (title, homeMd, footerMd) <- liftIO $ (,,)
-  title  <- liftIO Conf.appTitle
+    <$> Conf.title
-  -- Read a Commonmark Markdown file and process it to HTML
+    <*> mdFileToLucid "./data/posts/home.md"
-  homeMd <- liftIO  $ 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)
+  sendLucidFragment $ basePage title (baseHome homeMd) footerMd
 
--- Responds with processed Commonmark -> HTML for posts existing at app init
+-- Responds with processed Commonmark -> HTML for posts
-posts :: FilePath -> ResponderM a 
+posts :: ResponderM a
-posts postName = do
+posts = do
-  title  <- liftIO Conf.appTitle
+  postName  <- param "name"
-  postMd <- liftIO  $ mdFileToLucid ("./data/posts/" ++ postName ++ ".md")
+  postValid <- liftIO $ postExists postName
-  sendLucidFragment $ basePage title (basePost postMd)
+  case postValid of
+    False  -> missing
+    True   -> do
+      (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
+      postExists postName = doesFileExist $ postPath postName
 
--- Builds an index of all posts on filesystem as of application init
+      postPath :: T.Text -> FilePath
-postsIndex :: [FilePath] -> ResponderM a
+      postPath postName = "./data/posts/" ++ T.unpack postName ++ ".md"
-postsIndex postNames = do
+
-  title <- liftIO Conf.appTitle
+-- Builds an index of all posts
-  sendLucidFragment $ basePage title (postIndex postNames)
+postsIndex :: ResponderM a
+postsIndex = do
+  (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 :: [FilePath] -> ResponderM a
+feed :: ResponderM a
-feed postNames = do
+feed = do
-  title     <- liftIO   Conf.appTitle
+  (postNames, title, baseUrl, time) <- liftIO $ (,,,)
-  time      <- liftIO $ fmap (\x -> timeFormat x) getCurrentTime
+    <$> mdPostNames
-  -- Create Atom [Post] to populate the feed
+    <*> Conf.title
-  feedData  <- liftIO $ mapM makePost postNames
+    <*> 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 $ LTE.encodeUtf8 $ renderFeed 
+  send $ atom 
-       $ autoFeed (baseFeed title time) feedData
+       $ TLE.encodeUtf8 
+       $ renderFeed
+       $ autoFeed (baseFeed title time baseUrl) feedData
     where
+      -- Atom feed response headers
+      atom :: ByteString -> Response
+      atom f = withHeader (hContentType, "application/atom+xml") $ raw status200 [] $ f
+
       -- Base feed data structure which we populate with entries
-      baseFeed :: String -> String -> Atom.Feed
+      baseFeed :: String -> String -> String -> Atom.Feed
-      baseFeed title time = Atom.nullFeed
+      baseFeed title time baseUrl = Atom.nullFeed
-        "https://eversole.co/feed"
+        (T.pack $ baseUrl ++ "/feed")
-        (Atom.TextString $ pack title)
+        (Atom.TextString $ T.pack title)
-        (pack $ time ++ " UTC")
+        (T.pack $ time ++ " UTC")
 
       -- Create an Atom Post for each markdown post present
-      makePost :: FilePath -> IO (Post)
+      makePost :: String -> FilePath -> IO (Post)
-      makePost x = do 
+      makePost baseUrl postName = do
-        date   <- getModificationTime $ "./data/posts/" ++ x ++ ".md"
+        date <- getModificationTime $ "./data/posts/" ++ postName ++ ".md"
-        return  $ Post 
+        postContent <- mdFileToText $ "./data/posts/" ++ postName ++ ".md"
-          (pack $ (timeFormat date) ++ " UTC")
+        return  $ Post
-          (pack $ "https://eversole.co/posts/" ++ x) 
+          (T.pack $ (timeFormat date) ++ " UTC")
-          (pack $ show x)
+          (T.pack $ baseUrl ++ "/posts/" ++ postName)
+          (T.pack $ show postName)
+          (postContent)
 
       -- YYYY-MM-DD HH:MM | 2024-02-24 16:36
       timeFormat :: UTCTime -> String
-      timeFormat x = formatTime defaultTimeLocale "%Y-%m-%d %H:%M" x
+      timeFormat date = formatTime defaultTimeLocale "%Y-%m-%d %H:%M" date
-        
+
 -- Refer to index comments
 contact :: ResponderM a
 contact = do
-  title     <- liftIO Conf.appTitle
+  (title, contactMd, footerMd) <- liftIO $ (,,)
-  contactMd <- liftIO $ mdFileToLucid "./data/posts/contact.md"
+    <$> Conf.title
-  sendLucidFragment   $ basePage title (baseContact contactMd)
+    <*> mdFileToLucid "./data/posts/contact.md"
+    <*> mdFileToLucid "./data/posts/footer.md"
+  sendLucidFragment   $ basePage title (baseContact contactMd) footerMd
 
+-- Respond with primary processed CSS
+theme :: ResponderM a
+theme = send $ css $ TLE.encodeUtf8 $ S.cssRender S.composedStyles
 
--- Helper function for responding in ResponderM from Html 
+-- Helper function for responding in ResponderM from Html
 sendLucidFragment :: Html () -> ResponderM a
 sendLucidFragment x = send $ html $ lucidToTwain x
 
 -- 404 handler
 missing :: ResponderM a
 missing = sendLucidFragment pageNotFound
+
+-- List of all non-hidden .md posts that aren't part of templating
+mdPostNames :: IO [FilePath]
+mdPostNames = mapM (pure . dropExtension . takeFileName )
+                =<< find isVisible fileFilter "./data/posts"
+                       where
+                         isVisible  = fileName  /~? ".?*"
+                         isMdFile   = extension ==? ".md"
+                         isHome     = fileName  /~? "home.md"
+                         isContact  = fileName  /~? "contact.md"
+                         isFooter   = fileName  /~? "footer.md"
+                         fileFilter = isMdFile
+                                  &&? isVisible
+                                  &&? isHome
+                                  &&? isContact
+                                  &&? isFooter

src/Core/Rendering.hs

@@ -5,6 +5,7 @@ import           Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString      as B
 import           Data.Text
 import           Data.Text.Encoding   (decodeUtf8)
+import           Data.Text.Lazy       (toStrict)
 import qualified Lucid                as LU
 import           System.IO            ()
 
@@ -18,3 +19,8 @@ mdToLucid cmtextinput = case (commonmark "" cmtextinput) of
 
 mdFileToLucid :: FilePath -> IO (LU.Html ())
 mdFileToLucid path = fmap (mdToLucid . decodeUtf8) (B.readFile path)
+
+mdFileToText :: FilePath -> IO (Text)
+mdFileToText path = do
+  htmlContent <- mdFileToLucid path
+  return $ toStrict $ LU.renderText htmlContent

src/Fragments/Base.hs

@@ -15,10 +15,9 @@ baseDoc title bodyContent = doctypehtml_ $ do
     link_ [rel_ "stylesheet", type_ "text/css", href_ "/style.css"]
   body_ bodyContent
 
-baseFeed :: Html ()
+baseFooter :: Html () -> Html ()
-baseFeed = div_ [class_ "main"] $ do
+baseFooter content = footer_ $ do
-  h2_ "Oops, I haven't been implemented yet." 
+  p_ $ content
-  h3_ "Check back in a couple days!"
 
 baseHome :: Html () -> Html ()
 baseHome content = div_ [class_ "main"] content
@@ -31,19 +30,24 @@ baseNav = div_ [class_ "navContainer"] $ do
     li_ $ a_ [href_ "/contact"] "Contact"
     li_ $ a_ [href_ "/feed"]    "Feed"
 
-basePage :: String -> Html () -> Html()
+basePage :: String -> Html () -> Html () -> Html ()
-basePage title body = baseDoc title $ baseNav <> body
+basePage title body footer = baseDoc title $ baseNav <> body <> baseFooter footer
 
 basePost :: Html () -> Html ()
 basePost content = div_ [class_ "main"] content
 
 postIndex :: [FilePath] -> Html ()
-postIndex postNames = div_ [class_ "main"] $ do
+postIndex postNames = div_ [class_ "postList"] $ do
   h1_ [class_ "title"] "All Posts"
-  ul_ [class_ "postList"] $ do
+  ul_ [] $ do
     mapM_
       (\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")

src/Fragments/Styles.hs

@@ -0,0 +1,150 @@
+module Fragments.Styles where
+
+import           Clay           hiding (main_)
+import qualified Clay.Media     as M
+import           Data.Text.Lazy hiding (center)
+import           Prelude        hiding (div)
+
+cssRender :: Css -> Text
+cssRender css = renderWith compact [] css
+
+priColor, secColor, terColor :: Color
+priColor = "#f1f6f0"
+secColor = "#222323"
+terColor = "#6D92AD"
+
+composedStyles :: Css
+composedStyles = do
+  core_
+  main_
+  nav_
+  notFound_
+  postList_
+  mobileFriendly_
+
+core_ :: Css
+core_ = do
+  a_
+  body_
+  code_
+  footer_
+  html_
+  p_
+  pre_
+
+a_ :: Css
+a_ = do
+  a ? do
+    textDecoration    none
+    color             terColor
+
+body_ :: Css
+body_ = do
+  body ? do
+    display       flex
+    minHeight   $ vh 100
+    flexDirection column
+    fontFamily    [] [monospace]
+    fontSize    $ em 1.25
+    fontWeight  $ weight 300
+    textAlign     start
+    margin        (em 0) auto (em 0) auto
+    strong ? do
+      fontWeight    $ weight 600
+    li ? do
+      listStyleType $ other "\"~> \""
+
+footer_ :: Css
+footer_ = do
+  footer ? do
+    bottom            (em 0)
+    margin            auto (em 0) (em 0) (em 0)
+    width           $ pct 100
+    backgroundColor   terColor
+    textAlign         center
+    padding           (em 1) (em 0) (em 1) (em 0)
+    boxSizing         borderBox
+    p ? do
+      fontSize $ em 0.75
+      margin     (em 0) (em 2) (em 0) (em 2)
+      color      priColor
+      a ? do
+        color priColor
+
+html_ :: Css
+html_ = do
+  html   ? do
+    backgroundColor priColor
+    color           secColor
+
+p_ :: Css
+p_ = do
+  p ? do
+    margin (em 1) (em 0) (em 0.6) (em 0)
+
+main_ :: Css
+main_ = do
+  ".main" ? do
+    margin     (em 0) auto (em 2) auto
+    width    $ pct 60
+
+notFound_ :: Css
+notFound_ = do
+  ".notFound" ? do
+    margin    (em 0) auto (em 0) auto
+    textAlign center
+    h1 ? do
+      fontSize   $ pct 500
+      fontWeight $ weight 200
+      color        terColor
+
+postList_ :: Css
+postList_ = do
+  ".postList" ? do
+    margin   (em 0) auto (em 0) auto
+    minWidth (pct 60)
+    maxWidth (pct 95)
+    overflow scroll
+    ul ? do
+      fontSize (em 1.5)
+
+code_ :: Css
+code_ = do
+  code ? do
+    color           priColor
+    backgroundColor terColor
+    overflowX       scroll
+
+pre_ :: Css
+pre_ = do
+  pre ? do
+    color           priColor
+    backgroundColor terColor
+    overflowX       scroll
+
+nav_ :: Css
+nav_ = do
+  ".navContainer" ? do
+    margin      (em 1.5) (em 0) (em 1.5) (em 0)
+    width     $ pct 100
+    textAlign   center
+  ".mainNav"      ? do
+    margin      (em 0) auto (em 0) auto
+    padding     (em 0.5) (em 0.5) (em 0.5) (em 0.5)
+    overflow    hidden
+    boxShadow . pure $ bsColor "#ccc" $ shadowWithBlur (px 4) (px 4) (px 6)
+    display     inlineFlex
+    li ? do
+      listStyleType   none
+      a ? do
+        display       block
+        textAlign     center
+        padding       (em 0.25) (em 0.3) (em 0.25) (em 0.3)
+        textTransform lowercase
+
+mobileFriendly_ :: Css
+mobileFriendly_ = query M.screen [M.maxWidth 768] $ do
+  ".main" ? do
+    width $ pct 95
+  ".postList" ? do
+    width $ pct 95

src/Main.hs

@@ -3,26 +3,7 @@ module Main where
 import qualified Core.HTTP            as HTTP
 import qualified Core.Configuration   as Conf
 
-import           Control.Monad        ( mapM_ )
-import           System.FilePath.Find ( always, extension, fileName, find, (&&?)
-                                      , (/~?), (==?) )
-import           System.FilePath      ( dropExtension, takeFileName )
-
-
 main :: IO ()
 main = do
-  Conf.main 
+  Conf.main
-  mdFilePaths <- getMdFilePaths "./data/posts/"
+  HTTP.main
-  -- 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
-    isMdFile  = extension ==? ".md"
-    isVisible = fileName  /~? ".?*"
-    isHome = fileName  /~? "home.md"
-    isContact = fileName  /~? "contact.md"
-    fileFilter = isMdFile &&? isVisible &&? isHome &&? isContact