matebeamter/src/Types/Page.hs

63 lines
1.8 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Types.Page where
import qualified Data.Text as T
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
data Page markup attr = Page
{ pageTitle :: attr -- ^ Page title
, pageFavicon :: markup -- ^ Favicon tags
, pageMetaVars :: markup -- ^ @\<meta\>@ tags
-- , initScripts :: markup -- ^ JavaScript to include at the top of the page
-- , beforeStylesScripts :: markup -- ^ JavaScript to include before @\<style\>@ tags
, pageStyles :: markup -- ^ Styles
-- , afterStylesScripts :: markup -- ^ JavaScript to include after @\<style\>@ tags - ie: <http://modernizr.com Modernizr>
-- , bodyScripts :: markup -- ^ JavaScript to include at the base of @\<body\>@
-- , bodyStyles :: attrSet -- ^ Additional styles to assign to @\<body\>@
} deriving (Show, Eq, Ord)
instance (Semigroup m, Semigroup a) => Semigroup (Page m a)
where
(Page t1 f1 m1 s1) <> (Page t2 f2 m2 s2) =
Page (t1 <> t2)
(f1 <> f2)
(m1 <> m2)
(s1 <> s2)
instance (Monoid m, Monoid a) => Monoid (Page m a) where
mempty = Page mempty mempty mempty mempty
initPage
:: T.Text
-> Page H.Html T.Text
initPage title = Page
title
mempty
mempty
(H.link
H.! HA.rel "stylesheet"
H.! HA.type_ "text/css"
H.! HA.href "/static/css/bootstrap.min.css"
<>
H.link
H.! HA.rel "stylesheet"
H.! HA.type_ "text/css"
H.! HA.href "/static/css/style.css"
)
template
:: Page H.Html T.Text
-> H.Html
-> H.Html
template (Page title favicon meta style) content =
H.docTypeHtml $ do
H.head $ do
H.title $ H.toHtml title
meta
favicon
style
H.body
content