Working Markdown processing and rendering

.gitignore

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

README.md

@@ -1,31 +1,32 @@
 # the sampu Haskell blog engine
 
-https://blog.eversole.co (not live yet!)
+https://eversole.co (not live yet!)
 
 a _work-in-progress_ blog engine using simple flat-file Markdown content storage
 
 sampu is a word in [Lojban](https://mw.lojban.org) with the English definition: 
+
 "x1 is __simple__/__unmixed__/__uncomplicated__ in property x2"
 
 Therefore, `la sampu cu sampu lo ka samtci`!
 
 ## Stack
 
-- ["Haskell"](https://www.haskell.org)
+- [Haskell](https://www.haskell.org)
-- ["Twain"](https://github.com/alexmingoia/twain)
+- [Twain](https://github.com/alexmingoia/twain)
-- ["Lucid2"](https://chrisdone.com/posts/lucid2)
+- [Lucid2](https://chrisdone.com/posts/lucid2)
-- ["HTMX"](https://htmx.org/)
+- [HTMX](https://htmx.org/)
 
 ## Goal
 
 Provide a simple blog engine that is easily customizable via HTML fragments
-and easy HTMX integration for dynamic content.
+and straightforward HTMX integration for dynamic server-driven content.
 
 ## Deployment
 
-We're not there yet, but soon! This project is built and packaged with Nix,
+We're not there yet! This project is built and packaged with Nix,
 so I will provide directions on deploying with Nix as well as via OCI 
-containers once there's something viable to run here.
+containers once there's something viable to run.
 
 ## Development and Support
 

sampu.cabal

@@ -17,6 +17,7 @@ executable sampu
     build-depends:      base
                       , bytestring            >= 0.11.5.0
                       , commonmark            >= 0.2.4
+                      , directory             >= 1.3.7.0
                       , dotenv                >= 0.11.0.0
                       , lucid                 >= 2.11.0
                       , text                  >= 2.0

src/Core/Configuration.hs

@@ -1,17 +1,45 @@
 module Core.Configuration where
 
 import Configuration.Dotenv
-import System.Environment   (getEnv, lookupEnv)
 
+import System.Directory   (doesFileExist)
+import System.Environment (getEnv, lookupEnv)
+
+-- Load environment variables from dotenv file if required
 main :: IO ()
 main = do
-  envFile <- lookupEnv "NOENVFILE"
+  reqEnvLookup <- getRequiredEnv
-  case envFile of
+  if (Nothing `elem` reqEnvLookup)
-    Nothing  -> loadFile defaultConfig
+    then checkEnvFile requiredEnvVars
-    _        -> putStrLn "Not using dotenv"
+    else pure ()
+  where
+    getRequiredEnv :: IO [Maybe String]
+    getRequiredEnv = mapM (\s -> lookupEnv s) requiredEnvVars
+
+    checkEnvFile :: [String] -> IO ()
+    checkEnvFile requiredEnv = do
+      dotEnvExists <- doesFileExist "./.env"
+      if dotEnvExists
+        then do
+          loadFile defaultConfig
+          fromEnvFile <- getRequiredEnv
+          if (Nothing `elem` fromEnvFile)
+             then error $ missingEnvMsg requiredEnv
+             else pure ()
+        else error $ "Cannot find .env file in application directory.\n"
+          ++ missingEnvMsg requiredEnv
+
+    missingEnvMsg :: [String] -> String
+    missingEnvMsg required =
+      "Missing required environment variable(s).\n"
+      ++ "All required environment variables:\n"
+      ++  unlines required
 
 appPort :: IO String
 appPort = getEnv "APPLICATIONPORT"
 
 appTitle :: IO String
 appTitle = getEnv "BLOGTITLE"
+
+requiredEnvVars :: [String]
+requiredEnvVars = [ "APPLICATIONPORT", "BLOGTITLE" ]

src/Core/HTTP.hs

@@ -25,9 +25,7 @@ preProcessors = [ logStdoutDev
 -- The application's routes expressed as a list of WAI Middlewares
 routes :: [Middleware]
 routes =
-  [ get "/" Handle.index
+  [ get "/" Handle.index ]
-  , get "/echo/:testParam" Handle.testRoute
-  ]
 
 -- Combine our Preprocessor Middlewares and Routes to create an App to run
 app :: [Middleware]

src/Core/Handlers.hs

@@ -1,27 +1,27 @@
 module Core.Handlers where
 
 import qualified Core.Configuration     as Conf
-import qualified Core.Rendering         as R
+import           Core.Rendering 
-import Fragments.Base
+import           Fragments.Base
-import Fragments.NotFound
+import           Fragments.NotFound
 
-import Control.Monad.IO.Class           (liftIO)
+import           Control.Monad.IO.Class (liftIO)
-import Lucid                            (Html)
+import           Lucid                  (Html)
-import Web.Twain
+import           Web.Twain
 
 index :: ResponderM a
-index = liftIO Conf.appTitle >>= (\title -> 
+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/base/home.md"
   sendLucidFragment 
-   $ baseDoc title baseNav 
+    $ baseDoc title 
-  <> baseHome)
+    $ baseNav 
-
+   <> baseHome homeMd
-testRoute :: ResponderM a
-testRoute = do
-  testParam <- param "testParam"
-  send $ status status202 $ html $ "Testing echo parameter: " <> testParam
 
 missing :: ResponderM a
 missing = sendLucidFragment pageNotFound
 
 sendLucidFragment :: Html () -> ResponderM a
-sendLucidFragment x = send $ html $ R.lucidToTwain x
+sendLucidFragment x = send $ html $ lucidToTwain x

src/Core/Rendering.hs

@@ -1,7 +1,20 @@
 module Core.Rendering where
 
-import Lucid
+import           Commonmark
-import Data.ByteString.Lazy (ByteString)
+import           Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString      as B
+import           Data.Text
+import           Data.Text.Encoding   (decodeUtf8)
+import qualified Lucid                as LU
+import           System.IO            ()
 
-lucidToTwain :: Html () -> ByteString
+lucidToTwain :: LU.Html () -> ByteString
-lucidToTwain = renderBS
+lucidToTwain = LU.renderBS
+
+mdToLucid :: Text -> LU.Html ()
+mdToLucid cmtextinput = case (commonmark "" cmtextinput) of
+  Left _               -> LU.toHtmlRaw ("Failed to parse Markdown document" :: Text)
+  Right (h :: Html ()) -> LU.toHtmlRaw (renderHtml h)
+
+mdFileToLucid :: FilePath -> IO (LU.Html ())
+mdFileToLucid path = fmap (mdToLucid . decodeUtf8) (B.readFile path)

src/Fragments/Base.hs

@@ -1,16 +1,18 @@
 module Fragments.Base where
 
+import Core.Rendering 
+
 import Data.Text
-import Data.String (fromString)
+import Data.String    (fromString)
 import Lucid
 
 baseDoc :: String -> Html () -> Html ()
-baseDoc title nav = doctypehtml_ $ do
+baseDoc title bodyContent = doctypehtml_ $ do
   head_ $ do
     title_ $ fromString title
     link_ [rel_ "stylesheet", type_ "text/css", href_ "style.css"]
     script_ [src_ "/htmx.min.js"] none
-  body_ nav
+  body_ bodyContent
 
 baseNav :: Html ()
 baseNav = div_ [class_ "navContainer"] $ do
@@ -20,12 +22,8 @@ baseNav = div_ [class_ "navContainer"] $ do
     li_ $ a_ [href_ "/contact"] "Contact"
     li_ $ a_ [href_ "/feed"]    "Feed"
 
-baseHome :: Html ()
+baseHome :: Html () -> Html ()
-baseHome = div_ [class_ "main"] $ do
+baseHome content = div_ [class_ "main"] content
-  {- Remove the below and replace with a Markdown fragment once .md
-     processing is implemented. -}
-  h1_ "James Eversole"
-  p_ "A blog about functional programming, philosophy, and politics (sorry)"
   
 none :: Text
 none = mempty