{-# 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 -- ^ @\@ tags -- , initScripts :: markup -- ^ JavaScript to include at the top of the page -- , beforeStylesScripts :: markup -- ^ JavaScript to include before @\@ tags , pageStyles :: markup -- ^ Styles -- , afterStylesScripts :: markup -- ^ JavaScript to include after @\@ tags - ie: -- , bodyScripts :: markup -- ^ JavaScript to include at the base of @\@ -- , bodyStyles :: attrSet -- ^ Additional styles to assign to @\@ } 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