Basic navigation and styles

src/Core/HTTP.hs

@@ -3,8 +3,10 @@ module Core.HTTP where
 import qualified Core.Configuration         as Conf
 import qualified Core.Handlers              as Handle
 
-import Network.Wai.Middleware.RequestLogger (logStdoutDev)
 import Network.Wai.Handler.Warp             (Port, run)
+import Network.Wai.Middleware.RequestLogger (logStdoutDev)
+import Network.Wai.Middleware.Static
+
 import Web.Twain
 
 -- Get the port to listen on from the ENV and start the webserver
@@ -14,9 +16,11 @@ main = do
   run (read port :: Int) $
     foldr ($) (notFound Handle.missing) app
 
--- These Middlewares are always executed before any routes are reached
+-- These Middlewares are executed before any routes are reached
 preProcessors :: [Middleware]
-preProcessors = [logStdoutDev]
+preProcessors = [ logStdoutDev
+                , staticPolicy $ noDots >-> addBase "data/assets/public"
+                ]
 
 -- The application's routes expressed as a list of WAI Middlewares
 routes :: [Middleware]

src/Core/Handlers.hs

@@ -2,15 +2,18 @@ module Core.Handlers where
 
 import qualified Core.Configuration     as Conf
 import qualified Core.Rendering         as R
-import qualified Templates.Base         as T
+import Fragments.Base
+import Fragments.NotFound
 
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Class           (liftIO)
+import Lucid                            (Html)
 import Web.Twain
 
 index :: ResponderM a
 index = liftIO Conf.appTitle >>= (\title -> 
-  send $ html $ R.twain $
-  T.baseDoc title T.baseNav)
+  sendLucidFragment 
+   $ baseDoc title baseNav 
+  <> baseHome)
 
 testRoute :: ResponderM a
 testRoute = do
@@ -18,4 +21,7 @@ testRoute = do
   send $ status status202 $ html $ "Testing echo parameter: " <> testParam
 
 missing :: ResponderM a
-missing = send $ html "404 NOT FOUND"
+missing = sendLucidFragment pageNotFound
+
+sendLucidFragment :: Html () -> ResponderM a
+sendLucidFragment x = send $ html $ R.lucidToTwain x

src/Core/Rendering.hs

@@ -3,5 +3,5 @@ module Core.Rendering where
 import Lucid
 import Data.ByteString.Lazy (ByteString)
 
-twain :: Html () -> ByteString
-twain = renderBS
+lucidToTwain :: Html () -> ByteString
+lucidToTwain = renderBS

src/Fragments/Base.hs

@@ -0,0 +1,31 @@
+module Fragments.Base where
+
+import Data.Text
+import Data.String (fromString)
+import Lucid
+
+baseDoc :: String -> Html () -> Html ()
+baseDoc title nav = doctypehtml_ $ do
+  head_ $ do
+    title_ $ fromString title
+    link_ [rel_ "stylesheet", type_ "text/css", href_ "style.css"]
+    script_ [src_ "/htmx.min.js"] none
+  body_ nav
+
+baseNav :: Html ()
+baseNav = div_ [class_ "navContainer"] $ do
+  ul_ [class_ "mainNav"] $ do
+    li_ $ a_ [href_ "/"]        "Home"
+    li_ $ a_ [href_ "/posts"]   "Posts"
+    li_ $ a_ [href_ "/contact"] "Contact"
+    li_ $ a_ [href_ "/feed"]    "Feed"
+
+baseHome :: Html ()
+baseHome = div_ [class_ "main"] $ do
+  {- 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

src/Fragments/NotFound.hs

@@ -0,0 +1,9 @@
+module Fragments.NotFound where
+
+import Fragments.Base 
+
+import Lucid
+
+pageNotFound :: Html ()
+pageNotFound = baseDoc "404" baseNav <>
+  (div_ [class_ "notFound"] $ h1_ "404 NOT FOUND")

src/Templates/Base.hs

@@ -1,15 +0,0 @@
-module Templates.Base where
-
-import Data.Text
-import Data.String (fromString)
-import Lucid
-
-baseDoc :: String -> Html () -> Html ()
-baseDoc title nav = doctypehtml_ $ do
-  head_ $ do
-    title_ (fromString title)
-    link_ [rel_ "stylesheet", type_ "text/css", href_ "style.css"]
-  body_ nav
-
-baseNav :: Html ()
-baseNav = h1_ "This will be a nav eventually."