From 2f72bf2452ac4ad259be6c6542201c645e368315 Mon Sep 17 00:00:00 2001 From: sabadev Date: Sat, 3 Jul 2021 11:52:35 -0400 Subject: [PATCH] Factored out website title into the configuration. --- config.json | 3 ++- src/Configuration.hs | 3 +++ src/Html.hs | 9 +++++---- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/config.json b/config.json index 38ef27d..53f3a1a 100644 --- a/config.json +++ b/config.json @@ -1,4 +1,5 @@ { "configPort": 5000, - "configShowExceptions": true + "configShowExceptions": true, + "configTitle": "Saba's Site" } diff --git a/src/Configuration.hs b/src/Configuration.hs index e2a1053..309b8ea 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -5,12 +5,14 @@ import Data.Aeson (FromJSON(..), eitherDecodeStrict') import GHC.Generics (Generic(..)) import Network.Wai.Handler.Warp (Port(..)) import qualified Data.ByteString as B +import qualified Data.Text as T class (Monad m) => MonadReadConfig m where readConfigFile :: FilePath -> m B.ByteString data ServerConfiguration = ServerConfiguration { configPort :: !Port , configShowExceptions :: !Bool + , configTitle :: !T.Text } deriving (Show, Generic) instance FromJSON ServerConfiguration @@ -18,6 +20,7 @@ instance FromJSON ServerConfiguration defaultConfiguration :: ServerConfiguration defaultConfiguration = ServerConfiguration { configPort = 5000 , configShowExceptions = False + , configTitle = "Default Title" } readConfiguration :: (MonadReadConfig m) => FilePath -> m (Either String ServerConfiguration) diff --git a/src/Html.hs b/src/Html.hs index ae4d9cd..b6d43b9 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -21,13 +21,14 @@ import System.FilePath.Posix (()) import qualified Data.Text as T import qualified Data.Text.IO as T -htmlContainer :: (MonadDirectory m) => Maybe Theme -> Maybe BlogId -> Html a -> m (Html ()) +htmlContainer :: (MonadDirectory m, MonadReader ServerConfiguration m) => Maybe Theme -> Maybe BlogId -> Html a -> m (Html ()) htmlContainer theme maybeBlogId contents = do nav <- navigation theme themeConfig <- themeConfiguration theme maybeBlogId + title <- siteTitle pure $ sanitizeHtml $ void $ with doctypehtml_ [lang_ "en"] $ do head_ $ do - title_ $ toHtml siteTitle + title_ $ toHtml title meta_ [charset_ "utf8"] meta_ [name_ "description", content_ "A personal website with custom theming"] meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1.0"] @@ -104,8 +105,8 @@ blogNotFound theme blogId exceptionReason = do if showExceptions then p_ $ toHtml $ T.pack $ show exceptionReason else pure () throwError $ err404 { errBody = renderBS body } -siteTitle :: T.Text -siteTitle = "Saba's Site" +siteTitle :: (MonadReader ServerConfiguration m) => m T.Text +siteTitle = ask >>= pure . configTitle staticPath :: FilePath staticPath = "static" -- 2.20.1