2019-12-24 12:17:45 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2019-09-08 00:37:50 +00:00
|
|
|
module Types.Page where
|
|
|
|
|
|
|
|
import qualified Data.Text as T
|
|
|
|
|
|
|
|
import qualified Text.Blaze.Html5 as H
|
2019-12-24 12:17:45 +00:00
|
|
|
import qualified Text.Blaze.Html5.Attributes as HA
|
2019-09-08 00:37:50 +00:00
|
|
|
|
|
|
|
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
|
|
|
|
|
2019-09-11 04:27:54 +00:00
|
|
|
initPage
|
|
|
|
:: T.Text
|
|
|
|
-> Page H.Html T.Text
|
|
|
|
initPage title = Page
|
|
|
|
title
|
|
|
|
mempty
|
|
|
|
mempty
|
2019-12-24 12:17:45 +00:00
|
|
|
(H.link
|
|
|
|
H.! HA.rel "stylesheet"
|
|
|
|
H.! HA.type_ "text/css"
|
2019-12-26 08:41:31 +00:00
|
|
|
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"
|
2019-12-24 12:17:45 +00:00
|
|
|
)
|
2019-09-08 00:37:50 +00:00
|
|
|
|
|
|
|
template
|
2019-09-11 04:27:54 +00:00
|
|
|
:: Page H.Html T.Text
|
2019-09-08 00:37:50 +00:00
|
|
|
-> H.Html
|
|
|
|
-> H.Html
|
2019-09-11 04:27:54 +00:00
|
|
|
template (Page title favicon meta style) content =
|
2019-09-08 00:37:50 +00:00
|
|
|
H.docTypeHtml $ do
|
|
|
|
H.head $ do
|
2019-10-16 16:07:12 +00:00
|
|
|
H.title $ H.toHtml title
|
2019-09-08 00:37:50 +00:00
|
|
|
meta
|
|
|
|
favicon
|
|
|
|
style
|
2019-10-16 16:07:12 +00:00
|
|
|
H.body
|
2019-09-08 00:37:50 +00:00
|
|
|
content
|