summaryrefslogtreecommitdiff
path: root/src/Settlr/UI/Page.hs
blob: 575b076382b5e8e573688d8ae08b6c3c4014cffc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Settlr.UI.Page
  ( page
  ) where

import Text.Blaze.Html5 (Html, (!), text, textValue)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Data.Text (Text)
import Settlr.Config (Config(..))
import Settlr.Scripts (ScriptM, getToasts, Toast(..))
import Control.Monad.Reader (asks)
import Control.Monad (forM_)

page
  :: Text         -- ^ the page title
  -> Html         -- ^ main content
  -> ScriptM Html -- ^ given the config, the rendered page (i.e., the entire html document)
page title content = do
  cssPath <- asks cfgCssPath
  toasts  <- getToasts
  pure $ H.docTypeHtml $ do
           H.head $ do
             H.meta ! A.charset "utf-8"
             H.title (text (title <> " | Settlr"))
             H.link ! A.rel "stylesheet" ! A.href (textValue cssPath)
           H.body $ do
             H.ul $ do
               forM_ toasts $ \(Toast msg) -> do
                 H.li $ do
                   H.span (text msg) ! A.class_ "toast"
             H.main $ do
               content