heterocephalus-1.0.5.0: A type-safe template engine for working with popular front end development tools

CopyrightKadzuya Okamoto 2016
LicenseMIT
Stabilityexperimental
Portabilityunknown
Safe HaskellNone
LanguageHaskell2010

Text.Heterocephalus

Contents

Description

This module exports functions for working with frontend templates from Haskell.

Synopsis

Core functions

compileTextFile :: FilePath -> Q Exp Source #

A function to compile template file. This function DOES NOT escape template variables. To render the compiled file, use Renderer.*.renderMarkup.

>>> putStr $ renderMarkup (let as = ["<a>", "b"] in $(compileTextFile "templates/sample.txt"))
sample
key: <a>,
key: b,

compileTextFileWith :: FilePath -> ScopeM () -> Q Exp Source #

Same as compileText but allows the user to specify extra values for template parameters. Values declared by overwrite overwrites same name variables. Values declared by setDefault are overwritten by same name variables.

>>> :set -XOverloadedStrings
>>> :{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileTextFileWith "templates/sample.txt" $ do
    setDefault "as" [| ["foo", "bar"] |]
  )
)
:}
sample
key: <a>,
key: b,
>>> :{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileTextFileWith "templates/sample.txt" $ do
    overwrite "as" [| ["foo", "bar"] |]
  )
)
:}
sample
key: foo,
key: bar,
>>> :{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileTextFileWith "templates/sample.txt" $ do
    overwrite "as" [| ["bazbaz", "barbar"] |]
    setDefault "as" [| ["foo", "bar"] |]
    overwrite "as" [| ["baz", "foobar"] |]
  )
)
:}
sample
key: baz,
key: foobar,

compileTextFileWithDefault :: FilePath -> DefaultScope -> Q Exp Source #

Same as compileText but allows the user to specify default values for template parameters.

>>> :set -XOverloadedStrings
>>> :{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileTextFileWithDefault "templates/sample.txt"
    [("as", [| ["foo", "bar"] |])]
  )
)
:}
sample
key: <a>,
key: b,
>>> :{
putStr $ renderMarkup (
  $(compileTextFileWithDefault "templates/sample.txt"
    [("as", [| ["foo", "bar"] |])]
  )
)
:}
sample
key: foo,
key: bar,

compileHtmlFile :: FilePath -> Q Exp Source #

Same as compileTextFile but escapes template variables in HTML.

>>> putStr $ renderMarkup (let as = ["<a>", "b"] in $(compileHtmlFile "templates/sample.txt"))
sample
key: &lt;a&gt;,
key: b,

compileHtmlFileWith :: FilePath -> ScopeM () -> Q Exp Source #

Same as compileHtmlFile but allows the user to specify extra values for template parameters. Values declared by overwrite overwrites same name variables. Values declared by setDefault are overwritten by same name variables.

>>> :set -XOverloadedStrings
>>> :{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileHtmlFileWith "templates/sample.txt" $ do
    setDefault "as" [| ["foo", "bar"] |]
  )
)
:}
sample
key: &lt;a&gt;,
key: b,
>>> :{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileHtmlFileWith "templates/sample.txt" $ do
    overwrite "as" [| ["foo", "bar"] |]
  )
)
:}
sample
key: foo,
key: bar,
>>> :{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileHtmlFileWith "templates/sample.txt" $ do
    overwrite "as" [| ["bazbaz", "barbar"] |]
    setDefault "as" [| ["foo", "bar"] |]
    overwrite "as" [| ["baz", "foobar"] |]
  )
)
:}
sample
key: baz,
key: foobar,

compileHtmlFileWithDefault :: FilePath -> DefaultScope -> Q Exp Source #

Same as compileHtmlFile but allows the user to specify default values for template parameters.

>>> :set -XOverloadedStrings
:{
putStr $ renderMarkup (
  let as = ["<a>", "b"]
  in $(compileHtmlFileWithDefault "templates/sample.txt"
    [("as", [| ["foo", "bar"] |])]
  )
)
:}
sample
key: &lt;a&gt;,
key: b,
>>> :{
putStr $ renderMarkup (
  $(compileHtmlFileWithDefault "templates/sample.txt"
    [("as", [| ["foo", "bar"] |])]
  )
)
:}
sample
key: foo,
key: bar,

QuasiQuoters

compileText :: QuasiQuoter Source #

Heterocephalus quasi-quoter. This function DOES NOT escape template variables. To render the compiled file, use Renderer.*.renderMarkup.

>>> renderMarkup (let as = ["<a>", "b"] in [compileText|sample %{ forall a <- as }key: #{a}, %{ endforall }|])
"sample key: <a>, key: b, "
>>> renderMarkup (let num=2 in [compileText|#{num} is %{ if even num }an even number.%{ elseif (num > 100) }big.%{ else }an odd number.%{ endif }|])
"2 is an even number."

compileHtml :: QuasiQuoter Source #

Heterocephalus quasi-quoter for HTML. Same as compileText but this function does escape template variables in HTML.

>>> renderMarkup (let as = ["<a>", "b"] in [compileHtml|sample %{ forall a <- as }key: #{a}, %{ endforall }|])
"sample key: &lt;a&gt;, key: b, "

ScopeM

data ScopeM a Source #

A type to handle extra scopes. This is opaque type, so use setDefault and overwrite to construct new ScopeM.

Instances

Monad ScopeM Source # 

Methods

(>>=) :: ScopeM a -> (a -> ScopeM b) -> ScopeM b #

(>>) :: ScopeM a -> ScopeM b -> ScopeM b #

return :: a -> ScopeM a #

fail :: String -> ScopeM a #

Functor ScopeM Source # 

Methods

fmap :: (a -> b) -> ScopeM a -> ScopeM b #

(<$) :: a -> ScopeM b -> ScopeM a #

Applicative ScopeM Source # 

Methods

pure :: a -> ScopeM a #

(<*>) :: ScopeM (a -> b) -> ScopeM a -> ScopeM b #

(*>) :: ScopeM a -> ScopeM b -> ScopeM b #

(<*) :: ScopeM a -> ScopeM b -> ScopeM a #

Monoid (ScopeM ()) Source # 

Methods

mempty :: ScopeM () #

mappend :: ScopeM () -> ScopeM () -> ScopeM () #

mconcat :: [ScopeM ()] -> ScopeM () #

setDefault :: Ident -> Q Exp -> ScopeM () Source #

Constructor for ScopeM. Values declared by this function are overwritten by same name variables exits in scope of render function.

overwrite :: Ident -> Q Exp -> ScopeM () Source #

Constructor for ScopeM. Values declared by this function overwrites same name variables exits in scope of render function.

low-level

data HeterocephalusSetting Source #

Settings that are used when processing heterocephalus templates.

Constructors

HeterocephalusSetting 

Fields

textSetting :: HeterocephalusSetting Source #

A setting that DOES NOT escape template variables.

This sets escapeExp to preEscapedToMarkup.

htmlSetting :: HeterocephalusSetting Source #

A setting that escapes template variables for Html

This sets escapeExp to toHtml.

defaultParseOptions :: ParseOptions Source #

Default set of parser options.

Sets parseOptionsControlPrefix to '%' and parseOptionsVariablePrefix to '#'.

createParseOptions Source #

Arguments

:: Char

The control prefix.

-> Char

The variable prefix.

-> ParseOptions 

compileFile :: HeterocephalusSetting -> FilePath -> Q Exp Source #

Compile a template file.

compileFileWith :: ScopeM () -> HeterocephalusSetting -> FilePath -> Q Exp Source #

Same as compileFile but we can specify default scope.

compileFileWithDefault :: DefaultScope -> HeterocephalusSetting -> FilePath -> Q Exp Source #

Same as compileFile but we can specify default scope.

compileFromString :: HeterocephalusSetting -> String -> Q Exp Source #

Same as compileFile, but just compile the String given.

>>> let as = ["<a>", "b"]
>>> let template = "sample %{ forall a <- as }key: #{a}, %{ endforall }"
>>> renderMarkup $(compileFromString textSetting template)
"sample key: <a>, key: b, "
>>> let as = ["<a>", "b"]
>>> let options = createParseOptions '|' '?'
>>> let setting = textSetting { parseOptions = options }
>>> let template = "sample |{ forall a <- as }key: ?{a}, |{ endforall }"
>>> renderMarkup $(compileFromString setting template)
"sample key: <a>, key: b, "

Orphan instances