packages feed

heist-emanote (empty) → 1.2.0.0

raw patch · 110 files changed

+7823/−0 lines, 110 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changedbinary-added

Dependencies added: HUnit, QuickCheck, aeson, attoparsec, base, bifunctors, blaze-builder, blaze-html, bytestring, containers, criterion, criterion-measurement, directory, directory-tree, dlist, filepath, hashable, lens, lifted-base, map-syntax, monad-control, mtl, process, random, semigroups, statistics, test-framework, test-framework-hunit, test-framework-quickcheck2, text, time, transformers, transformers-base, transformers-compat, unordered-containers, vector, xmlhtml

Files

+ .ghci view
@@ -0,0 +1,7 @@+:set -XOverloadedStrings+:set -XCPP+:set -Wall+:set -isrc+:set -itest/suite+:set -hide-package MonadCatchIO-mtl+:set -hide-package monads-tf
+ CONTRIBUTORS view
@@ -0,0 +1,8 @@+Doug Beardsley <mightybyte@gmail.com>+Gregory Collins <greg@gregorycollins.net>+Carl Howells <chowells79@gmail.com>+Edward Kmett+Will Langstroth <will@langstroth.com>+Shane O'Brien <shane@duairc.com>+James Sanders <jimmyjazz14@gmail.com>+Mark Wright <gienah@gentoo.org>
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2009, Snap Framework authors (see CONTRIBUTORS)+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++Redistributions in binary form must reproduce the above copyright notice, this+list of conditions and the following disclaimer in the documentation and/or+other materials provided with the distribution.++Neither the name of the Snap Framework authors nor the names of its+contributors may be used to endorse or promote products derived from this+software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.SNAP.md view
@@ -0,0 +1,42 @@+Snap Framework+--------------++Snap is a simple and fast web development framework and server written in+Haskell. For more information or to download the latest version, you can visit+the Snap project website at http://snapframework.com/.+++Snap Status and Features+------------------------++The Snap core system consists of:++  * a high-speed HTTP server, with an optional high-concurrency backend using+    the [libev](http://software.schmorp.de/pkg/libev.html) library++  * a sensible and clean monad for web programming++  * an xml-based templating system for generating HTML that allows you to bind+    Haskell functionality to XML tags without getting PHP-style tag soup all+    over your pants++  * a "snaplet" system for building web sites from composable pieces.++Snap is currently only officially supported on Unix platforms; it has been+tested on Linux and Mac OSX Snow Leopard, and is reported to work on Windows.+++Snap Philosophy+---------------++Snap aims to be the *de facto* web toolkit for Haskell, on the basis of:++  * High performance++  * High design standards++  * Simplicity and ease of use, even for Haskell beginners++  * Excellent documentation++  * Robustness and high test coverage
+ README.md view
@@ -0,0 +1,65 @@+# Heist++[![Build Status](https://travis-ci.org/snapframework/heist.svg?branch=master)](https://travis-ci.org/snapframework/heist)++!!!+This is a fork of `heist` released to Hackage, with [this PR](https://github.com/snapframework/heist/pull/130) applied on top of upstream master.+!!!++Heist, part of the [Snap Framework](http://www.snapframework.com/), is a+Haskell library for xml/html templating. It uses simple XML tags to bind+values to your templates in a straightforward way. For example, if you were to+put the following in a template:++    <bind tag="message">some text</bind>+    <p><message/></p>++the resulting xhtml would be++    <p>some text</p>++Likewise, if you need to add text to an attribute,++    <bind tag="special">special-id</bind>+    <div id="${special}">very special</div>++gives you++    <div id="special-id">very special</div>++Values can also be pulled from "Splices" (see +[the documentation](http://snapframework.com/docs/tutorials/heist#heist-programming) +for more information.)++## Building heist++The heist library is built using [Cabal](http://www.haskell.org/cabal/) and+[Hackage](http://hackage.haskell.org/packages/hackage.html). Just run++    cabal install++from the `heist` toplevel directory.+++## Building the Haddock Documentation++The haddock documentation can be built using the supplied `haddock.sh` shell+script:++    ./haddock.sh++The docs get put in `dist/doc/html/`.+++## Building the testsuite++To build the test suite, `cd` into the `test/` directory and run++    $ cabal configure+    $ cabal build++From here you can invoke the testsuite by running:++    $ ./runTestsAndCoverage.sh ++The testsuite generates an `hpc` test coverage report in `test/dist/hpc`.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ TODO view
@@ -0,0 +1,8 @@+* Fix handling of ".." in apply tags++Ongoing+-------++* Improve test coverage+* Head merging (ala the Lift Web Framework)+
+ docs/Makefile view
@@ -0,0 +1,9 @@+all: out/templates.html++clean:+	rm -Rf out++out/templates.html: templates.md templates.css+	mkdir -p out+	cp templates.css out/+	pandoc -c templates.css -s -f markdown  -o out/templates.html templates.md
+ docs/templates.css view
@@ -0,0 +1,47 @@+body{+    font-size: 12pt;+    color:#2c558a;+    background:#fdfeff;+    width: 75ex;+    margin:0 auto;+    font-family: "Helvetica Neue", "Arial", "Helvetica", sans-serif;+}++a:link, a:visited, a:active, a:hover{+    text-decoration: none;+}++a:link, a:visited {+    color: #3d3dff;+}++a:hover {+    color: #622c8c;+}++a:active {+    color: #8c2c85;+}++h1,h2,h3{+    font-weight:normal;+    color:#2c558a;+    letter-spacing:-0.02em;+}++h1{+    font-size:2em;+}+h2{+    font-size:1.5em;+}+h3{+    font-weight: bold;+}+p{+    line-height:1.7em;+    text-align: justify;+}+ul li{+    padding: 0.5em 0em;+}
+ docs/templates.md view
@@ -0,0 +1,308 @@+## Heist Templates++Heist templates serve two primary design goals.  First, they facilitate+the separation of the view from the other aspects of your application.+Second, they provide abstraction capabilities that allow you to avoid+repeated template code.  This allows you to follow the DRY principle+(Don't Repeat Yourself) in the development of your application views.++Heist has two primary template abstraction constructs: bind and apply.+They are implemented as specialized XML tags.++### The `<bind ...>` tag++The `bind` tag allows you to bind XML content to a single tag.+Whenever the bound tag is used, the template engine will substitute+the 'bind' tag's child nodes in its place.  This allows you to+essentially create your own higher-level markup language that Heist+transforms into whatever XML-based markup language is native to your+application.++#### Attributes++The `bind` tag has a single required attribute called `tag` specifying the+name of the bound tag.  If this attribute is not present, then the+`bind` tag has no effect.++#### Example++Here's a simple example demonstrating the use of bind.++~~~~~~~~~~~~~~~ {.html}+  <bind tag="longname">+    Einstein, Feynman, Heisenberg, and Newton Reasearch Corporation+Ltd.<sup>TM</sup>+  </bind>+  We at <longname/> have research expertise in many areas of physics.+Employment at <longname/> carries significant prestige.  The rigorous+hiring process developed by <longname/> is leading the industry.+~~~~~~~~~~~~~~~++The full company name will be substituted at every occurrance of the+`<longname/>` tag.  This eliminates repetition and makes it easier to+make changes.++### The `<apply ...>` tag++The `apply` tag loads one of your application templates and inserts it+into the current template's XML tree.  If the target template does not+have any special tags, then the contents of the `apply` tag are+ignored.++#### Attributes++The `apply` tag has one required attribute called `template`.  This+attribute specifies the name of the template being applied.  Heist+template names work a little differently from traditional paths and+filenames.++If the template name contains a '/' character, then it will behave+like traditional relative and absolute paths.  The root directory will+be the root of your template directory tree, and the current directory+will be the directory containing whatever template is currently being+processed.  Absolute template path names start at the root directory.+Relative template path names start at the current directory.++If the template name does not have any '/' characters, then Heist+searches in the current directory for a template with that name.  If+it finds one, then Heist applies the template just like you would+expect.  The different behavior is that if the named template is+not found in the current directory, Heist recursively searches up the+directory hierarchy looking for the name.  Heist uses the first+template it finds on the way up that has that name.  If no template is+found, then you'll get an error.++This cascading behavior allows you to put site-wide templates in the+top-level directory and selectively override them in subdirectories+for certain parts of your site.++#### Example++Let's look at a simple example to demonstrate the most basic use of+the `apply` tag.  Say you have a navigation menu that is used on many+different pages of your site.  You want to avoid duplicating the HTML+code in multiple different page templates, so you might put it in a+template file by itself called `nav.tpl` that looks like this:++~~~~~~~~~~~~~~~ {.html}+  <ul>+    <li><a href="/">Home</a></li>+    <li><a href="/faq">FAQ</a></li>+    <li><a href="/contact">Contact</a></li>+  </ul>+~~~~~~~~~~~~~~~++Then to include this nav template in your front page template, you+would use the `apply` tag.  Here is what a simple home page template+`home.tpl` might look like:++~~~~~~~~~~~~~~~ {.html}+  <html>+    <head>+      <title>Home Page</title>+    </head>+    <body>+      <h1>Home Page</h1>+      <apply template="nav"/>+      <p>Welcome to our home page</p>+    </body>+  </html>+~~~~~~~~~~~~~~~++When a user requests the `/home` URL, Heist would serve `home.tpl`,+and the nav template would automatically be inserted into the page.+Here is what the HTML will look like after Heist processes the+template:++~~~~~~~~~~~~~~~ {.html}+  <html>+    <head>+      <title>Home Page</title>+    </head>+    <body>+      <h1>Home Page</h1>+      <ul>+        <li><a href="/">Home</a></li>+        <li><a href="/faq">FAQ</a></li>+        <li><a href="/contact">Contact</a></li>+      </ul>+      <p>Welcome to our home page</p>+    </body>+  </html>+~~~~~~~~~~~~~~~+++### The `<content>` tag++Sometimes it is useful to pass information (usually in the form of XML+data) into the template when it is applied so the template can insert+it in useful places.  This allows you to build page templates that are+not just static blocks of code.  If you are a programmer, you can+think of a template as if it was a function that could have any number+of parameters.++In our previous example, we did not pass any parameters to the `nav`+template when it was applied, so the `<apply>` tag was empty.  If we+include data inside the body of the `<apply>` tag, the template being+called can access this data with the `<content>` tag.  The following+simple example illustrates this concept.  We create a site template+called `default.tpl`:++~~~~~~~~~~~~~~~ {.html}+<html>+  <head>+    <title>Home Page</title>+  </head>+  <body>+    <div id="header">+      <h1>XYZ Inc.</h1>+    </div>+    <div id="content">+      <content />+    </div>+    <div id="footer">+      <p>Copyright XYZ Inc</p>+    </div>+  </body>+</html>+~~~~~~~~~~~~~~~+++The `<content>` tag "pulls in" the page content from the calling+template and inserts it into the content `<div>`.++Now we have a template for our home page called home.tpl:++~~~~~~~~~~~~~~~ {.html}+<apply template="default">+  <h1>Home Page</h1>+  <p>Welcome to XYZ Inc</p>+</apply>+~~~~~~~~~~~~~~~++And when Heist receives a request to `/home`, it will serve the+following:++~~~~~~~~~~~~~~~ {.html}+<html>+  <head>+    <title>Home Page</title>+  </head>+  <body>+    <div id="header">+      <h1>XYZ Inc.</h1>+    </div>+    <div id="content">+      <h1>Home Page</h1>+      <p>Welcome to XYZ Inc</p>+    </div>+    <div id="footer">+      <p>Copyright XYZ Inc</p>+    </div>+  </body>+</html>+~~~~~~~~~~~~~~~++The two lines from inside the `<apply>` tag have been substituted into+the content div in `default.tpl`.  Notice the difference between these+two examples.  In the first example we pulled in a template+(`nav.tpl`) that went inside the page being served (`home.tpl`).  In+the second example, `home.tpl` is still the intended target of+requests, but the `default.tpl` template surrounds the content that+home.tpl supplies as an argument.  This seems like different behavior,+but it is just a different use of the same `apply` tag.  This+illustrates the power of a simple concept like `apply`.++### Using Bind and Apply++What if, in the above example, we decided that the contents of the+header div should be different for different pages?  To do this, we+need a way to pass multiple parameters into a template.  Heist+provides this capability with the `<bind>` tag.  Inside the body of a+`<apply>` tag, you can have multiple bind tags surrounding data to be+passed as separate parameters.  Each `<bind>` tag must have a `tag`+attribute that provides a name for its contents just as described+above.  Then, inside the template, those tags will be substituted with+the appropriate data.++The previous example only needs a few modifications to `default.tpl`+to allow multiple parameters.++~~~~~~~~~~~~~~~ {.html}+<html>+  <head>+    <title>Home Page</title>+  </head>+  <body>+    <div id="header">+      <header/>+    </div>+    <div id="content">+      <main/>+    </div>+    <div id="footer">+      <p>Copyright XYZ Inc</p>+    </div>+  </body>+</html>+~~~~~~~~~~~~~~~+++And `home.tpl` uses the `<bind>` tag with a name attribute to define+values for the `<header/>` and `<main/>` tags:++~~~~~~~~~~~~~~~ {.html}+<apply template="default">+  <bind tag="header">+    <h1>XYZ Inc.</h1>+  </bind>+  Some in-between text.+  <bind tag="main">+    <h1>Home Page</h1>+    <p>Welcome to XYZ Inc</p>+  </bind>+</apply>+~~~~~~~~~~~~~~~++The result template for this example is the same as the previous+example.++NOTE: In this example the `<content/>` tag is still bound as described+above.  The `<content/>` tag is always bound to the complete contents+of the calling `apply` tag.  However, any `bind` tags inside the apply+will disappear.  If we changed `default.tpl` to the following:++~~~~~~~~~~~~~~~ {.html}+<foo>+  <content/>+</foo>+~~~~~~~~~~~~~~~++Then the above `home.tpl` template would render like this:++~~~~~~~~~~~~~~~ {.html}+<foo>+  Some in-between text.+</foo>+~~~~~~~~~~~~~~~+++### The `<ignore>` tag++In some cases you may want to include example data in a Heist template+that should not be rendered when the site is active.  Heist provides+the `<ignore>` tag for this purpose.  All `<ignore>` tags and their+contents will be eliminated in a template's output.+++### The `<children>` tag++XML requires that well-formed documents have a single root element.+Sometimes you might want to make templates that don't have a single+root element.  In these situations the `<children>` tag is just what+you want.  When the children tag is rendered, it strips itself off and+just returns its child nodes.  This allows you to have a single root+element where necessary, but have that tag disappear in the rendered+output.++
+ examples/ex01/home.tpl view
@@ -0,0 +1,10 @@+<html>+  <head>+    <title>Home Page</title>+  </head>+  <body>+    <h1>Home Page</h1>+    <apply template="ex01/nav"/>+    <p>Welcome to our home page.</p>+  </body>+</html>
+ examples/ex01/nav.tpl view
@@ -0,0 +1,5 @@+<ul>+  <li><a href="/">Home</a></li>+  <li><a href="/faq">FAQ</a></li>+  <li><a href="/contact">Contact</a></li>+</ul>
+ examples/ex02/default.tpl view
@@ -0,0 +1,16 @@+<html>+  <head>+    <title>Home Page</title>+  </head>+  <body>+    <div id="header">+      <h1>XYZ Inc.</h1>+    </div>+    <div id="content">+      <content/>+    </div>+    <div id="footer">+      <p>Copyright XYZ Inc</p>+    </div>+  </body>+</html>
+ examples/ex02/home.tpl view
@@ -0,0 +1,4 @@+<apply template="ex02/default">+  <h1>Home Page</h1>+  <p>Welcome to XYZ Inc</p>+</apply>
+ examples/ex03/default.tpl view
@@ -0,0 +1,16 @@+<html>+  <head>+    <title>Home Page</title>+  </head>+  <body>+    <div id="header">+      <header/>+    </div>+    <div id="content">+      <main/>+    </div>+    <div id="footer">+      <p>Copyright XYZ Inc</p>+    </div>+  </body>+</html>
+ examples/ex03/home.tpl view
@@ -0,0 +1,9 @@+<apply template="ex03/default">+  <bind tag="header">+    <h1>XYZ Inc.</h1>+  </bind>+  <bind tag="main">+    <h1>Home Page</h1>+    <p>Welcome to XYZ Inc</p>+  </bind>+</apply>
+ examples/test01.tpl view
@@ -0,0 +1,1 @@+<root><bind tag="foo"><bind tag="foo">bar</bind></bind><foo/><foo/></root>
+ examples/test02.tpl view
@@ -0,0 +1,5 @@+<root><bind tag="foo">***</bind>+<foo/>+This is a test <foo/> of the emergency broadcasting system.+<foo/>+</root>
+ extra/haddock.css view
@@ -0,0 +1,436 @@+/* -------- Global things --------- */++HTML {+  background-color: #f0f3ff;+  width: 100%;+}++BODY { +  -moz-border-radius:5px;+  -webkit-border-radius:5px;+  width: 50em;+  margin: 2em auto;+  padding: 0;+  background-color: #ffffff;+  color: #000000;+  font-size: 110%;+  font-family: Georgia, serif;+  }++A:link    { color: #5200A3; text-decoration: none }+A:visited { color: #5200A3; text-decoration: none }+A:hover   { color: #5200A3; text-decoration: none; border-bottom:#5200A3 dashed 1px; }++TABLE.vanilla {+  width: 100%;+  border-width: 0px;+  /* I can't seem to specify cellspacing or cellpadding properly using CSS... */+}++DL {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  letter-spacing: -0.01em;+  margin: 0;+}++.vanilla .vanilla dl { font-size: 80%; }+.vanilla .vanilla dl dl { padding-left: 0; font-size: 95%; }++TD.section1, TD.section2, TD.section3, TD.section4, TD.doc, DL {+  padding: 0 30px 0 34px;+}++TABLE.vanilla2 {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  border-width: 0px;+}++/* <TT> font is a little too small in MSIE */+TT, PRE, CODE  {+  font-family: Monaco,+               "DejaVu Sans Mono",+               "Bitstream Vera Sans Mono",+               "Lucida Console",+               monospace;+  font-size: 90%;+}++LI P { margin: 0pt } ++P { margin-top: 0; margin-bottom: 0.75em; }++TD {+  border-width: 0px;+}++TABLE.narrow {+  border-width: 0px;+}++TD.s8  {  height: 0; margin:0; padding: 0  }+TD.s15 {  height: 20px; }++SPAN.keyword { text-decoration: underline; }++/* Resize the buttom image to match the text size */+IMG.coll { width : 0.75em; height: 0.75em; margin-bottom: 0; margin-right: 0.5em }++/* --------- Contents page ---------- */++DIV.node {+  padding-left: 3em;+}++DIV.cnode {+  padding-left: 1.75em;+}++SPAN.pkg {+  position: absolute;+  left: 50em;+}++/* --------- Documentation elements ---------- */++TD FONT { font-weight: bold; letter-spacing: -0.02em; }++TD.children {+  padding-left: 25px;+  }++TD.synopsis {+  padding: 2px;+  background-color: #f0f0f0;+  font-size: 80%;+  font-family: Monaco,+               "DejaVu Sans Mono",+               "Bitstream Vera Sans Mono",+               "Lucida Console",+               monospace;++ }++TD.decl { +  padding: 4px 8px;+  background-color: #FAFAFA; +  border-bottom: #F2F2F2 solid 1px;+  border-top: #FCFCFC solid 1px;+  font-size: 80%;+  font-family: Monaco,+               "DejaVu Sans Mono",+               "Bitstream Vera Sans Mono",+               "Lucida Console",+               monospace;++  vertical-align: top;+  }++TD.decl TD.decl {+  font-size: 100%;+  padding: 4px 0;+  border: 0;+}++TD.topdecl {+  padding: 20px 30px 0.5ex 30px;+  font-size: 80%;+  font-family: Monaco,+               "DejaVu Sans Mono",+               "Bitstream Vera Sans Mono",+               "Lucida Console",+               monospace;+;+  vertical-align: top;+}++.vanilla .vanilla .vanilla .topdecl {+  padding-left: 0;+  padding-right: 0;+}++.vanilla .vanilla .vanilla {+  padding-left: 30px;+}++.decl .vanilla {+  padding-left: 0px !important;+}++.body .vanilla .body {+  padding-left: 0;+  padding-right: 0;+}++.body .vanilla .body .decl {+  padding-left: 12px;+}++.body .vanilla .body div .vanilla .decl {+  padding-left: 12px;+}++TABLE.declbar {+  background-color: #f0f0f0;+  border-spacing: 0px;+  border-bottom:1px solid #d7d7df;+  border-right:1px solid #d7d7df;+  border-top:1px solid #f4f4f9;+  border-left:1px solid #f4f4f9;+  padding: 4px;+ }++TD.declname {+  width: 100%;+  padding-right: 4px;+ }++TD.declbut {+  padding-left: 8px;+  padding-right: 5px;+  border-left-width: 1px;+  border-left-color: #000099;+  border-left-style: solid;+  white-space: nowrap;+  font-size: x-small;+ }++/* +  arg is just like decl, except that wrapping is not allowed.  It is+  used for function and constructor arguments which have a text box+  to the right, where if wrapping is allowed the text box squashes up+  the declaration by wrapping it.+*/+TD.arg { +  padding: 2px 12px;+  background-color: #f0f0f0; +  font-size: 80%;+  font-family: Monaco,+             "DejaVu Sans Mono",+             "Bitstream Vera Sans Mono",+             "Lucida Console",+             monospace;++  vertical-align: top;+  white-space: nowrap;+  }++TD.recfield { padding-left: 20px }++TD.doc  { +  padding-left: 38px;+  font-size: 95%;+  line-height: 1.66;+  }++TD.ndoc  { +  font-size: 95%;+  line-height: 1.66;+  padding: 2px 4px 2px 8px;+  }++TD.rdoc  { +  padding: 2px;+  padding-left: 30px;+  width: 100%;+  font-size: 80%;+  font-style: italic;+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  }++TD.body  { +  padding: 0 30px;+  }++TD.pkg {+  width: 100%;+  padding-left: 30px+}++TABLE.indexsearch TR.indexrow {+  display: none;+}+TABLE.indexsearch TR.indexshow {+  display: table-row;+}++TD.indexentry {+  vertical-align: top;+  padding: 0 30px+  }++TD.indexannot {+  vertical-align: top;+  padding-left: 20px;+  white-space: nowrap+  }++TD.indexlinks {+  width: 100%+  }++/* ------- Section Headings ------- */++TD.section1, TD.section2, TD.section3, TD.section4, TD.section5 {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+}++TD.section1 {+  padding-top: 14px;+  font-weight: bold;+  letter-spacing: -0.02em;+  font-size: 140%+  }++TD.section2 {+  padding-top: 4px;+  font-weight: bold;+  letter-spacing: -0.02em;+  font-size: 120%+  }++TD.section3 {+  padding-top: 5px;+  font-weight: bold;+  letter-spacing: -0.02em;+  font-size: 105%+  }++TD.section4 {+  font-weight: bold;+  padding-top: 12px;+  padding-bottom: 4px;+  letter-spacing: -0.02em;+  font-size: 90%+  }++/* -------------- The title bar at the top of the page */++TD.infohead {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  color: #ffffff;+  font-weight: bold;+  padding: 0 30px;+  text-align: left;+}++TD.infoval {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  color: #ffffff;+  padding: 0 30px;+  text-align: left;+}++TD.topbar {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  background-color: #3465a4;+  padding: 5px;+  -moz-border-radius-topleft:5px;+  -moz-border-radius-topright:5px;+  -webkit-border-radius-topleft:5px;+  -webkit-border-radius-topright:5px;+}++TD.title {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  color: #ffffff;+  padding-left: 30px;+  letter-spacing: -0.02em;+  font-weight: bold;+  width: 100%+  }++TD.topbut {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  padding-left: 5px;+  padding-right: 5px;+  border-left-width: 1px;+  border-left-color: #ffffff;+  border-left-style: solid;+  letter-spacing: -0.02em;+  font-weight: bold;+  white-space: nowrap;+  }++TD.topbut A:link {+  color: #ffffff+  }++TD.topbut A:visited {+  color: #ffff00+  }++TD.topbut A:hover {+  background-color: #C9D3DE;+  }++TD.topbut:hover {+  background-color: #C9D3DE;+  }++TD.modulebar { +  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  color: #141B24;+  background-color: #C9D3DE;+  padding: 5px;+  border-top-width: 1px;+  border-top-color: #ffffff;+  border-top-style: solid;+  -moz-border-radius-bottomleft:5px;+  -moz-border-radius-bottomright:5px;+  -webkit-border-radius-bottomleft:5px;+  -webkit-border-radius-bottomright:5px;++  }++/* --------- The page footer --------- */++TD.botbar {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  -moz-border-radius:5px;+  -webkit-border-radius:5px;+  background-color: #3465a4;+  color: #ffffff;+  padding: 5px+  }+TD.botbar A:link {+  color: #ffffff;+  text-decoration: underline+  }+TD.botbar A:visited {+  color: #ffff00+  }+TD.botbar A:hover {+  background-color: #6060ff+  }++/* --------- Mini Synopsis for Frame View --------- */++.outer {+  margin: 0 0;+  padding: 0 0;+}++.mini-synopsis {+  padding: 0.25em 0.25em;+}++.mini-synopsis H1 { font-size: 120%; }+.mini-synopsis H2 { font-size: 107%; }+.mini-synopsis H3 { font-size: 100%; }+.mini-synopsis H1, .mini-synopsis H2, .mini-synopsis H3 {+  font-family: "Gill Sans", "Helvetica Neue","Arial",sans-serif;+  margin-top: 0.5em;+  margin-bottom: 0.25em;+  padding: 0 0;+  font-weight: bold; letter-spacing: -0.02em;+}++.mini-synopsis H1 { border-bottom: 1px solid #ccc; }++.mini-topbar {+  font-size: 120%;+  background: #0077dd;+  padding: 0.25em;+}++
+ extra/hscolour.css view
@@ -0,0 +1,15 @@+body { font-size: 90%; }++pre, code, body {+  font-family: Monaco,+               "DejaVu Sans Mono",+               "Bitstream Vera Sans Mono",+               "Lucida Console",+               monospace;+}++.hs-keyglyph, .hs-layout {color: #5200A3;}+.hs-keyword {color: #3465a4; font-weight: bold;}+.hs-comment, .hs-comment a {color: #579; }+.hs-str, .hs-chr {color: #141B24;}+.hs-keyword, .hs-conid, .hs-varid, .hs-conop, .hs-varop, .hs-num, .hs-cpp, .hs-sel, .hs-definition {}
+ extra/logo.gif view

binary file changed (absent → 607 bytes)

+ haddock.sh view
@@ -0,0 +1,10 @@+#!/bin/sh++set -x++HADDOCK_OPTS='--html-location=http://hackage.haskell.org/packages/archive/$pkg/latest/doc/html --css=extra/haddock.css'++cabal haddock $HADDOCK_OPTS --hyperlink-source $@++cp extra/logo.gif dist/doc/html/heist/haskell_icon.gif+cp extra/hscolour.css dist/doc/html/heist/src/
+ heist-emanote.cabal view
@@ -0,0 +1,328 @@+name:           heist-emanote+version:        1.2.0.0+synopsis:       An Haskell template system supporting both HTML5 and XML.+description:+    Heist is a powerful template system that supports both HTML5 and XML.+    Some of Heist's features are:+    .+    * Designer-friendly HTML5 (or XML) syntax+    .+    * Templates can be reloaded to make changes visible without recompiling+      your Haskell code+    .+    * Enforces near-perfect separation of business logic and view+    .+    * Powerful abstraction primitives allowing you to eliminate repetition+    .+    * Easy creation of domain-specific markup languages+    .+    * Built-in support for including JSON and Markdown content in templates+    .+    * Simple mechanism for designer-specified template caching+    .+    * Optional merging of multiple \<head\> tags defined anywhere in the+      document+license:        BSD3+license-file:   LICENSE+author:         Doug Beardsley, Gregory Collins+maintainer:     snap@snapframework.com+build-type:     Simple+cabal-version:  >= 1.10+homepage:       http://snapframework.com/+category:       Web, Snap++Tested-With:+  GHC == 7.4.2,+  GHC == 7.6.3,+  GHC == 7.8.4,+  GHC == 7.10.3,+  GHC == 8.0.2,+  GHC == 8.2.2,+  GHC == 8.4.4,+  GHC == 8.6.3,+  GHC == 8.8.3,+  GHC == 8.10.1++extra-source-files:+  .ghci,+  CONTRIBUTORS,+  docs/Makefile,+  docs/templates.css,+  docs/templates.md,+  examples/ex01/home.tpl,+  examples/ex01/nav.tpl,+  examples/ex02/default.tpl,+  examples/ex02/home.tpl,+  examples/ex03/default.tpl,+  examples/ex03/home.tpl,+  examples/test01.tpl,+  examples/test02.tpl,+  extra/haddock.css,+  extra/hscolour.css,+  extra/logo.gif,+  haddock.sh,+  LICENSE,+  README.md,+  README.SNAP.md,+  test/suite/Benchmark.hs,+  test/suite/Heist/Compiled/Tests.hs,+  test/suite/Heist/Interpreted/Tests.hs,+  test/suite/Heist/TestCommon.hs,+  test/suite/Heist/Tests.hs,+  test/suite/Heist/Tutorial/AttributeSplices.lhs,+  test/suite/Heist/Tutorial/CompiledSplices.lhs,+  test/suite/Heist/Tutorial/Imports.hs,+  test/suite/TestSuite.hs,+  test/templates/a.tpl,+  test/templates/attr_splice.tpl,+  test/templates/attrs.tpl,+  test/templates/attrsubtest1.tpl,+  test/templates/attrsubtest2.tpl,+  test/templates/backslash.tpl+  test/templates/bar/a.tpl,+  test/templates/bar/index.tpl,+  test/templates/bind-apply-interaction/_outer.tpl,+  test/templates/bind-apply-interaction/caller.tpl,+  test/templates/bind-attrs.tpl,+  test/templates/bind_param.tpl,+  test/templates/cache.tpl,+  test/templates/div_expansion.tpl,+  test/templates/foo/a.tpl,+  test/templates/foo/b.tpl,+  test/templates/foo/markdown-chdir.tpl,+  test/templates/foo/markdown-origdir.tpl,+  test/templates/foo/test2.md,+  test/templates/head_merge/index.tpl,+  test/templates/head_merge/nav.tpl,+  test/templates/head_merge/wrap.tpl,+  test/templates/index.tpl,+  test/templates/ioc.tpl,+  test/templates/json.tpl,+  test/templates/json_array.tpl+  test/templates/json_object.tpl,+  test/templates/json_snippet.tpl,+  test/templates/markdown.tpl,+  test/templates/namespaces.tpl+  test/templates/page.tpl,+  test/templates/pandoc.tpl+  test/templates/pandocdiv.tpl+  test/templates/people.tpl,+  test/templates/post.tpl,+  test/templates/readme.txt,+  test/templates/rss.xtpl+  test/templates/test.md,+  test/templates/textarea_expansion.tpl,+  test/templates/title_expansion.tpl,+  test/templates/user/admin/main.tpl,+  test/templates/user/admin/menu.tpl,+  test/templates/user/main.tpl,+  test/templates/user/menu.tpl,+  test/templates-bad/apply-missing-attr.tpl,+  test/templates-bad/apply-template-not-found.tpl,+  test/templates-bad/bind-infinite-loop.tpl,+  test/templates-bad/bind-missing-attr.tpl,+  test/templates-defer/test.tpl,+  test/templates-loaderror/_error.tpl,+  test/templates-loaderror/_ok.tpl,+  test/templates-loaderror/test.tpl,+  test/templates-nsbind/nsbind.tpl,+  test/templates-nsbind/nsbinderror.tpl,+  test/templates-ns-nested/test.tpl,+  test/templates-nscall/_call.tpl,+  test/templates-nscall/_invalid.tpl,+  test/templates-nscall/nscall.tpl,+  TODO+++Library+  default-language: Haskell2010+  hs-source-dirs: src++  exposed-modules:+    Heist,+    Heist.Common,+    Heist.Compiled,+    Heist.Compiled.LowLevel,+    Heist.Internal.Types,+    Heist.Interpreted,+    Heist.Splices,+    Heist.Splices.Apply,+    Heist.Splices.Bind,+    Heist.Splices.BindStrict,+    Heist.Splices.Cache,+    Heist.Splices.Html,+    Heist.Splices.Ignore,+    Heist.Splices.Json,+    Heist.Splices.Markdown,+    Heist.TemplateDirectory++  other-modules:+    Data.HeterogeneousEnvironment,+    Heist.Compiled.Internal,+    Heist.Internal.Types.HeistState,+    Heist.Interpreted.Internal++  build-depends:+    aeson                      >= 0.6     && < 1.6,+    attoparsec                 >= 0.10    && < 0.14,+    base                       >= 4.5     && < 4.15,+    blaze-builder              >= 0.2     && < 0.5,+    blaze-html                 >= 0.4     && < 0.10,+    bytestring                 >= 0.9     && < 0.11,+    containers                 >= 0.2     && < 0.7,+    directory                  >= 1.1     && < 1.4,+    directory-tree             >= 0.10    && < 0.13,+    dlist                      >= 0.5     && < 0.9,+    filepath                   >= 1.3     && < 1.5,+    hashable                   >= 1.1     && < 1.4,+    lifted-base                >= 0.2     && < 0.3,+    map-syntax                 >= 0.3     && < 0.4,+    monad-control              >= 0.3     && < 1.1,+    mtl                        >= 2.0     && < 2.3,+    process                    >= 1.1     && < 1.7,+    random                     >= 1.0.1.0 && < 1.3,+    text                       >= 0.10    && < 1.3,+    time                       >= 1.1     && < 1.11,+    transformers               >= 0.3     && < 0.6,+    transformers-base          >= 0.4     && < 0.5,+    unordered-containers       >= 0.1.4   && < 0.3,+    vector                     >= 0.9     && < 0.13,+    xmlhtml                    >= 0.2.3.5 && < 0.3++  if !impl(ghc >= 8.0)+    build-depends: semigroups >= 0.16 && < 0.19++  if impl(ghc >= 6.12.0)+    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields+                 -fno-warn-unused-do-bind+  else+    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields++  default-extensions:+    GeneralizedNewtypeDeriving,+    PackageImports,+    ScopedTypeVariables,+    DeriveDataTypeable,+    FlexibleInstances,+    MultiParamTypeClasses,+    UndecidableInstances,+    OverloadedStrings,+    TypeSynonymInstances,+    NoMonomorphismRestriction+++source-repository head+  type:     git+  location: https://github.com/snapframework/heist.git++Test-suite testsuite+  default-language: Haskell2010+  hs-source-dirs: src test/suite+  type: exitcode-stdio-1.0+  main-is: TestSuite.hs++  build-depends:+    HUnit                      >= 1.2      && < 2,+    QuickCheck                 >= 2        && < 2.15,+    lens                       >= 4.3      && < 4.20,+    test-framework             >= 0.4      && < 0.9,+    test-framework-hunit       >= 0.2.7    && < 0.4,+    test-framework-quickcheck2 >= 0.2.12.1 && < 0.4,+    aeson,+    attoparsec,+    base,+    bifunctors >= 5.3 && < 5.6,+    blaze-builder,+    blaze-html,+    bytestring,+    containers,+    directory,+    directory-tree,+    dlist,+    filepath,+    hashable,+    lifted-base,+    map-syntax,+    monad-control,+    mtl,+    process,+    random,+    text,+    time,+    transformers,+    transformers-base,+    unordered-containers,+    vector,+    xmlhtml++  if !impl(ghc >= 8.0)+    build-depends: semigroups >= 0.16 && < 0.19++  if impl(ghc >= 7.8) && impl(ghc < 7.10)+    build-depends: transformers-compat >= 0.3 && < 0.7++  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded+  default-extensions: OverloadedStrings++Benchmark benchmark+  default-language: Haskell2010+  hs-source-dirs: src test/suite+  type: exitcode-stdio-1.0+  main-is: Benchmark.hs++  build-depends:+    HUnit,+    criterion                 >= 1.0     && < 1.6,+    criterion-measurement     >= 0.1     && < 0.2,+    test-framework,+    test-framework-hunit,++    -- Copied from regular dependencies:++    aeson,+    attoparsec,+    base,+    blaze-builder,+    blaze-html,+    bytestring,+    containers,+    directory,+    directory-tree,+    dlist,+    filepath,+    hashable,+    lifted-base,+    map-syntax,+    monad-control,+    mtl,+    process,+    random,+    statistics                 >= 0.11    && < 0.16,+    text,+    time,+    transformers,+    transformers-base,+    unordered-containers,+    vector,+    xmlhtml++  if !impl(ghc >= 8.0)+    build-depends: semigroups >= 0.16 && < 0.19++  if impl(ghc >= 7.8) && impl(ghc < 7.10)+    build-depends: transformers-compat++  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded+               -fno-warn-unused-do-bind -rtsopts++  default-extensions:+    GeneralizedNewtypeDeriving,+    PackageImports,+    ScopedTypeVariables,+    DeriveDataTypeable,+    FlexibleInstances,+    MultiParamTypeClasses,+    UndecidableInstances,+    OverloadedStrings,+    TypeSynonymInstances,+    NoMonomorphismRestriction
+ src/Data/HeterogeneousEnvironment.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RankNTypes   #-}++------------------------------------------------------------------------------+module Data.HeterogeneousEnvironment+  ( KeyGen+  , HeterogeneousEnvironment+  , Key+  , newKeyGen+  , empty+  , makeKey+  , lookup+  , insert+  , delete+  , adjust+  , getKeyId+  ) where++------------------------------------------------------------------------------+import           Control.Monad+import           Data.IntMap   (IntMap)+import qualified Data.IntMap   as IM+import           Data.IORef+import           GHC.Exts+import           Prelude hiding (lookup)+import           Unsafe.Coerce++------------------------------------------------------------------------------+data HeterogeneousEnvironment = HeterogeneousEnvironment (IntMap Any)+newtype Key a = Key Int+newtype KeyGen = KeyGen (IORef Int)+++------------------------------------------------------------------------------+-- | If you use two different KeyGens to work with the same map, you deserve+-- what you get.+newKeyGen :: IO KeyGen+newKeyGen = liftM KeyGen $ newIORef 0+++------------------------------------------------------------------------------+getKeyId :: Key a -> Int+getKeyId (Key x) = x+++------------------------------------------------------------------------------+empty :: HeterogeneousEnvironment+empty = HeterogeneousEnvironment $ IM.empty+++------------------------------------------------------------------------------+makeKey :: KeyGen -> IO (Key a)+makeKey (KeyGen gen) = do+    k <- atomicModifyIORef gen nextKey+    return $ Key k+  where+    nextKey !x = if x >= maxBound-1+                   then error "too many keys generated"+                   else let !x' = x+1 in (x',x)+++------------------------------------------------------------------------------+lookup :: Key a -> HeterogeneousEnvironment -> Maybe a+lookup (Key k) (HeterogeneousEnvironment m) = fmap unsafeCoerce $ IM.lookup k m+++------------------------------------------------------------------------------+insert :: Key a -> a -> HeterogeneousEnvironment -> HeterogeneousEnvironment+insert (Key k) v (HeterogeneousEnvironment m) = HeterogeneousEnvironment $+                                                IM.insert k (unsafeCoerce v) m+++------------------------------------------------------------------------------+delete :: Key a -> HeterogeneousEnvironment -> HeterogeneousEnvironment+delete (Key k) (HeterogeneousEnvironment m) = HeterogeneousEnvironment $+                                              IM.delete k m+++------------------------------------------------------------------------------+adjust :: (a -> a) -> Key a -> HeterogeneousEnvironment -> HeterogeneousEnvironment+adjust f (Key k) (HeterogeneousEnvironment m) = HeterogeneousEnvironment $+                                                IM.adjust f' k m+  where+    f' = unsafeCoerce . f . unsafeCoerce
+ src/Heist.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}++{-|++This module defines the core data types used by Heist.  In practice you will+also want to import one or both of "Heist.Compiled" or "Heist.Interpreted" to+get functions needed for writing splices.++The Heist template system allows you to build custom HTML and XML based markup+languages.  With Heist you can define your own domain-specific tags+implemented with Haskell and use them in your templates.++-}++module Heist+  (+  -- * Primary Heist initialization functions+    loadTemplates+  , reloadTemplates+  , addTemplatePathPrefix+  , initHeist+  , initHeistWithCacheTag+  , defaultInterpretedSplices+  , defaultLoadTimeSplices+  , emptyHeistConfig++  -- * Core Heist data types+  , SpliceConfig+  , HeistConfig+  , TemplateRepo+  , TemplateLocation+  , Template+  , TPath+  , MIMEType+  , DocumentFile(..)+  , AttrSplice+  , RuntimeSplice+  , Chunk+  , HeistState+  , SpliceError(..)+  , CompileException(..)+  , HeistT++  -- * Lenses (can be used with lens or lens-family)+  , scInterpretedSplices+  , scLoadTimeSplices+  , scCompiledSplices+  , scAttributeSplices+  , scTemplateLocations+  , scCompiledTemplateFilter+  , hcSpliceConfig+  , hcNamespace+  , hcErrorNotBound+  , hcInterpretedSplices+  , hcLoadTimeSplices+  , hcCompiledSplices+  , hcAttributeSplices+  , hcTemplateLocations+  , hcCompiledTemplateFilter++  -- * HeistT functions+  , templateNames+  , compiledTemplateNames+  , hasTemplate+  , spliceNames+  , compiledSpliceNames+  , evalHeistT+  , getParamNode+  , getContext+  , getTemplateFilePath+  , localParamNode+  , getsHS+  , getHS+  , putHS+  , modifyHS+  , restoreHS+  , localHS+  , getDoc+  , getXMLDoc+  , tellSpliceError+  , spliceErrorText+  , orError+  , Splices+  ) where+++------------------------------------------------------------------------------+import           Control.Exception.Lifted+import           Control.Monad.State+import           Data.ByteString               (ByteString)+import qualified Data.ByteString.Char8         as BC+import qualified Data.ByteString               as B+import           Data.Either+import qualified Data.Foldable                 as F+import           Data.HashMap.Strict           (HashMap)+import qualified Data.HashMap.Strict           as Map+import qualified Data.HeterogeneousEnvironment as HE+import           Data.Map.Syntax+#if !MIN_VERSION_base(4,11,0)+import           Data.Monoid+#endif+import           Data.Text                     (Text)+import qualified Data.Text                     as T+import           System.Directory.Tree+import qualified Text.XmlHtml                  as X+------------------------------------------------------------------------------+import           Heist.Common+import qualified Heist.Compiled.Internal       as C+import qualified Heist.Interpreted.Internal    as I+import           Heist.Splices+import           Heist.Internal.Types+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | The built-in set of splices that you should use in compiled splice mode.+-- This list includes everything from 'defaultInterpretedSplices' plus a+-- splice for the content tag that errors out when it sees any instance of the+-- old content tag, which has now been moved to two separate tags called+-- apply-content and bind-content.+defaultLoadTimeSplices :: MonadIO m => Splices (I.Splice m)+defaultLoadTimeSplices = do+    -- To be removed in later versions+    defaultInterpretedSplices+    "content" #! deprecatedContentCheck++++------------------------------------------------------------------------------+-- | The built-in set of static splices.  All the splices that used to be+-- enabled by default are included here.  To get the normal Heist behavior you+-- should include these in the scLoadTimeSplices list in your SpliceConfig.+-- If you are using interpreted splice mode, then you might also want to bind+-- the 'deprecatedContentCheck' splice to the content tag as a load time+-- splice.+defaultInterpretedSplices :: MonadIO m => Splices (I.Splice m)+defaultInterpretedSplices = do+    applyTag ## applyImpl+    bindTag ## bindImpl+    ignoreTag ## ignoreImpl+    markdownTag ## markdownSplice++++------------------------------------------------------------------------------+-- | An empty HeistConfig that uses the \"h\" namespace with error checking+-- turned on.+emptyHeistConfig :: HeistConfig m+emptyHeistConfig = HeistConfig mempty "h" True+++allErrors :: [Either String (TPath, v)]+          -> Either [String] (HashMap TPath v)+allErrors tlist =+    case errs of+        [] -> Right $ Map.fromList $ rights tlist+        _  -> Left errs+  where+    errs = lefts tlist+++------------------------------------------------------------------------------+-- | Loads templates from disk.  This function returns just a template map so+-- you can load multiple directories and combine the maps before initializing+-- your HeistState.+loadTemplates :: FilePath -> IO (Either [String] TemplateRepo)+loadTemplates dir = do+    d <- readDirectoryWith (loadTemplate dir) dir+#if MIN_VERSION_directory_tree(0,11,0)+    return $ allErrors $ F.fold (dirTree d)+#else+    return $ allErrors $ F.fold (free d)+#endif+++------------------------------------------------------------------------------+-- | Reloads all the templates an an existing TemplateRepo.+reloadTemplates :: TemplateRepo -> IO (Either [String] TemplateRepo)+reloadTemplates repo = do+    tlist <- mapM loadOrKeep $ Map.toList repo+    return $ allErrors tlist+  where+    loadOrKeep (p,df) =+      case dfFile df of+        Nothing -> return $ Right (p, df)+        Just fp -> do+          df' <- loadTemplate' fp+          return $ fmap (p,) $ case df' of+            [t] -> t+            _ -> Left "Template repo has non-templates"+++------------------------------------------------------------------------------+-- | Adds a path prefix to a templates in a map returned by loadTemplates.  If+-- you want to add multiple levels of directories, separate them with slashes+-- as in "foo/bar".  Using an empty string as a path prefix will leave the+-- map unchanged.+addTemplatePathPrefix :: ByteString -> TemplateRepo -> TemplateRepo+addTemplatePathPrefix dir ts+  | B.null dir = ts+  | otherwise  = Map.fromList $+                 map (\(x,y) -> (f x, y)) $+                 Map.toList ts+  where+    f ps = ps++splitTemplatePath dir+++------------------------------------------------------------------------------+-- | Creates an empty HeistState.+emptyHS :: HE.KeyGen -> HeistState m+emptyHS kg = HeistState Map.empty Map.empty Map.empty Map.empty Map.empty+                        True [] [] 0 [] Nothing kg False Html "" [] False 0+++------------------------------------------------------------------------------+-- | This is the main Heist initialization function.  You pass in a map of all+-- templates and all of your splices and it constructs and returns a+-- HeistState.+--+-- We don't provide functions to add either type of loadtime splices to your+-- HeistState after initHeist because it doesn't make any sense unless you+-- re-initialize all templates with the new splices.  If you add any old-style+-- runtime heist splices after calling this function, they will still work+-- fine if you use Heist.Interpreted.renderTemplate.  If you add any templates+-- later, then those templates will be available for interpreted rendering,+-- but not for compiled rendering.+--+-- In the past you could add templates to your HeistState after initialization+-- using its Monoid instance.  Due to implementation details, this is no+-- longer possible.  All of your templates must be known when you call this+-- function.+initHeist :: Monad n+          => HeistConfig n+          -> IO (Either [String] (HeistState n))+initHeist hc = do+    keyGen <- HE.newKeyGen+    repos <- sequence $ _scTemplateLocations $ _hcSpliceConfig hc+    case sequence repos of+      Left es -> return $ Left es+      Right rs -> initHeist' keyGen hc (Map.unions rs)+++------------------------------------------------------------------------------+mkSplicePrefix :: Text -> Text+mkSplicePrefix ns+  | T.null ns = ""+  | otherwise = ns `mappend` ":"+++------------------------------------------------------------------------------+initHeist' :: Monad n+           => HE.KeyGen+           -> HeistConfig n+           -> TemplateRepo+           -> IO (Either [String] (HeistState n))+initHeist' keyGen (HeistConfig sc ns enn) repo = do+    let empty = emptyHS keyGen+    let (SpliceConfig i lt c a _ f) = sc+    etmap <- preproc keyGen lt repo ns+    let prefix = mkSplicePrefix ns+    let eis = runHashMap $ mapK (prefix<>) i+        ecs = runHashMap $ mapK (prefix<>) c+        eas = runHashMap $ mapK (prefix<>) a+    let hs1 = do+          tmap <- etmap+          is <- eis+          cs <- ecs+          as <- eas+          return $ empty { _spliceMap = is+                         , _templateMap = tmap+                         , _compiledSpliceMap = cs+                         , _attrSpliceMap = as+                         , _splicePrefix = prefix+                         , _errorNotBound = enn+                         }+    either (return . Left) (C.compileTemplates f) hs1+++------------------------------------------------------------------------------+-- | Runs preprocess on a TemplateRepo and returns the modified templates.+preproc :: HE.KeyGen+        -> Splices (I.Splice IO)+        -> TemplateRepo+        -> Text+        -> IO (Either [String] TemplateRepo)+preproc keyGen splices templates ns = do+    let esm = runHashMap splices+    case esm of+      Left errs -> return $ Left errs+      Right sm -> do+        let hs = (emptyHS keyGen) { _spliceMap = sm+                                  , _templateMap = templates+                                  , _preprocessingMode = True+                                  , _splicePrefix = mkSplicePrefix ns }+        let eval a = evalHeistT a (X.TextNode "") hs+        tPairs <- mapM (eval . preprocess) $ Map.toList templates+        let bad = lefts tPairs+        return $ if not (null bad)+                   then Left bad+                   else Right $ Map.fromList $ rights tPairs+++------------------------------------------------------------------------------+-- | Processes a single template, running load time splices.+preprocess :: (TPath, DocumentFile)+           -> HeistT IO IO (Either String (TPath, DocumentFile))+preprocess (tpath, docFile) = do+    let tname = tpathName tpath+        die   = error $ "Preprocess failed because the template `"+                     ++ BC.unpack tname+                     ++ "` was not found in the template repository."+    !emdoc <- try $ I.evalWithDoctypes tname+              :: HeistT IO IO (Either SomeException (Maybe X.Document))+    let f !doc = (tpath, docFile { dfDoc = doc })+    return $! either (Left . show) (Right . maybe die f) emdoc+++------------------------------------------------------------------------------+-- | Wrapper around initHeist that also sets up a cache tag.  It sets up both+-- compiled and interpreted versions of the cache tag splices.  If you need to+-- configure the cache tag differently than how this function does it, you+-- will still probably want to pattern your approach after this function's+-- implementation.+initHeistWithCacheTag :: MonadIO n+                      => HeistConfig n+                      -> IO (Either [String] (HeistState n, CacheTagState))+initHeistWithCacheTag (HeistConfig sc ns enn) = do+    (ss, cts) <- liftIO mkCacheTag+    let tag = "cache"+    keyGen <- HE.newKeyGen++    erepos <- sequence $ _scTemplateLocations sc+    case sequence erepos of+      Left es -> return $ Left es+      Right repos -> do+        -- We have to do one preprocessing pass with the cache setup splice.  This+        -- has to happen for both interpreted and compiled templates, so we do it+        -- here by itself because interpreted templates don't get the same load+        -- time splices as compiled templates.+        eRawWithCache <- preproc keyGen (tag ## ss) (Map.unions repos) ns+        case eRawWithCache of+          Left es -> return $ Left es+          Right rawWithCache -> do+            let sc' = SpliceConfig (tag #! cacheImpl cts) mempty+                                   (tag #! cacheImplCompiled cts)+                                   mempty mempty (const True)+            let hc = HeistConfig (mappend sc sc') ns enn+            hs <- initHeist' keyGen hc rawWithCache+            return $ fmap (,cts) hs
+ src/Heist/Common.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Heist.Common where++------------------------------------------------------------------------------+import           Control.Applicative      (Alternative (..))+import           Control.Exception        (SomeException)+import qualified Control.Exception.Lifted as C+import           Control.Monad            (liftM, mplus)+import qualified Data.Attoparsec.Text     as AP+import           Data.ByteString          (ByteString)+import qualified Data.ByteString          as B+import qualified Data.ByteString.Char8    as BC+import           Data.Hashable            (Hashable)+import           Data.HashMap.Strict      (HashMap)+import qualified Data.HashMap.Strict      as Map+import           Data.List                (isSuffixOf)+import           Data.Map.Syntax+import           Data.Maybe               (isJust)+import           Data.Monoid              ((<>))+import           Data.Text                (Text)+import qualified Data.Text                as T+import           Heist.Internal.Types.HeistState+import           System.FilePath          (pathSeparator)+import qualified Text.XmlHtml             as X+#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative      (Applicative (..), (<$>))+import           Data.Monoid              (Monoid (..))+#endif+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+runHashMap+    :: Splices s+    -> Either [String] (HashMap T.Text s)+runHashMap ms =+    case runMapSyntax Map.lookup Map.insert ms of+      Left keys -> Left $ map (T.unpack . mkMsg) keys+      Right hm -> Right hm+  where+    mkMsg k = "You tried to bind "<>k<>" more than once!"+++------------------------------------------------------------------------------+runMapNoErrors :: (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v+runMapNoErrors = either (const mempty) id .+    runMapSyntax' (\_ new _ -> Just new) Map.lookup Map.insert++applySpliceMap :: HeistState n+                -> (HeistState n -> HashMap Text v)+                -> MapSyntaxM Text v a+                -> HashMap Text v+applySpliceMap hs f =  (flip Map.union (f hs)) .+    runMapNoErrors .+    mapK (mappend pre)+  where+    pre = _splicePrefix hs++------------------------------------------------------------------------------+-- | If Heist is running in fail fast mode, then this function will throw an+-- exception with the second argument as the error message.  Otherwise, the+-- first argument will be executed to represent silent failure.+--+-- This behavior allows us to fail quickly if an error crops up during+-- load-time splice processing or degrade more gracefully if the error occurs+-- while a user request is being processed.+orError :: Monad m => HeistT n m b -> String -> HeistT n m b+orError silent msg = do+    hs <- getHS+    if _preprocessingMode hs+      then do fullMsg <- heistErrMsg (T.pack msg)+              error $ T.unpack fullMsg+      else silent+++------------------------------------------------------------------------------+-- | Prepends the location of the template currently being processed to an+-- error message.+heistErrMsg :: Monad m => Text -> HeistT n m Text+heistErrMsg msg = do+    tf <- getsHS _curTemplateFile+    return $ (maybe "" ((`mappend` ": ") . T.pack) tf) `mappend` msg+++------------------------------------------------------------------------------+-- | Adds an error message to the list of splice processing errors.+tellSpliceError :: Monad m => Text -> HeistT n m ()+tellSpliceError msg = do+    hs <- getHS+    node <- getParamNode+    let spliceError = SpliceError+                      { spliceHistory = _splicePath hs+                      , spliceTemplateFile = _curTemplateFile hs+                      , visibleSplices = Map.keys $ _compiledSpliceMap hs+                      , contextNode = node+                      , spliceMsg = msg+                      }+    modifyHS (\hs' -> hs { _spliceErrors = spliceError : _spliceErrors hs' })+++------------------------------------------------------------------------------+-- | Function for showing a TPath.+showTPath :: TPath -> String+showTPath = BC.unpack . (`BC.append` ".tpl") . tpathName+++------------------------------------------------------------------------------+-- | Convert a TPath into a ByteString path.+tpathName :: TPath -> ByteString+tpathName = BC.intercalate "/" . reverse+++------------------------------------------------------------------------------+-- | Sets the current template file.+setCurTemplateFile :: Maybe FilePath -> HeistState n -> HeistState n+setCurTemplateFile Nothing ts = ts+setCurTemplateFile fp ts = ts { _curTemplateFile = fp }+++------------------------------------------------------------------------------+setCurContext :: TPath -> HeistState n -> HeistState n+setCurContext tp ts = ts { _curContext = tp }+++------------------------------------------------------------------------------+-- | Parser for attribute variable substitution.+attParser :: AP.Parser [AttAST]+attParser = liftM ($! []) (loop id)+  where+    append !dl !x = dl . (x:)++    loop !dl = go id+      where+        finish subDL = let !txt = T.concat $! subDL []+                           lit  = Literal $! T.concat $! subDL []+                       in return $! if T.null txt+                                      then dl+                                      else append dl lit++        go !subDL = (gobbleText >>= go . append subDL)+                    <|> (AP.endOfInput *> finish subDL)+                    <|> (do+                            idp <- identParser+                            dl' <- finish subDL+                            loop $! append dl' idp)++    gobbleText = AP.takeWhile1 (AP.notInClass "$")++    identParser = AP.char '$' *> (ident <|> return (Literal "$"))+    ident = (AP.char '{' *> (Ident <$> AP.takeWhile (/='}')) <* AP.string "}")+++------------------------------------------------------------------------------+-- | Converts a path into an array of the elements in reverse order.  If the+-- path is absolute, we need to remove the leading slash so the split doesn't+-- leave @\"\"@ as the last element of the TPath.+--+-- FIXME @\"..\"@ currently doesn't work in paths, the solution is non-trivial+splitPathWith :: Char -> ByteString -> TPath+splitPathWith s p = if BC.null p then [] else (reverse $ BC.split s path)+  where+    path = if BC.head p == s then BC.tail p else p+++------------------------------------------------------------------------------+-- | Converts a path into an array of the elements in reverse order using the+-- path separator of the local operating system. See 'splitPathWith' for more+-- details.+splitLocalPath :: ByteString -> TPath+splitLocalPath = splitPathWith pathSeparator+++------------------------------------------------------------------------------+-- | Converts a path into an array of the elements in reverse order using a+-- forward slash (/) as the path separator. See 'splitPathWith' for more+-- details.+splitTemplatePath :: ByteString -> TPath+splitTemplatePath = splitPathWith '/'+++------------------------------------------------------------------------------+-- | Convenience function for looking up a template.+lookupTemplate :: ByteString+               -> HeistState n+               -> (HeistState n -> HashMap TPath t)+               -> Maybe (t, TPath)+lookupTemplate nameStr ts tm = f (tm ts) path name+  where+    (name:p) = case splitTemplatePath nameStr of+                   [] -> [""]+                   ps -> ps+    ctx = if B.isPrefixOf "/" nameStr then [] else _curContext ts+    path = p ++ ctx+    f = if '/' `BC.elem` nameStr+            then singleLookup+            else traversePath+++------------------------------------------------------------------------------+-- | Returns 'True' if the given template can be found in the heist state.+hasTemplate :: ByteString -> HeistState n -> Bool+hasTemplate nameStr ts =+    isJust $ lookupTemplate nameStr ts _templateMap+++------------------------------------------------------------------------------+-- | Does a single template lookup without cascading up.+singleLookup :: (Eq a, Hashable a)+             => HashMap [a] t -> [a] -> a -> Maybe (t, [a])+singleLookup tm path name = fmap (\a -> (a,path)) $ Map.lookup (name:path) tm+++------------------------------------------------------------------------------+-- | Searches for a template by looking in the full path then backing up into+-- each of the parent directories until the template is found.+traversePath :: (Eq a, Hashable a)+             => HashMap [a] t -> [a] -> a -> Maybe (t, [a])+traversePath tm [] name = fmap (\a -> (a,[])) (Map.lookup [name] tm)+traversePath tm path name =+    singleLookup tm path name `mplus`+    traversePath tm (tail path) name+++------------------------------------------------------------------------------+-- | Maps a splice generating function over a list and concatenates the+-- results.  This function now has a more general type signature so it works+-- with both compiled and interpreted splices.  The old type signature was+-- this:+--+-- > mapSplices :: (Monad n)+-- >         => (a -> Splice n n)+-- >         -> [a]+-- >         -> Splice n n+mapSplices :: (Monad m, Monoid b)+           => (a -> m b)+           -- ^ Splice generating function+           -> [a]+           -- ^ List of items to generate splices for+           -> m b+           -- ^ The result of all splices concatenated together.+mapSplices f vs = liftM mconcat $ mapM f vs+{-# INLINE mapSplices #-}+++------------------------------------------------------------------------------+-- | Gets the current context+getContext :: Monad m => HeistT n m TPath+getContext = getsHS _curContext+++------------------------------------------------------------------------------+-- | Gets the full path to the file holding the template currently being+-- processed.  Returns Nothing if the template is not associated with a file+-- on disk or if there is no template being processed.+getTemplateFilePath :: Monad m => HeistT n m (Maybe FilePath)+getTemplateFilePath = getsHS _curTemplateFile+++------------------------------------------------------------------------------+-- | Loads a template with the specified path and filename.  The+-- template is only loaded if it has a ".tpl" or ".xtpl" extension.+loadTemplate :: String -- ^ path of the template root+             -> String -- ^ full file path (includes the template root)+             -> IO [Either String (TPath, DocumentFile)] --TemplateMap+loadTemplate templateRoot fname = do+    c <- loadTemplate' fname+    return $ map (fmap (\t -> (splitLocalPath $ BC.pack tName, t))) c+  where -- tName is path relative to the template root directory+    isHTMLTemplate = ".tpl"  `isSuffixOf` fname+    correction = if last templateRoot == '/' then 0 else 1+    extLen     = if isHTMLTemplate then 4 else 5+    tName = drop ((length templateRoot)+correction) $+            -- We're only dropping the template root, not the whole path+            take ((length fname) - extLen) fname+++------------------------------------------------------------------------------+-- | Loads a template at the specified path, choosing the appropriate parser+-- based on the file extension.  The template is only loaded if it has a+-- \".tpl\" or \".xtpl\" extension.  Returns an empty list if the extension+-- doesn't match.+loadTemplate' :: String -> IO [Either String DocumentFile]+loadTemplate' fullDiskPath+    | isHTMLTemplate = liftM (:[]) $ getDoc fullDiskPath+    | isXMLTemplate = liftM (:[]) $ getXMLDoc fullDiskPath+    | otherwise = return []+  where+    isHTMLTemplate = ".tpl"  `isSuffixOf` fullDiskPath+    isXMLTemplate  = ".xtpl" `isSuffixOf` fullDiskPath+++------------------------------------------------------------------------------+-- | Type synonym for parsers.+type ParserFun = String -> ByteString -> Either String X.Document+++------------------------------------------------------------------------------+-- | Reads an HTML or XML template from disk.+getDocWith :: ParserFun -> String -> IO (Either String DocumentFile)+getDocWith parser f = do+    bs <- C.catch (liftM Right $ B.readFile f)+                (\(e::SomeException) -> return $ Left $ show e)++    let eitherDoc = either Left (parser f) bs+    return $ either (\s -> Left $ f ++ " " ++ s)+                    (\d -> Right $ DocumentFile d (Just f)) eitherDoc+++------------------------------------------------------------------------------+-- | Reads an HTML template from disk.+getDoc :: String -> IO (Either String DocumentFile)+getDoc = getDocWith X.parseHTML+++------------------------------------------------------------------------------+-- | Reads an XML template from disk.+getXMLDoc :: String -> IO (Either String DocumentFile)+getXMLDoc = getDocWith X.parseXML+++------------------------------------------------------------------------------+-- | Sets the templateMap in a HeistState.+setTemplates :: HashMap TPath DocumentFile -> HeistState n -> HeistState n+setTemplates m ts = ts { _templateMap = m }+++------------------------------------------------------------------------------+-- | Adds a template to the heist state.+insertTemplate :: TPath+               -> DocumentFile+               -> HeistState n+               -> HeistState n+insertTemplate p t st =+    setTemplates (Map.insert p t (_templateMap st)) st+++------------------------------------------------------------------------------+-- Gives the MIME type for a 'X.Document'+mimeType :: X.Document -> MIMEType+mimeType d = case d of+    (X.HtmlDocument e _ _) -> "text/html;charset=" `BC.append` enc e+    (X.XmlDocument  e _ _) -> "text/xml;charset="  `BC.append` enc e+  where+    enc X.UTF8    = "utf-8"+    -- Should not include byte order designation for UTF-16 since+    -- rendering will include a byte order mark. (RFC 2781, Sec. 3.3)+    enc X.UTF16BE = "utf-16"+    enc X.UTF16LE = "utf-16"+    enc X.ISO_8859_1 = "iso-8859-1"+++------------------------------------------------------------------------------+-- | Binds a set of new splice declarations within a 'HeistState'.+bindAttributeSplices :: Splices (AttrSplice n) -- ^ splices to bind+                     -> HeistState n           -- ^ start state+                     -> HeistState n+bindAttributeSplices ss hs =+    hs { _attrSpliceMap = applySpliceMap hs _attrSpliceMap ss }++------------------------------------------------------------------------------+-- | Mappends a doctype to the state.+addDoctype :: Monad m => [X.DocType] -> HeistT n m ()+addDoctype dt = do+    modifyHS (\s -> s { _doctypes = _doctypes s `mappend` dt })++
+ src/Heist/Compiled.hs view
@@ -0,0 +1,66 @@+{-|++Compiled splices are similar to the original Heist (interpreted) splices, but+without the high performance costs of traversing a DOM at runtime.  Compiled+splices do all of their DOM processing at load time.  They are compiled to+produce a runtime computation that generates a ByteString Builder.  This+preserves the ability to write splices that access runtime information from+the HTTP request, database, etc.++If you import both this module and "Heist.Interpreted" in the same file, then+you will need to import them qualified.++-}++module Heist.Compiled+  (+  -- * High level compiled splice API+    Splice+  , renderTemplate+  , codeGen+  , runChildren++  -- * Functions for manipulating lists of compiled splices+  , textSplice+  , nodeSplice+  , xmlNodeSplice+  , htmlNodeSplice+  , pureSplice++  , deferMany+  , defer+  , deferMap+  , mayDeferMap+  , bindLater+  , withSplices+  , manyWithSplices+  , manyWith+  , withLocalSplices++  -- * Constructing Chunks+  -- $yieldOverview+  , yieldPure+  , yieldRuntime+  , yieldRuntimeEffect+  , yieldPureText+  , yieldRuntimeText++  -- * Running nodes and splices+  , runNodeList+  , runNode+  , runAttributes+  , runAttributesRaw+  , callTemplate++  ) where++import Heist.Compiled.Internal++-- $yieldOverview+-- The internals of the Chunk data type are deliberately not exported because+-- we want to hide the underlying implementation as much as possible.  The+-- @yield...@ functions give you lower level construction of DLists of Chunks.+--+-- Most of the time you will use these functions composed with return to+-- generate a Splice.  But we decided not to include the return in these+-- functions to allow you to work with the DLists purely.
+ src/Heist/Compiled/Internal.hs view
@@ -0,0 +1,805 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeSynonymInstances       #-}++module Heist.Compiled.Internal where+++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Blaze.ByteString.Builder.Char.Utf8+import           Control.Arrow+import           Control.Exception+import           Control.Monad+import           Control.Monad.RWS.Strict+import           Control.Monad.State.Strict+import qualified Data.Attoparsec.Text               as AP+import           Data.ByteString                    (ByteString)+import           Data.DList                         (DList)+import qualified Data.DList                         as DL+import qualified Data.HashMap.Strict                as H+import qualified Data.HashSet                       as S+import qualified Data.HeterogeneousEnvironment      as HE+import           Data.Map.Syntax+import           Data.Maybe+import           Data.Text                          (Text)+import qualified Data.Text                          as T+import qualified Data.Text.Encoding                 as T+import qualified Data.Vector                        as V+import           Text.Printf+import qualified Text.XmlHtml                       as X+import qualified Text.XmlHtml.HTML.Meta             as X+------------------------------------------------------------------------------+#if !MIN_VERSION_base(4,8,0)+import           Data.Foldable                      (Foldable)+#endif+import qualified Data.Foldable                      as Foldable+------------------------------------------------------------------------------+import           Heist.Common+import           Heist.Internal.Types.HeistState+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | A compiled Splice is a HeistT computation that returns a @DList+-- (Chunk m)@.+--+-- The more interesting part of the type signature is what comes before the+-- return value.  The first type parameter in @'HeistT' n IO@ is the runtime+-- monad.  This reveals that the Chunks know about the runtime monad.  The+-- second type parameter in @HeistT n IO@ is @IO@.  This tells us that the+-- compiled splices themselves are run in the IO monad, which will usually+-- mean at load time.  Compiled splices run at load time, and they return+-- computations that run at runtime.+type Splice n = HeistT n IO (DList (Chunk n))+++------------------------------------------------------------------------------+-- | Runs the parameter node's children and returns the resulting compiled+-- chunks.  By itself this function is a simple passthrough splice that makes+-- the spliced node disappear.  In combination with locally bound splices,+-- this function makes it easier to pass the desired view into your splices.+runChildren :: Monad n => Splice n+runChildren = runNodeList . X.childNodes =<< getParamNode+{-# INLINE runChildren #-}+++renderFragment :: Markup -> [X.Node] -> Builder+renderFragment markup ns =+    case markup of+      Html -> X.renderHtmlFragment X.UTF8 ns+      Xml  -> X.renderXmlFragment X.UTF8 ns+++------------------------------------------------------------------------------+-- | Yields pure text known at load time.+pureTextChunk :: Text -> Chunk n+pureTextChunk t = Pure $ T.encodeUtf8 t+{-# INLINE pureTextChunk #-}+++------------------------------------------------------------------------------+-- | Yields a pure Builder known at load time.  You should use this and+-- 'yieldPureText' as much as possible to maximize the parts of your page that+-- can be compiled to static ByteStrings.+yieldPure :: Builder -> DList (Chunk n)+yieldPure = DL.singleton . Pure . toByteString+{-# INLINE yieldPure #-}+++------------------------------------------------------------------------------+-- | Yields a runtime action that returns a builder.+yieldRuntime :: RuntimeSplice n Builder -> DList (Chunk n)+yieldRuntime = DL.singleton . RuntimeHtml+{-# INLINE yieldRuntime #-}+++------------------------------------------------------------------------------+-- | Yields a runtime action that returns no value and is only needed for its+-- side effect.+yieldRuntimeEffect :: Monad n => RuntimeSplice n () -> DList (Chunk n)+yieldRuntimeEffect = DL.singleton . RuntimeAction+{-# INLINE yieldRuntimeEffect #-}+++------------------------------------------------------------------------------+-- | A convenience wrapper around yieldPure for working with Text.  Roughly+-- equivalent to 'textSplice' from Heist.Interpreted.+yieldPureText :: Text -> DList (Chunk n)+yieldPureText = DL.singleton . pureTextChunk+{-# INLINE yieldPureText #-}+++------------------------------------------------------------------------------+-- | Convenience wrapper around yieldRuntime allowing you to work with Text.+yieldRuntimeText :: Monad n => RuntimeSplice n Text -> DList (Chunk n)+yieldRuntimeText = yieldRuntime .  liftM fromText+{-# INLINE yieldRuntimeText #-}+++------------------------------------------------------------------------------+-- | Returns a computation that performs load-time splice processing on the+-- supplied list of nodes.+runNodeList :: Monad n => [X.Node] -> Splice n+runNodeList = mapSplices runNode+++------------------------------------------------------------------------------+-- | Runs a DocumentFile with the appropriate template context set.+runDocumentFile :: Monad n+                => TPath+                -> DocumentFile+                -> Splice n+runDocumentFile tpath df = do+    let markup = case dfDoc df of+                   X.XmlDocument _ _ _ -> Xml+                   X.HtmlDocument _ _ _ -> Html+    modifyHS (\hs -> hs { _curMarkup = markup })+    let inDoctype = X.docType $ dfDoc df+    addDoctype $ maybeToList inDoctype+    modifyHS (setCurTemplateFile curPath .  setCurContext tpath)+    res <- runNodeList nodes+    dt <- getsHS (listToMaybe . _doctypes)+    let enc = X.docEncoding $ dfDoc df+    return $! (yieldPure (X.renderDocType enc dt) `mappend` res)+  where+    curPath     = dfFile df+    nodes       = X.docContent $! dfDoc df+++------------------------------------------------------------------------------+compileTemplate+    :: Monad n+    => TPath+    -> DocumentFile+    -> HeistT n IO [Chunk n]+compileTemplate tpath df = do+    !chunks <- runDocumentFile tpath df+    return $! consolidate chunks+++------------------------------------------------------------------------------+compileTemplates+    :: Monad n+    => (TPath -> Bool)+    -> HeistState n+    -> IO (Either [String] (HeistState n))+compileTemplates f hs = do+    (tmap, hs') <- runHeistT (compileTemplates' f) (X.TextNode "") hs+    let pre = _splicePrefix hs'+    let canError = _errorNotBound hs'+    let errs = _spliceErrors hs'+    let nsErr = if not (T.null pre) && (_numNamespacedTags hs' == 0)+                  then Left [noNamespaceSplicesMsg $ T.unpack pre]+                  else Right ()+    return $ if canError+               then case errs of+                     [] -> nsErr >>+                           (Right $! hs { _compiledTemplateMap = tmap })+                     es -> Left $ either (++) (const id) nsErr $+                           map (T.unpack . spliceErrorText) es+               else nsErr >> (Right $! hs { _compiledTemplateMap = tmap+                                          , _spliceErrors = errs+                                          })+++------------------------------------------------------------------------------+noNamespaceSplicesMsg :: String -> String+noNamespaceSplicesMsg pre = unwords+    [ printf "You are using a namespace of '%s', but you don't have any" ns+    , printf "tags starting with '%s'.  If you have not defined any" pre+    , "splices, then change your namespace to the empty string to get rid"+    , "of this message."+    ]+  where+    ns = reverse $ drop 1 $ reverse pre+++------------------------------------------------------------------------------+compileTemplates'+    :: Monad n+    => (TPath -> Bool)+    -> HeistT n IO (H.HashMap TPath ([Chunk n], MIMEType))+compileTemplates' f = do+    hs <- getHS+    let tpathDocfiles :: [(TPath, DocumentFile)]+        tpathDocfiles = filter (f . fst)+                            (H.toList $ _templateMap hs)+    foldM runOne H.empty tpathDocfiles+  where+    runOne tmap (tpath, df) = do+        modifyHS (\hs -> hs { _doctypes = []})+        !mHtml <- compileTemplate tpath df+        return $! H.insert tpath (mHtml, mimeType $! dfDoc df) tmap+++------------------------------------------------------------------------------+-- | Consolidate consecutive Pure Chunks.+consolidate :: (Monad n) => DList (Chunk n) -> [Chunk n]+consolidate = consolidateL . DL.toList+  where+    consolidateL []     = []+    consolidateL (y:ys) = boilDown [] $! go [] y ys+      where+        ----------------------------------------------------------------------+        go soFar x [] = x : soFar++        go soFar (Pure a) ((Pure b) : xs) =+            go soFar (Pure $! a `mappend` b) xs++        go soFar (RuntimeHtml a) ((RuntimeHtml b) : xs) =+            go soFar (RuntimeHtml $! a `mappend` b) xs++        go soFar (RuntimeHtml a) ((RuntimeAction b) : xs) =+            go soFar (RuntimeHtml $! a >>= \x -> b >> return x) xs++        go soFar (RuntimeAction a) ((RuntimeHtml b) : xs) =+            go soFar (RuntimeHtml $! a >> b) xs++        go soFar (RuntimeAction a) ((RuntimeAction b) : xs) =+            go soFar (RuntimeAction $! a >> b) xs++        go soFar a (b : xs) = go (a : soFar) b xs++        ----------------------------------------------------------------------+        boilDown soFar []              = soFar++        boilDown soFar ((Pure h) : xs) = boilDown ((Pure $! h) : soFar) xs++        boilDown soFar (x : xs) = boilDown (x : soFar) xs+++------------------------------------------------------------------------------+-- | Given a list of output chunks, codeGen turns consecutive runs of+-- @Pure Html@ values into maximally-efficient pre-rendered strict+-- 'ByteString' chunks.+codeGen :: Monad n => DList (Chunk n) -> RuntimeSplice n Builder+codeGen l = V.foldr mappend mempty $!+            V.map toAct $! V.fromList $! consolidate l+  where+    toAct !(RuntimeHtml !m)   = m+    toAct !(Pure !h)          = return $! fromByteString h+    toAct !(RuntimeAction !m) = m >> return mempty+{-# INLINE codeGen #-}+++------------------------------------------------------------------------------+-- | Looks up a splice in the compiled splice map.+lookupSplice :: Text -> HeistT n IO (Maybe (Splice n))+lookupSplice nm = do+    pre <- getsHS _splicePrefix+    res <- getsHS (H.lookup nm . _compiledSpliceMap)+    if isNothing res && T.isPrefixOf pre nm && not (T.null pre)+      then do+          tellSpliceError $ "No splice bound for " `mappend` nm+          return Nothing+      else return res+++------------------------------------------------------------------------------+-- | Runs a single node.  If there is no splice referenced anywhere in the+-- subtree, then it is rendered as a pure chunk, otherwise it calls+-- compileNode to generate the appropriate runtime computation.+runNode :: Monad n => X.Node -> Splice n+runNode node = localParamNode (const node) $ do+    hs <- getHS+    let pre = _splicePrefix hs+    let hasPrefix = (T.isPrefixOf pre `fmap` X.tagName node) == Just True+    when (not (T.null pre) && hasPrefix) incNamespacedTags+    hs' <- getHS+    -- Plain rethrows for CompileException to avoid multiple annotations.+    (res, hs'') <- liftIO $ catches (compileIO hs')+                     [ Handler (\(ex :: CompileException) -> throwIO ex)+                     , Handler (\(ex :: SomeException) -> handleError ex hs')]+    putHS hs''+    return res+  where+    localSplicePath =+        localHS (\hs -> hs {_splicePath = (_curContext hs,+                                           _curTemplateFile hs,+                                           X.elementTag node):+                                          (_splicePath hs)})+    compileIO hs = runHeistT compile node hs+    compile = do+        isStatic <- subtreeIsStatic node+        dl <- compile' isStatic+        liftIO $ evaluate $ DL.fromList $! consolidate dl+    compile' True = do+        markup <- getsHS _curMarkup+        return $! yieldPure $! renderFragment markup [parseAttrs node]+    compile' False = localSplicePath $ compileNode node+    handleError ex hs = do+        errs <- evalHeistT (do localSplicePath $ tellSpliceError $ T.pack $+                                 "Exception in splice compile: " ++ show ex+                               getsHS _spliceErrors) node hs+        throwIO $ CompileException ex errs+++parseAttrs :: X.Node -> X.Node+parseAttrs (X.Element nm attrs ch) = newAttrs `seq` X.Element nm newAttrs ch+  where+    newAttrs = map parseAttr attrs+parseAttrs !n = n++parseAttr :: (Text, Text) -> (Text, Text)+parseAttr (k,v) = (k, T.concat $! map cvt ast)+  where+    !ast = case AP.feed (AP.parse attParser v) "" of+            (AP.Done _ res) -> res+            (AP.Fail _ _ _) -> []+            (AP.Partial _ ) -> []+    cvt (Literal x) = x+    cvt (Ident i) = T.concat ["${", i, "}"]++------------------------------------------------------------------------------+-- | Checks whether a node's subtree is static and can be rendered up front at+-- load time.+subtreeIsStatic :: X.Node -> HeistT n IO Bool+subtreeIsStatic (X.Element nm attrs ch) = do+    isNodeDynamic <- liftM isJust $ lookupSplice nm+    attrSplices <- getsHS _attrSpliceMap+    let hasSubstitutions (k,v) = hasAttributeSubstitutions v ||+                                 H.member k attrSplices+    if isNodeDynamic+      then return False+      else do+          let hasDynamicAttrs = any hasSubstitutions attrs+          if hasDynamicAttrs+            then return False+            else do+                staticSubtrees <- mapM subtreeIsStatic ch+                return $ and staticSubtrees++subtreeIsStatic _ = return True+++------------------------------------------------------------------------------+-- | Checks whether a string has any attribute substitutions.+hasAttributeSubstitutions :: Text -> Bool+hasAttributeSubstitutions txt = any isIdent ast+  where+    ast = case AP.feed (AP.parse attParser txt) "" of+            (AP.Done _ res) -> res+            (AP.Fail _ _ _) -> []+            (AP.Partial _ ) -> []+++------------------------------------------------------------------------------+-- | Given a 'X.Node' in the DOM tree, produces a \"runtime splice\" that will+-- generate html at runtime.+compileNode :: Monad n => X.Node -> Splice n+compileNode (X.Element nm attrs ch) = do+    msplice <- lookupSplice nm+    fromMaybe compileStaticElement msplice+  where+    tag0 = T.append "<" nm+    end = T.concat [ "</" , nm , ">"]+    -- If the tag is not a splice, but it contains dynamic children+    compileStaticElement = do+        -- Parse the attributes: we have Left for static and Right for runtime+        compiledAttrs <- runAttributes attrs++        childHtml <- runNodeList ch++        return $! if null (DL.toList childHtml) && nm `S.member` X.voidTags+          then DL.concat [ DL.singleton $! pureTextChunk $! tag0+                         , DL.concat compiledAttrs+                         , DL.singleton $! pureTextChunk " />"+                         ]+          else DL.concat [ DL.singleton $! pureTextChunk $! tag0+                         , DL.concat compiledAttrs+                         , DL.singleton $! pureTextChunk ">"+                         , childHtml+                         , DL.singleton $! pureTextChunk $! end+                         ]+compileNode _ = error "impossible"+++------------------------------------------------------------------------------+-- |+parseAtt :: Monad n => (Text, Text) -> HeistT n IO (DList (Chunk n))+parseAtt (k,v) = do+    mas <- getsHS (H.lookup k . _attrSpliceMap)+    maybe doInline (return . doAttrSplice) mas++  where+    cvt (Literal x) = return $ yieldPureText x+    cvt (Ident x) =+        localParamNode (const $ X.Element x [] []) $ getAttributeSplice x++    -- Handles inline parsing of $() splice syntax in attributes+    doInline = do+        let ast = case AP.feed (AP.parse attParser v) "" of+                    (AP.Done _ res) -> res+                    (AP.Fail _ _ _) -> []+                    (AP.Partial _ ) -> []+        chunks <- mapM cvt ast+        let value = DL.concat chunks+        return $ attrToChunk k value++    -- Handles attribute splices+    doAttrSplice splice = DL.singleton $ RuntimeHtml $ do+        res <- splice v+        return $ mconcat $ map attrToBuilder res+++------------------------------------------------------------------------------+-- |+parseAtt2 :: Monad n+          => (Text, Text)+          -> HeistT n IO (RuntimeSplice n [(Text, Text)])+parseAtt2 (k,v) = do+    mas <- getsHS (H.lookup k . _attrSpliceMap)+    maybe doInline (return . doAttrSplice) mas++  where+    cvt (Literal x) = return $ return x+    cvt (Ident x) =+        localParamNode (const $ X.Element x [] []) $ getAttributeSplice2 x++    -- Handles inline parsing of $() splice syntax in attributes+    doInline = do+        let ast = case AP.feed (AP.parse attParser v) "" of+                    (AP.Done _ res) -> res+                    (AP.Fail _ _ _) -> []+                    (AP.Partial _ ) -> []+        chunks <- mapM cvt ast+        return $ do+            list <- sequence chunks+            return [(k, T.concat list)]++    -- Handles attribute splices+    doAttrSplice splice = splice v+++------------------------------------------------------------------------------+-- | Performs splice processing on a list of attributes.  This is useful in+-- situations where you need to stop recursion, but still run splice+-- processing on the node's attributes.+runAttributes :: Monad n+              => [(Text, Text)] -- ^ List of attributes+              -> HeistT n IO [DList (Chunk n)]+runAttributes = mapM parseAtt+++------------------------------------------------------------------------------+-- | Performs splice processing on a list of attributes.  This is useful in+-- situations where you need to stop recursion, but still run splice+-- processing on the node's attributes.+runAttributesRaw :: Monad n+                 -- Note that this parameter should not be changed to Splices+                 => [(Text, Text)] -- ^ List of attributes+                 -> HeistT n IO (RuntimeSplice n [(Text, Text)])+runAttributesRaw attrs = do+    arrs <- mapM parseAtt2 attrs+    return $ liftM concat $ sequence arrs+++attrToChunk :: Text -> DList (Chunk n) -> DList (Chunk n)+attrToChunk !k !v = do+    DL.concat+        [ DL.singleton $! pureTextChunk $! T.concat [" ", k, "=\""]+        , v, DL.singleton $! pureTextChunk "\"" ]+++attrToBuilder :: (Text, Text) -> Builder+attrToBuilder (k,v)+  | T.null v  = mconcat+    [ fromText " "+    , fromText k+    ]+  | otherwise = mconcat+    [ fromText " "+    , fromText k+    , fromText "=\""+    , fromText v+    , fromText "\""+    ]+++------------------------------------------------------------------------------+getAttributeSplice :: Text -> HeistT n IO (DList (Chunk n))+getAttributeSplice name =+    lookupSplice name >>= fromMaybe+      (return $ DL.singleton $ Pure $ T.encodeUtf8 $+       T.concat ["${", name, "}"])+{-# INLINE getAttributeSplice #-}+++getAttributeSplice2 :: Monad n => Text -> HeistT n IO (RuntimeSplice n Text)+getAttributeSplice2 name = do+    mSplice <- lookupSplice name+    case mSplice of+      Nothing -> return $ return $ T.concat ["${", name, "}"]+      Just splice -> do+        res <- splice+        return $ liftM (T.decodeUtf8 . toByteString) $ codeGen res+{-# INLINE getAttributeSplice2 #-}+++------------------------------------------------------------------------------+-- | Promises are used for referencing the results of future runtime+-- computations during load time splice processing.+newtype Promise a = Promise (HE.Key a)+++------------------------------------------------------------------------------+-- | Gets the result of a promised runtime computation.+getPromise :: (Monad n) => Promise a -> RuntimeSplice n a+getPromise (Promise k) = do+    mb <- gets (HE.lookup k)+    return $ fromMaybe e mb++  where+    e = error $ "getPromise: dereferenced empty key (id "+                ++ show (HE.getKeyId k) ++ ")"+{-# INLINE getPromise #-}+++------------------------------------------------------------------------------+-- | Adds a promise to the runtime splice context.+putPromise :: (Monad n) => Promise a -> a -> RuntimeSplice n ()+putPromise (Promise k) x = modify (HE.insert k x)+{-# INLINE putPromise #-}+++------------------------------------------------------------------------------+-- | Modifies a promise.+adjustPromise :: Monad n => Promise a -> (a -> a) -> RuntimeSplice n ()+adjustPromise (Promise k) f = modify (HE.adjust f k)+{-# INLINE adjustPromise #-}+++------------------------------------------------------------------------------+-- | Creates an empty promise.+newEmptyPromise :: HeistT n IO (Promise a)+newEmptyPromise = do+    keygen <- getsHS _keygen+    key    <- liftIO $ HE.makeKey keygen+    return $! Promise key+{-# INLINE newEmptyPromise #-}+++-- ------------------------------------------------------------------------------+-- -- | Creates an empty promise with some error checking to help with debugging.+-- newEmptyPromiseWithError :: (Monad n)+--                          => String -> HeistT n IO (Promise a)+-- newEmptyPromiseWithError from = do+--     keygen <- getsHS _keygen+--     prom   <- liftM Promise $ liftIO $ HE.makeKey keygen+--     yieldRuntimeEffect $ putPromise prom+--                        $ error+--                        $ "deferenced empty promise created at" ++ from+--     return prom+-- {-# INLINE newEmptyPromiseWithError #-}+++------------------------------------------------------------------------------+-- | Binds a compiled splice.  This function should not be exported.+bindSplice :: Text             -- ^ tag name+           -> Splice n         -- ^ splice action+           -> HeistState n     -- ^ source state+           -> HeistState n+bindSplice n v ts =+    ts { _compiledSpliceMap = H.insert n' v (_compiledSpliceMap ts) }+  where+    n' = _splicePrefix ts `mappend` n++------------------------------------------------------------------------------+-- | Binds a list of compiled splices.  This function should not be exported.+bindSplices :: Splices (Splice n)  -- ^ splices to bind+            -> HeistState n        -- ^ source state+            -> HeistState n+bindSplices ss hs =+    hs { _compiledSpliceMap = applySpliceMap hs _compiledSpliceMap ss }+++------------------------------------------------------------------------------+-- | Adds a list of compiled splices to the splice map.  This function is+-- useful because it allows compiled splices to bind other compiled splices+-- during load-time splice processing.+withLocalSplices :: Splices (Splice n)+                 -> Splices (AttrSplice n)+                 -> HeistT n IO a+                 -> HeistT n IO a+withLocalSplices ss as = localHS (bindSplices ss . bindAttributeSplices as)+++------------------------------------------------------------------------------+-- | Looks up a compiled template and returns a runtime monad computation that+-- constructs a builder.+--+-- Note that template names should not include the .tpl extension:+--+-- @renderTemplate hs "index"@+renderTemplate :: Monad n+               => HeistState n+               -> ByteString+               -> Maybe (n Builder, MIMEType)+renderTemplate hs nm =+    fmap (first (interpret . DL.fromList) . fst) $!+      lookupTemplate nm hs _compiledTemplateMap+++------------------------------------------------------------------------------+-- | Looks up a compiled template and returns a compiled splice.+callTemplate :: Monad n+             => ByteString+             -> Splice n+callTemplate nm = do+    hs <- getHS+    maybe (error err) call $ lookupTemplate nm hs _templateMap+  where+    err = "callTemplate: "++(T.unpack $ T.decodeUtf8 nm)++(" does not exist")+    call (df,_) = localHS (\hs' -> hs' {_curTemplateFile = dfFile df}) $+                    runNodeList $ X.docContent $ dfDoc df+++interpret :: Monad n => DList (Chunk n) -> n Builder+interpret = flip evalStateT HE.empty . unRT . codeGen+++------------------------------------------------------------------------------+-- | Converts a pure text splice function to a pure Builder splice function.+textSplice :: (a -> Text) -> a -> Builder+textSplice f = fromText . f+++                               ---------------+                               -- New Stuff --+                               ---------------+++------------------------------------------------------------------------------+-- | This is the same as htmlNodeSplice.  +nodeSplice :: (a -> [X.Node]) -> a -> Builder+nodeSplice f = X.renderHtmlFragment X.UTF8 . f+{-# DEPRECATED nodeSplice+   "Use xmlNodeSplice or htmlNodeSplice, will be removed in Heist 1.1" #-}+++------------------------------------------------------------------------------+-- | Converts a pure XML Node splice function to a pure Builder splice+-- function.+xmlNodeSplice :: (a -> [X.Node]) -> a -> Builder+xmlNodeSplice f = X.renderXmlFragment X.UTF8 . f+++------------------------------------------------------------------------------+-- | Converts a pure HTML Node splice function to a pure Builder splice+-- function.+htmlNodeSplice :: (a -> [X.Node]) -> a -> Builder+htmlNodeSplice f = X.renderHtmlFragment X.UTF8 . f+++------------------------------------------------------------------------------+-- | Converts a pure Builder splice function into a monadic splice function+-- of a RuntimeSplice.+pureSplice :: Monad n => (a -> Builder) -> RuntimeSplice n a -> Splice n+pureSplice f n = return $ yieldRuntime (return . f =<< n)+++------------------------------------------------------------------------------+-- | Runs a splice, but first binds splices given by splice functions that+-- need some runtime data.+withSplices :: Monad n+            => Splice n+            -- ^ Splice to be run+            -> Splices (RuntimeSplice n a -> Splice n)+            -- ^ Splices to be bound first+            -> RuntimeSplice n a+            -- ^ Runtime data needed by the above splices+            -> Splice n+withSplices splice splices runtimeAction =+    withLocalSplices splices' mempty splice+  where+    splices' = mapV ($runtimeAction) splices+++------------------------------------------------------------------------------+{-# INLINE foldMapM #-}+foldMapM :: (Monad f, Monoid m, Foldable list)+         => (a -> f m)+         -> list a+         -> f m+foldMapM f =+  Foldable.foldlM (\xs x -> xs `seq` liftM (xs <>) (f x)) mempty++------------------------------------------------------------------------------+-- | Like withSplices, but evaluates the splice repeatedly for each element in+-- a list generated at runtime.+manyWithSplices :: (Foldable f, Monad n)+                => Splice n+                -> Splices (RuntimeSplice n a -> Splice n)+                -> RuntimeSplice n (f a)+                -> Splice n+manyWithSplices splice splices runtimeAction =+    manyWith splice splices mempty runtimeAction+++------------------------------------------------------------------------------+-- | More powerful version of manyWithSplices that lets you also define+-- attribute splices.+manyWith :: (Foldable f, Monad n)+         => Splice n+         -> Splices (RuntimeSplice n a -> Splice n)+         -> Splices (RuntimeSplice n a -> AttrSplice n)+         -> RuntimeSplice n (f a)+         -> Splice n+manyWith splice splices attrSplices runtimeAction = do+    p <- newEmptyPromise+    let splices' = mapV ($ getPromise p) splices+    let attrSplices' = mapV ($ getPromise p) attrSplices+    chunks <- withLocalSplices splices' attrSplices' splice+    return $ yieldRuntime $ do+        items <- runtimeAction+        foldMapM (\item -> putPromise p item >> codeGen chunks) items+++------------------------------------------------------------------------------+-- | Similar to 'mapSplices' in interpreted mode.  Gets a runtime list of+-- items and applies a compiled runtime splice function to each element of the+-- list.+deferMany :: (Foldable f, Monad n)+          => (RuntimeSplice n a -> Splice n)+          -> RuntimeSplice n (f a)+          -> Splice n+deferMany f getItems = do+    promise <- newEmptyPromise+    chunks <- f $ getPromise promise+    return $ yieldRuntime $ do+        items <- getItems+        foldMapM (\item -> putPromise promise item >> codeGen chunks) items+++------------------------------------------------------------------------------+-- | Saves the results of a runtime computation in a 'Promise' so they don't+-- get recalculated if used more than once.+--+-- Note that this is just a specialized version of function application ($)+-- done for the side effect in runtime splice.+defer :: Monad n+      => (RuntimeSplice n a -> Splice n)+      -> RuntimeSplice n a -> Splice n+defer pf n = do+    p2 <- newEmptyPromise+    let action = yieldRuntimeEffect $ putPromise p2 =<< n+    res <- pf $ getPromise p2+    return $ action `mappend` res+++------------------------------------------------------------------------------+-- | A version of defer which applies a function on the runtime value.+deferMap :: Monad n+         => (a -> RuntimeSplice n b)+         -> (RuntimeSplice n b -> Splice n)+         -> RuntimeSplice n a -> Splice n+deferMap f pf n = defer pf $ f =<< n+++------------------------------------------------------------------------------+-- | Like deferMap, but only runs the result if a Maybe function of the+-- runtime value returns Just.  If it returns Nothing, then no output is+-- generated.+mayDeferMap :: Monad n+            => (a -> RuntimeSplice n (Maybe b))+            -> (RuntimeSplice n b -> Splice n)+            -> RuntimeSplice n a -> Splice n+mayDeferMap f pf n = deferMany pf $ f =<< n+++------------------------------------------------------------------------------+-- | Converts an RuntimeSplice into a Splice, given a helper function that+-- generates a Builder.+bindLater :: (Monad n)+          => (a -> RuntimeSplice n Builder)+          -> RuntimeSplice n a+          -> Splice n+bindLater f p = return $ yieldRuntime $ f =<< p++
+ src/Heist/Compiled/LowLevel.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeSynonymInstances       #-}++module Heist.Compiled.LowLevel+  (+  -- * Lower level promise functions+    Promise+  , newEmptyPromise+  , getPromise+  , putPromise+  , adjustPromise++  ) where++import           Heist.Compiled.Internal
+ src/Heist/Internal/Types.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE UndecidableInstances       #-}++{-|++Internal types and accessors.  There are no guarantees that heist will+preserve backwards compatibility for symbols in this module.  If you use them,+no complaining when your code breaks.++-}++module Heist.Internal.Types+  ( module Heist.Internal.Types.HeistState+  , module Heist.Internal.Types+  ) where++------------------------------------------------------------------------------+import           Data.HashMap.Strict (HashMap)+import           Data.Text (Text)++#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative+#endif+#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup+#endif++------------------------------------------------------------------------------+import qualified Heist.Compiled.Internal       as C+import qualified Heist.Interpreted.Internal    as I+import           Heist.Internal.Types.HeistState+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+type TemplateRepo = HashMap TPath DocumentFile+++------------------------------------------------------------------------------+-- | An IO action for getting a template repo from this location.  By not just+-- using a directory path here, we support templates loaded from a database,+-- retrieved from the network, or anything else you can think of.+type TemplateLocation = IO (Either [String] TemplateRepo)+++------------------------------------------------------------------------------+-- | My lens creation function to avoid a dependency on lens.+lens :: Functor f => (t1 -> t) -> (t1 -> a -> b) -> (t -> f a) -> t1 -> f b+lens sa sbt afb s = sbt s <$> afb (sa s)+++------------------------------------------------------------------------------+-- | The splices and templates Heist will use.  To bind a splice simply+-- include it in the appropriate place here.+data SpliceConfig m = SpliceConfig+    { _scInterpretedSplices     :: Splices (I.Splice m)+        -- ^ Interpreted splices are the splices that Heist has always had.+        -- They return a list of nodes and are processed at runtime.+    , _scLoadTimeSplices        :: Splices (I.Splice IO)+        -- ^ Load time splices are like interpreted splices because they+        -- return a list of nodes.  But they are like compiled splices because+        -- they are processed once at load time.  All of Heist's built-in+        -- splices should be used as load time splices.+    , _scCompiledSplices        :: Splices (C.Splice m)+        -- ^ Compiled splices return a DList of Chunks and are processed at+        -- load time to generate a runtime monad action that will be used to+        -- render the template.+    , _scAttributeSplices       :: Splices (AttrSplice m)+        -- ^ Attribute splices are bound to attribute names and return a list+        -- of attributes.+    , _scTemplateLocations      :: [TemplateLocation]+        -- ^ A list of all the locations that Heist should get its templates+        -- from.+    , _scCompiledTemplateFilter :: TPath -> Bool+        -- ^ Predicate function to control which templates to compile.  Using+        -- templates filtered out with this is still possible via+        -- callTemplate.+    }+++------------------------------------------------------------------------------+-- | Lens for interpreted splices+-- :: Simple Lens (SpliceConfig m) (Splices (I.Splice m))+scInterpretedSplices+    :: Functor f+    => (Splices (I.Splice m) -> f (Splices (I.Splice m)))+    -> SpliceConfig m -> f (SpliceConfig m)+scInterpretedSplices = lens _scInterpretedSplices setter+  where+    setter sc v = sc { _scInterpretedSplices = v }+++------------------------------------------------------------------------------+-- | Lens for load time splices+-- :: Simple Lens (SpliceConfig m) (Splices (I.Splice IO))+scLoadTimeSplices+    :: Functor f+    => (Splices (I.Splice IO) -> f (Splices (I.Splice IO)))+    -> SpliceConfig m -> f (SpliceConfig m)+scLoadTimeSplices = lens _scLoadTimeSplices setter+  where+    setter sc v = sc { _scLoadTimeSplices = v }+++------------------------------------------------------------------------------+-- | Lens for complied splices+-- :: Simple Lens (SpliceConfig m) (Splices (C.Splice m))+scCompiledSplices+    :: Functor f+    => (Splices (C.Splice m) -> f (Splices (C.Splice m)))+    -> SpliceConfig m -> f (SpliceConfig m)+scCompiledSplices = lens _scCompiledSplices setter+  where+    setter sc v = sc { _scCompiledSplices = v }+++------------------------------------------------------------------------------+-- | Lens for attribute splices+-- :: Simple Lens (SpliceConfig m) (Splices (AttrSplice m))+scAttributeSplices+    :: Functor f+    => (Splices (AttrSplice m) -> f (Splices (AttrSplice m)))+    -> SpliceConfig m -> f (SpliceConfig m)+scAttributeSplices = lens _scAttributeSplices setter+  where+    setter sc v = sc { _scAttributeSplices = v }+++------------------------------------------------------------------------------+-- | Lens for template locations+-- :: Simple Lens (SpliceConfig m) [TemplateLocation]+scTemplateLocations+    :: Functor f+    => ([TemplateLocation] -> f [TemplateLocation])+    -> SpliceConfig m -> f (SpliceConfig m)+scTemplateLocations = lens _scTemplateLocations setter+  where+    setter sc v = sc { _scTemplateLocations = v }+++------------------------------------------------------------------------------+-- | Lens for compiled template filter+-- :: Simple Lens (SpliceConfig m) (TBool -> Bool)+scCompiledTemplateFilter+    :: Functor f+    => ((TPath -> Bool) -> f (TPath -> Bool))+    -> SpliceConfig m -> f (SpliceConfig m)+scCompiledTemplateFilter = lens _scCompiledTemplateFilter setter+  where+    setter sc v = sc { _scCompiledTemplateFilter = v }+++instance Semigroup (SpliceConfig m) where+    SpliceConfig a1 b1 c1 d1 e1 f1 <> SpliceConfig a2 b2 c2 d2 e2 f2 =+      SpliceConfig (a1 <> a2) (b1 <> b2) (c1 <> c2)+                   (d1 <> d2) (e1 <> e2) (\x -> f1 x && f2 x)++instance Monoid (SpliceConfig m) where+    mempty = SpliceConfig mempty mempty mempty mempty mempty (const True)+#if !MIN_VERSION_base(4,11,0)+    mappend = (<>)+#endif+++data HeistConfig m = HeistConfig+    { _hcSpliceConfig  :: SpliceConfig m+        -- ^ Splices and templates+    , _hcNamespace     :: Text+        -- ^ A namespace to use for all tags that are bound to splices.  Use+        -- empty string for no namespace.+    , _hcErrorNotBound :: Bool+        -- ^ Whether to throw an error when a tag wih the heist namespace does+        -- not correspond to a bound splice.  When not using a namespace, this+        -- flag is ignored.+    }+++------------------------------------------------------------------------------+-- | Lens for the SpliceConfig+-- :: Simple Lens (HeistConfig m) (SpliceConfig m)+hcSpliceConfig+    :: Functor f+    => ((SpliceConfig m) -> f (SpliceConfig m))+    -> HeistConfig m -> f (HeistConfig m)+hcSpliceConfig = lens _hcSpliceConfig setter+  where+    setter hc v = hc { _hcSpliceConfig = v }+++------------------------------------------------------------------------------+-- | Lens for the namespace+-- :: Simple Lens (HeistConfig m) Text+hcNamespace+    :: Functor f+    => (Text -> f Text)+    -> HeistConfig m -> f (HeistConfig m)+hcNamespace = lens _hcNamespace setter+  where+    setter hc v = hc { _hcNamespace = v }+++------------------------------------------------------------------------------+-- | Lens for the namespace error flag+-- :: Simple Lens (HeistConfig m) Bool+hcErrorNotBound+    :: Functor f+    => (Bool -> f Bool)+    -> HeistConfig m -> f (HeistConfig m)+hcErrorNotBound = lens _hcErrorNotBound setter+  where+    setter hc v = hc { _hcErrorNotBound = v }+++------------------------------------------------------------------------------+-- | Lens for interpreted splices+-- :: Simple Lens (HeistConfig m) (Splices (I.Splice m))+hcInterpretedSplices+    :: Functor f+    => (Splices (I.Splice m) -> f (Splices (I.Splice m)))+    -> HeistConfig m -> f (HeistConfig m)+hcInterpretedSplices = hcSpliceConfig . scInterpretedSplices+++------------------------------------------------------------------------------+-- | Lens for load time splices+-- :: Simple Lens (HeistConfig m) (Splices (I.Splice IO))+hcLoadTimeSplices+    :: Functor f+    => (Splices (I.Splice IO) -> f (Splices (I.Splice IO)))+    -> HeistConfig m -> f (HeistConfig m)+hcLoadTimeSplices = hcSpliceConfig . scLoadTimeSplices +++------------------------------------------------------------------------------+-- | Lens for compiled splices+-- :: Simple Lens (HeistConfig m) (Splices (C.Splice m))+hcCompiledSplices+    :: Functor f+    => (Splices (C.Splice m) -> f (Splices (C.Splice m)))+    -> HeistConfig m -> f (HeistConfig m)+hcCompiledSplices = hcSpliceConfig . scCompiledSplices +++------------------------------------------------------------------------------+-- | Lens for attribute splices+-- :: Simple Lens (HeistConfig m) (Splices (AttrSplice m))+hcAttributeSplices+    :: Functor f+    => (Splices (AttrSplice m) -> f (Splices (AttrSplice m)))+    -> HeistConfig m -> f (HeistConfig m)+hcAttributeSplices = hcSpliceConfig . scAttributeSplices +++------------------------------------------------------------------------------+-- | Lens for template locations+-- :: Simple Lens (HeistConfig m) [TemplateLocation]+hcTemplateLocations+    :: Functor f+    => ([TemplateLocation] -> f [TemplateLocation])+    -> HeistConfig m -> f (HeistConfig m)+hcTemplateLocations = hcSpliceConfig . scTemplateLocations +++------------------------------------------------------------------------------+-- | Lens for compiled template filter+-- :: Simple Lens (SpliceConfig m) (TBool -> Bool)+hcCompiledTemplateFilter+    :: Functor f+    => ((TPath -> Bool) -> f (TPath -> Bool))+    -> HeistConfig m -> f (HeistConfig m)+hcCompiledTemplateFilter = hcSpliceConfig . scCompiledTemplateFilter++
+ src/Heist/Internal/Types/HeistState.hs view
@@ -0,0 +1,680 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-}++{-|++This module contains the core Heist data types.++Edward Kmett wrote most of the HeistT monad code and associated instances,+liberating us from the unused writer portion of RWST.++-}++module Heist.Internal.Types.HeistState where++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder      (Builder)+import           Control.Applicative           (Alternative (..))+import           Control.Arrow                 (first)+import           Control.Exception             (Exception)+import           Control.Monad                 (MonadPlus (..), ap)+import           Control.Monad.Base+import           Control.Monad.Cont            (MonadCont (..))+#if MIN_VERSION_mtl(2,2,1)+import           Control.Monad.Except          (MonadError (..))+#else+import           Control.Monad.Error           (MonadError (..))+#endif+#if MIN_VERSION_base(4,9,0)+import qualified Control.Monad.Fail as Fail+#endif+import           Control.Monad.Fix             (MonadFix (..))+import           Control.Monad.Reader          (MonadReader (..))+import           Control.Monad.State.Strict    (MonadState (..), StateT)+import           Control.Monad.Trans           (MonadIO (..), MonadTrans (..))+import           Control.Monad.Trans.Control+import           Data.ByteString.Char8         (ByteString)+import           Data.DList                    (DList)+import           Data.HashMap.Strict           (HashMap)+import qualified Data.HashMap.Strict           as H+import           Data.HeterogeneousEnvironment (HeterogeneousEnvironment)+import qualified Data.HeterogeneousEnvironment as HE+import           Data.Map.Syntax+#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup+#endif+import           Data.Text                     (Text)+import qualified Data.Text                     as T+import           Data.Text.Encoding            (decodeUtf8)+#if MIN_VERSION_base (4,7,0)+import           Data.Typeable                 (Typeable)+#else+import           Data.Typeable                 (TyCon, Typeable(..),+                                                Typeable1(..), mkTyCon,+                                                mkTyConApp)+#endif++#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative           (Applicative (..), (<$>))+import           Data.Monoid                   (Monoid(..))+#endif++import qualified Text.XmlHtml                  as X+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Convenient type alies for splices.+type Splices s = MapSyntax Text s+++------------------------------------------------------------------------------+-- | A 'Template' is a forest of XML nodes.  Here we deviate from the \"single+-- root node\" constraint of well-formed XML because we want to allow+-- templates to contain document fragments that may not have a single root.+type Template = [X.Node]+++------------------------------------------------------------------------------+-- | MIME Type.  The type alias is here to make the API clearer.+type MIMEType = ByteString+++------------------------------------------------------------------------------+-- | Reversed list of directories.  This holds the path to the template+-- currently being processed.+type TPath = [ByteString]+++------------------------------------------------------------------------------+-- | Holds data about templates read from disk.+data DocumentFile = DocumentFile+    { dfDoc  :: X.Document+    , dfFile :: Maybe FilePath+    } deriving ( Eq, Show+#if MIN_VERSION_base(4,7,0)+               , Typeable+#endif+               )+++------------------------------------------------------------------------------+-- | Designates whether a document should be treated as XML or HTML.+data Markup = Xml | Html+++------------------------------------------------------------------------------+-- | Monad used for runtime splice execution.+newtype RuntimeSplice m a = RuntimeSplice {+      unRT :: StateT HeterogeneousEnvironment m a+    } deriving ( Applicative+               , Functor+               , Monad+               , MonadIO+               , MonadState HeterogeneousEnvironment+               , MonadTrans+#if MIN_VERSION_base(4,7,0)+               , Typeable+#endif+               )+++------------------------------------------------------------------------------+instance (Monad m, Semigroup a) => Semigroup (RuntimeSplice m a) where+    a <> b = do+        !x <- a+        !y <- b+        return $! x <> y+++#if !MIN_VERSION_base(4,11,0)+instance (Monad m, Semigroup a, Monoid a) => Monoid (RuntimeSplice m a) where+#else+instance (Monad m, Monoid a) => Monoid (RuntimeSplice m a) where+#endif+    mempty = return mempty+#if !MIN_VERSION_base(4,11,0)+    mappend = (<>)+#endif+++------------------------------------------------------------------------------+-- | Opaque type representing pieces of output from compiled splices.+data Chunk m = Pure !ByteString+               -- ^ output known at load time+             | RuntimeHtml !(RuntimeSplice m Builder)+               -- ^ output computed at run time+             | RuntimeAction !(RuntimeSplice m ())+               -- ^ runtime action used only for its side-effect+#if MIN_VERSION_base(4,7,0)+             deriving Typeable+#endif++instance Show (Chunk m) where+    show (Pure _) = "Pure"+    show (RuntimeHtml _) = "RuntimeHtml"+    show (RuntimeAction _) = "RuntimeAction"+++showChunk :: Chunk m -> String+showChunk (Pure b) = T.unpack $ decodeUtf8 b+showChunk (RuntimeHtml _) = "RuntimeHtml"+showChunk (RuntimeAction _) = "RuntimeAction"+++isPureChunk :: Chunk m -> Bool+isPureChunk (Pure _) = True+isPureChunk _ = False+++------------------------------------------------------------------------------+-- | Type alias for attribute splices.  The function parameter is the value of+-- the bound attribute splice.  The return value is a list of attribute+-- key/value pairs that get substituted in the place of the bound attribute.+type AttrSplice m = Text -> RuntimeSplice m [(Text, Text)]+++------------------------------------------------------------------------------+-- | Detailed information about a splice error.+data SpliceError = SpliceError+    { spliceHistory      :: [(TPath, Maybe FilePath, Text)]+    , spliceTemplateFile :: Maybe FilePath+    , visibleSplices     :: [Text]+    , contextNode        :: X.Node+    , spliceMsg          :: Text+    } deriving ( Show, Eq )+++------------------------------------------------------------------------------+-- | Transform a SpliceError record to a Text message.+spliceErrorText :: SpliceError -> Text+spliceErrorText (SpliceError hist tf splices node msg) =+    (maybe "" ((`mappend` ": ") . T.pack) tf) `T.append` msg `T.append`+    foldr (\(_, tf', tag) -> (("\n   ... via " `T.append`+                               (maybe "" ((`mappend` ": ") . T.pack) tf')+                               `T.append` tag) `T.append`)) T.empty hist+    `T.append`+    if null splices+      then T.empty+      else "\nBound splices:" `T.append`+         foldl (\x y -> x `T.append` " " `T.append` y) T.empty splices+    `T.append`+    (T.pack $ "\nNode: " ++ (show node))+++------------------------------------------------------------------------------+-- | Exception type for splice compile errors.  Wraps the original+-- exception and provides context.+--data (Exception e) => CompileException e = CompileException+data CompileException = forall e . Exception e => CompileException+    { originalException :: e+    -- The list of splice errors.  The head of it has the context+    -- related to the exception.+    , exceptionContext :: [SpliceError]+    } deriving ( Typeable )+++instance Show CompileException where+    show (CompileException e []) =+      "Heist load exception (unknown context): " ++ (show e)+    show (CompileException _ (c:_)) = (T.unpack $ spliceErrorText c)+++instance Exception CompileException+++------------------------------------------------------------------------------+-- | Holds all the state information needed for template processing.  You will+-- build a @HeistState@ using 'initHeist' and any of Heist's @HeistState ->+-- HeistState@ \"filter\" functions.  Then you use the resulting @HeistState@+-- in calls to 'renderTemplate'.+--+-- m is the runtime monad+data HeistState m = HeistState {+    -- | A mapping of splice names to splice actions+      _spliceMap           :: HashMap Text (HeistT m m Template)+    -- | A mapping of template names to templates+    , _templateMap         :: HashMap TPath DocumentFile++    -- | A mapping of splice names to splice actions+    , _compiledSpliceMap   :: HashMap Text (HeistT m IO (DList (Chunk m)))+    -- | A mapping of template names to templates+    --, _compiledTemplateMap :: HashMap TPath (m Builder, MIMEType)+    , _compiledTemplateMap :: !(HashMap TPath ([Chunk m], MIMEType))++    , _attrSpliceMap       :: HashMap Text (AttrSplice m)++    -- | A flag to control splice recursion+    , _recurse             :: Bool+    -- | The path to the template currently being processed.+    , _curContext          :: TPath+    -- | Stack of the splices used.+    , _splicePath          :: [(TPath, Maybe FilePath, Text)]+    -- | A counter keeping track of the current recursion depth to prevent+    -- infinite loops.+    , _recursionDepth      :: Int+    -- | The doctypes encountered during template processing.+    , _doctypes            :: [X.DocType]+    -- | The full path to the current template's file on disk.+    , _curTemplateFile     :: Maybe FilePath+    -- | A key generator used to produce new unique Promises.+    , _keygen              :: HE.KeyGen++    -- | Flag indicating whether we're in preprocessing mode.  During+    -- preprocessing, errors should stop execution and be reported.  During+    -- template rendering, it's better to skip the errors and render the page.+    , _preprocessingMode   :: Bool++    -- | This is needed because compiled templates are generated with a bunch+    -- of calls to renderFragment rather than a single call to render.+    , _curMarkup           :: Markup++    -- | A prefix for all splices (namespace ++ ":").+    , _splicePrefix        :: Text++    -- | List of errors encountered during splice processing.+    , _spliceErrors        :: [SpliceError]++    -- | Whether to throw an error when a tag wih the heist namespace does not+    -- correspond to a bound splice.  When not using a namespace, this flag is+    -- ignored.+    , _errorNotBound       :: Bool+    , _numNamespacedTags   :: Int+#if MIN_VERSION_base(4,7,0)+} deriving (Typeable)+#else+}+#endif++#if !MIN_VERSION_base(4,7,0)+-- NOTE: We got rid of the Monoid instance because it is absolutely not safe+-- to combine two compiledTemplateMaps.  All compiled templates must be known+-- at load time and processed in a single call to initHeist/loadTemplates or+-- whatever we end up calling it..++instance (Typeable1 m) => Typeable (HeistState m) where+    typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]++#endif++------------------------------------------------------------------------------+-- | HeistT is the monad transformer used for splice processing.  HeistT+-- intentionally does not expose any of its functionality via MonadState or+-- MonadReader functions.  We define passthrough instances for the most common+-- types of monads.  These instances allow the user to use HeistT in a monad+-- stack without needing calls to `lift`.+--+-- @n@ is the runtime monad (the parameter to HeistState).+--+-- @m@ is the monad being run now.  In this case, \"now\" is a variable+-- concept.  The type @HeistT n n@ means that \"now\" is runtime.  The type+-- @HeistT n IO@ means that \"now\" is @IO@, and more importantly it is NOT+-- runtime. In Heist, the rule of thumb is that @IO@ means load time and @n@+-- means runtime.+newtype HeistT n m a = HeistT {+    runHeistT :: X.Node+              -> HeistState n+              -> m (a, HeistState n)+#if MIN_VERSION_base(4,7,0)+} deriving Typeable+#else+}+#endif+++------------------------------------------------------------------------------+-- | Gets the names of all the templates defined in a HeistState.+templateNames :: HeistState m -> [TPath]+templateNames ts = H.keys $ _templateMap ts+++------------------------------------------------------------------------------+-- | Gets the names of all the templates defined in a HeistState.+compiledTemplateNames :: HeistState m -> [TPath]+compiledTemplateNames ts = H.keys $ _compiledTemplateMap ts+++------------------------------------------------------------------------------+-- | Gets the names of all the interpreted splices defined in a HeistState.+spliceNames :: HeistState m -> [Text]+spliceNames ts = H.keys $ _spliceMap ts+++------------------------------------------------------------------------------+-- | Gets the names of all the compiled splices defined in a HeistState.+compiledSpliceNames :: HeistState m -> [Text]+compiledSpliceNames ts = H.keys $ _compiledSpliceMap ts+++#if !MIN_VERSION_base(4,7,0)+------------------------------------------------------------------------------+-- | The Typeable instance is here so Heist can be dynamically executed with+-- Hint.+templateStateTyCon :: TyCon+templateStateTyCon = mkTyCon "Heist.HeistState"+{-# NOINLINE templateStateTyCon #-}+#endif+++------------------------------------------------------------------------------+-- | Evaluates a template monad as a computation in the underlying monad.+evalHeistT :: (Monad m)+           => HeistT n m a+           -> X.Node+           -> HeistState n+           -> m a+evalHeistT m r s = do+    (a, _) <- runHeistT m r s+    return a+{-# INLINE evalHeistT #-}+++------------------------------------------------------------------------------+-- | Functor instance+instance Functor m => Functor (HeistT n m) where+    fmap f (HeistT m) = HeistT $ \r s -> first f <$> m r s+++------------------------------------------------------------------------------+-- | Applicative instance+instance (Monad m, Functor m) => Applicative (HeistT n m) where+    pure = return+    (<*>) = ap+++------------------------------------------------------------------------------+-- | Monad instance+instance Monad m => Monad (HeistT n m) where+    return a = HeistT (\_ s -> return (a, s))+    {-# INLINE return #-}+    HeistT m >>= k = HeistT $ \r s -> do+        (a, s') <- m r s+        runHeistT (k a) r s'+    {-# INLINE (>>=) #-}+++#if MIN_VERSION_base(4,9,0)+------------------------------------------------------------------------------+-- | MonadFail instance+instance Fail.MonadFail m => Fail.MonadFail (HeistT n m) where+    fail = lift . Fail.fail+#endif+++------------------------------------------------------------------------------+-- | MonadIO instance+instance MonadIO m => MonadIO (HeistT n m) where+    liftIO = lift . liftIO+++------------------------------------------------------------------------------+-- | MonadTrans instance+instance MonadTrans (HeistT n) where+    lift m = HeistT $ \_ s -> do+        a <- m+        return (a, s)+++instance MonadBase b m => MonadBase b (HeistT n m) where+    liftBase = lift . liftBase++#if MIN_VERSION_monad_control(1,0,0)+instance MonadTransControl (HeistT n) where+    type StT (HeistT n) a = (a, HeistState n)+    liftWith f = HeistT $ \n s -> do+        res <- f $ \(HeistT g) -> g n s+        return (res, s)+    restoreT k = HeistT $ \_ _ -> k+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}+++instance MonadBaseControl b m => MonadBaseControl b (HeistT n m) where+     type StM (HeistT n m) a = ComposeSt (HeistT n) m a+     liftBaseWith = defaultLiftBaseWith+     restoreM = defaultRestoreM+     {-# INLINE liftBaseWith #-}+     {-# INLINE restoreM #-}+#else+instance MonadTransControl (HeistT n) where+    newtype StT (HeistT n) a = StHeistT {unStHeistT :: (a, HeistState n)}+    liftWith f = HeistT $ \n s -> do+        res <- f $ \(HeistT g) -> liftM StHeistT $ g n s+        return (res, s)+    restoreT k = HeistT $ \_ _ -> liftM unStHeistT k+    {-# INLINE liftWith #-}+    {-# INLINE restoreT #-}+++instance MonadBaseControl b m => MonadBaseControl b (HeistT n m) where+     newtype StM (HeistT n m) a = StMHeist {unStMHeist :: ComposeSt (HeistT n) m a}+     liftBaseWith = defaultLiftBaseWith StMHeist+     restoreM = defaultRestoreM unStMHeist+     {-# INLINE liftBaseWith #-}+     {-# INLINE restoreM #-}+#endif++------------------------------------------------------------------------------+-- | MonadFix passthrough instance+instance MonadFix m => MonadFix (HeistT n m) where+    mfix f = HeistT $ \r s ->+        mfix $ \ (a, _) -> runHeistT (f a) r s+++------------------------------------------------------------------------------+-- | Alternative passthrough instance+instance (Functor m, MonadPlus m) => Alternative (HeistT n m) where+    empty = mzero+    (<|>) = mplus+++------------------------------------------------------------------------------+-- | MonadPlus passthrough instance+instance MonadPlus m => MonadPlus (HeistT n m) where+    mzero = lift mzero+    m `mplus` n = HeistT $ \r s ->+        runHeistT m r s `mplus` runHeistT n r s+++------------------------------------------------------------------------------+-- | MonadState passthrough instance+instance MonadState s m => MonadState s (HeistT n m) where+    get = lift get+    {-# INLINE get #-}+    put = lift . put+    {-# INLINE put #-}+++------------------------------------------------------------------------------+-- | MonadReader passthrough instance+instance MonadReader r m => MonadReader r (HeistT n m) where+    ask = HeistT $ \_ s -> do+            r <- ask+            return (r,s)+    local f (HeistT m) =+        HeistT $ \r s -> local f (m r s)+++------------------------------------------------------------------------------+-- | Helper for MonadError instance.+_liftCatch+    :: (m (a,HeistState n)+        -> (e -> m (a,HeistState n))+        -> m (a,HeistState n))+    -> HeistT n m a+    -> (e -> HeistT n m a)+    -> HeistT n m a+_liftCatch ce m h =+    HeistT $ \r s ->+        (runHeistT m r s `ce`+        (\e -> runHeistT (h e) r s))+++------------------------------------------------------------------------------+-- | MonadError passthrough instance+instance (MonadError e m) => MonadError e (HeistT n m) where+    throwError = lift . throwError+    catchError = _liftCatch catchError+++------------------------------------------------------------------------------+-- | Helper for MonadCont instance.+_liftCallCC+    :: ((((a,HeistState n) -> m (b, HeistState n))+           -> m (a, HeistState n))+         -> m (a, HeistState n))+    -> ((a -> HeistT n m b) -> HeistT n m a)+    -> HeistT n m a+_liftCallCC ccc f = HeistT $ \r s ->+    ccc $ \c ->+    runHeistT (f (\a -> HeistT $ \_ _ -> c (a, s))) r s+++------------------------------------------------------------------------------+-- | MonadCont passthrough instance+instance (MonadCont m) => MonadCont (HeistT n m) where+    callCC = _liftCallCC callCC+++#if !MIN_VERSION_base(4,7,0)+------------------------------------------------------------------------------+-- | The Typeable instance is here so Heist can be dynamically executed with+-- Hint.+templateMonadTyCon :: TyCon+templateMonadTyCon = mkTyCon "Heist.HeistT"+{-# NOINLINE templateMonadTyCon #-}++instance (Typeable1 m) => Typeable1 (HeistT n m) where+    typeOf1 _ = mkTyConApp templateMonadTyCon [typeOf1 (undefined :: m ())]+#endif+++------------------------------------------------------------------------------+-- Functions for our monad.+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Gets the node currently being processed.+--+--   > <speech author="Shakespeare">+--   >   To sleep, perchance to dream.+--   > </speech>+--+-- When you call @getParamNode@ inside the code for the @speech@ splice, it+-- returns the Node for the @speech@ tag and its children.  @getParamNode >>=+-- childNodes@ returns a list containing one 'TextNode' containing part of+-- Hamlet's speech.  @liftM (getAttribute \"author\") getParamNode@ would+-- return @Just \"Shakespeare\"@.+getParamNode :: Monad m => HeistT n m X.Node+getParamNode = HeistT $ curry return+{-# INLINE getParamNode #-}+++------------------------------------------------------------------------------+-- | HeistT's 'local'.+localParamNode :: Monad m+               => (X.Node -> X.Node)+               -> HeistT n m a+               -> HeistT n m a+localParamNode f m = HeistT $ \r s -> runHeistT m (f r) s+{-# INLINE localParamNode #-}+++------------------------------------------------------------------------------+-- | HeistT's 'gets'.+getsHS :: Monad m => (HeistState n -> r) -> HeistT n m r+getsHS f = HeistT $ \_ s -> return (f s, s)+{-# INLINE getsHS #-}+++------------------------------------------------------------------------------+-- | HeistT's 'get'.+getHS :: Monad m => HeistT n m (HeistState n)+getHS = HeistT $ \_ s -> return (s, s)+{-# INLINE getHS #-}+++------------------------------------------------------------------------------+-- | HeistT's 'put'.+putHS :: Monad m => HeistState n -> HeistT n m ()+putHS s = HeistT $ \_ _ -> return ((), s)+{-# INLINE putHS #-}+++------------------------------------------------------------------------------+-- | HeistT's 'modify'.+modifyHS :: Monad m+         => (HeistState n -> HeistState n)+         -> HeistT n m ()+modifyHS f = HeistT $ \_ s -> return ((), f s)+{-# INLINE modifyHS #-}+++------------------------------------------------------------------------------+-- | Restores the HeistState.  This function is almost like putHS except it+-- preserves the current doctypes and splice errors.  You should use this+-- function instead of @putHS@ to restore an old state.  This was needed+-- because doctypes needs to be in a "global scope" as opposed to the template+-- call "local scope" of state items such as recursionDepth, curContext, and+-- spliceMap.+restoreHS :: Monad m => HeistState n -> HeistT n m ()+restoreHS old = modifyHS (\cur -> old { _doctypes = _doctypes cur+                                      , _numNamespacedTags =+                                        _numNamespacedTags cur+                                      , _spliceErrors = _spliceErrors cur })+{-# INLINE restoreHS #-}+++------------------------------------------------------------------------------+-- | Abstracts the common pattern of running a HeistT computation with+-- a modified heist state.+localHS :: Monad m+        => (HeistState n -> HeistState n)+        -> HeistT n m a+        -> HeistT n m a+localHS f k = do+    ts <- getHS+    putHS $ f ts+    res <- k+    restoreHS ts+    return res+{-# INLINE localHS #-}+++------------------------------------------------------------------------------+-- | Modifies the recursion depth.+modRecursionDepth :: Monad m => (Int -> Int) -> HeistT n m ()+modRecursionDepth f =+    modifyHS (\st -> st { _recursionDepth = f (_recursionDepth st) })+++------------------------------------------------------------------------------+-- | Increments the namespaced tag count+incNamespacedTags :: Monad m => HeistT n m ()+incNamespacedTags =+    modifyHS (\st -> st { _numNamespacedTags = _numNamespacedTags st + 1 })+++------------------------------------------------------------------------------+-- | AST to hold attribute parsing structure.  This is necessary because+-- attoparsec doesn't support parsers running in another monad.+data AttAST = Literal Text+            | Ident   Text+  deriving (Show)+++------------------------------------------------------------------------------+isIdent :: AttAST -> Bool+isIdent (Ident _) = True+isIdent _         = False++
+ src/Heist/Interpreted.hs view
@@ -0,0 +1,83 @@+{-|++This module defines the API for writing and working with interpreted splices.+It exports some of the same symbols as "Heist.Compiled", so you will probably+want to import it qualified.++Interpreted splices can be thought of as a function @Node -> m [Node]@.  Heist+then substitutes the resulting list of nodes into your template in place of+the input node.  'Splice' is implemented as a type synonym @type Splice m =+HeistT m [Node]@, and 'HeistT' has a function 'getParamNode' that lets you get+the input node.++Suppose you have a place on your page where you want to display a link with+the text \"Logout username\" if the user is currently logged in or a link to+the login page if no user is logged in.  Assume you have a function+@getUser :: MyAppMonad (Maybe Text)@ that gets the current user.+You can implement this functionality with a 'Splice' as follows:++> import           Blaze.ByteString.Builder+> import           Data.ByteString.Char8 (ByteString)+> import qualified Data.ByteString.Char8 as B+> import           Data.Text (Text)+> import qualified Data.Text as T+> import qualified Text.XmlHtml as X+>+> import qualified Heist.Interpreted as I+>+> link :: Text -> Text -> X.Node+> link target text = X.Element "a" [("href", target)] [X.TextNode text]+>+> loginLink :: X.Node+> loginLink = link "/login" "Login"+>+> logoutLink :: Text -> X.Node+> logoutLink user = link "/logout" (T.append "Logout " user)+>+> loginLogoutSplice :: I.Splice MyAppMonad+> loginLogoutSplice = do+>     user <- lift getUser+>     return [maybe loginLink logoutLink user]+>++-}++module Heist.Interpreted+  (+    Splice++  -- * HeistState Functions+  , addTemplate+  , addXMLTemplate+  , lookupSplice+  , bindSplice+  , bindSplices+  , bindAttributeSplices++  -- * Functions for creating splices+  , textSplice+  , runChildren+  , runChildrenWith+  , runChildrenWithTrans+  , runChildrenWithTemplates+  , runChildrenWithText+  , mapSplices++  -- * HeistT functions+  , stopRecursion+  , runNode+  , runAttributes+  , runNodeList+  , evalTemplate+  , bindStrings+  , bindString+  , callTemplate+  , callTemplateWithText+  , renderTemplate+  , renderTemplateToDoc+  , renderWithArgs+  ) where++import Heist.Interpreted.Internal+import Heist.Common (mapSplices, bindAttributeSplices)+
+ src/Heist/Interpreted/Internal.hs view
@@ -0,0 +1,423 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE PackageImports             #-}+{-# LANGUAGE ScopedTypeVariables        #-}++module Heist.Interpreted.Internal where++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Control.Monad+import           Control.Monad.State.Strict+import qualified Data.Attoparsec.Text          as AP+import           Data.ByteString               (ByteString)+import qualified Data.HashMap.Strict           as Map+import qualified Data.HeterogeneousEnvironment as HE+import           Data.Map.Syntax+import           Data.Maybe+import           Data.Text                     (Text)+import qualified Data.Text                     as T+import qualified Text.XmlHtml                  as X+------------------------------------------------------------------------------+import           Heist.Common+import           Heist.Internal.Types.HeistState+------------------------------------------------------------------------------+++type Splice n = HeistT n n Template+++------------------------------------------------------------------------------+-- HeistState functions+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Binds a new splice declaration to a tag name within a 'HeistState'.+bindSplice :: Text            -- ^ tag name+           -> Splice n        -- ^ splice action+           -> HeistState n    -- ^ source state+           -> HeistState n+bindSplice n v hs = hs {_spliceMap = Map.insert n v (_spliceMap hs)}+++------------------------------------------------------------------------------+-- | Binds a set of new splice declarations within a 'HeistState'.+bindSplices :: Splices (Splice n) -- ^ splices to bind+            -> HeistState n       -- ^ start state+            -> HeistState n+bindSplices ss hs =+    hs { _spliceMap = applySpliceMap hs _spliceMap ss }+++------------------------------------------------------------------------------+-- | Converts 'Text' to a splice returning a single 'TextNode'.+textSplice :: Monad m => Text -> HeistT n m Template+textSplice t = return [X.TextNode t]+++------------------------------------------------------------------------------+-- | Runs the parameter node's children and returns the resulting node list.+-- By itself this function is a simple passthrough splice that makes the+-- spliced node disappear.  In combination with locally bound splices, this+-- function makes it easier to pass the desired view into your splices.+runChildren :: Monad n => Splice n+runChildren = runNodeList . X.childNodes =<< getParamNode+++------------------------------------------------------------------------------+-- | Binds a list of splices before using the children of the spliced node as+-- a view.+runChildrenWith :: (Monad n)+                => Splices (Splice n)+                -- ^ List of splices to bind before running the param nodes.+                -> Splice n+                -- ^ Returns the passed in view.+runChildrenWith splices = localHS (bindSplices splices) runChildren+++------------------------------------------------------------------------------+-- | Wrapper around runChildrenWith that applies a transformation function to+-- the second item in each of the tuples before calling runChildrenWith.+runChildrenWithTrans :: (Monad n)+          => (b -> Splice n)+          -- ^ Splice generating function+          -> Splices b+          -- ^ List of tuples to be bound+          -> Splice n+runChildrenWithTrans f = runChildrenWith . mapV f+++------------------------------------------------------------------------------+-- | Like runChildrenWith but using constant templates rather than dynamic+-- splices.+runChildrenWithTemplates :: (Monad n) => Splices Template -> Splice n+runChildrenWithTemplates = runChildrenWithTrans return+++------------------------------------------------------------------------------+-- | Like runChildrenWith but using literal text rather than dynamic splices.+runChildrenWithText :: (Monad n) => Splices Text -> Splice n+runChildrenWithText = runChildrenWithTrans textSplice+++------------------------------------------------------------------------------+-- | Convenience function for looking up a splice.+lookupSplice :: Text+             -> HeistState n+             -> Maybe (Splice n)+lookupSplice nm hs = Map.lookup nm $ _spliceMap hs+{-# INLINE lookupSplice #-}+++------------------------------------------------------------------------------+-- | Adds an HTML format template to the heist state.+addTemplate :: ByteString+            -- ^ Path that the template will be referenced by+            -> Template+            -- ^ The template's DOM nodes+            -> Maybe FilePath+            -- ^ An optional path to the actual file on disk where the+            -- template is stored+            -> HeistState n+            -> HeistState n+addTemplate n t mfp st =+    insertTemplate (splitTemplatePath n) doc st+  where+    doc = DocumentFile (X.HtmlDocument X.UTF8 Nothing t) mfp+++------------------------------------------------------------------------------+-- | Adds an XML format template to the heist state.+addXMLTemplate :: ByteString+               -- ^ Path that the template will be referenced by+               -> Template+               -- ^ The template's DOM nodes+               -> Maybe FilePath+               -- ^ An optional path to the actual file on disk where the+               -- template is stored+               -> HeistState n+               -> HeistState n+addXMLTemplate n t mfp st =+    insertTemplate (splitTemplatePath n) doc st+  where+    doc = DocumentFile (X.XmlDocument X.UTF8 Nothing t) mfp+++------------------------------------------------------------------------------+-- | Stops the recursive processing of splices.  Consider the following+-- example:+--+--   > <foo>+--   >   <bar>+--   >     ...+--   >   </bar>+--   > </foo>+--+-- Assume that @\"foo\"@ is bound to a splice procedure. Running the @foo@+-- splice will result in a list of nodes @L@.  Normally @foo@ will recursively+-- scan @L@ for splices and run them.  If @foo@ calls @stopRecursion@, @L@+-- will be included in the output verbatim without running any splices.+stopRecursion :: Monad m => HeistT n m ()+stopRecursion = modifyHS (\st -> st { _recurse = False })+++------------------------------------------------------------------------------+-- | Performs splice processing on a single node.+runNode :: Monad n => X.Node -> Splice n+runNode (X.Element nm at ch) = do+    newAtts <- runAttributes at+    let n = X.Element nm newAtts ch+    s <- liftM (lookupSplice nm) getHS+    maybe (runKids newAtts) (recurseSplice n) s+  where+    runKids newAtts = do+        newKids <- runNodeList ch+        return [X.Element nm newAtts newKids]+runNode n                    = return [n]+++------------------------------------------------------------------------------+-- | Performs splice processing on a list of attributes.  This is useful in+-- situations where you need to stop recursion, but still run splice+-- processing on the node's attributes.+runAttributes :: Monad n => [(Text, Text)] -> HeistT n n [(Text, Text)]+runAttributes attrs = (return . concat) =<< mapM runAttrSplice attrs+++------------------------------------------------------------------------------+-- | Runs the attribute splice if it exists, otherwise it does inline $()+-- substitution.+runAttrSplice :: (Monad n) => (Text, Text) -> HeistT n n [(Text, Text)]+runAttrSplice a@(k,v) = do+    splice <- getsHS (Map.lookup k . _attrSpliceMap)+    maybe (liftM (:[]) $ attSubst a)+          (lift . flip evalStateT HE.empty . unRT . ($v)) splice+++------------------------------------------------------------------------------+-- | Helper function for substituting a parsed attribute into an attribute+-- tuple.+attSubst :: (Monad n) => (t, Text) -> HeistT n n (t, Text)+attSubst (n,v) = do+    v' <- parseAtt v+    return (n,v')+++------------------------------------------------------------------------------+-- | Parses an attribute for any identifier expressions and performs+-- appropriate substitution.+parseAtt :: (Monad n) => Text -> HeistT n n Text+parseAtt bs = do+    let ast = case AP.feed (AP.parse attParser bs) "" of+                (AP.Done _ res) -> res+                (AP.Fail _ _ _) -> []+                (AP.Partial _)  -> []+    chunks <- mapM cvt ast+    return $ T.concat chunks+  where+    cvt (Literal x) = return x+    cvt (Ident x)   =+        localParamNode (const $ X.Element x [] []) $ getAttributeSplice x+++------------------------------------------------------------------------------+-- | Gets the attribute value.  If the splice's result list contains non-text+-- nodes, this will translate them into text nodes with nodeText and+-- concatenate them together.+--+-- Originally, this only took the first node from the splices's result list,+-- and only if it was a text node. This caused problems when the splice's+-- result contained HTML entities, as they would split a text node. This was+-- then fixed to take the first consecutive bunch of text nodes, and return+-- their concatenation. This was seen as more useful than throwing an error,+-- and more intuitive than trying to render all the nodes as text.+--+-- However, it was decided in the end to render all the nodes as text, and+-- then concatenate them. If a splice returned+-- \"some \<b\>text\<\/b\> foobar\", the user would almost certainly want+-- \"some text foobar\" to be rendered, and Heist would probably seem+-- annoyingly limited for not being able to do this. If the user really did+-- want it to render \"some \", it would probably be easier for them to+-- accept that they were silly to pass more than that to be substituted than+-- it would be for the former user to accept that+-- \"some \<b\>text\<\/b\> foobar\" is being rendered as \"some \" because+-- it's \"more intuitive\".+getAttributeSplice :: Monad n => Text -> HeistT n n Text+getAttributeSplice name = do+    hs <- getHS+    let noSplice = return $ T.concat ["${", name, "}"]+        s = lookupSplice name hs+    maybe noSplice (liftM (T.concat . map X.nodeText)) s++------------------------------------------------------------------------------+-- | Performs splice processing on a list of nodes.+runNodeList :: Monad n => [X.Node] -> Splice n+runNodeList = mapSplices runNode+{-# INLINE runNodeList #-}+++------------------------------------------------------------------------------+-- | The maximum recursion depth.  (Used to prevent infinite loops.)+mAX_RECURSION_DEPTH :: Int+mAX_RECURSION_DEPTH = 50+++------------------------------------------------------------------------------+-- | Checks the recursion flag and recurses accordingly.  Does not recurse+-- deeper than mAX_RECURSION_DEPTH to avoid infinite loops.+recurseSplice :: Monad n => X.Node -> Splice n -> Splice n+recurseSplice node splice = do+    result <- localParamNode (const node) splice+    hs <- getHS+    if _recurse hs+        then if _recursionDepth hs < mAX_RECURSION_DEPTH+               then do modRecursionDepth (+1)+                       res <- runNodeList result+                       restoreHS hs+                       return res+               else return result `orError` err+        else do modifyHS (\st -> st { _recurse = True })+                return result+  where+    err = unwords+        ["Recursion limit reached in node"+        ,"<"++(T.unpack $ X.elementTag node)++">.  You"+        ,"probably have infinite splice recursion!"+        ]++++------------------------------------------------------------------------------+-- | Looks up a template name runs a 'HeistT' computation on it.+lookupAndRun :: Monad m+             => ByteString+             -> ((DocumentFile, TPath) -> HeistT n m (Maybe a))+             -> HeistT n m (Maybe a)+lookupAndRun name k = do+    hs <- getHS+    let mt = lookupTemplate name hs _templateMap+    let curPath = join $ fmap (dfFile . fst) mt+    modifyHS (setCurTemplateFile curPath)+    maybe (return Nothing) k mt+++------------------------------------------------------------------------------+-- | Looks up a template name evaluates it by calling runNodeList.+evalTemplate :: Monad n+             => ByteString+             -> HeistT n n (Maybe Template)+evalTemplate name = lookupAndRun name+    (\(t,ctx) -> localHS (\hs -> hs {_curContext = ctx})+                         (liftM Just $ runNodeList $ X.docContent $ dfDoc t))+++------------------------------------------------------------------------------+-- | Sets the document type of a 'X.Document' based on the 'HeistT'+-- value.+fixDocType :: Monad m => X.Document -> HeistT n m X.Document+fixDocType d = do+    dts <- getsHS _doctypes+    return $ d { X.docType = listToMaybe dts }+++------------------------------------------------------------------------------+-- | Runs a template and sets the doctype properly.  This is the right thing+-- to do if we are starting at the top level.+evalWithDoctypes :: Monad n+                 => ByteString+                 -> HeistT n n (Maybe X.Document)+evalWithDoctypes name = lookupAndRun name $ \(t,ctx) -> do+    addDoctype $ maybeToList $ X.docType $ dfDoc t+    hs <- getHS+    let nodes = X.docContent $ dfDoc t+    putHS (hs {_curContext = ctx})+    newNodes <- runNodeList nodes+    restoreHS hs+    newDoc   <- fixDocType $ (dfDoc t) { X.docContent = newNodes }+    return (Just newDoc)+++------------------------------------------------------------------------------+-- | Binds a list of constant string splices.+bindStrings :: Monad n+            => Splices Text+            -> HeistState n+            -> HeistState n+bindStrings splices = bindSplices (mapV textSplice splices)+++------------------------------------------------------------------------------+-- | Binds a single constant string splice.+bindString :: Monad n+           => Text+           -> Text+           -> HeistState n+           -> HeistState n+bindString n = bindSplice n . textSplice+++------------------------------------------------------------------------------+-- | Renders a template with the specified parameters.  This is the function+-- to use when you want to "call" a template and pass in parameters from+-- inside a splice.  If the template does not exist, this version simply+-- returns an empty list.+callTemplate :: Monad n+             => ByteString         -- ^ The name of the template+             -> Splices (Splice n) -- ^ Splices to call the template with+             -> HeistT n n Template+callTemplate name splices = do+    modifyHS $ bindSplices splices+    liftM (maybe [] id) $ evalTemplate name+++------------------------------------------------------------------------------+-- | Like callTemplate except the splices being bound are constant text+-- splices.+callTemplateWithText :: Monad n+                     => ByteString     -- ^ The name of the template+                     -> Splices Text -- ^ Splices to call the template with+                     -> HeistT n n Template+callTemplateWithText name splices = callTemplate name $ mapV textSplice splices+++------------------------------------------------------------------------------+-- | Renders a template from the specified HeistState to a 'Builder'.  The+-- MIME type returned is based on the detected character encoding, and whether+-- the root template was an HTML or XML format template.  It will always be+-- @text/html@ or @text/xml@.  If a more specific MIME type is needed for a+-- particular XML application, it must be provided by the application.+--+-- Note that template names should not include the .tpl extension:+--+-- @renderTemplate hs "index"@+renderTemplate :: Monad n+               => HeistState n+               -> ByteString+               -> n (Maybe (Builder, MIMEType))+renderTemplate hs name = evalHeistT tpl (X.TextNode "") hs+  where tpl = do mt <- evalWithDoctypes name+                 case mt of+                    Nothing  -> return Nothing+                    Just doc -> return $ Just $ (X.render doc, mimeType doc)+++------------------------------------------------------------------------------+-- | Renders a template with the specified arguments passed to it.  This is a+-- convenience function for the common pattern of calling renderTemplate after+-- using bindString, bindStrings, or bindSplice to set up the arguments to the+-- template.+renderWithArgs :: Monad n+               => Splices Text+               -> HeistState n+               -> ByteString+               -> n (Maybe (Builder, MIMEType))+renderWithArgs args hs = renderTemplate (bindStrings args hs)+++renderTemplateToDoc :: Monad n+            => HeistState n+            -> ByteString+            -> n (Maybe X.Document)+renderTemplateToDoc hs name =+    evalHeistT (evalWithDoctypes name) (X.TextNode "") hs
+ src/Heist/Splices.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE CPP               #-}++module Heist.Splices+  ( ifISplice+  , ifCSplice+  , ifElseISplice+  , ifElseCSplice+  , module Heist.Splices.Apply+  , module Heist.Splices.Bind+  , module Heist.Splices.Cache+  , module Heist.Splices.Html+  , module Heist.Splices.Ignore+  , module Heist.Splices.Markdown+  ) where++#if !MIN_VERSION_base(4,8,0)+import           Data.Monoid (Monoid(..))+#endif++import qualified Heist.Compiled as C+import qualified Heist.Interpreted as I+import           Heist.Splices.Apply+import           Heist.Splices.Bind+import           Heist.Splices.Cache+import           Heist.Splices.Html+import           Heist.Splices.Ignore+import           Heist.Splices.Markdown+import           Heist.Internal.Types.HeistState+import qualified Text.XmlHtml as X++------------------------------------------------------------------------------+-- | Run the splice contents if given condition is True, make splice disappear+-- if not.+ifISplice :: Monad m => Bool -> I.Splice m+ifISplice cond =+    case cond of+      False -> return []+      True -> I.runChildren+++------------------------------------------------------------------------------+-- | Function for constructing if splices that use a runtime predicate+-- function to determine whether the node's children should be rendered.+ifCSplice :: Monad m+          => (t -> Bool)+          -> RuntimeSplice m t+          -> C.Splice m+ifCSplice predicate runtime = do+    chunks <- C.runChildren+    return $ C.yieldRuntime $ do+        a <- runtime+        if predicate a+          then+            C.codeGen chunks+          else+            return mempty+++------------------------------------------------------------------------------+-- | Implements an if\/then\/else conditional splice.  It splits its children+-- around the \<else\/\> element to get the markup to be used for the two cases.+ifElseISplice :: Monad m => Bool -> I.Splice m+ifElseISplice cond = getParamNode >>= (rewrite . X.childNodes)+  where+    rewrite nodes = +      let (ns, ns') = break (\n -> X.tagName n==Just "else") nodes+      in I.runNodeList $ if cond then ns else (drop 1 ns') +++------------------------------------------------------------------------------+-- | Implements an if\/then\/else conditional splice.  It splits its children+-- around the \<else\/\> element to get the markup to be used for the two cases.+ifElseCSplice :: Monad m => Bool -> C.Splice m+ifElseCSplice cond = getParamNode >>= (rewrite . X.childNodes)+  where rewrite nodes = +          let (ns, ns') = break (\n -> X.tagName n==Just "else") nodes+          in C.runNodeList $ if cond then ns else (drop 1 ns')
+ src/Heist/Splices/Apply.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+module Heist.Splices.Apply where++------------------------------------------------------------------------------+import           Data.Maybe+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Text.XmlHtml as X++------------------------------------------------------------------------------+import           Heist.Common+import           Heist.Interpreted.Internal+import           Heist.Internal.Types.HeistState+++------------------------------------------------------------------------------+-- | Default name for the apply splice.+applyTag :: Text+applyTag = "apply"+++------------------------------------------------------------------------------+-- | Default attribute name for the apply tag.+applyAttr :: Text+applyAttr = "template"+++------------------------------------------------------------------------------+-- | +rawApply :: (Monad n)+         => Text+         -> [X.Node]+         -> Maybe FilePath+         -> TPath+         -> [X.Node]+         -> Splice n+rawApply paramTag calledNodes templateFile newContext paramNodes = do+    hs <- getHS  -- Can't use localHS here because the modifier is not pure+    processedParams <- runNodeList paramNodes++    -- apply should do a bottom-up traversal, so we run the called nodes+    -- before doing <content/> substitution.+    modifyHS (setCurContext newContext . setCurTemplateFile templateFile)++    let process = concatMap (treeMap processedParams)+    if _recursionDepth hs < mAX_RECURSION_DEPTH+      then do modRecursionDepth (+1)+              res <- runNodeList calledNodes+              restoreHS hs+              return $! process res+      else do restoreHS hs+              (return []) `orError` err+  where+    err = "template recursion exceeded max depth, "+++          "you probably have infinite splice recursion!" :: String+    treeMap :: [X.Node] -> X.Node -> [X.Node]+    treeMap ns n@(X.Element nm _ cs)+      | nm == paramTag = ns+      | otherwise = [n { X.elementChildren = cs' }]+      where+        !cs' = concatMap (treeMap ns) cs+    treeMap _ n = [n]+++------------------------------------------------------------------------------+-- | Applies a template as if the supplied nodes were the children of the+-- <apply> tag.+applyNodes :: Monad n => Template -> Text -> Splice n+applyNodes nodes template = do+    hs <- getHS+    maybe (return [] `orError` err)+          (\(t,ctx) -> do+              addDoctype $ maybeToList $ X.docType $ dfDoc t+              rawApply "apply-content" (X.docContent $ dfDoc t)+                       (dfFile t) ctx nodes)+          (lookupTemplate (T.encodeUtf8 template) hs _templateMap)+  where+    err = "apply tag cannot find template \""++(T.unpack template)++"\""+++------------------------------------------------------------------------------+-- | Implementation of the apply splice.+applyImpl :: Monad n => Splice n+applyImpl = do+    node <- getParamNode+    let err = "must supply \"" ++ T.unpack applyAttr +++              "\" attribute in <" ++ T.unpack (X.elementTag node) ++ ">"+    case X.getAttribute applyAttr node of+        Nothing   -> return [] `orError` err+        Just template -> applyNodes (X.childNodes node) template+++------------------------------------------------------------------------------+-- | This splice crashes with an error message.  Its purpose is to provide a+-- load-time warning to anyone still using the old content tag in their+-- templates.  In Heist 0.10, tho content tag was replaced by two separate+-- apply-content and bind-content tags used by the apply and bind splices+-- respectively.+deprecatedContentCheck :: Monad m => Splice m+deprecatedContentCheck =+    return [] `orError` unwords+      ["<content> tag deprecated.  Use"+      ,"<apply-content> or <bind-content>"+      ]+
+ src/Heist/Splices/Bind.hs view
@@ -0,0 +1,42 @@+module Heist.Splices.Bind where++------------------------------------------------------------------------------+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Text.XmlHtml as X++------------------------------------------------------------------------------+import           Heist.Common+import           Heist.Interpreted.Internal+import           Heist.Splices.Apply+import           Heist.Internal.Types.HeistState++-- | Default name for the bind splice.+bindTag :: Text+bindTag = "bind"+++------------------------------------------------------------------------------+-- | Default attribute name for the bind tag.+bindAttr :: Text+bindAttr = "tag"+++------------------------------------------------------------------------------+-- | Implementation of the bind splice.+bindImpl :: Monad n => Splice n+bindImpl = do+    node <- getParamNode+    let err = "must supply \"" ++ T.unpack bindAttr +++              "\" attribute in <" ++ T.unpack (X.elementTag node) ++ ">"+    maybe (return () `orError` err)+          (add node)+          (X.getAttribute bindAttr node)+    return []+  where+    add node nm = modifyHS $ bindSplice nm $ do+        caller <- getParamNode+        ctx <- getContext+        rawApply "bind-content" (X.childNodes node)+                 Nothing ctx (X.childNodes caller)+
+ src/Heist/Splices/BindStrict.hs view
@@ -0,0 +1,36 @@+module Heist.Splices.BindStrict where++------------------------------------------------------------------------------+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Text.XmlHtml as X++------------------------------------------------------------------------------+import           Heist.Common+import           Heist.Interpreted.Internal+import           Heist.Splices.Apply+import           Heist.Splices.Bind+import           Heist.Internal.Types.HeistState++-- | Default name for the bind splice.+bindStrictTag :: Text+bindStrictTag = "bindStrict"+++------------------------------------------------------------------------------+-- | Implementation of the bind splice.+bindStrictImpl :: Monad n => Splice n+bindStrictImpl = do+    node <- getParamNode+    cs <- runChildren+    let err = "must supply \"" ++ T.unpack bindAttr +++              "\" attribute in <" ++ T.unpack (X.elementTag node) ++ ">"+    maybe (return () `orError` err) (add cs)+          (X.getAttribute bindAttr node)+    return []++  where+    add cs nm = modifyHS $ bindSplice nm $ do+        caller <- getParamNode+        ctx <- getContext+        rawApply "bindstrict-content" cs Nothing ctx (X.childNodes caller)
+ src/Heist/Splices/Cache.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The \"cache\" splice ensures that its contents are cached and only+-- evaluated periodically.  The cached contents are returned every time the+-- splice is referenced.+--+-- Use the ttl attribute to set the amount of time between reloads.  The ttl+-- value should be a positive integer followed by a single character+-- specifying the units.  Valid units are a single letter abbreviation for one+-- of seconds, minutes, hours, days, and weeks.  If the ttl string is invalid+-- or the ttl attribute is not specified, the cache is never refreshed unless+-- explicitly cleared with clearCacheTagState.  The compiled splice version of+-- the cache tag does not require a cache tag state, so clearCacheTagState+-- will not work for compiled cache tags.++module Heist.Splices.Cache+  ( CacheTagState+  , cacheImpl+  , cacheImplCompiled+  , mkCacheTag+  , clearCacheTagState+  ) where++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Control.Concurrent+import           Control.Monad+import           Control.Monad.Trans+import           Data.IORef+import qualified Data.HashMap.Strict as H+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashSet as Set+import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Text.Read+import           Data.Time.Clock+import           System.Random+import           Text.XmlHtml++#if !MIN_VERSION_base(4,8,0)+import           Data.Word (Word)+#endif++------------------------------------------------------------------------------+import qualified Heist.Compiled.Internal as C+import           Heist.Interpreted.Internal+import           Heist.Internal.Types.HeistState+++------------------------------------------------------------------------------+cacheTagName :: Text+cacheTagName = "cache"+++------------------------------------------------------------------------------+-- | State for storing cache tag information+newtype CacheTagState =+    CTS (MVar ([IORef (Maybe (UTCTime, Builder))], HashMap Text (UTCTime, Template)))+++addCompiledRef :: IORef (Maybe (UTCTime, Builder)) -> CacheTagState -> IO ()+addCompiledRef ref (CTS mv) = do+    modifyMVar_ mv (\(a,b) -> return (ref:a, b))++    +------------------------------------------------------------------------------+-- | Clears the cache tag state.+clearCacheTagState :: CacheTagState -> IO ()+clearCacheTagState (CTS cacheMVar) = do+    refs <- modifyMVar cacheMVar (\(a,_) -> return ((a, H.empty), a))+    mapM_ (\ref -> writeIORef ref Nothing) refs+++------------------------------------------------------------------------------+-- | Converts a TTL string into an integer number of seconds.+parseTTL :: Text -> Int+parseTTL s = value * multiplier+  where+    (value,rest) = either (const (0::Int,"s")) id $ decimal s+    multiplier = case T.take 1 rest of+        "s" -> 1 :: Int+        "m" -> 60+        "h" -> 3600+        "d" -> 86400+        "w" -> 604800+        _   -> 1+++getTTL :: Node -> NominalDiffTime+getTTL tree = fromIntegral $ maybe 0 parseTTL $ getAttribute "ttl" tree+{-# INLINE getTTL #-}+++------------------------------------------------------------------------------+-- | This is the splice that actually does the work.  You should bind it to+-- the same tag name as you bound the splice returned by mkCacheTag otherwise+-- it won't work and you'll get runtime errors.+cacheImpl :: (MonadIO n) => CacheTagState -> Splice n+cacheImpl (CTS mv) = do+    tree <- getParamNode+    let err = error $ unwords ["cacheImpl is bound to a tag"+                              ,"that didn't get an id attribute."+                              ," This should never happen."]+    let i = maybe err id $ getAttribute "id" tree+        !ttl = getTTL tree+    mp <- liftIO $ readMVar mv++    ns <- do+        cur <- liftIO getCurrentTime+        let mbn = H.lookup i $ snd mp+            reload = do+                nodes' <- runNodeList $ childNodes tree+                let newMap = H.insert i (cur, nodes') $ snd mp+                liftIO $ modifyMVar_ mv (\(a,_) -> return (a, newMap))+                return $! nodes'+        case mbn of+            Nothing -> reload+            (Just (lastUpdate,n)) -> do+                if ttl > 0 && tagName tree == Just cacheTagName &&+                   diffUTCTime cur lastUpdate > ttl+                  then reload+                  else do+                      stopRecursion+                      return $! n++    return ns+++------------------------------------------------------------------------------+-- | This is the compiled splice version of cacheImpl.+cacheImplCompiled :: (MonadIO n) => CacheTagState -> C.Splice n+cacheImplCompiled cts = do+    tree <- getParamNode+    let !ttl = getTTL tree++    compiled <- C.runNodeList $ childNodes tree+    ref <- liftIO $ newIORef Nothing+    liftIO $ addCompiledRef ref cts+    let reload curTime = do+            builder <- C.codeGen compiled+            let out = fromByteString $! toByteString $! builder+            liftIO $ writeIORef ref (Just (curTime, out))+            return $! out+    return $ C.yieldRuntime $ do+        mbn <- liftIO $ readIORef ref+        cur <- liftIO getCurrentTime+        case mbn of+            Nothing -> reload cur+            (Just (lastUpdate,bs)) -> do+                if (ttl > 0 && diffUTCTime cur lastUpdate > ttl)+                  then reload cur+                  else return $! bs+++------------------------------------------------------------------------------+-- | Returns items necessary to set up a \"cache\" tag.  The cache tag cannot+-- be bound automatically with the other default Heist tags.  This is because+-- this function also returns CacheTagState, so the user will be able to clear+-- it with the 'clearCacheTagState' function.+--+-- This function returns a splice and a CacheTagState.  The splice is of type+-- @Splice IO@ because it has to be bound as a load time preprocessing splice.+-- Haskell's type system won't allow you to screw up and pass this splice as+-- the wrong argument to initHeist.+mkCacheTag :: IO (Splice IO, CacheTagState)+mkCacheTag = do+    sr <- newIORef $ Set.empty+    mv <- liftM CTS $ newMVar ([], H.empty)++    return $ (setupSplice sr, mv)+++------------------------------------------------------------------------------+-- | Explicit type signature to avoid the Show polymorphism problem.+generateId :: IO Word+generateId = getStdRandom random+++------------------------------------------------------------------------------+-- | Gets a unique ID for use in the cache tags.+getId :: IORef (Set.HashSet Text) -> IO Text+getId setref = do+    i <- liftM (T.pack . show) generateId+    _set <- readIORef setref+    if Set.member i _set+      then getId setref+      else do+          writeIORef setref $ Set.insert i _set+          return $ T.append "cache-id-" i+++------------------------------------------------------------------------------+-- | A splice that sets the id attribute so that nodes can be cache-aware.+setupSplice :: IORef (Set.HashSet Text) -> Splice IO+setupSplice setref = do+    i <- liftIO $ getId setref+    node <- getParamNode++    newChildren <- runNodeList $ childNodes node+    stopRecursion+    return $ [setAttribute "id" i $ node { elementChildren = newChildren }]++
+ src/Heist/Splices/Html.hs view
@@ -0,0 +1,47 @@+module Heist.Splices.Html where++------------------------------------------------------------------------------+import           Data.Maybe+import           Data.Text (Text)+import qualified Text.XmlHtml as X++------------------------------------------------------------------------------+import           Heist.Interpreted.Internal+import           Heist.Internal.Types.HeistState+++------------------------------------------------------------------------------+-- | Name for the html splice.+htmlTag :: Text+htmlTag = "html"+++------------------------------------------------------------------------------+-- | The html splice runs all children and then traverses the returned node+-- forest removing all head nodes.  Then it merges them all and prepends it to+-- the html tag's child list.+htmlImpl :: Monad n => Splice n+htmlImpl = do+    node <- getParamNode+    children <- runNodeList $ X.childNodes node+    let (heads, mnode) = extractHeads $ node { X.elementChildren = children }+        new (X.Element t a c) = X.Element t a $+            X.Element "head" [] heads : c+        new n = n+    stopRecursion+    return [maybe node new mnode]++------------------------------------------------------------------------------+-- | Extracts all heads from a node tree.+extractHeads :: X.Node+             -- ^ The root (html) node+             -> ([X.Node], Maybe X.Node)+             -- ^ A tuple of a list of head nodes and the original tree with+             --   heads removed.+extractHeads (X.Element t a c)+  | t == "head" = (c, Nothing)+  | otherwise   = (concat heads, Just $ X.Element t a (catMaybes mcs))+  where+    (heads, mcs) = unzip $ map extractHeads c+extractHeads n = ([], Just n)+
+ src/Heist/Splices/Ignore.hs view
@@ -0,0 +1,22 @@+module Heist.Splices.Ignore where++------------------------------------------------------------------------------+import           Data.Text (Text)++------------------------------------------------------------------------------+import           Heist.Interpreted.Internal+++------------------------------------------------------------------------------+-- | Default name for the ignore splice.+ignoreTag :: Text+ignoreTag = "ignore"+++------------------------------------------------------------------------------+-- | The ignore tag and everything it surrounds disappears in the+-- rendered output.+ignoreImpl :: Monad m => Splice m+ignoreImpl = return []++
+ src/Heist/Splices/Json.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Heist.Splices.Json (+  bindJson+) where++------------------------------------------------------------------------------+import           Control.Monad.Reader+import           Data.Aeson+import qualified Data.ByteString.Char8       as S+import qualified Data.ByteString.Lazy.Char8  as L+import qualified Data.HashMap.Strict         as Map+import           Data.Map.Syntax+import           Data.Maybe+import           Data.Text                   (Text)+import qualified Data.Text                   as T+import qualified Data.Text.Encoding          as T+import qualified Data.Vector                 as V+import           Text.Blaze.Html5            ((!))+import qualified Text.Blaze.Html5            as B+import           Text.Blaze.Renderer.XmlHtml+import           Text.XmlHtml+------------------------------------------------------------------------------+import           Heist.Interpreted.Internal+import           Heist.Internal.Types.HeistState+------------------------------------------------------------------------------++                                 ------------+                                 -- public --+                                 ------------++------------------------------------------------------------------------------+-- | This splice binds convenience tags for the given JSON (or+-- JSON-convertible) value and runs the tag's child nodes using the new+-- bindings.+--+-- /Tags bound when you pass in an object/+--+-- Tags bound for an object looking like this:+--+-- > { "k_1": v_1, ..., "k_N": v_N }+--+-- @\<value:{k_i}\>@    -- treats v_i as text+-- @\<snippet:{k_i}\>@  -- treats v_i as HTML+-- @\<with:{k_i}\>@     -- explodes v_i and runs its children+--+-- @\<value var=\"foo.bar.baz\"\/>@ -- walks the JSON tree to find+-- \"foo.bar.baz\", and interprets it as a string+-- @\<snippet var=\"foo.bar.baz\"\/\>@+-- @\<with var=\"foo.bar.baz\"\>...\<with\>@+--+-- /Tags bound when you pass in anything else/+--+-- @\<value\/\>@    --  the given JSON value, as a string+-- @\<snippet\/\>@  --  the given JSON value, parsed and spliced in as HTML+--+bindJson :: (ToJSON a, Monad n) => a -> Splice n+bindJson = runReaderT explodeTag . toJSON+++                                 -------------+                                 -- private --+                                 -------------++------------------------------------------------------------------------------+errorMessage :: String -> [Node]+errorMessage s = renderHtmlNodes $+                     B.strong ! B.customAttribute "class" "error" $+                     B.toHtml s+++------------------------------------------------------------------------------+type JsonMonad n m a = ReaderT Value (HeistT n m) a+++------------------------------------------------------------------------------+withValue :: (Monad m) => Value -> JsonMonad n m a -> HeistT n m a+withValue = flip runReaderT+++------------------------------------------------------------------------------+boolToText :: Bool -> Text+boolToText b = if b then "true" else "false"+++------------------------------------------------------------------------------+numToText :: ToJSON a => a -> Text+numToText = T.decodeUtf8 . S.concat . L.toChunks . encode+++------------------------------------------------------------------------------+findExpr :: Text -> Value -> Maybe Value+findExpr t = go (T.split (=='.') t)+  where+    go [] !value     = Just value+    go (x:xs) !value = findIn value >>= go xs+      where+        findIn (Object obj) = Map.lookup x obj+        findIn (Array arr)  = tryReadIndex >>= \i -> arr V.!? i+        findIn _            = Nothing++        tryReadIndex = fmap fst . listToMaybe . reads . T.unpack $ x+++------------------------------------------------------------------------------+asHtml :: Monad m => Text -> m [Node]+asHtml t =+    case (parseHTML "" $ T.encodeUtf8 t) of+      Left e  -> return $ errorMessage $+                 "Template error turning JSON into HTML: " ++ e+      Right d -> return $! docContent d+++------------------------------------------------------------------------------+snippetTag :: Monad m => JsonMonad n m [Node]+snippetTag = ask >>= snip+  where+    txt t = lift $ asHtml t++    snip Null       = txt ""+    snip (Bool b)   = txt $ boolToText b+    snip (Number n) = txt $ numToText n+    snip (String t) = txt t+    snip _          = lift $ do+        node <- getParamNode+        return $ errorMessage $ concat [+                     "error processing tag <"+                   , T.unpack $ fromMaybe "???" $ tagName node+                   , ">: can't interpret JSON arrays or objects as HTML."+                   ]+++------------------------------------------------------------------------------+valueTag :: Monad m => JsonMonad n m [Node]+valueTag = ask >>= go+  where+    go Null       = txt ""+    go (Bool b)   = txt $ boolToText b+    go (Number n) = txt $ numToText n+    go (String t) = txt t+    go _          = lift $ do+        node <- getParamNode+        return $ errorMessage $ concat [+                     "error processing tag <"+                   , T.unpack $ fromMaybe "???" $ tagName node+                   , ">: can't interpret JSON arrays or objects as text."+                   ]+++    txt t = return [TextNode t]+++------------------------------------------------------------------------------+explodeTag :: forall n. (Monad n) => JsonMonad n n [Node]+explodeTag = ask >>= go+  where+    --------------------------------------------------------------------------+    go Null       = goText ""+    go (Bool b)   = goText $ boolToText b+    go (Number n) = goText $ numToText n+    go (String t) = goText t+    go (Array a)  = goArray a+    go (Object o) = goObject o++    --------------------------------------------------------------------------+    goText t = lift $ runChildrenWith $ do+        "value"   ## return [TextNode t]+        "snippet" ## asHtml t++    --------------------------------------------------------------------------+    goArray :: V.Vector Value -> JsonMonad n n [Node]+    goArray a = do+        lift stopRecursion+        dl <- V.foldM f id a+        return $! dl []+      where+        f dl jsonValue = do+            tags <- go jsonValue+            return $! dl . (tags ++)++    --------------------------------------------------------------------------+    -- search the param node for attribute \"var=expr\", search the given JSON+    -- object for the expression, and if it's found run the JsonMonad action m+    -- using the restricted JSON object.+    varAttrTag :: Value -> (JsonMonad n n [Node]) -> Splice n+    varAttrTag v m = do+        node <- getParamNode+        maybe (noVar node) (hasVar node) $ getAttribute "var" node+      where+        noVar node = return $ errorMessage $+                     concat [ "expression error: no var attribute in <"+                            , T.unpack $ fromMaybe "???" $ tagName node+                            , "> tag"+                            ]++        hasVar node expr = maybe (return $ errorMessage $+                                  concat [+                                    "expression error: can't find \""+                                  , T.unpack expr+                                  , "\" in JSON object (<"+                                  , T.unpack $ fromMaybe "???" $ tagName node+                                  , "> tag)"+                                  ])+                                 (runReaderT m)+                                 (findExpr expr v)++    --------------------------------------------------------------------------+    genericBindings :: JsonMonad n n (Splices (Splice n))+    genericBindings = ask >>= \v -> return $ do+        "with"     ## varAttrTag v explodeTag+        "snippet"  ## varAttrTag v snippetTag+        "value"    ## varAttrTag v valueTag+++    --------------------------------------------------------------------------+    goObject obj = do+        start <- genericBindings+        let bindings = Map.foldlWithKey' bindKvp start obj+        lift $ runChildrenWith bindings++    --------------------------------------------------------------------------+    bindKvp bindings k v =+        let newBindings = do+                T.append "with:" k    ## withValue v explodeTag+                T.append "snippet:" k ## withValue v snippetTag+                T.append "value:" k   ## withValue v valueTag+        in  bindings >> newBindings
+ src/Heist/Splices/Markdown.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RecordWildCards    #-}+{-| The \"markdown\" splice formats markdown content as HTML and inserts+it into the document.++If the file attribute is present the contents of the tag is ignored and+the file specified is converted to HTML.++Otherwise the non-markup children of the tag are processed as markdown+and converted to HTML.++This splice requires that the \"pandoc\" executable is in your path.++You can add custom pandoc splice with 'pandocSplice'. It is not limited to+markdown input, and can process anything pandoc can.++For example you can create a page with generated table of contents, using+heist template as pandoc template.++>  <!-- _wrap.tpl -->+>  <html>+>    <head> <title> <pageTitle/> </title> </head>+>+>    <div class="nav"> <pageToc/> </div>+>    <apply-content/>+>  </html>++And pandoc template, which would bind @pageTitle@ and @pageToc@ splices and+applies "_wrap" template.++>  <!-- _pandoc.tpl -->+>  <apply template="_wrap.tpl">+>    <bind tag="pageTitle"> $title$</bind>+>    <bind tag="pageToc"> $toc$</bind>+>    $body$+>  </apply>++Bind splice pandoc splice. Set it to not wrap in div, or it will break html+from _wrap.tpl++>  splices = "docmarkdown" ## pandocSplice opts+>    where+>      opts = setPandocArgs  ["-S", "--no-wrap", "--toc"+>                            , "--standalone"+>                            , "--template", "_pandoc.tpl"+>                            , "--html5"]+>             $ setPandocWrapDiv Nothing+>             $ defaultPandocOptions+>++And then use it to render your markdown file+++>  <!-- apidocs.tpl -->+>  <DOCTYPE html>+>  <html lang="en">+>  <head>+>    <link href="/static/css/site.css rel="stylesheet">+>  </head>+>  <body>+>    <apply template="_navbar.tpl" />+>    <docmarkdown file="apidocs.md"/>+>  </body>++-}+module Heist.Splices.Markdown+  (+  -- * Exceptions+    PandocMissingException+  , MarkdownException+  , NoMarkdownFileException+  -- * Markdown Splice+  , markdownTag+  , markdownSplice+  -- * Generic pandoc splice+  , pandocSplice+  -- ** Pandoc Options+  , PandocOptions+  , defaultPandocOptions+  , setPandocExecutable+  , setPandocArgs+  , setPandocBaseDir+  , setPandocWrapDiv+  -- ** Lens for 'PandocOptions'+  , pandocExecutable+  , pandocArgs+  , pandocBaseDir+  , pandocWrapDiv+  ) where++------------------------------------------------------------------------------+import           Control.Concurrent+import           Control.Exception.Lifted+import           Control.Monad+import           Control.Monad.Trans+import           Data.ByteString                 (ByteString)+import qualified Data.ByteString                 as B+import qualified Data.ByteString.Char8           as BC+import           Data.Maybe                      (fromMaybe)+import           Data.Text                       (Text)+import qualified Data.Text                       as T+import qualified Data.Text.Encoding              as T+import           Data.Typeable+import           System.Directory+import           System.Exit+import           System.FilePath.Posix+import           System.IO+import           System.Process+import           Text.XmlHtml++#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative             ((<$>))+#endif++------------------------------------------------------------------------------+import           Heist.Common+import           Heist.Internal.Types.HeistState+import           Heist.Interpreted.Internal++data PandocMissingException = PandocMissingException+   deriving (Typeable)++instance Show PandocMissingException where+    show PandocMissingException =+        "Cannot find the \"pandoc\" executable.  If you have Haskell, then install it with \"cabal install\".  Otherwise you can download it from http://johnmacfarlane.net/pandoc/installing.html.  Then make sure it is in your $PATH."++instance Exception PandocMissingException+++data MarkdownException = MarkdownException ByteString+   deriving (Typeable)++instance Show MarkdownException where+    show (MarkdownException e) =+        "Markdown error: pandoc replied:\n\n" ++ BC.unpack e++instance Exception MarkdownException+++data NoMarkdownFileException = NoMarkdownFileException+    deriving (Typeable)++instance Show NoMarkdownFileException where+    show NoMarkdownFileException =+        "Markdown error: no file or template in context" +++        " during processing of markdown tag"++instance Exception NoMarkdownFileException where++--------------------------------------------------------------------------------++data PandocOptions = PandocOptions+     { _pandocExecutable :: FilePath+     , _pandocArgs       :: [String]         -- ^ Arguments to pandoc+     , _pandocBaseDir    :: Maybe FilePath   -- ^ Base directory for input files+                                             --   defaults to template path+     , _pandocWrapDiv    :: Maybe Text       -- ^ Wrap content in div with class+     } deriving (Eq, Ord, Show)++-- | Default options+defaultPandocOptions :: PandocOptions+defaultPandocOptions = PandocOptions "pandoc"+                                     []+                                     Nothing+                                     (Just "markdown")++-- | Name of pandoc executable+setPandocExecutable :: FilePath -> PandocOptions -> PandocOptions+setPandocExecutable e opt = opt { _pandocExecutable = e }++-- | Arguments passed to pandoc+setPandocArgs :: [String] -> PandocOptions -> PandocOptions+setPandocArgs args opt = opt { _pandocArgs = args }++-- | Base directory for input files, defaults to current template dir+setPandocBaseDir :: Maybe FilePath -> PandocOptions -> PandocOptions+setPandocBaseDir bd opt = opt { _pandocBaseDir = bd }++-- | Wrap pandoc output in div with class. Appends node attributes to+--   div and appends class to ones specified on node.+setPandocWrapDiv :: Maybe Text -> PandocOptions -> PandocOptions+setPandocWrapDiv wd opt = opt { _pandocWrapDiv = wd }++pandocExecutable :: Functor f =>+     (FilePath -> f FilePath) -> PandocOptions -> f PandocOptions+pandocExecutable f po = (\e -> po { _pandocExecutable = e})+                       <$> f (_pandocExecutable po)++pandocArgs :: Functor f =>+     ([String] -> f [String]) -> PandocOptions -> f PandocOptions+pandocArgs f po = (\a -> po { _pandocArgs = a}) <$> f (_pandocArgs po)++pandocBaseDir :: Functor f =>+     (Maybe FilePath -> f (Maybe FilePath)) -> PandocOptions -> f PandocOptions+pandocBaseDir f po = (\b -> po {_pandocBaseDir = b }) <$> f (_pandocBaseDir po)++pandocWrapDiv :: Functor f =>+     (Maybe Text -> f (Maybe Text)) -> PandocOptions -> f PandocOptions+pandocWrapDiv f po = (\w -> po {_pandocWrapDiv = w}) <$> f (_pandocWrapDiv po)++------------------------------------------------------------------------------+-- | Default name for the markdown splice.+markdownTag :: Text+markdownTag = "markdown"++------------------------------------------------------------------------------+-- | Default markdown splice with executable "pandoc"+markdownSplice :: MonadIO m => Splice m+markdownSplice= pandocSplice defaultPandocOptions++-- | Implementation of the markdown splice.+pandocSplice :: MonadIO m => PandocOptions -> Splice m+pandocSplice PandocOptions{..} = do+    templateDir <- liftM (fmap takeDirectory) getTemplateFilePath+    pdMD <- liftIO $ findExecutable _pandocExecutable++    pandocExe <- case pdMD of+       Nothing -> liftIO $ throwIO PandocMissingException+       Just pd -> return pd+    let withDir tp = fromMaybe tp _pandocBaseDir+        pandocFile f tp = pandocWith pandocExe _pandocArgs (withDir tp) f+    tree <- getParamNode+    (source,markup) <- liftIO $+        case getAttribute "file" tree of+            Just f  -> do+                m <- maybe (liftIO $ throwIO NoMarkdownFileException )+                           (pandocFile (T.unpack f))+                           templateDir+                return (T.unpack f,m)+            Nothing -> do+                m <- pandocWithBS pandocExe _pandocArgs $ T.encodeUtf8 $ nodeText tree+                return ("inline_splice",m)++    let ee = parseHTML source markup+        nodeAttrs = case tree of+          Element _ a _ -> a+          _ -> []+        nodeClass = lookup "class" nodeAttrs+        attrs = filter (\(name, _) -> name /= "class" && name /= "file") nodeAttrs+    case ee of+      Left e  -> throw $ MarkdownException+                       $ BC.pack ("Error parsing markdown output: " ++ e)+      Right d -> return $ wrapResult nodeClass attrs (docContent d)++  where+    wrapResult nodeClass attrs body = case _pandocWrapDiv of+        Nothing -> body+        Just cls -> let finalAttrs = ("class", appendClass nodeClass cls):attrs+                    in [Element "div" finalAttrs  body]+    appendClass Nothing cls = cls+    appendClass (Just orig) cls = T.concat [orig, " ", cls]+++pandocWith :: FilePath -> [String] -> FilePath -> FilePath -> IO ByteString+pandocWith path args templateDir inputFile = do+    (ex, sout, serr) <- readProcessWithExitCode' path args' ""++    when (isFail ex) $ throw $ MarkdownException serr+    return sout++  where+    isFail ExitSuccess = False+    isFail _           = True++    args' = args ++ [templateDir </> inputFile ]++pandocWithBS :: FilePath -> [String] -> ByteString -> IO ByteString+pandocWithBS pandocPath args s = do+    -- using the crummy string functions for convenience here+    (ex, sout, serr) <- readProcessWithExitCode' pandocPath args s++    when (isFail ex) $ throw $ MarkdownException serr+    return sout++  where+    isFail ExitSuccess = False+    isFail _           = True+++-- a version of readProcessWithExitCode that does I/O properly+readProcessWithExitCode'+    :: FilePath                 -- ^ command to run+    -> [String]                 -- ^ any arguments+    -> ByteString               -- ^ standard input+    -> IO (ExitCode,ByteString,ByteString) -- ^ exitcode, stdout, stderr+readProcessWithExitCode' cmd args input = do+    (Just inh, Just outh, Just errh, pid) <-+        createProcess (proc cmd args){ std_in  = CreatePipe,+                                       std_out = CreatePipe,+                                       std_err = CreatePipe }+    outMVar <- newEmptyMVar++    outM <- newEmptyMVar+    errM <- newEmptyMVar++    -- fork off a thread to start consuming stdout+    _ <- forkIO $ do+        out <- B.hGetContents outh+        putMVar outM out+        putMVar outMVar ()++    -- fork off a thread to start consuming stderr+    _ <- forkIO $ do+        err  <- B.hGetContents errh+        putMVar errM err+        putMVar outMVar ()++    -- now write and flush any input+    when (not (B.null input)) $ do B.hPutStr inh input; hFlush inh+    hClose inh -- done with stdin++    -- wait on the output+    takeMVar outMVar+    takeMVar outMVar+    hClose outh++    -- wait on the process+    ex <- waitForProcess pid++    out <- readMVar outM+    err <- readMVar errM++    return (ex, out, err)
+ src/Heist/TemplateDirectory.hs view
@@ -0,0 +1,105 @@+{-|++This module defines a TemplateDirectory data structure for convenient+interaction with templates within web apps.++-}++module Heist.TemplateDirectory+    ( TemplateDirectory+    , newTemplateDirectory+    , newTemplateDirectory'++    , getDirectoryHS+    , getDirectoryCTS+    , reloadTemplateDirectory+    ) where++------------------------------------------------------------------------------+import           Control.Concurrent+import           Control.Monad+import           Control.Monad.Trans+import           Heist+import           Heist.Internal.Types+import           Heist.Splices.Cache+++------------------------------------------------------------------------------+-- | Structure representing a template directory.+data TemplateDirectory n+    = TemplateDirectory+        FilePath+        (HeistConfig n)+        (MVar (HeistState n))+        (MVar CacheTagState)+++------------------------------------------------------------------------------+-- | Creates and returns a new 'TemplateDirectory' wrapped in an Either for+-- error handling.+newTemplateDirectory+    :: MonadIO n+    => FilePath+    -> HeistConfig n+    -- namespaced tag.+    -> IO (Either [String] (TemplateDirectory n))+newTemplateDirectory dir hc = do+    let sc = (_hcSpliceConfig hc) { _scTemplateLocations = [loadTemplates dir] }+    let hc' = hc { _hcSpliceConfig = sc }+    epair <- initHeistWithCacheTag hc'+    case epair of+      Left es -> return $ Left es+      Right (hs,cts) -> do+        tsMVar <- liftIO $ newMVar hs+        ctsMVar <- liftIO $ newMVar cts+        return $ Right $ TemplateDirectory dir hc' tsMVar ctsMVar+++------------------------------------------------------------------------------+-- | Creates and returns a new 'TemplateDirectory', using the monad's fail+-- function on error.+newTemplateDirectory'+    :: MonadIO n+    => FilePath+    -> HeistConfig n+    -> IO (TemplateDirectory n)+newTemplateDirectory' dir hc = do+    res <- newTemplateDirectory dir hc+    either (error . concat) return res+++------------------------------------------------------------------------------+-- | Gets the 'HeistState' from a TemplateDirectory.+getDirectoryHS :: (MonadIO n)+               => TemplateDirectory n+               -> IO (HeistState n)+getDirectoryHS (TemplateDirectory _ _ tsMVar _) =+    liftIO $ readMVar $ tsMVar+++------------------------------------------------------------------------------+-- | Clears the TemplateDirectory's cache tag state.+getDirectoryCTS :: TemplateDirectory n -> IO CacheTagState+getDirectoryCTS (TemplateDirectory _ _ _ ctsMVar) = readMVar ctsMVar+++------------------------------------------------------------------------------+-- | Clears cached content and reloads templates from disk.+reloadTemplateDirectory :: (MonadIO n)+                        => TemplateDirectory n+                        -> IO (Either String ())+reloadTemplateDirectory (TemplateDirectory p hc tsMVar ctsMVar) = do+    let sc = (_hcSpliceConfig hc) { _scTemplateLocations = [loadTemplates p] }+    ehs <- initHeistWithCacheTag (hc { _hcSpliceConfig = sc })+    leftPass ehs $ \(hs,cts) -> do+        modifyMVar_ tsMVar (const $ return hs)+        modifyMVar_ ctsMVar (const $ return cts)+++------------------------------------------------------------------------------+-- | Prepends an error onto a Left.+leftPass :: Monad m => Either [String] b -> (b -> m c) -> m (Either String c)+leftPass e m = either (return . Left . loadError . concat)+                      (liftM Right . m) e+  where+    loadError = (++) ("Error loading templates: " :: String)
+ test/suite/Benchmark.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Control.Concurrent+import           Control.Exception        (evaluate)+import           Control.Monad+import           Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)+import           Criterion+import           Criterion.Main+import           Criterion.Measurement    hiding (getTime)+import qualified Data.ByteString          as B+import qualified Data.DList               as DL+import           Data.Maybe+import           Data.Monoid+import qualified Data.Text                as T+import           Data.Text.Encoding+import           Data.Time.Clock+import           System.Environment+import qualified Text.XmlHtml             as X+------------------------------------------------------------------------------+import           Heist+import           Heist.Common+import qualified Heist.Compiled           as C+import qualified Heist.Compiled.Internal  as CI+import qualified Heist.Interpreted        as I+import           Heist.TestCommon+import           Heist.Internal.Types+------------------------------------------------------------------------------++loadWithCache baseDir = do+    etm <- runExceptT $ do+        let sc = SpliceConfig mempty defaultLoadTimeSplices mempty mempty+                              [loadTemplates baseDir] (const True)+        ExceptT $ initHeistWithCacheTag $ HeistConfig sc "" False+    either (error . unlines) (return . fst) etm++main = do+    (dir:file:_) <- getArgs+    applyComparison dir file++justRender dir = do+    let page = "faq"+        pageStr = T.unpack $ decodeUtf8 page+    hs <- loadWithCache dir+    let !compiledTemplate = fst $! fromJust $! C.renderTemplate hs page+        compiledAction = do+            res <- compiledTemplate+            return $! toByteString $! res+    out <- compiledAction+    putStrLn $ "Rendered ByteString of length "++(show $ B.length out)+    B.writeFile (pageStr++".out.compiled."++dir) $ out++    defaultMain+       [ bench (pageStr++"-compiled (just render)") (whnfIO compiledAction)+       ]++------------------------------------------------------------------------------+applyComparison :: FilePath -> String -> IO ()+applyComparison dir pageStr = do+    let page = encodeUtf8 $ T.pack pageStr+    hs <- loadWithCache dir+    let compiledAction = do+            res <- fst $ fromJust $ C.renderTemplate hs page+            return $! toByteString $! res+    out <- compiledAction+    B.writeFile (pageStr++".out.compiled."++dir) $ out++    let interpretedAction = do+            res <- I.renderTemplate hs page+            return $! toByteString $! fst $! fromJust res+    out2 <- interpretedAction+    B.writeFile (pageStr++".out.interpreted."++dir) $ out++    defaultMain+       [ bench (pageStr++"-compiled") (whnfIO compiledAction)+       , bench (pageStr++"-interpreted") (whnfIO interpretedAction)+       ]++cmdLineTemplate :: String -> String -> IO ()+cmdLineTemplate dir page = do+--    args <- getArgs+--    let page = head args+--    let dir = "test/snap-website"+    hs <- loadHS dir+    let action = fst $ fromJust $ C.renderTemplate hs+            (encodeUtf8 $ T.pack page)+    out <- action+    B.writeFile (page++".out.cur") $ toByteString out++--    reference <- B.readFile "faq.out"+--    if False+--      then do+--        putStrLn "Template didn't render properly"+--        error "Aborting"+--      else+--        putStrLn "Template rendered correctly"++    defaultMain [+         bench (page++"-speed") (whnfIO action)+       ]+++testNode =+  X.Element "div" [("foo", "aoeu"), ("bar", "euid")]+    [X.Element "b" [] [X.TextNode "bolded text"]+    ,X.TextNode " not bolded"+    ,X.Element "a" [("href", "/path/to/page")] [X.TextNode "link"]+    ]++getChunks templateName = do+    hs <- loadHS "snap-website-nocache"+    let (Just t) = lookupTemplate templateName hs _compiledTemplateMap+    return $! fst $! fst t+
+ test/suite/Heist/Compiled/Tests.hs view
@@ -0,0 +1,419 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Heist.Compiled.Tests where++import           Blaze.ByteString.Builder+import           Control.Applicative+import           Control.Exception+import           Control.Monad.Trans.Except+import           Control.Lens+import           Control.Monad.Trans+import           Data.Bifunctor (first)+import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import           Data.Char+import           Data.IORef+import           Data.Maybe+import           Data.Map.Syntax+import           Data.Monoid+import qualified Data.Set as Set+import qualified Data.Text as T+import           Data.Text.Encoding+import           Test.Framework (Test)+import           Test.Framework.Providers.HUnit+import qualified Test.HUnit as H+import qualified Text.XmlHtml as X+++------------------------------------------------------------------------------+import           Heist+import           Heist.Compiled+import           Heist.Compiled.Internal+import           Heist.Internal.Types+import           Heist.Tutorial.CompiledSplices+import           Heist.TestCommon++-- NOTE: We can't test compiled templates on the templates directory as it+-- stands today because that directory contains some error conditions such as+-- infinite bind loops, apply tags with no template attribute, and apply tags+-- with ".." in the tag path (which doesn't currently work).++tests :: [Test]+tests = [ testCase     "compiled/simple"        simpleCompiledTest+        , testCase     "compiled/people"        peopleTest+        , testCase     "compiled/namespace1"    namespaceTest1+        , testCase     "compiled/namespace2"    namespaceTest2+        , testCase     "compiled/namespace3"    namespaceTest3+        , testCase     "compiled/namespace4"    namespaceTest4+        , testCase     "compiled/namespace5"    namespaceTest5+        , testCase     "compiled/no-ns-splices" noNsSplices+        , testCase     "compiled/ns-nested"     nsNestedUnused+        , testCase     "compiled/nsbind"        nsBindTest+        , testCase     "compiled/nsbinderr"     nsBindErrorTest+        , testCase     "compiled/nscall"        nsCallTest+        , testCase     "compiled/nscallerr"     nsCallErrTest+        , testCase     "compiled/nsbindstack"   nsBindStackTest+        , testCase     "compiled/doctype"       doctypeTest+        , testCase     "compiled/exceptions"    exceptionsTest+        , testCase     "compiled/defer"         deferTest+        ]++simpleCompiledTest :: IO ()+simpleCompiledTest = do+    res <- runWithStateSplice "templates"+    H.assertEqual "compiled state splice" expected res+  where+    expected =+      mappend doctype "\n\n<html>\n3\n</html>\n"++peopleTest :: IO ()+peopleTest = do+    res <- personListTest "templates"+    H.assertEqual "people splice" expected res+  where+    expected =+      "\n<p>Doe, John: 42&#32;years old</p>\n\n<p>Smith, Jane: 21&#32;years old</p>\n\n"++templateHC :: HeistConfig IO+templateHC = HeistConfig sc "" False+  where+    sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices+                & scCompiledSplices .~ ("foo" ## return (yieldPureText "aoeu"))+                & scTemplateLocations .~ [loadTemplates "templates"]++genericTest :: String -> ByteString -> ByteString -> IO ()+genericTest nm template expected = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist templateHC+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs template+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual nm (Right expected) res++doctypeTest :: IO ()+doctypeTest = genericTest "doctype test" "rss" expected+  where+    expected = encodeUtf8+      "<rss><channel><link>http://www.devalot.com/</link></channel></rss>\n"++namespaceTest1 :: IO ()+namespaceTest1 = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist templateHC+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test 1" (Right expected) res+  where+    expected = "Alpha\naoeu\nBeta\n<h:foo aoeu='htns'>Inside h:foo</h:foo>\nEnd\n"+++namespaceTest2 :: IO ()+namespaceTest2 = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ templateHC & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test 2" (Right expected) res+  where+    expected = "Alpha\naoeu\nBeta\n<h:foo aoeu='htns'>Inside h:foo</h:foo>\nEnd\n"+++namespaceTest3 :: IO ()+namespaceTest3 = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ templateHC & hcNamespace .~ "h"+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test 3" (Right expected) res+  where+    expected = "Alpha\n<foo aoeu='htns'>Inside foo</foo>\nBeta\naoeu\nEnd\n"+++namespaceTest4 :: IO ()+namespaceTest4 = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ templateHC & hcNamespace .~ "h"+                                     & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test 4" (Right expected) res+  where+    expected = "Alpha\n<foo aoeu='htns'>Inside foo</foo>\nBeta\naoeu\nEnd\n"+++namespaceTest5 :: IO ()+namespaceTest5 = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ templateHC & hcNamespace .~ "h"+                                     & hcCompiledSplices .~ mempty+                                     & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test 5" (Left ["templates/namespaces.tpl: No splice bound for h:foo"]) res++------------------------------------------------------------------------------+-- | The templates-no-ns directory should have no tags beginning with h: so+-- this test will throw an error.+noNsSplices :: IO ()+noNsSplices = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist hc+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "test"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "noNsSplices" (Left [noNamespaceSplicesMsg "h:"]) res+  where+    hc = HeistConfig sc "h" True+    sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices+                & scCompiledSplices .~ ("foo" ## return (yieldPureText "aoeu"))+                & scTemplateLocations .~ [loadTemplates "templates-no-ns"]+++------------------------------------------------------------------------------+-- | Test that no namespace splice message works correctly when there are no+-- top level splices used+nsNestedUnused :: IO ()+nsNestedUnused = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist hc+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "test"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "ns nested unused warn test" (Right "<div>aeou</div>\n") res+  where+    hc = HeistConfig sc "h" False+    sc = mempty & scCompiledSplices .~ ("foo" ## return $ yieldPureText "aeou")+                & scTemplateLocations .~ [loadTemplates "templates-ns-nested"]+++nsBindTemplateHC :: String -> HeistConfig IO+nsBindTemplateHC dir = HeistConfig sc "h" False+  where+    sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices+                & scCompiledSplices .~ nsBindTestSplices+                & scTemplateLocations .~ [loadTemplates dir]+++nsBindTestSplices :: Splices (Splice IO)+nsBindTestSplices = do+    "call" ## do+        tpl <- withSplices (callTemplate "_call")+               nsBindSubSplices (return ())+        return $ yieldRuntime $ codeGen tpl+    "main" ## nsBindSubImpl (return ())+    "main2" ## nsBindSubImpl (return ())+++nsBindSubImpl :: RuntimeSplice IO b -> Splice IO+nsBindSubImpl _ = do+    tpl <- withSplices runChildren nsBindSubSplices (return ())+    return $ yieldRuntime $ codeGen tpl+++nsBindSubSplices :: Splices (RuntimeSplice IO () -> Splice IO)+nsBindSubSplices = do+    "sub" ## pureSplice . textSplice $ const "asdf"+    "recurse" ## nsBindSubImpl+++nsBindTest :: IO ()+nsBindTest = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nsbind")+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "nsbind"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace bind test" (Right expected)  res+  where+    expected = "Alpha\n\nBeta\nasdf\nGamma\n<sub></sub>\n\n"+++------------------------------------------------------------------------------+-- | Test splice error reporting.+nsBindErrorTest :: IO ()+nsBindErrorTest = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nsbind")+                                     & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "nsbinderror"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace bind error test" (Left [ err1, err2, err3 ])  res+  where+    err1 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid3\n   ... via templates-nsbind/nsbinderror.tpl: h:main2\nBound splices: h:sub h:recurse h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid3\", elementAttrs = [], elementChildren = []}"+    err2 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid2\n   ... via templates-nsbind/nsbinderror.tpl: h:recurse\n   ... via templates-nsbind/nsbinderror.tpl: h:main\nBound splices: h:sub h:recurse h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid2\", elementAttrs = [], elementChildren = []}"+    err3 = "templates-nsbind/nsbinderror.tpl: No splice bound for h:invalid1\nBound splices: h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid1\", elementAttrs = [], elementChildren = []}"+++------------------------------------------------------------------------------+-- | Test splice error data structure.+nsBindStackTest :: IO ()+nsBindStackTest = do+    res <- initHeist (nsBindTemplateHC "templates-nsbind") >>=+           return . (either Left (Right . _spliceErrors))++    H.assertEqual "namespace bind stack test" (Right [ err1, err2, err3 ]) res+  where+    err1 = SpliceError [ ( ["nsbinderror"]+                         , Just "templates-nsbind/nsbinderror.tpl"+                         , "h:main2") ]+               (Just "templates-nsbind/nsbinderror.tpl")+               ["h:sub","h:recurse","h:call","h:main2","h:main"]+               (X.Element "h:invalid3" [] [])+               "No splice bound for h:invalid3"+    err2 = SpliceError [ ( ["nsbinderror"]+                         , Just "templates-nsbind/nsbinderror.tpl"+                         , "h:recurse")+                       , ( ["nsbinderror"]+                         , Just "templates-nsbind/nsbinderror.tpl"+                         ,"h:main") ]+               (Just "templates-nsbind/nsbinderror.tpl")+               ["h:sub","h:recurse","h:call","h:main2","h:main"]+               (X.Element "h:invalid2" [] [])+               "No splice bound for h:invalid2"+    err3 = SpliceError []+               (Just "templates-nsbind/nsbinderror.tpl")+               ["h:call","h:main2","h:main"]+               (X.Element "h:invalid1" [] [])+               "No splice bound for h:invalid1"+++nsCallTest :: IO ()+nsCallTest = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nscall")+                                     & hcErrorNotBound .~ True+                                     & hcCompiledTemplateFilter .~ nsFilter+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "nscall"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace call test" (Right "Top\n\nInside 1\nCalled\nasdf\n\nInside 2\n\n") res+  where+    nsFilter = (/=) (fromIntegral $ ord '_') . B.head . head+++nsCallErrTest :: IO ()+nsCallErrTest = do+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ (nsBindTemplateHC "templates-nscall")+                                     & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "nscall"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace call error test"+      (Left $ Set.fromList [ err1, err2 ])+      (first Set.fromList res)+  where+    err1 = "templates-nscall/_call.tpl: No splice bound for h:sub\nBound splices: h:call h:main2 h:main\nNode: Element {elementTag = \"h:sub\", elementAttrs = [], elementChildren = []}"+    err2 = "templates-nscall/_invalid.tpl: No splice bound for h:invalid\nBound splices: h:call h:main2 h:main\nNode: Element {elementTag = \"h:invalid\", elementAttrs = [], elementChildren = []}"+++------------------------------------------------------------------------------+-- | Test exception handling in template load.+exceptionsTest :: IO ()+exceptionsTest = do+    res <- Control.Exception.catch+             (runExceptT $ do+                  hs <- ExceptT $ initHeist hc+                  -- The rest needed only for type inference.+                  runner <- noteT ["Error rendering"] $ hoistMaybe $+                              renderTemplate hs ""+                  _ <- lift $ fst runner+                  throwE ["Unexpected success"])+             (\(e :: CompileException) -> return $ Right+                                            (show e, head $+                                                       exceptionContext e))++    H.assertEqual "exceptions" (Right (msg, err)) $ res++  where+    msg = "templates-loaderror/_error.tpl: Exception in splice compile: Prelude.read: no parse\n   ... via templates-loaderror/_error.tpl: h:adder\n   ... via templates-loaderror/test.tpl: h:call2\nBound splices: h:adder h:call2 h:call1\nNode: Element {elementTag = \"h:adder\", elementAttrs = [(\"value\",\"noparse\")], elementChildren = []}"+    err = SpliceError [ ( ["test"]+                        , Just "templates-loaderror/_error.tpl"+                        , "h:adder"),+                        ( ["test"]+                        , Just "templates-loaderror/test.tpl"+                        ,"h:call2") ]+              (Just "templates-loaderror/_error.tpl")+              ["h:adder", "h:call2", "h:call1"]+              (X.Element "h:adder" [("value", "noparse")] [])+              "Exception in splice compile: Prelude.read: no parse"+    hc = HeistConfig sc "h" True+    sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices+                & scCompiledSplices .~ splices+                & scTemplateLocations .~ [loadTemplates "templates-loaderror"]+    splices = do+        "call1" ## callTemplate "_ok"+        "call2" ## callTemplate "_error"+        "adder" ## do+            value :: Int <- read . T.unpack . fromJust .+                              X.getAttribute "value" <$> getParamNode+            return $ yieldPureText $ T.pack $ show $ 1 + value+++------------------------------------------------------------------------------+-- | Test for defer functions to see that they correctly save the result of+-- a runtime computation.+deferTest :: IO ()+deferTest = do+    rs <- mapM newIORef $ replicate 5 (0 :: Int)+    res <- runExceptT $ do+        hs <- ExceptT $ initHeist $ hc rs+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "test"+        b <- lift $ fst runner+        return $ toByteString b++    vs <- mapM readIORef rs+    H.assertEqual "defer test" ([2, 1, 1, 1, 1], Right msg) (vs, res)+  where+    msg = "1&#32;2\n1&#32;1\n1&#32;1\n\n1&#32;1\n"+    hc rs = HeistConfig (sc rs) "h" True+    sc rs = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices+                   & scCompiledSplices .~ (splices rs)+                   & scTemplateLocations .~ [loadTemplates "templates-defer"]+    splices [r1, r2, r3, r4, r5] = do+        "plain" ## subSplice $ addAndReturn r1+        "defer" ## deferMap return subSplice $ addAndReturn r2+        "maydefer" ## mayDeferMap (return . Just) subSplice $ addAndReturn r3+        "maydefer2" ## mayDeferMap (const $ return Nothing) subSplice $+                         addAndReturn r4+        "defermany" ## deferMany subSplice $ addAndReturn' r5+    subSplice =+        withSplices runChildren+          ("use" ## \n -> return $ yieldRuntimeText $ return . T.pack . show =<< n)+    addAndReturn r = liftIO $ modifyIORef r (+1) >> readIORef r+    addAndReturn' r = liftIO $ do+        modifyIORef r (+1)+        val <- readIORef r+        return [val]
+ test/suite/Heist/Interpreted/Tests.hs view
@@ -0,0 +1,669 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeSynonymInstances       #-}+{-# OPTIONS_GHC -fno-warn-orphans       #-}++module Heist.Interpreted.Tests+  ( tests+  , quickRender+  ) where++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Control.Monad.State+import           Data.Aeson+import           Data.ByteString.Char8                (ByteString)+import qualified Data.ByteString.Char8                as B+import qualified Data.ByteString.Lazy.Char8           as L+import qualified Data.HashMap.Strict                  as Map+import           Data.Map.Syntax+import           Data.Maybe+import           Data.Monoid+import           Data.Text                            (Text)+import qualified Data.Text                            as T+import qualified Data.Text.Encoding                   as T+import           System.IO.Unsafe+import           Test.Framework                       (Test)+import           Test.Framework.Providers.HUnit+import           Test.Framework.Providers.QuickCheck2+import qualified Test.HUnit                           as H+import           Test.QuickCheck+import           Test.QuickCheck.Monadic+++------------------------------------------------------------------------------+import           Heist+import           Heist.Common+import           Heist.Internal.Types+import           Heist.Interpreted.Internal+import           Heist.Splices.Apply+import           Heist.Splices.Ignore+import           Heist.Splices.Json+import           Heist.Splices.Markdown+import           Heist.TestCommon+import qualified Text.XmlHtml                         as X+import qualified Text.XmlHtml.Cursor                  as X+++------------------------------------------------------------------------------+tests :: [Test]+tests = [ testProperty "heist/simpleBind"            simpleBindTest+        , testProperty "heist/simpleApply"           simpleApplyTest+        , testCase     "heist/templateAdd"           addTest+        , testCase     "heist/hasTemplate"           hasTemplateTest+        , testCase     "heist/getDoc"                getDocTest+        , testCase     "heist/load"                  loadTest+        , testCase     "heist/fsLoad"                fsLoadTest+        , testCase     "heist/renderNoName"          renderNoNameTest+        , testCase     "heist/doctype"               doctypeTest+        , testCase     "heist/attributeSubstitution" attrSubstTest+        , testCase     "heist/bindAttribute"         bindAttrTest+        , testCase     "heist/markdown"              markdownTest+        , testCase     "heist/pandoc"                pandocTest+        , testCase     "heist/pandoc_div"            pandocDivTest+        , testCase     "heist/title_expansion"       titleExpansion+        , testCase     "heist/textarea_expansion"    textareaExpansion+        , testCase     "heist/div_expansion"         divExpansion+        , testCase     "heist/bind_param"            bindParam+        , testCase     "heist/markdownText"          markdownTextTest+        , testCase     "heist/apply"                 applyTest+        , testCase     "heist/ignore"                ignoreTest+        , testCase     "heist/lookupTemplateContext" lookupTemplateTest+        , testCase     "heist/attrSpliceContext"     attrSpliceContext+        , testCase     "heist/json/values"           jsonValueTest+        , testCase     "heist/json/object"           jsonObjectTest+        , testCase     "heist/renderXML"             xmlNotHtmlTest+        ]+++------------------------------------------------------------------------------+simpleBindTest :: Property+simpleBindTest = monadicIO $ forAllM arbitrary prop+  where+    prop :: Bind -> PropertyM IO ()+    prop bind = do+        let template = buildBindTemplate bind+        let result   = buildResult bind++        spliceResult <- run $ do+            hs <- loadEmpty defaultLoadTimeSplices mempty mempty mempty+            evalHeistT (runNodeList template)+                       (X.TextNode "") hs++        assert $ result == spliceResult+++------------------------------------------------------------------------------+simpleApplyTest :: Property+simpleApplyTest = monadicIO $ forAllM arbitrary prop+  where+    prop :: Apply -> PropertyM IO ()+    prop apply = do+        let correct = calcCorrect apply+        result <- run $ calcResult apply+        assert $ correct == result+++------------------------------------------------------------------------------+addTest :: IO ()+addTest = do+    es <- loadEmpty mempty mempty mempty mempty+    let hs = addTemplate "aoeu" [] Nothing es+    H.assertEqual "lookup test" (Just []) $+        fmap (X.docContent . dfDoc . fst) $+        lookupTemplate "aoeu" hs _templateMap+++------------------------------------------------------------------------------+hasTemplateTest :: H.Assertion+hasTemplateTest = do+    ets <- loadIO "templates" mempty mempty mempty mempty+    let tm = either (error . unlines) _templateMap ets+    hs <- loadEmpty mempty mempty mempty mempty+    let hs's = setTemplates tm hs+    H.assertBool "hasTemplate hs's" (hasTemplate "index" hs's)+++------------------------------------------------------------------------------+getDocTest :: H.Assertion+getDocTest = do+    d <- getDoc "bkteoar"+    H.assertBool "non-existent doc" $ isLeft d+    f <- getDoc "templates/index.tpl"+    H.assertBool "index doc" $ not $ isLeft f+++------------------------------------------------------------------------------+loadTest :: H.Assertion+loadTest = do+    ets <- loadIO "templates" mempty mempty mempty mempty+    either (error "Error loading templates")+           (\ts -> do let tm = _templateMap ts+                      H.assertEqual "loadTest size" 41 $ Map.size tm+           ) ets+++------------------------------------------------------------------------------+fsLoadTest :: H.Assertion+fsLoadTest = do+    ets <- loadIO "templates" mempty mempty mempty mempty+    let tm = either (error "Error loading templates") _templateMap ets+    es <- loadEmpty mempty mempty mempty mempty+    let hs = setTemplates tm es+    let f  = g hs++    f isNothing "abc/def/xyz"+    f isJust "a"+    f isJust "bar/a"+    f isJust "/bar/a"++  where+    g ts p n = H.assertBool ("loading template " ++ n) $ p $+               lookupTemplate (B.pack n) ts _templateMap++------------------------------------------------------------------------------+renderNoNameTest :: H.Assertion+renderNoNameTest = do+    ets <- loadT "templates" mempty mempty mempty mempty+    either (error "Error loading templates")+           (\ts -> do t <- renderTemplate ts ""+                      H.assertBool "renderNoName" $ isNothing t+           ) ets+++------------------------------------------------------------------------------+doctypeTest :: H.Assertion+doctypeTest = do+    ets <- loadT "templates" mempty mempty mempty mempty+    let ts = either (error "Error loading templates") id ets+    Just (indexDoc, _) <- renderTemplate ts "index"+    H.assertEqual "index doctype test" indexRes $ toByteString $ indexDoc+    Just (_, _) <- renderTemplate ts "ioc"+    H.assertEqual "ioc doctype test" indexRes $ toByteString $ indexDoc+  where+    indexRes = B.concat+        [doctype+        ,"\n\n<html>\n<div id='pre_{att}_post'>\n/index\n</div>\n</html>\n"+        ]++------------------------------------------------------------------------------+attrSubstTest :: H.Assertion+attrSubstTest = do+    ets <- loadT "templates" mempty mempty mempty mempty+    let ts = either (error "Error loading templates") id ets+    check "attr subst 1" (bindSplices splices ts) out1+    check "attr subst 2" ts out2++  where+    splices = defaultLoadTimeSplices `mappend`+        ("foo" ## return [X.TextNode "meaning_of_everything"])++    check str ts expected = do+        Just (resDoc, _) <- renderTemplate ts "attrs"+        H.assertEqual str expected $ toByteString $ resDoc++    out1 = B.unlines+        ["<mytag flag>Empty attribute</mytag>"+        ,"<mytag flag='abc${bar}'>No ident capture</mytag>"+        ,"<div id='pre_meaning_of_everything_post'></div>"+        ]+    out2 = B.unlines+        ["<mytag flag>Empty attribute</mytag>"+        ,"<mytag flag='abc${bar}'>No ident capture</mytag>"+        ,"<div id='pre_${foo}_post'></div>"+        ]+++------------------------------------------------------------------------------+bindAttrTest :: H.Assertion+bindAttrTest = do+    ets <- loadT "templates" mempty mempty mempty mempty+    let ts = either (error "Error loading templates") id ets+    check ts "<div id=\'zzzzz\'"++  where+    check ts str = do+        Just (resDoc, _) <- renderTemplate ts "bind-attrs"+        H.assertBool ("attr subst " ++ (show str)) $ not $ B.null $+            snd $ B.breakSubstring str $ toByteString $ resDoc+        H.assertBool ("attr subst bar") $ B.null $+            snd $ B.breakSubstring "${bar}" $ toByteString $ resDoc+++------------------------------------------------------------------------------+markdownHtmlExpected :: ByteString+markdownHtmlExpected =+    "<div class='markdown'><p>This <em>is</em> a test.</p></div>"++------------------------------------------------------------------------------+-- | Markdown test on a file+markdownTest :: H.Assertion+markdownTest = renderTest "markdown" markdownHtmlExpected++-----------------------------------------------------------------------------++-- | Pandoc test on a file+pandocTest :: H.Assertion+pandocTest = renderTest "pandoc" pandocNoDivHtmlExpected++pandocDivTest :: H.Assertion+pandocDivTest = renderTest "pandocdiv" pandocDivHtmlExpected++pandocNoDivHtmlExpected :: ByteString+pandocNoDivHtmlExpected = "<p>This <em>is</em> a test.</p>"++pandocDivHtmlExpected :: ByteString+pandocDivHtmlExpected =+  "<div class='foo test' id='pandoc'><p>This <em>is</em> a test.</p></div>"+  -- Implementaton dependent. Class is prepended in current implementation,+  -- it will be first attribute++pandocTestSplices :: Splices (Splice IO)+pandocTestSplices = do+    "pandocnodiv" ## pandocSplice optsNoDiv+    "pandocdiv"   ## pandocSplice optsDiv+  where+    optsNoDiv = setPandocWrapDiv Nothing defaultPandocOptions+    optsDiv = setPandocWrapDiv (Just "test") defaultPandocOptions++------------------------------------------------------------------------------+jsonValueTest :: H.Assertion+jsonValueTest = do+    renderTest "json" jsonExpected1+    renderTest "json_snippet" jsonExpected2++  where+    jsonExpected1 = B.concat [ "<i>&lt;b&gt;ok&lt;/b&gt;</i><i>1</i>"+                             , "<i></i><i>false</i><i>foo</i>" ]+    jsonExpected2 = "<i><b>ok</b></i><i>1</i><i></i><i>false</i><i>foo</i>"++++------------------------------------------------------------------------------+jsonObjectTest :: H.Assertion+jsonObjectTest = do+    renderTest "json_object" jsonExpected+  where+    jsonExpected = "<i>1</i><i><b>ok</b></i>12quuxquux1<b>ok</b>"+++------------------------------------------------------------------------------+-- | Render a template and assert that it matches an expected result+renderTest  :: ByteString   -- ^ template name+            -> ByteString   -- ^ expected result+            -> H.Assertion+renderTest templateName expectedResult = do+    ets <- loadT "templates" mempty pandocTestSplices mempty mempty+    let ts = either (error "Error loading templates") id ets++    check ts expectedResult++  where+    bind txt = bindJson v+      where+        v :: Value+        v = fromJust $ decode txt++    check ts0 str = do+        let splices = do+                "json" ## bind "[\"<b>ok</b>\", 1, null, false, \"foo\"]"+                "jsonObject" ##+                       (bind $ mconcat [+                                 "{\"foo\": 1, \"bar\": \"<b>ok</b>\", "+                                , "\"baz\": { \"baz1\": 1, \"baz2\": 2 }, "+                                , "\"quux\": \"quux\" }"+                                ])+        let ts = bindSplices splices ts0+        Just (doc, _) <- renderTemplate ts templateName+        let result = B.filter (/= '\n') (toByteString doc)+        H.assertEqual ("Should match " ++ (show str)) str result+++------------------------------------------------------------------------------+-- | Expansion of a bound name inside a title-tag+titleExpansion :: H.Assertion+titleExpansion = renderTest "title_expansion" expected+  where+    expected = "<title>foo</title>"+++------------------------------------------------------------------------------+-- | Expansion of a bound name inside a textarea-tag+textareaExpansion :: H.Assertion+textareaExpansion = renderTest "textarea_expansion" expected+  where+    expected = B.concat+        [ "<textarea>foo</textarea>" ]+++------------------------------------------------------------------------------+-- | Expansion of a bound name inside a div-tag+divExpansion :: H.Assertion+divExpansion = renderTest "div_expansion" expected+  where+    expected = "<div>foo</div>"+++------------------------------------------------------------------------------+-- | Handling of <content> and bound parameters in a bound tag.+bindParam :: H.Assertion+bindParam = renderTest "bind_param" "<li>Hi there world</li>"+++------------------------------------------------------------------------------+-- | Handling of <content> and bound parameters in a bound tag.+attrSpliceContext :: H.Assertion+attrSpliceContext = renderTest "attrsubtest2"+    "<a href='asdf'>link</a><a href='before$after'>foo</a>"+++------------------------------------------------------------------------------+-- | Markdown test on supplied text+markdownTextTest :: H.Assertion+markdownTextTest = do+    hs <- loadEmpty mempty mempty mempty mempty+    result <- evalHeistT markdownSplice+                         (X.TextNode "This *is* a test.")+                         hs+    H.assertEqual "Markdown text" markdownHtmlExpected+      (B.filter (/= '\n') $ toByteString $+        X.render (X.HtmlDocument X.UTF8 Nothing result))+++------------------------------------------------------------------------------+applyTest :: H.Assertion+applyTest = do+    es <- loadEmpty mempty mempty mempty mempty+    res <- evalHeistT applyImpl+        (X.Element "apply" [("template", "nonexistant")] []) es++    H.assertEqual "apply nothing" [] res+++------------------------------------------------------------------------------+ignoreTest :: H.Assertion+ignoreTest = do+    es <- loadEmpty mempty mempty mempty mempty+    res <- evalHeistT ignoreImpl+        (X.Element "ignore" [("tag", "ignorable")]+          [X.TextNode "This should be ignored"]) es+    H.assertEqual "<ignore> tag" [] res+++lookupTemplateTest :: IO ()+lookupTemplateTest = do+    hs <- loadHS "templates"+    let k = do+            modifyHS (\st -> st { _curContext = ["foo"] })+            getsHS $ (\hs' -> lookupTemplate "/user/menu" hs' _templateMap)+    res <- runHeistT k (X.TextNode "") hs+    H.assertBool "lookup context test" $ isJust $ fst res++------------------------------------------------------------------------------+xmlNotHtmlTest :: H.Assertion+xmlNotHtmlTest = renderTest "rss" expected where+  expected = "<?xml version=\"1.0\" encoding=\"UTF-8\"?><rss><channel><link>http://www.devalot.com/</link></channel></rss>"++------------------------------------------------------------------------------+identStartChar :: [Char]+identStartChar = ['a'..'z']+++------------------------------------------------------------------------------+identChar :: [Char]+identChar = '_' : identStartChar+++------------------------------------------------------------------------------+textGen :: Gen [Char]+textGen = listOf $ elements ((replicate 5 ' ') ++ identStartChar)+++------------------------------------------------------------------------------+limitedDepth :: Int -> Gen X.Node+limitedDepth 0 = liftM (X.TextNode . T.pack) textGen+limitedDepth n =+    oneof [ liftM (X.TextNode . T.pack) textGen+          , liftM3 X.Element arbitrary+                       (liftM (take 2) arbitrary)+                       (liftM (take 3) $ listOf $ limitedDepth (n - 1))+          ]+++------------------------------------------------------------------------------+-- | Returns the number of unique insertion points in the tree.+-- If h = insertAt f n g", the following property holds:+-- insSize h == (insSize f) + (insSize g) - 1+insSize :: [X.Node] -> Int+insSize ns = 1 + (sum $ map nodeSize ns)+  where nodeSize (X.Element _ _ c) = 1 + (insSize c)+        nodeSize _                 = 1+++------------------------------------------------------------------------------+insertAt :: [X.Node] -> Int -> [X.Node] -> [X.Node]+insertAt elems 0 ns = elems ++ ns+insertAt elems _ [] = elems+insertAt elems n list = maybe [] X.topNodes $+    evalState (processNode elems $ fromJust $ X.fromNodes list) n+++------------------------------------------------------------------------------+move :: Insert ()+move = modify (\x -> x - 1)+++------------------------------------------------------------------------------+processNode :: [X.Node] -> X.Cursor -> Insert (Maybe X.Cursor)+processNode elems loc =+    liftM2 mplus (move >> goDown loc) (move >> goRight loc)++  where+    goDown l =+        case X.current l of+          X.TextNode _    -> modify (+1) >> return Nothing+          X.Element _ _ _ -> doneCheck (X.insertManyFirstChild elems)+                                       X.firstChild+                                       l+          X.Comment _     -> return Nothing++    goRight = doneCheck (Just . X.insertManyRight elems) X.right++    doneCheck insertFunc next l = do+      s <- get+      if s == 0+        then return $ insertFunc l+        else maybe (return Nothing) (processNode elems) $ next l+++------------------------------------------------------------------------------+newtype Name = Name { unName :: Text } deriving (Show)++instance Arbitrary Name where+  arbitrary = do+    x     <- elements identStartChar+    n     <- choose (4,10)+    rest  <- vectorOf n $ elements identChar+    return $ Name $ T.pack (x:rest)++instance Arbitrary X.Node where+  arbitrary = limitedDepth 3+  shrink (X.Element _ [] []) = []+  shrink (X.Element n [] (_:cs)) = [X.Element n [] cs]+  shrink (X.Element n (_:as) []) = [X.Element n as []]+  shrink (X.Element n as cs) = [X.Element n as (tail cs), X.Element n (tail as) cs]+  shrink _ = []++instance Arbitrary T.Text where+  arbitrary = liftM unName arbitrary++--+-- Code for inserting nodes into any point of a tree+--+type Insert a = State Int a+++------------------------------------------------------------------------------+-- <bind> tests++-- Data type encapsulating the parameters for a bind operation+data Bind = Bind+    { _bindElemName :: Name+    , _bindChildren :: [X.Node]+    , _bindDoc :: [X.Node]+    , _bindPos :: Int+    , _bindRefPos :: Int+    } -- deriving (Show)+++instance Arbitrary Bind where+  arbitrary = do+    name <- arbitrary+    kids <- liftM (take 3) arbitrary+    doc <- liftM (take 5) arbitrary+    let s = insSize doc+    loc <- choose (0, s - 1)+    loc2 <- choose (0, s - loc - 1)+    return $ Bind name kids doc loc loc2+  shrink (Bind e [c] (_:ds) p r) = [Bind e [c] ds p r]+  shrink (Bind e (_:cs) d p r) = [Bind e cs d p r]+  shrink _ = []+++instance Show Bind where+  show b@(Bind e c d p r) = unlines+    [ "\n"+    , "Bind element name: " ++ (show e)+    , "Bind pos: " ++ (show p)+    , "Bind ref pos: " ++ (show r)+    , "Bind document:"+    , L.unpack $ L.concat $ map formatNode d+    , "Bind children:"+    , L.unpack $ L.concat $ map formatNode c+    , "Result:"+    , L.unpack $ L.concat $ map formatNode $ buildResult b+    , "Splice result:"+    , L.unpack $ L.concat $ map formatNode $ unsafePerformIO $ do+        hs <- loadEmpty mempty mempty mempty mempty+        evalHeistT (runNodeList $ buildBindTemplate b)+                          (X.TextNode "") hs+    , "Template:"+    , L.unpack $ L.concat $ map formatNode $ buildBindTemplate b+    ]+    where+      formatNode n = toLazyByteString $ X.render+                                      $ X.HtmlDocument X.UTF8 Nothing [n]++------------------------------------------------------------------------------+buildNode :: Text -> Text -> Bind -> X.Node+buildNode tag attr (Bind s c _ _ _) = X.Element tag [(attr, unName s)] c+++------------------------------------------------------------------------------+buildBind :: Bind -> X.Node+buildBind = buildNode "bind" "tag"+++------------------------------------------------------------------------------+empty :: Text -> X.Node+empty n = X.Element n [] []+++------------------------------------------------------------------------------+buildBindTemplate :: Bind -> [X.Node]+buildBindTemplate s@(Bind n _ d b r) =+    insertAt [empty $ unName $ n] pos $ withBind+  where bind = [buildBind s]+        bindSize = insSize bind+        withBind = insertAt bind b d+        pos = b + bindSize - 1 + r+++------------------------------------------------------------------------------+buildResult :: Bind -> [X.Node]+buildResult (Bind _ c d b r) = insertAt c (b + r) d+++------------------------------------------------------------------------------+-- <apply> tests++data Apply = Apply+    { _applyName :: Name+    , _applyCaller :: [X.Node]+    , _applyCallee :: Template+    , _applyChildren :: [X.Node]+    , _applyPos :: Int+    } deriving (Show)+++instance Arbitrary Apply where+    arbitrary = do+      name <- arbitrary+      kids <- liftM (take 3) $ listOf $ limitedDepth 2+      caller <- liftM (take 5) arbitrary+      callee <- liftM (take 1) $ listOf $ limitedDepth 3+      let s = insSize caller+      loc <- choose (0, s - 1)+      return $ Apply name caller callee kids loc+++------------------------------------------------------------------------------+buildApplyCaller :: Apply -> [X.Node]+buildApplyCaller (Apply name caller _ kids pos) =+    insertAt [X.Element "apply" [("template", unName name)] kids] pos caller+++------------------------------------------------------------------------------+calcCorrect :: Apply -> [X.Node]+calcCorrect (Apply _ caller callee _ pos) = insertAt callee pos caller+++------------------------------------------------------------------------------+calcResult :: Apply -> IO [X.Node]+calcResult apply@(Apply name _ callee _ _) = do+    hs <- loadEmpty defaultLoadTimeSplices mempty mempty mempty+    let hs' = setTemplates (Map.singleton [T.encodeUtf8 $ unName name]+                           (DocumentFile (X.HtmlDocument X.UTF8 Nothing callee)+                                         Nothing)) hs+    evalHeistT (runNodeList $ buildApplyCaller apply)+        (X.TextNode "") hs'++++{-+ - Convenience code for manual ghci experimentation+ -}++--html :: [Node] -> Node+--html c = X.Element "html" [] [hhead, body c]+--hhead :: Node+--hhead = X.Element "head" [] [title, X.Element "script" [] []]+--title :: Node+--title = X.Element "title" [] [X.Text "Test Page"]+--body :: [Node] -> Node+--body = X.Element "body" []+--+--para :: Int -> Node+--para n = X.Element "p" [] [X.Text $ B.pack $ "This is paragraph " ++ show n]+--para2 :: B.ByteString -> Node+--para2 c = X.Element "p" [] [X.Text c]+--para3 :: Node+--para3 = X.Element "p" [] [X.Text "AHA!"]+--+--foo :: Int -> [Node]+--foo n = insertAt [X.Element "NEW" [] []] n [html [para 1, para 2]]+--+--tdoc :: [Node]+--tdoc = [para 1, para 2, para 3, para 4]+--+--bindElem :: [Node] -> Int -> Int -> Bind+--bindElem = Bind (Name "mytag") [para2 "bound paragraph"]+--+--addBind :: Bind -> [Node] -> [Node]+--addBind b = insertAt [buildBind b] 0 . insertAt [empty $ unName $ _bindElemName b] 2+--+--prn :: Node -> IO ()+--prn = L.putStrLn . formatNode+--runTests :: IO ()+--runTests = defaultMain tests
+ test/suite/Heist/TestCommon.hs view
@@ -0,0 +1,134 @@+module Heist.TestCommon where++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Control.Monad.Trans+import           Control.Monad.Trans.Maybe  (MaybeT(..), runMaybeT)+import           Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)+import           Data.ByteString.Char8      (ByteString)+import qualified Data.ByteString.Char8      as B+import           Data.Maybe+import           Data.Monoid+++------------------------------------------------------------------------------+import           Heist+import qualified Heist.Compiled             as C+import           Heist.Internal.Types+import qualified Heist.Interpreted          as I+import qualified Heist.Interpreted.Internal as I+import qualified Text.XmlHtml               as X+++------------------------------------------------------------------------------+-- | The default doctype given to templates+doctype :: ByteString+doctype = B.concat+    [ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "+    , "'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>" ]+++loadT :: MonadIO m+      => FilePath+      -> Splices (I.Splice m)+      -> Splices (I.Splice IO)+      -> Splices (C.Splice m)+      -> Splices (AttrSplice m)+      -> IO (Either [String] (HeistState m))+loadT baseDir a b c d = runExceptT $ do+    let sc = SpliceConfig (defaultInterpretedSplices `mappend` a)+                          (defaultLoadTimeSplices `mappend` b) c d+                          [loadTemplates baseDir] (const True)+    ExceptT $ initHeist $ HeistConfig sc "" False+++------------------------------------------------------------------------------+loadIO :: FilePath+       -> Splices (I.Splice IO)+       -> Splices (I.Splice IO)+       -> Splices (C.Splice IO)+       -> Splices (AttrSplice IO)+       -> IO (Either [String] (HeistState IO))+loadIO baseDir a b c d = runExceptT $ do+    let sc = SpliceConfig (defaultInterpretedSplices >> a)+                          (defaultLoadTimeSplices >> b) c d+                          [loadTemplates baseDir] (const True)+    ExceptT $ initHeist $ HeistConfig sc "" False+++------------------------------------------------------------------------------+loadHS :: FilePath -> IO (HeistState IO)+loadHS baseDir = do+    etm <- runExceptT $ do+        let sc = SpliceConfig defaultInterpretedSplices+                              defaultLoadTimeSplices mempty mempty+                              [loadTemplates baseDir] (const True)+        ExceptT $ initHeist $ HeistConfig sc "" False+    either (error . concat) return etm+++loadEmpty :: Splices (I.Splice IO)+          -> Splices (I.Splice IO)+          -> Splices (C.Splice IO)+          -> Splices (AttrSplice IO)+          -> IO (HeistState IO)+loadEmpty a b c d = do+    let sc = SpliceConfig (defaultInterpretedSplices `mappend` a)+                          (defaultLoadTimeSplices `mappend` b) c d mempty+                          (const True)+    res <- initHeist $ HeistConfig sc "" False+    either (error . concat) return res+++testTemplate :: FilePath -> ByteString -> IO ByteString+testTemplate tdir tname = do+    ts <- loadHS tdir+    Just (resDoc, _) <- I.renderTemplate ts tname+    return $ toByteString resDoc+++testTemplateEval :: ByteString -> IO (Maybe Template)+testTemplateEval tname = do+    ts <- loadHS "templates"+    md <- evalHeistT (I.evalWithDoctypes tname) (X.TextNode "") ts+    return $ fmap X.docContent md+++------------------------------------------------------------------------------+-- | Reloads the templates from disk and renders the specified+-- template.  (Old convenience code.)+quickRender :: FilePath -> ByteString -> IO (Maybe ByteString)+quickRender baseDir name = do+    ts  <- loadHS baseDir+    res <- I.renderTemplate ts name+    return (fmap (toByteString . fst) res)++cRender :: HeistState IO -> ByteString -> IO ByteString+cRender hs name = do+    builder <- fst $ fromJust $ C.renderTemplate hs name+    return $ toByteString builder++iRender :: HeistState IO -> ByteString -> IO ByteString+iRender hs name = do+    builder <- I.renderTemplate hs name+    return $ toByteString $ fst $ fromJust builder+++------------------------------------------------------------------------------+isLeft :: Either e a -> Bool+isLeft (Left _) = True+isLeft _        = False+++------------------------------------------------------------------------------+noteT :: Monad m => e -> MaybeT m a -> ExceptT e m a+noteT e ma = do+  x <- lift $ runMaybeT ma+  case x of+    Nothing -> ExceptT $ return (Left  e)+    Just a  -> ExceptT $ return (Right a)+++------------------------------------------------------------------------------+hoistMaybe :: Monad m => Maybe a -> MaybeT m a+hoistMaybe = MaybeT . return
+ test/suite/Heist/Tests.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE CPP              #-}+{-# LANGUAGE FlexibleContexts #-}++module Heist.Tests+  ( tests+  ) where+++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Control.Monad.State+import qualified Data.ByteString.Char8           as B+import           Data.List+import           Data.Map.Syntax+import           Data.Maybe+import           Data.Monoid+import qualified Data.Text                       as T+import           Test.Framework                  (Test)+import           Test.Framework.Providers.HUnit+import qualified Test.HUnit                      as H+++------------------------------------------------------------------------------+import           Heist+import qualified Heist.Compiled                  as C+import           Heist.Internal.Types+import qualified Heist.Interpreted               as I+import           Heist.Splices.Cache+import           Heist.Splices.Html+import           Heist.TemplateDirectory+import           Heist.Tutorial.AttributeSplices+import           Heist.Tutorial.CompiledSplices++import           Heist.TestCommon++tests :: [Test]+tests = [ testCase     "loadErrors"            loadErrorsTest+        , testCase     "attrsplice/autocheck"  attrSpliceTest+        , testCase     "tdirCache"             tdirCacheTest+        , testCase     "headMerge"             headMergeTest+        , testCase     "bindApplyInteraction"  bindApplyInteractionTest+        , testCase     "backslashHandling"     backslashHandlingTest+        ]+++------------------------------------------------------------------------------+-- | Tests that load fails correctly on errors.+loadErrorsTest :: H.Assertion+loadErrorsTest = do+    ets <- loadIO "templates-bad" mempty mempty mempty mempty+    either (H.assertEqual "load errors test" expected . sort)+           (const $ H.assertFailure "No failure when loading templates-bad")+           ets+  where+    expected = sort+#if MIN_VERSION_base(4,9,0)+        ["templates-bad/apply-missing-attr.tpl: must supply \"template\" attribute in <apply>\nCallStack (from HasCallStack):\n  error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+        ,"templates-bad/apply-template-not-found.tpl: apply tag cannot find template \"/page\"\nCallStack (from HasCallStack):\n  error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+        ,"templates-bad/bind-infinite-loop.tpl: template recursion exceeded max depth, you probably have infinite splice recursion!\nCallStack (from HasCallStack):\n  error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+        ,"templates-bad/bind-missing-attr.tpl: must supply \"tag\" attribute in <bind>\nCallStack (from HasCallStack):\n  error, called at src/Heist/Common.hs:76:15 in main:Heist.Common"+        ]+#else+        ["templates-bad/bind-infinite-loop.tpl: template recursion exceeded max depth, you probably have infinite splice recursion!"+        ,"templates-bad/apply-template-not-found.tpl: apply tag cannot find template \"/page\""+        ,"templates-bad/bind-missing-attr.tpl: must supply \"tag\" attribute in <bind>"+        ,"templates-bad/apply-missing-attr.tpl: must supply \"template\" attribute in <apply>"+        ]+#endif+++attrSpliceTest :: IO ()+attrSpliceTest = do+    ehs <- loadT "templates" mempty mempty mempty+                 ("autocheck" ## lift . autocheckedSplice)+    let hs = either (error . show) id ehs+        runtime = fromJust $ C.renderTemplate hs "attr_splice"++    mres <- evalStateT (I.renderTemplate hs "attr_splice") "foo"+    H.assertEqual "interpreted foo" expected1+      (toByteString $ fst $ fromJust mres)+    mres2 <- evalStateT (I.renderTemplate hs "attr_splice") "bar"+    H.assertEqual "interpreted bar" expected2+      (toByteString $ fst $ fromJust mres2)++    builder <- evalStateT (fst runtime) "foo"+    H.assertEqual "compiled foo" expected3+      (toByteString builder)+    builder2 <- evalStateT (fst runtime) "bar"+    H.assertEqual "compiled bar" expected4+      (toByteString builder2)+  where+    expected1 = "<input type='checkbox' value='foo' checked />\n<input type='checkbox' value='bar' />\n"+    expected2 = "<input type='checkbox' value='foo' />\n<input type='checkbox' value='bar' checked />\n"+    expected3 = "<input type=\"checkbox\" value=\"foo\" checked />\n<input type=\"checkbox\" value=\"bar\" />\n"+    expected4 = "<input type=\"checkbox\" value=\"foo\" />\n<input type=\"checkbox\" value=\"bar\" checked />\n"++fooSplice :: I.Splice (StateT Int IO)+fooSplice = do+    val <- get+    put val+    I.textSplice $ T.pack $ show val++tdirCacheTest :: IO ()+tdirCacheTest = do+    let rSplices = ("foosplice" ## fooSplice)+        dSplices = ("foosplice" ## stateSplice)+        sc = SpliceConfig rSplices mempty dSplices mempty mempty (const True)+        hc = HeistConfig sc "" False+    td <- newTemplateDirectory' "templates" hc++    [a,b,c,d] <- evalStateT (testInterpreted td) 5+    H.assertBool "interpreted doesn't cache" $ a == b+    H.assertBool "interpreted doesn't clear" $ b /= c+    H.assertBool "interpreted doesn't reload" $ c /= d++    td' <- newTemplateDirectory' "templates" hc+    [e,f,g,h] <- evalStateT (testCompiled td') 5+    H.assertBool "compiled doesn't cache" $ e == f+    H.assertBool "compiled doesn't clear" $ f /= g+    H.assertBool "compiled doesn't reload" $ g /= h+  where+    testInterpreted td = do+        hs <- liftIO $ getDirectoryHS td+        cts <- liftIO $ getDirectoryCTS td+        a <- I.renderTemplate hs "cache"+        modify (+1)+        b <- I.renderTemplate hs "cache"+        liftIO $ clearCacheTagState cts+        c <- I.renderTemplate hs "cache"+        modify (+1)+        _ <- liftIO $ reloadTemplateDirectory td++        -- The reload changes the HeistState, so we have to get it again+        hs' <- liftIO $ getDirectoryHS td+        d <- I.renderTemplate hs' "cache"+        return $ map (toByteString . fst . fromJust) [a,b,c,d]++    testCompiled td = do+        hs <- liftIO $ getDirectoryHS td+        cts <- liftIO $ getDirectoryCTS td+        a <- fst $ fromJust $ C.renderTemplate hs "cache"+        modify (+1)+        b <- fst $ fromJust $ C.renderTemplate hs "cache"+        liftIO $ clearCacheTagState cts+        c <- fst $ fromJust $ C.renderTemplate hs "cache"+        modify (+1)+        _ <- liftIO $ reloadTemplateDirectory td++        -- The reload changes the HeistState, so we have to get it again+        hs' <- liftIO $ getDirectoryHS td+        d <- fst $ fromJust $ C.renderTemplate hs' "cache"+        return $ map toByteString [a,b,c,d]+++headMergeTest :: IO ()+headMergeTest = do+    ehs <- loadT "templates" mempty (htmlTag ## htmlImpl) mempty mempty+    let hs = either (error . show) id ehs+        runtime = fromJust $ C.renderTemplate hs "head_merge/index"+    mres <- fst runtime+    H.assertEqual "assertion failed" expected+      (toByteString mres)+  where+    expected = B.intercalate "\n"+      ["<html><head>\n<link href='wrapper-link' />\n"+      ,"<link href='nav-link' />\n\n<link href='index-link' />"+      ,"</head>\n\n<body>\n\n<div>nav bar</div>\n\n\n"+      ,"<div>index page</div>\n\n</body>\n</html>\n\n"+      ]++bindApplyInteractionTest :: IO ()+bindApplyInteractionTest = do+    hs <- loadHS "templates"++    cOut <- cRender hs "bind-apply-interaction/caller"+    H.assertEqual "compiled failure" cExpected cOut++    iOut <- iRender hs "bind-apply-interaction/caller"+    H.assertEqual "interpreted failure" iExpected iOut+  where+    cExpected = B.intercalate "\n"+      ["\nThis is a test."+      ,"===bind content===\nAnother test line."+      ,"apply content\nLast test line."+      ,"\n"+      ]+    iExpected = B.unlines+      ["\nThis is a test."+      ,"===bind content==="+      ,"Another test line."+      ,"apply content"+      ,"Last test line."+      ,""+      ]+++------------------------------------------------------------------------------+-- | Test backslash escaping in the attribute parser.+backslashHandlingTest :: IO ()+backslashHandlingTest = do+    hs <- loadHS "templates"+    cOut <- cRender hs "backslash"+    H.assertEqual "compiled failure" expected cOut++    iOut <- iRender hs "backslash"+    H.assertEqual "interpreted failure" expected iOut+  where+    expected = "<foo regex='abc\\d+\\\\e'></foo>\n"+
+ test/suite/Heist/Tutorial/AttributeSplices.lhs view
@@ -0,0 +1,58 @@+Attribute Splices+=================++Attribute splices are new in Heist 0.10.  They solve the problem of wanting to+be able to dynamically make empty attributes appear or disappear with a splice+without binding a splice to the whole tag.  This issue comes up most+frequently when dealing with empty attributes such as HTML's "disabled" or+"checked".++> module Heist.Tutorial.AttributeSplices where+> import           Heist.Tutorial.Imports++Consider a page with several radio buttons.  You want the correct one to be+selected based on the value of a parameter in the HTTP request.  The HTML+would look something like this:++    <input type="radio" name="color" value="red" checked>Red</input>+    <input type="radio" name="color" value="green">Green</input>+    <input type="radio" name="color" value="blue">Blue</input>++We want to automatically generate the "checked" attribute appropriately.  This+could be done with a splice bound to the input tag, but there might be a+number of other input tags on the page, so your splice would at best be+executed on more tags than necessary and at worst not have the granularity+necessary to work properly.  The ${} syntax for splices inside of attribute+values also won't work because it can only affect an attribute's value.  It+can't make the attribute disappear entirely.  This problem can be solved+nicely with attribute splices that have the following type:++< type AttrSplice m = Text -> m [(Text, Text)]++An attribute splice is a computation in the runtime monad that takes the value+of the attribute it is bound to as its argument and returns a list of+attributes to substitute back into the tag.  Here's how we might implement a+splice to solve the above problem.++> autocheckedSplice :: Text -> StateT Text IO [(Text, Text)]+> autocheckedSplice v = do+>     val <- get -- app-specific retrieval of the appropriate value here+>     let checked = if v == val+>                     then [("checked","")]+>                     else []+>     return $ ("value", v) : checked++In this toy example we are using `StateT Text IO` as our "runtime" monad where+the Text state holds the value of the radio button that should be checked.  We+assume that the current value we're checking against is passed as the bound+attribute's value, so we compare that against the value to be checked.  Then+we return a list with the appropriate value and the checked attribute if+necessary.  We bind this splice to the "autocheck" attribute by adding it to+the hcAttributeSplices list in HeistConfig.++To make everything work we use the following markup for our radio buttons:++    <input type="radio" name="color" autocheck="red">Red</input>+    <input type="radio" name="color" autocheck="green">Green</input>+    <input type="radio" name="color" autocheck="blue">Blue</input>+
+ test/suite/Heist/Tutorial/CompiledSplices.lhs view
@@ -0,0 +1,274 @@+Introduction to Compiled Heist+==============================++Before version 0.10, Heist has essentially been an interpreter.  It loads your+templates and "runs" them whenever a page is served.  This is relatively+inefficient since a lot of document transformations happen every time the+template is requested.  For Heist version 0.10 we completely rethought+everything with performance in mind.  We call it "compiled Heist".  The main+idea is to do most of your splice processing up front at load time.  There is+still a mechanism for rendering dynamic information at runtime, but it is+faster than the fully interpreted approach that Heist started with.++It should also be mentioned that the old "interpreted Heist" is not gone.  You+can still use the old approach where all the transformations happen at+render time.  This allows you to upgrade without making sweeping changes to+your code, and gradually convert your application to the more performant+compiled approach as you see fit.++Before we continue it should be mentioned that you are reading real live+literate Haskell code from our test suite.  All the code you see here is+compiled into our test suite and the results automatically checked by our+buildbot.  So first we need to get some boilerplate and imports out of the way.++> {-# LANGUAGE NoMonomorphismRestriction #-}+> module Heist.Tutorial.CompiledSplices where+> import           Heist+> import qualified Heist.Compiled as C+> import           Heist.Tutorial.Imports++> import           Control.Applicative+> import           Control.Lens+> import           Data.Map.Syntax++As a review, normal (interpreted) Heist splices are defined like this.++< type Splice m = HeistT m m [Node]++The type parameter `m` is the runtime execution monad (in a Snap application+this will usually be `Handler` or `Snap`).  Don't worry about why the `m` is+there twice right now.  We'll get to that later.  The splice's return value is+a list of nodes that is substituted back into the document wherever the+spliced node was.  ++This kind of splice proccessing involves traversing the DOM, which is+inefficient.  Compiled Heist is designed so that all the DOM traversals happen+once at load time in the IO monad.  This is the "compile" phase.  The type+signature for compiled splices is this.++< type Splice n = HeistT n IO (DList (Chunk n))++We see that where Heist splices ran in the m monad, compiled splices run in the+IO monad.  This also explains why HeistT now has two monad type parameters.+The first parameter is a placeholder for the runtime monad and the second+parameter is the monad that we're actually running in now.++But the key point of the compiled splice type signature is the return value.+They return a DList of Chunks.  DList is a list that supports efficient+insertion to both the front and back of the list.  The Chunk type is not+exposed publicly, but there are three ways to construct a Chunk.++< yieldPure :: Builder -> DList (Chunk m)+< yieldRuntime :: RuntimeSplice m Builder -> DList (Chunk m)+< yieldRuntimeEffect :: Monad m => RuntimeSplice m () -> DList (Chunk m)++If your splice output can be calculated at load time, then you should use+`yieldPure` or one of its variants.  When you do this, Heist can concatenate+all adjacent pure chunks into a single precalculated ByteString that can be+rendered very efficiently.  If your template needs a value that has to be+calculated at runtime, then you should use the `yieldRuntime` constructor and+supply a computation in the RuntimeSplice monad transformer that is+parameterized by `m` which we saw above is the runtime monad.  Occasionally+you might want to run a runtime side effect that doesn't actually insert any+data into your template.  The `yieldRuntimeEffect` function gives you that+capability.++An Example+==========++With that background, let's get to a real example.++> stateSplice :: C.Splice (StateT Int IO)+> stateSplice = return $ C.yieldRuntimeText $ do+>     val <- lift get+>     return $ pack $ show (val+1)++Here we see that our splice's runtime monad is `StateT Int IO`.  This makes+for a simple example that can clearly demonstrate the different contexts that+we are operating in.  To make things more clear, here's a version with some+print statements that clarify the details of which monad is executed when.++> stateSplice2 :: C.Splice (StateT Int IO)+> stateSplice2 = do+>     -- :: C.Splice (StateT Int IO)+>     lift $ putStrLn "This executed at load time"+>     let res = C.yieldRuntimeText $ do+>             -- :: RuntimeSplice (StateT Int IO) a+>             lift $ lift $ putStrLn "This executed at run/render time"+>             val <- lift get+>             return $ pack $ show (val+1)+>     lift $ putStrLn "This also executed at load time"+>     return res++Note here that even though the type parameter to C.Splice is a monad, it is not+a monad transformer.  RuntimeSplice, however, is.  Now let's look at a simple+load function that sets up a default HeistState and loads templates from a+directory with compiled splices.++> load :: MonadIO n+>      => FilePath+>      -> Splices (C.Splice n)+>      -> IO (HeistState n)+> load baseDir splices = do+>     tmap <- runExceptT $ do+>         let sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices+>                         & scCompiledSplices .~ splices+>                         & scTemplateLocations .~ [loadTemplates baseDir]+>         ExceptT $ initHeist $ emptyHeistConfig & hcNamespace .~ ""+>                                      & hcErrorNotBound .~ False+>                                      & hcSpliceConfig .~ sc+>     either (error . concat) return tmap++Here's a function demonstrating all of this in action.++> runWithStateSplice :: FilePath+>                    -> IO ByteString+> runWithStateSplice baseDir = do+>     hs <- load baseDir ("div" ## stateSplice)+>     let runtime = fromJust $ C.renderTemplate hs "index"+>     builder <- evalStateT (fst runtime) 2+>     return $ toByteString builder++First this function loads the templates with the above compiled splice.  You+have to specify all the compiled splices in the call to loadTemplates because+loadTemplates takes care of compiling all the templates up front.  If you were+able to bind compiled splices later, then all the templates would have to be+recompiled, a potentially expensive operation.  Next, the function renders the+template called "index" using a runtime (StateT Int IO) seeded with a value of+2 and returns the resulting ByteString.++Now let's look at a more complicated example.  We want to render a data+structure with a compiled splice.++> data Person = Person+>     { pFirstName :: Text+>     , pLastName  :: Text+>     , pAge       :: Int+>     }+> +> personSplices :: Monad n+>              => Splices (RuntimeSplice n Person -> C.Splice n)+> personSplices = mapV (C.pureSplice . C.textSplice) $ do+>     "firstName" ## pFirstName+>     "lastName" ## pLastName+>     "age" ## pack . show . pAge+> +> peopleSplice :: (Monad n)+>              => RuntimeSplice n [Person]+>              -> C.Splice n+> peopleSplice = C.manyWithSplices C.runChildren personSplices+> +> allPeopleSplice :: C.Splice (StateT [Person] IO)+> allPeopleSplice = peopleSplice (lift get)+> +> personListTest :: FilePath+>                -> IO ByteString+> personListTest baseDir = do+>     hs <- load baseDir ("people" ## allPeopleSplice)+>     let runtime = fromJust $ C.renderTemplate hs "people"+>     builder <- evalStateT (fst runtime)+>                  [ Person "John" "Doe" 42+>                  , Person "Jane" "Smith" 21+>                  ]+>     return $ toByteString builder+++Disadvantages of Compiled Heist+===============================++Compiled Heist is faster than the original interpreted approach, but as with+most things in computing there is a tradeoff.  Compiled Heist is strictly less+powerful than interpreted Heist.  There are two things that compiled Heist+loses: the ability to bind new splices on the fly at runtime and splice+recursion/composability.++The first point follows immediately from the definition of compiled Heist.+When you decide to do all your splice DOM traversals once at load time you're+unavoidably limited to only those splices that you defined at load time.  But+this seems to be a good pattern to use in general because debugging your+splices will be easier if you don't have to consider the possibility that+the handler that binds them didn't run.++The loss of recursion/composability happens because of the change in the type+signature of splices.  Interpreted splices are a essentially function `[Node]+-> m [Node]`.  This means that the output of one splice can be the input of+another splice (including itself).  Compiled splices are a function `[Node] ->+IO (DList (Chunk m))`.  Therefore, once a splice processes some nodes, the+output is no longer something that can be passed into other splices.  ++This composability turns out to be a very powerful feature.  Head merging is+one feature that can't be done without it.  Head merging allows you to put+`<head>` tags anyhere in any template and have them all merged into a single+`<head>` tag at the top of your HTML document.  This is useful because it allows+you to keep concerns localized.  For instance, you can have a template+represent a small piece of functionality that uses a less common javascript or+CSS file.  Instead of having to depend on that resource being included in the+top-level `<head>` tag, you can include it in a `<head>` tag right where you're+using it.  Then it will only be included on your pages when you are using the+markup that needs it.++Our implementation of head merging uses a splice bound to the `<html>` tag.+This splice removes all the `<head>` nodes from its children, combines them, and+inserts them as its first child.  This won't work unless the `<html>` splice+first runs all its children to make sure all `<apply>` and `<bind>` tags have+happened first.  And that is impossible to do with compiled splices.++To get around this problem we added the concept of load time splices.  Load+time splices are just interpreted splices that are completely executed at load+time.  If interpreted splices have type `[Node] -> m [Node]` where m is the+runtime monad, then load time splices have type `[Node] -> IO [Node]`, where+IO is the monad being executed at load time.  Load time splices give you the+power and composability of interpreted splices as long as they are performing+transformations that don't require runtime data.  All of the built-in splices+that we ship with Heist work as load time splices.  So you can still have head+merging by including our html splice in the load time splice list in your+HeistConfig.+++A More Involved Example+=======================++The person example above is a very common and useful pattern for using dynamic+data in splices.  But it has the simplification that it always generates+output the same way.  Sometimes you might want a splice's output to have one+form in some cases and a different form in other cases.  A simple example is a+splice that reads some kind of a key from a request parameter then looks that+key up in some kind of map.  If the key is present the splice uses its child+nodes as a view for the retrieved value, otherwise it outputs an error message.  ++This pattern is a little tricky because you're making decisions about what to+render based on runtime data, but the actual rendering of child nodes has to+be done at load time.  To bridge the gap and allow communication between load+time and runtime processing we provide the Promise data type.  A Promise is+kind of like an IORef except that operations on them are restricted to the+appropriate Heist context.  You create a new empty promise in the HeistT n IO+(load time) monad, and you operate on it in the RuntimeSplice monad.++Here's an example of how to use a promise manually to render a splice+differently in the case of failure.++< failingSplice :: MonadSnap m => C.Splice m+< failingSplice = do+<     promise <- C.newEmptyPromise+<     outputChildren <- C.withSplices C.runChildren splices (C.getPromise promise)+<     return $ C.yieldRuntime $ do         +<         -- :: RuntimeSplice m Builder+<         mname <- lift $ getParam "username"+<         let err = return $ fromByteString "Must supply a username"+<             single name = do          +<                 euser <- lift $ lookupUser name+<                 either (return . fromByteString . encodeUtf8 . T.pack)+<                        doUser euser+<               where+<                 doUser value = do+<                   C.putPromise promise (name, value)+<                   C.codeGen outputChildren+<         maybe err single mname+<   +<   +< splices :: Monad n+<         => Splices (RuntimeSplice n (Text, Text) -> C.Splice n)+< splices = mapS (C.pureSplice . C.htmlNodeSplice) $ do+<   "user"  ## (:[]) . TextNode . fst+<   "value" ## (:[]) . TextNode . snd+
+ test/suite/Heist/Tutorial/Imports.hs view
@@ -0,0 +1,26 @@+module Heist.Tutorial.Imports+  ( module Blaze.ByteString.Builder+  , module Control.Monad+  , module Control.Monad.Trans+  , module Data.Maybe+  , module Data.Monoid+  , ST.get+  , ST.StateT(..)+  , ST.evalStateT+  , T.Text+  , T.pack+  , ByteString+  , runExceptT+  , ExceptT(..)+  ) where++import           Blaze.ByteString.Builder+import           Control.Monad+import           Control.Monad.Trans+import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)+import qualified Control.Monad.Trans.State as ST+import           Data.ByteString.Char8 (ByteString)+import           Data.Maybe+import           Data.Monoid+import qualified Data.Text as T+
+ test/suite/TestSuite.hs view
@@ -0,0 +1,21 @@+module Main where++import System.Directory+import Test.Framework (defaultMain, testGroup)++import qualified Heist.Interpreted.Tests+import qualified Heist.Compiled.Tests+import qualified Heist.Tests++main :: IO ()+main = do+    -- Need to change directory after we switched to cabal test infra+    setCurrentDirectory "test"+    defaultMain tests+  where tests = [ testGroup "Heist.Interpreted.Tests"+                            Heist.Interpreted.Tests.tests+                , testGroup "Heist.Compiled.Tests"+                            Heist.Compiled.Tests.tests+                , testGroup "Heist.Tests"+                            Heist.Tests.tests+                ]
+ test/templates-bad/apply-missing-attr.tpl view
@@ -0,0 +1,3 @@+<apply>+noroot+</apply>
+ test/templates-bad/apply-template-not-found.tpl view
@@ -0,0 +1,3 @@+<apply template="/page">+This template is missing+</apply>
+ test/templates-bad/bind-infinite-loop.tpl view
@@ -0,0 +1,2 @@+<bind tag="foo"><p>line</p><foo/></bind>+<foo/>
+ test/templates-bad/bind-missing-attr.tpl view
@@ -0,0 +1,2 @@+<bind><p>line</p></bind>+<foo/>
+ test/templates-defer/test.tpl view
@@ -0,0 +1,5 @@+<h:plain><h:use/> <h:use/></h:plain>+<h:defer><h:use/> <h:use/></h:defer>+<h:maydefer><h:use/> <h:use/></h:maydefer>+<h:maydefer2><h:use/> <h:use/></h:maydefer2>+<h:defermany><h:use/> <h:use/></h:defermany>
+ test/templates-loaderror/_error.tpl view
@@ -0,0 +1,1 @@+<h:adder value="noparse"/>
+ test/templates-loaderror/_ok.tpl view
@@ -0,0 +1,1 @@+<h:adder value="1"/>
+ test/templates-loaderror/test.tpl view
@@ -0,0 +1,3 @@+<h:call1/>+<h:call2/>+<h:call1/>
+ test/templates-ns-nested/test.tpl view
@@ -0,0 +1,1 @@+<div><h:foo/></div>
+ test/templates-nsbind/nsbind.tpl view
@@ -0,0 +1,7 @@+Alpha+<h:main>+Beta+<h:sub/>+Gamma+<sub/>+</h:main>
+ test/templates-nsbind/nsbinderror.tpl view
@@ -0,0 +1,10 @@+Alpha+<h:invalid1/>+<h:main>+<h:recurse>+<h:invalid2/>+</h:recurse>+</h:main>+<h:main2>+<h:invalid3/>+</h:main2>
+ test/templates-nscall/_call.tpl view
@@ -0,0 +1,2 @@+Called+<h:sub/>
+ test/templates-nscall/_invalid.tpl view
@@ -0,0 +1,1 @@+<h:invalid/>
+ test/templates-nscall/nscall.tpl view
@@ -0,0 +1,6 @@+Top+<h:main>+Inside 1+<h:call/>+Inside 2+</h:main>
+ test/templates/a.tpl view
@@ -0,0 +1,1 @@+<root>/a</root>
+ test/templates/attr_splice.tpl view
@@ -0,0 +1,2 @@+<input type="checkbox" autocheck="foo"/>+<input type="checkbox" autocheck="bar"/>
+ test/templates/attrs.tpl view
@@ -0,0 +1,3 @@+<mytag flag="">Empty attribute</mytag>+<mytag flag="abc${bar}">No ident capture</mytag>+<div id="pre_${foo}_post"/>
+ test/templates/attrsubtest1.tpl view
@@ -0,0 +1,1 @@+<apply-content />
+ test/templates/attrsubtest2.tpl view
@@ -0,0 +1,1 @@+<bind tag="randName284">asdf</bind><apply template="attrsubtest1"><a href="${randName284}">link</a></apply><a href="before$after">foo</a>
+ test/templates/backslash.tpl view
@@ -0,0 +1,1 @@+<foo regex='abc\d+\\e'/>
+ test/templates/bar/a.tpl view
@@ -0,0 +1,1 @@+<root>/bar/a</root>
+ test/templates/bar/index.tpl view
@@ -0,0 +1,1 @@+<root>/bar/index</root>
+ test/templates/bind-apply-interaction/_outer.tpl view
@@ -0,0 +1,6 @@+<bind tag="foo">===<bind-content/>===</bind>+This is a test.+<foo>bind content</foo>+Another test line.+<apply-content/>+Last test line.
+ test/templates/bind-apply-interaction/caller.tpl view
@@ -0,0 +1,1 @@+<apply template="_outer">apply content</apply>
+ test/templates/bind-attrs.tpl view
@@ -0,0 +1,2 @@+<bind tag="bar">zzzzz</bind>+<div id="${bar}"> </div>
+ test/templates/bind_param.tpl view
@@ -0,0 +1,1 @@+<bind tag="item"><li><bind-content/> <foo/></li></bind><item><bind tag="foo">world</bind>Hi there<bind tag="bar">hello</bind></item>
+ test/templates/cache.tpl view
@@ -0,0 +1,3 @@+<cache ttl="0">+<foosplice/>+</cache>
+ test/templates/div_expansion.tpl view
@@ -0,0 +1,1 @@+<bind tag="mytext">foo</bind><div><mytext/></div>
+ test/templates/foo/a.tpl view
@@ -0,0 +1,1 @@+/foo/a
+ test/templates/foo/b.tpl view
@@ -0,0 +1,1 @@+/foo/b
+ test/templates/foo/markdown-chdir.tpl view
@@ -0,0 +1,5 @@+Different directory markdown+<apply template="markdown"/>+This file doesn't have any actual test code referring to it because compiled+Heist will automatically fail the whole test suite if the case tested by this+template isn't tested correctly.
+ test/templates/foo/markdown-origdir.tpl view
@@ -0,0 +1,3 @@+<apply template="page">+<markdown file="test2.md"/>+</apply>
+ test/templates/foo/test2.md view
@@ -0,0 +1,1 @@+This *is* another test.
+ test/templates/head_merge/index.tpl view
@@ -0,0 +1,6 @@+<apply template="wrap">+<head>+<link href="index-link">+</head>+<div>index page</div>+</apply>
+ test/templates/head_merge/nav.tpl view
@@ -0,0 +1,4 @@+<head>+<link href="nav-link">+</head>+<div>nav bar</div>
+ test/templates/head_merge/wrap.tpl view
@@ -0,0 +1,9 @@+<html>+<head>+<link href="wrapper-link">+</head>+<body>+<apply template="nav"/>+<apply-content/>+</body>+</html>
+ test/templates/index.tpl view
@@ -0,0 +1,8 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">+<bind tag="att">ultralongname</bind>+<html>+<div id="pre_{att}_post">+/index+</div>+</html>
+ test/templates/ioc.tpl view
@@ -0,0 +1,3 @@+<apply template="/page">+Inversion of control content+</apply>
+ test/templates/json.tpl view
@@ -0,0 +1,1 @@+<json><i><value/></i></json>
+ test/templates/json_array.tpl view
@@ -0,0 +1,1 @@+<jsonArray><value var="ctx.0"/>, <value var="ctx.1"/> and <with var="ctx.2"><value:deep/> <value:inside/></with></jsonArray>
+ test/templates/json_object.tpl view
@@ -0,0 +1,1 @@+<jsonObject><i><value:foo/></i><i><snippet:bar/></i><with:baz><value:baz1/><value:baz2/></with:baz><with:quux><value/></with:quux><with var="quux"><value/></with><value var="baz.baz1"/><snippet var="bar"/></jsonObject>
+ test/templates/json_snippet.tpl view
@@ -0,0 +1,1 @@+<json><i><snippet/></i></json>
+ test/templates/markdown.tpl view
@@ -0,0 +1,1 @@+<markdown file="test.md"/>
+ test/templates/namespaces.tpl view
@@ -0,0 +1,5 @@+Alpha+<foo aoeu="htns">Inside foo</foo>+Beta+<h:foo aoeu="htns">Inside h:foo</h:foo>+End
+ test/templates/page.tpl view
@@ -0,0 +1,5 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">+<wrapper>+<apply-content/>+</wrapper>
+ test/templates/pandoc.tpl view
@@ -0,0 +1,1 @@+<pandocnodiv file="test.md"/>
+ test/templates/pandocdiv.tpl view
@@ -0,0 +1,1 @@+<pandocdiv file="test.md" id="pandoc" class="foo"/>
+ test/templates/people.tpl view
@@ -0,0 +1,3 @@+<people>+<p><lastName/>, <firstName/>: <age/> years old</p>+</people>
+ test/templates/post.tpl view
@@ -0,0 +1,4 @@+<post>+<h1><postTitle/></h1>+<p><postBody/></p>+</post>
+ test/templates/readme.txt view
@@ -0,0 +1,1 @@+This file intentionally doesn't have a .tpl extension to get test coverage for this case.
+ test/templates/rss.xtpl view
@@ -0,0 +1,1 @@+<rss><channel><link>http://www.devalot.com/</link></channel></rss>
+ test/templates/test.md view
@@ -0,0 +1,1 @@+This *is* a test.
+ test/templates/textarea_expansion.tpl view
@@ -0,0 +1,1 @@+<bind tag="mytext">foo</bind><textarea><mytext/></textarea>
+ test/templates/title_expansion.tpl view
@@ -0,0 +1,1 @@+<bind tag="mytext">foo</bind><title><mytext/></title>
+ test/templates/user/admin/main.tpl view
@@ -0,0 +1,4 @@+<html>+Admin Page+<apply template="menu"/>+</html>
+ test/templates/user/admin/menu.tpl view
@@ -0,0 +1,4 @@+<ul>+  <li>Manage Users</li>+  <li>Configure Site</li>+</ul>
+ test/templates/user/main.tpl view
@@ -0,0 +1,5 @@+<html>+User Page+<apply template="menu"/>+<apply template="admin/menu"/>+</html>
+ test/templates/user/menu.tpl view
@@ -0,0 +1,5 @@+<ul>+  <li>Entries</li>+  <li>Post</li>+  <li>Logout</li>+</ul>