Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Using endo monoid, writer monad and blaze html combinators for creating a web page
{-# Language GeneralizedNewtypeDeriving #-}
{-# Language OverloadedStrings #-}
import Data.Monoid
import Text.Blaze.Html.Renderer.Text
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html ((!), Html)
import Control.Monad.Writer
import Control.Monad.Identity
data Template = Template {
scripts :: [Html]
, title :: Html
, body :: Html
}
type EndoTemplate = Endo Template
newtype Page m a = Page (WriterT EndoTemplate m a) deriving (Monad, MonadWriter EndoTemplate)
runPage (Page w) = runWriterT w
emptyTemplate = (Template [] "" "")
setTitle :: (H.ToMarkup a, Monad m) => a -> Page m ()
setTitle x = tell . Endo $ \y -> y{title=H.toHtml x}
pushScript :: (H.ToValue a, Monad m) => a -> Page m ()
pushScript url = let
script = H.script ! A.type_ "application/javascript" ! A.src (H.toValue url) $ mempty
in tell . Endo $ \y -> y{scripts=script : scripts y}
addSnippet :: Monad m => Html -> Page m ()
addSnippet h = tell . Endo $ \y -> y{body=body y `mappend` h}
defaultLayout :: Page Identity () -> Html
defaultLayout p = let
(_, endo) = runIdentity $ runPage p
template = appEndo endo emptyTemplate
in H.docTypeHtml $ do
H.head $ do
H.title (title template)
H.body $ do
(body template)
foldr mappend mempty (scripts template)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.