public
Created

Using endo monoid, writer monad and blaze html combinators for creating a web page

  • Download Gist
endotemplates.hs
Haskell
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 36 37 38 39 40 41 42
{-# 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)

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.