Skip to content

Instantly share code, notes, and snippets.

@stepcut

stepcut/hsp-xml.hs

Forked from bitonic/gist:928585
Created April 19, 2011 17:41
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save stepcut/928978 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save stepcut/928978 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
hsp-xml.hs
{-# OPTIONS_GHC -F -pgmFtrhsx #-}
module Main (main) where
import Control.Monad
import Happstack.Server
import qualified Text.Blaze.Html5 as H
import Data.String (fromString)
import HSP
import qualified HSX.XMLGenerator as HSX
import Happstack.Server.HSP.HTML ()
import HSP.ServerPartT ()
import HSP.Identity
fs = fromString
main :: IO ()
main = simpleHTTP nullConf $ msum
[ dir "simple" $ ok $ toResponse "Hello, World!"
, dir "blaze" $ ok $ toResponse $
H.html $ do
H.head $ do
H.title (fs "Test page")
H.body $ do
H.h1 (fs "Hello world!")
H.div $ do
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
H.span (fs "blaze test page.")
, dir "hsp" (hspHtml >>= ok . toResponse)
, dir "hsp-xml" (ok $ toResponse $ hspXML)
, dir "hsp-identity" (ok $ toResponse $ evalIdentity hspPage)
]
where
hspHtml = unXMLGenT hspPage
hspPage :: (XMLGenerator m) => XMLGenT m (HSX.XML m)
hspPage =
<html>
<head>
<title>Test Page</title>
</head>
<body>
<h1>Hello world!</h1>
<div>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
<span>hsp test page</span>
</div>
</body>
</html>
hspXML = Element (Nothing,"html") [] [
Element (Nothing,"head") [] [
Element (Nothing,"title") [] [CDATA True "Test Page"]],
Element (Nothing,"body") [] [
Element (Nothing,"h1") [] [CDATA True "Hello world!"],
Element (Nothing,"div") [] [ Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"],
Element (Nothing,"span") [] [CDATA True "hsp test page"]
]]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment