Compositional HTML fragments

sampu.cabal

@@ -13,17 +13,18 @@ executable sampu
     import:             warnings
     main-is:            Main.hs
     default-extensions: OverloadedStrings
+    ghc-options:        -threaded -rtsopts -with-rtsopts=-N -optl-pthread -fPIC
     build-depends:      base
                       , bytestring >= 0.11.5.0
                       , commonmark >= 0.2.4
                       , dotenv     >= 0.11.0.0
                       , lucid      >= 2.11.0
+                      , text       >= 2.0
                       , twain      >= 2.1.0.0
                       , wai-extra  >= 3.0 && < 3.2
                       , warp       == 3.3.25
     hs-source-dirs:     src
-    other-modules:
+    other-modules:      Core.Configuration
-      Core.Configuration
                         Core.Handlers
                         Core.HTTP
                         Core.Rendering

src/Core/HTTP.hs

@@ -7,23 +7,24 @@ import Network.Wai.Middleware.RequestLogger (logStdoutDev)
 import Network.Wai.Handler.Warp             (Port, run)
 import Web.Twain
 
+-- Get the port to listen on from the ENV and start the webserver
 main :: IO ()
 main = do
   port <- Conf.appPort
   run (read port :: Int) $
     foldr ($) (notFound Handle.missing) app
 
--- Combine our Preprocessor Middlewares and Routes to create an App
+-- These Middlewares are always executed before any routes are reached
-app :: [Middleware]
-app = preProcessors ++ routes
-
--- These Middleware are always executed before any routes are reached
 preProcessors :: [Middleware]
 preProcessors = [logStdoutDev]
 
--- The application's core routes expressed as a list of WAI middlewares
+-- The application's routes expressed as a list of WAI Middlewares
 routes :: [Middleware]
 routes =
   [ get "/" Handle.index
   , get "/echo/:testParam" Handle.testRoute
   ]
+
+-- Combine our Preprocessor Middlewares and Routes to create an App to run
+app :: [Middleware]
+app = preProcessors ++ routes

src/Core/Handlers.hs

@@ -1,12 +1,16 @@
 module Core.Handlers where
 
+import qualified Core.Configuration     as Conf
+import qualified Core.Rendering         as R
 import qualified Templates.Base         as T
-import           Core.Rendering as R
 
+import Control.Monad.IO.Class (liftIO)
 import Web.Twain
 
 index :: ResponderM a
-index = send $ html $ R.twain T.baseNav
+index = liftIO Conf.appTitle >>= (\title -> 
+  send $ html $ R.twain $
+  T.baseDoc title T.baseNav)
 
 testRoute :: ResponderM a
 testRoute = do

src/Templates/Base.hs

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