thsutton/README.md

## README.md

      
    Raw
  

              README.md
            
          
    Looping tags in Heist templates

This is a small example demonstrating how to implement looping template tags
("splices") with the Heist template system that is the default with the Snap
Framework.
The src/Site.hs file contains the interesting bits:


The loop handler which simply renders the loop.tpl
template with the loopSplice splice function; and


The loopSplice splice function which implements the <loop> template tag.
This new tag has two attributes -- from and to -- which specify the
initial and final values for the counter. The body of the tag is repeated
once for each step between the from and to values with the <step/>
tag, if it is in the body, replaced with the current value.


## Application.hs
{-

This module defines our application's monad and any application-specific
information it requires.

-}

module Application
  ( Application
  , applicationInitializer
  ) where

import           Snap.Extension
import           Snap.Extension.Heist.Impl


------------------------------------------------------------------------------
-- | 'Application' is our application's monad. It uses 'SnapExtend' from
-- 'Snap.Extension' to provide us with an extended 'MonadSnap' making use of
-- the Heist and Timer Snap extensions.
type Application = SnapExtend ApplicationState


------------------------------------------------------------------------------
-- | 'ApplicationState' is a record which contains the state needed by the Snap
-- extensions we're using.  We're using Heist so we can easily render Heist
-- templates, and Timer simply to illustrate the config loading differences
-- between development and production modes.
data ApplicationState = ApplicationState
    { templateState :: HeistState Application
    }


------------------------------------------------------------------------------
instance HasHeistState Application ApplicationState where
    getHeistState     = templateState
    setHeistState s a = a { templateState = s }


------------------------------------------------------------------------------
-- | The 'Initializer' for ApplicationState. For more on 'Initializer's, see
-- the documentation from the snap package. Briefly, this is used to
-- generate the 'ApplicationState' needed for our application and will
-- automatically generate reload\/cleanup actions for us which we don't need
-- to worry about.
applicationInitializer :: Initializer ApplicationState
applicationInitializer = do
    heist <- heistInitializer "resources/templates"
    return $ ApplicationState heist

## loop.cabal
Name:                loop
Version:             0.1
Synopsis:            Demonstrating how to "loop" in heist templates
Description:         Demonstrating how to "loop" in heist templates
License:             AllRightsReserved
Author:              Author
Maintainer:          maintainer@example.com
Stability:           Experimental
Category:            Web
Build-type:          Simple
Cabal-version:       >=1.2

Flag development
  Description: Whether to build the server in development (interpreted) mode
  Default: False

Executable loop
  hs-source-dirs: src
  main-is: Main.hs

  if !flag(development)
    cpp-options: -DPRODUCTION
  else
    build-depends: hint >= 0.3.2 && < 0.4

  Build-depends:
    base >= 4 && < 5,
    bytestring >= 0.9.1 && < 0.10,
    heist >= 0.4 && < 0.5,
    hexpat >= 0.19 && < 0.20,
    MonadCatchIO-transformers >= 0.2.1 && < 0.3,
    mtl >= 2 && < 3,
    snap >= 0.3 && < 0.4,
    snap-core >= 0.3 && < 0.4,
    snap-server >= 0.3 && <0.4,
    text >= 0.11 && < 0.12,
    time >= 1.1 && < 1.3

  extensions: TypeSynonymInstances MultiParamTypeClasses

  if impl(ghc >= 6.12.0)
    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
                 -fno-warn-orphans -fno-warn-unused-do-bind
  else
    ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
                 -fno-warn-orphans


## loop.tpl
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
  <head>
    <title>Snap web server</title>
    <link rel="stylesheet" type="text/css" href="screen.css"/>
  </head>
  <body>
    <div id="content">
      <h1>It works!</h1>
      <p>
        This is a simple demo page served using
        <a href="http://snapframework.com/docs/tutorials/heist">Heist</a>
        and the <a href="http://snapframework.com/">Snap</a> web framework.
      </p>
      <p>Let's loop from 1 to 10!</p>
      <ul>
      <loop from="1" to="10">
        <li>This is step number <step/>...</li>
      </loop>
      </ul>
    </div>
  </body>
</html>

## Main.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

{-|

This is the entry point for this web server application.  It supports easily
switching between interpreting source and running statically compiled code.

In either mode, the generated program should be run from the root of the
project tree.  It locates its templates, static content, and source files in
development mode, relative to the current working directory when it is run.

When compiled without the production flag, only changes to the libraries, your
cabal file, or this file should require a recompile to be picked up.
Everything else is interpreted at runtime.  There are a few consequences of
this.

First, this is much slower.  Running the interpreter seems to take about
300ms, regardless of the simplicity of the loaded code.  The results of the
interpreter process are cached for a few seconds, to hopefully ensure that
the the interpreter is only invoked once for each load of a page and the
resources it depends on.

Second, the generated server binary is MUCH larger, since it links in the GHC
API (via the hint library).

Third, it results in initialization\/cleanup code defined by the @Initializer@
being called for each request.  This is to ensure that the current state is
compatible with the running action.  If your application state takes a long
time to load or clean up, the penalty will be visible.

Fourth, and the reason you would ever want to actually compile without
production mode, is that it enables a *much* faster development cycle. You can
simply edit a file, save your changes, and hit reload to see your changes
reflected immediately.

When this is compiled with the production flag, all the actions are statically
compiled in.  This results in much faster execution, a smaller binary size,
only running initialization and cleanup once per application run, and having
to recompile the server for any code change.

-}

module Main where

#ifdef PRODUCTION
import           Snap.Extension.Server
#else
import           Snap.Extension.Loader.Devel
import           Snap.Http.Server (quickHttpServe)
#endif

import           Application
import           Site

main :: IO ()
#ifdef PRODUCTION
main = quickHttpServe applicationInitializer site
#else
main = do
    snap <- $(loadSnapTH 'applicationInitializer 'site)
    quickHttpServe snap
#endif

## screen.css
html {
   padding: 0;
   margin: 0;
   background-color: #ffffff;
   font-family: Verdana, Helvetica, sans-serif;
}
body {
   padding: 0;
   margin: 0;
}
a {
   text-decoration: underline;
}
a :hover {
   cursor: pointer;
   text-decoration: underline;
}
img {
   border: none;
}
#content {
   padding-left: 1em;
}
#info {
   font-size: 60%;
}

## Site.hs
{-# LANGUAGE OverloadedStrings #-}

{-|

This is where all the routes and handlers are defined for your site. The
'site' function combines everything together and is exported by this module.

-}

module Site
  ( site
  ) where

import           Control.Applicative
import qualified Data.ByteString.Char8 as B
import           Snap.Extension.Heist
import           Snap.Util.FileServe
import           Snap.Types
import           Text.Templating.Heist
import qualified Text.XML.Expat.Tree as X

import           Application


------------------------------------------------------------------------------
-- | Render the page containing a loop.
loop :: Application ()
loop = heistLocal (bindSplice "loop" loopSplice) $ render "loop"

loopSplice :: Splice Application
loopSplice = do
  ts <- getTS
  node <- getParamNode
  from <- return $ maybe (0) (read . B.unpack) (X.getAttribute node "from")
  to <- return $ maybe (0) (read . B.unpack) (X.getAttribute node "to")
  let body = X.getChildren node
  bds <- sequence $ map (step body) [from .. to]
  restoreTS ts
  return $ concat bds
  where
    step :: [Node] -> Int -> Splice Application
    step body i = do
      modifyTS $ bindString "step" (B.pack $ show i)
      runNodeList body


------------------------------------------------------------------------------
-- | The main entry point handler.
site :: Application ()
site = ifTop loop
       <|> fileServe "resources/static"
	{-

	This module defines our application's monad and any application-specific
	information it requires.

	-}

	module Application
	( Application
	, applicationInitializer
	) where

	import Snap.Extension
	import Snap.Extension.Heist.Impl


	------------------------------------------------------------------------------
	-- \| 'Application' is our application's monad. It uses 'SnapExtend' from
	-- 'Snap.Extension' to provide us with an extended 'MonadSnap' making use of
	-- the Heist and Timer Snap extensions.
	type Application = SnapExtend ApplicationState


	------------------------------------------------------------------------------
	-- \| 'ApplicationState' is a record which contains the state needed by the Snap
	-- extensions we're using. We're using Heist so we can easily render Heist
	-- templates, and Timer simply to illustrate the config loading differences
	-- between development and production modes.
	data ApplicationState = ApplicationState
	{ templateState :: HeistState Application
	}


	------------------------------------------------------------------------------
	instance HasHeistState Application ApplicationState where
	getHeistState = templateState
	setHeistState s a = a { templateState = s }


	------------------------------------------------------------------------------
	-- \| The 'Initializer' for ApplicationState. For more on 'Initializer's, see
	-- the documentation from the snap package. Briefly, this is used to
	-- generate the 'ApplicationState' needed for our application and will
	-- automatically generate reload\/cleanup actions for us which we don't need
	-- to worry about.
	applicationInitializer :: Initializer ApplicationState
	applicationInitializer = do
	heist <- heistInitializer "resources/templates"
	return $ ApplicationState heist
	Name: loop
	Version: 0.1
	Synopsis: Demonstrating how to "loop" in heist templates
	Description: Demonstrating how to "loop" in heist templates
	License: AllRightsReserved
	Author: Author
	Maintainer: maintainer@example.com
	Stability: Experimental
	Category: Web
	Build-type: Simple
	Cabal-version: >=1.2

	Flag development
	Description: Whether to build the server in development (interpreted) mode
	Default: False

	Executable loop
	hs-source-dirs: src
	main-is: Main.hs

	if !flag(development)
	cpp-options: -DPRODUCTION
	else
	build-depends: hint >= 0.3.2 && < 0.4

	Build-depends:
	base >= 4 && < 5,
	bytestring >= 0.9.1 && < 0.10,
	heist >= 0.4 && < 0.5,
	hexpat >= 0.19 && < 0.20,
	MonadCatchIO-transformers >= 0.2.1 && < 0.3,
	mtl >= 2 && < 3,
	snap >= 0.3 && < 0.4,
	snap-core >= 0.3 && < 0.4,
	snap-server >= 0.3 && <0.4,
	text >= 0.11 && < 0.12,
	time >= 1.1 && < 1.3

	extensions: TypeSynonymInstances MultiParamTypeClasses

	if impl(ghc >= 6.12.0)
	ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
	-fno-warn-orphans -fno-warn-unused-do-bind
	else
	ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
	-fno-warn-orphans
	<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
	<html xmlns="http://www.w3.org/1999/xhtml">
	<head>
	<title>Snap web server</title>
	<link rel="stylesheet" type="text/css" href="screen.css"/>
	</head>
	<body>
	<div id="content">
	<h1>It works!</h1>
	<p>
	This is a simple demo page served using
	<a href="http://snapframework.com/docs/tutorials/heist">Heist</a>
	and the <a href="http://snapframework.com/">Snap</a> web framework.
	</p>
	<p>Let's loop from 1 to 10!</p>
	<ul>
	<loop from="1" to="10">
	<li>This is step number <step/>...</li>
	</loop>
	</ul>
	</div>
	</body>
	</html>
	{-# LANGUAGE CPP #-}
	{-# LANGUAGE TemplateHaskell #-}

	{-\|

	This is the entry point for this web server application. It supports easily
	switching between interpreting source and running statically compiled code.

	In either mode, the generated program should be run from the root of the
	project tree. It locates its templates, static content, and source files in
	development mode, relative to the current working directory when it is run.

	When compiled without the production flag, only changes to the libraries, your
	cabal file, or this file should require a recompile to be picked up.
	Everything else is interpreted at runtime. There are a few consequences of
	this.

	First, this is much slower. Running the interpreter seems to take about
	300ms, regardless of the simplicity of the loaded code. The results of the
	interpreter process are cached for a few seconds, to hopefully ensure that
	the the interpreter is only invoked once for each load of a page and the
	resources it depends on.

	Second, the generated server binary is MUCH larger, since it links in the GHC
	API (via the hint library).

	Third, it results in initialization\/cleanup code defined by the @Initializer@
	being called for each request. This is to ensure that the current state is
	compatible with the running action. If your application state takes a long
	time to load or clean up, the penalty will be visible.

	Fourth, and the reason you would ever want to actually compile without
	production mode, is that it enables a much faster development cycle. You can
	simply edit a file, save your changes, and hit reload to see your changes
	reflected immediately.

	When this is compiled with the production flag, all the actions are statically
	compiled in. This results in much faster execution, a smaller binary size,
	only running initialization and cleanup once per application run, and having
	to recompile the server for any code change.

	-}

	module Main where

	#ifdef PRODUCTION
	import Snap.Extension.Server
	#else
	import Snap.Extension.Loader.Devel
	import Snap.Http.Server (quickHttpServe)
	#endif

	import Application
	import Site

	main :: IO ()
	#ifdef PRODUCTION
	main = quickHttpServe applicationInitializer site
	#else
	main = do
	snap <- $(loadSnapTH 'applicationInitializer 'site)
	quickHttpServe snap
	#endif
	html {
	padding: 0;
	margin: 0;
	background-color: #ffffff;
	font-family: Verdana, Helvetica, sans-serif;
	}
	body {
	padding: 0;
	margin: 0;
	}
	a {
	text-decoration: underline;
	}
	a :hover {
	cursor: pointer;
	text-decoration: underline;
	}
	img {
	border: none;
	}
	#content {
	padding-left: 1em;
	}
	#info {
	font-size: 60%;
	}
	{-# LANGUAGE OverloadedStrings #-}

	{-\|

	This is where all the routes and handlers are defined for your site. The
	'site' function combines everything together and is exported by this module.

	-}

	module Site
	( site
	) where

	import Control.Applicative
	import qualified Data.ByteString.Char8 as B
	import Snap.Extension.Heist
	import Snap.Util.FileServe
	import Snap.Types
	import Text.Templating.Heist
	import qualified Text.XML.Expat.Tree as X

	import Application


	------------------------------------------------------------------------------
	-- \| Render the page containing a loop.
	loop :: Application ()
	loop = heistLocal (bindSplice "loop" loopSplice) $ render "loop"

	loopSplice :: Splice Application
	loopSplice = do
	ts <- getTS
	node <- getParamNode
	from <- return $ maybe (0) (read . B.unpack) (X.getAttribute node "from")
	to <- return $ maybe (0) (read . B.unpack) (X.getAttribute node "to")
	let body = X.getChildren node
	bds <- sequence $ map (step body) [from .. to]
	restoreTS ts
	return $ concat bds
	where
	step :: [Node] -> Int -> Splice Application
	step body i = do
	modifyTS $ bindString "step" (B.pack $ show i)
	runNodeList body


	------------------------------------------------------------------------------
	-- \| The main entry point handler.
	site :: Application ()
	site = ifTop loop
	<\|> fileServe "resources/static"