Basic navigation and styles

data/assets/public/style.css

@@ -0,0 +1,42 @@
+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}
+.logo{margin:4% 3% 0 0;font-size:1.2vw;color:#435F5D;text-align:center}
+
+.navContainer {
+  width: 100%;
+  text-align: center;
+}
+
+.mainNav{
+  list-style-type: none;
+  margin: 0 auto;
+  padding: 0;
+  overflow: hidden;
+  box-shadow: 4px 4px 6px #ccc;
+  display: inline-flex;
+}
+
+.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}
+}

sampu.cabal

@@ -15,18 +15,20 @@ executable sampu
     default-extensions: OverloadedStrings
     ghc-options:        -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
     build-depends:      base
-                      , bytestring >= 0.11.5.0
+                      , bytestring            >= 0.11.5.0
-                      , commonmark >= 0.2.4
+                      , commonmark            >= 0.2.4
-                      , dotenv     >= 0.11.0.0
+                      , dotenv                >= 0.11.0.0
-                      , lucid      >= 2.11.0
+                      , lucid                 >= 2.11.0
-                      , text       >= 2.0
+                      , text                  >= 2.0
-                      , twain      >= 2.1.0.0
+                      , twain                 >= 2.1.0.0
-                      , wai-extra  >= 3.0 && < 3.2
+                      , wai-extra             >= 3.0 && < 3.2
-                      , warp       == 3.3.25
+                      , wai-middleware-static >= 0.9.0
+                      , warp                  == 3.3.25
     hs-source-dirs:     src
     other-modules:      Core.Configuration
                         Core.Handlers
                         Core.HTTP
                         Core.Rendering
-                        Templates.Base
+                        Fragments.Base
+                        Fragments.NotFound
     default-language:   GHC2021

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 $
+  sendLucidFragment 
-  T.baseDoc title T.baseNav)
+   $ 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
+lucidToTwain :: Html () -> ByteString
-twain = renderBS
+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."