Created
February 10, 2013 12:53
-
-
Save MasseR/4749508 to your computer and use it in GitHub Desktop.
Using endo monoid, writer monad and blaze html combinators for creating a web page
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# 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