{-# LANGUAGE FlexibleContexts, OverlappingInstances #-} {-# OPTIONS_GHC -F -pgmF trhsx #-} module Main where import Control.Applicative ((<$>)) import Control.Monad.Identity (Identity(runIdentity)) import Data.String (IsString(fromString)) import Data.Text (Text) import Happstack.Server.HSP.HTML import Happstack.Server (Request(rqMethod), ServerPartT, askRq, nullConf, simpleHTTP) import HSP.Identity () -- instance (XMLGen Identity) hello :: ServerPartT IO XML hello = unXMLGenT Hello, HSP!

Hello HSP!

We can insert Haskell expression such as this: <% sum [1 .. (10 :: Int)] %>

We can use the ServerPartT monad too. Your request method was: <% getMethod %>


We don't have to escape & or >. Isn't that nice?

If we want <% "<" %> then we have to do something funny.

But we don't have to worry about escaping <% "

a string like this

" %>

We can also nest <% like <% "this." %> %>

where getMethod :: XMLGenT (ServerPartT IO) String getMethod = show . rqMethod <$> askRq main :: IO () main = simpleHTTP nullConf $ hello foo :: XMLGenT (ServerPartT IO) XML foo = genElement (Nothing, "span") [ asAttr ("class" := "bar") ] [asChild ("foo")] bar :: (XMLGenerator m) => XMLGenT m (XMLType m) bar = bar a :: (XMLGenerator m) => GenChildList m a = <% 'a' %> printXML :: Identity XML -> IO () printXML = putStrLn . renderAsHTML . runIdentity empty :: IO () empty = printXML $ defaultTemplate "empty" () () twoParagraphs :: (XMLGenerator m) => XMLGenT m [ChildType m] twoParagraphs = <%>

Paragraph one

Paragraph two

twoParagraphsWithParent :: (XMLGenerator m) => XMLGenT m (XMLType m) twoParagraphsWithParent =
<% twoParagraphs %>
ifThen :: Bool -> IO () ifThen bool = printXML $ defaultTemplate "ifThen" () $
<% if bool then <%

Showing this thing.

%> else <% () %> %>
attrList :: IO () attrList = printXML $ defaultTemplate "attrList" () $
optAttrList :: Bool -> IO () optAttrList bool = printXML $ defaultTemplate "attrList" () $
overlapping :: (EmbedAsChild m String) => XMLGenT m (XMLType m) overlapping =

overlapping

overlapping' :: (XMLGenerator m) => XMLGenT m (XMLType m) overlapping' =

overlapping

ambiguous :: (EmbedAsChild m Text) => XMLGenT m (XMLType m) ambiguous =

<% (fromString "ambiguous") :: Text %>

overloaded :: XMLGenT Identity XML overloaded =

Hello