heist 0.1.2 → 0.2.0
raw patch · 17 files changed
+843/−1036 lines, 17 filesdep +attoparsecnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: attoparsec
API changes (from Hackage documentation)
- Text.Templating.Heist: heistExpatOptions :: ParserOptions ByteString ByteString
- Text.Templating.Heist: htmlEntityLookupTable :: Map ByteString ByteString
- Text.Templating.Heist: runRawTemplate :: (Monad m) => TemplateState m -> Template -> m [Node]
- Text.Templating.Heist: runSplice :: (Monad m) => TemplateState m -> Node -> Splice m -> m [Node]
- Text.Templating.Heist: runTemplate :: (Monad m) => TemplateState m -> ByteString -> m (Maybe [Node])
- Text.Templating.Heist: addTemplate :: (Monad m) => ByteString -> Template -> TemplateState m -> TemplateState m
+ Text.Templating.Heist: addTemplate :: (Monad m) => ByteString -> InternalTemplate -> TemplateState m -> TemplateState m
- Text.Templating.Heist: evalTemplate :: (Monad m) => ByteString -> TemplateMonad m (Maybe [Node])
+ Text.Templating.Heist: evalTemplate :: (Monad m) => ByteString -> TemplateMonad m (Maybe Template)
- Text.Templating.Heist: getDoc :: String -> IO (Either String Template)
+ Text.Templating.Heist: getDoc :: String -> IO (Either String InternalTemplate)
Files
- CONTRIBUTORS +1/−0
- TODO +5/−9
- docs/out/templates.html +127/−781
- heist.cabal +6/−4
- src/Text/Templating/Heist.hs +3/−8
- src/Text/Templating/Heist/Constants.hs +13/−0
- src/Text/Templating/Heist/Internal.hs +243/−201
- src/Text/Templating/Heist/Splices/Apply.hs +11/−7
- src/Text/Templating/Heist/Splices/Bind.hs +2/−1
- src/Text/Templating/Heist/Splices/Ignore.hs +1/−1
- src/Text/Templating/Heist/Splices/Markdown.hs +5/−2
- src/Text/Templating/Heist/Splices/Static.hs +1/−0
- src/Text/Templating/Heist/Types.hs +346/−0
- test/heist-testsuite.cabal +1/−0
- test/suite/Text/Templating/Heist/Tests.hs +68/−21
- test/templates/index.tpl +8/−1
- test/templates/noroot.tpl +2/−0
CONTRIBUTORS view
@@ -1,3 +1,4 @@ Doug Beardsley <mightybyte@gmail.com> Gregory Collins <greg@gregorycollins.net>+Edward Kmett James Sanders <jimmyjazz14@gmail.com>
TODO view
@@ -1,12 +1,8 @@-Add onLoad, preRun, postRun-- onLoad :: Node -> IO a- parameter to bindSplice+* Fix handling of ".." in apply tags - preRun :: Monad m => Template -> m a- postRun :: Monad m => Template -> m a+Ongoing+------- - The difference between pre-and post-Run and the splice is that the-splice only gets spliced node as input. preRun and postRun get the-whole document.+* Improve test coverage+* Head merging (ala the Lift Web Framework)
docs/out/templates.html view
@@ -5,26 +5,6 @@ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> <meta name="generator" content="pandoc" /> <meta name="date" content="" />- <style type="text/css">- table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode, table.sourceCode pre { margin: 0; padding: 0; border: 0; vertical-align: baseline; border: none; }- td.lineNumbers { border-right: 1px solid #AAAAAA; text-align: right; color: #AAAAAA; padding-right: 5px; padding-left: 5px; }- td.sourceCode { padding-left: 5px; }- pre.sourceCode { }- pre.sourceCode span.Normal { }- pre.sourceCode span.Keyword { color: #007020; font-weight: bold; } - pre.sourceCode span.DataType { color: #902000; }- pre.sourceCode span.DecVal { color: #40a070; }- pre.sourceCode span.BaseN { color: #40a070; }- pre.sourceCode span.Float { color: #40a070; }- pre.sourceCode span.Char { color: #4070a0; }- pre.sourceCode span.String { color: #4070a0; }- pre.sourceCode span.Comment { color: #60a0b0; font-style: italic; }- pre.sourceCode span.Others { color: #007020; }- pre.sourceCode span.Alert { color: red; font-weight: bold; }- pre.sourceCode span.Function { color: #06287e; }- pre.sourceCode span.RegionMarker { }- pre.sourceCode span.Error { color: red; font-weight: bold; }- </style> <link rel="stylesheet" href="templates.css" type="text/css" /> </head> <body>@@ -61,58 +41,16 @@ >Example</h4 ><p >Here's a simple example demonstrating the use of bind.</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><bind</span- ><span class="Others Attribute"- > tag=</span- ><span class="String Value"- >"longname"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > Einstein, Feynman, Heisenberg, and Newton Reasearch Corporation</span- ><br- /><span class="Normal NormalText"- >Ltd.</span- ><span class="Keyword Element"- ><sup></span- ><span class="Normal NormalText"- >TM</span- ><span class="Keyword Element"- ></sup></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></bind></span- ><br- /><span class="Normal NormalText"- > We at </span- ><span class="Keyword Element"- ><longname/></span- ><span class="Normal NormalText"- > have research expertise in many areas of physics.</span- ><br- /><span class="Normal NormalText"- >Employment at </span- ><span class="Keyword Element"- ><longname/></span- ><span class="Normal NormalText"- > carries significant prestige. The rigorous</span- ><br- /><span class="Normal NormalText"- >hiring process developed by </span- ><span class="Keyword Element"- ><longname/></span- ><span class="Normal NormalText"- > is leading the industry.</span- ><br- /></code+ > <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.+</code ></pre ><p >The full company name will be substituted at every occurrance of the <code@@ -156,64 +94,14 @@ > 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 <code >nav.tpl</code > that looks like this:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><ul></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><li><a</span- ><span class="Others Attribute"- > href=</span- ><span class="String Value"- >"/"</span- ><span class="Keyword Element"- >></span- ><span class="Normal NormalText"- >Home</span- ><span class="Keyword Element"- ></a></li></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><li><a</span- ><span class="Others Attribute"- > href=</span- ><span class="String Value"- >"/faq"</span- ><span class="Keyword Element"- >></span- ><span class="Normal NormalText"- >FAQ</span- ><span class="Keyword Element"- ></a></li></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><li><a</span- ><span class="Others Attribute"- > href=</span- ><span class="String Value"- >"/contact"</span- ><span class="Keyword Element"- >></span- ><span class="Normal NormalText"- >Contact</span- ><span class="Keyword Element"- ></a></li></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></ul></span- ><br- /></code+ > <ul>+ <li><a href="/">Home</a></li>+ <li><a href="/faq">FAQ</a></li>+ <li><a href="/contact">Contact</a></li>+ </ul>+</code ></pre ><p >Then to include this nav template in your front page template, you would use the <code@@ -221,77 +109,19 @@ > tag. Here is what a simple home page template <code >home.tpl</code > might look like:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><html></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><title></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></title></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><body></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><apply</span- ><span class="Others Attribute"- > template=</span- ><span class="String Value"- >"nav"</span- ><span class="Keyword Element"- >/></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Welcome to our home page</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></body></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></html></span- ><br- /></code+ > <html>+ <head>+ <title>Home Page</title>+ </head>+ <body>+ <h1>Home Page</h1>+ <apply template="nav"/>+ <p>Welcome to our home page</p>+ </body>+ </html>+</code ></pre ><p >When a user requests the <code@@ -299,121 +129,23 @@ > URL, Heist would serve <code >home.tpl</code >, and the nav template would automatically be inserted into the page. Here is what the HTML will look like after Heist processes the template:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><html></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><title></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></title></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><body></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><ul></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><li><a</span- ><span class="Others Attribute"- > href=</span- ><span class="String Value"- >"/"</span- ><span class="Keyword Element"- >></span- ><span class="Normal NormalText"- >Home</span- ><span class="Keyword Element"- ></a></li></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><li><a</span- ><span class="Others Attribute"- > href=</span- ><span class="String Value"- >"/faq"</span- ><span class="Keyword Element"- >></span- ><span class="Normal NormalText"- >FAQ</span- ><span class="Keyword Element"- ></a></li></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><li><a</span- ><span class="Others Attribute"- > href=</span- ><span class="String Value"- >"/contact"</span- ><span class="Keyword Element"- >></span- ><span class="Normal NormalText"- >Contact</span- ><span class="Keyword Element"- ></a></li></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></ul></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Welcome to our home page</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></body></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></html></span- ><br- /></code+ > <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>+</code ></pre ></div ></div@@ -436,119 +168,25 @@ > tag. The following simple example illustrates this concept. We create a site template called <code >default.tpl</code >:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Keyword Element"- ><html></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><title></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></title></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><body></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"header"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >XYZ Inc.</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"content"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><content</span- ><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- >/></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"footer"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Copyright XYZ Inc</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></body></span- ><br- /><span class="Keyword Element"- ></html></span- ><br- /></code+ ><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>+</code ></pre ><p >The <code@@ -558,166 +196,38 @@ >.</p ><p >Now we have a template for our home page called home.tpl:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Keyword Element"- ><apply</span- ><span class="Others Attribute"- > template=</span- ><span class="String Value"- >"default"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Welcome to XYZ Inc</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Keyword Element"- ></apply></span- ><br- /></code+ ><apply template="default">+ <h1>Home Page</h1>+ <p>Welcome to XYZ Inc</p>+</apply>+</code ></pre ><p >And when Heist receives a request to <code >/home</code >, it will serve the following:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Keyword Element"- ><html></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><title></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></title></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><body></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"header"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >XYZ Inc.</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"content"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Welcome to XYZ Inc</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"footer"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Copyright XYZ Inc</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></body></span- ><br- /><span class="Keyword Element"- ></html></span- ><br- /></code+ ><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>+</code ></pre ><p >The two lines from inside the <code@@ -755,111 +265,25 @@ >The previous example only needs a few modifications to <code >default.tpl</code > to allow multiple parameters.</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Keyword Element"- ><html></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><title></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></title></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></head></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><body></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"header"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><header/></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"content"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><main/></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><div</span- ><span class="Others Attribute"- > id=</span- ><span class="String Value"- >"footer"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Copyright XYZ Inc</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></div></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></body></span- ><br- /><span class="Keyword Element"- ></html></span- ><br- /></code+ ><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>+</code ></pre ><p >And <code@@ -871,83 +295,19 @@ > and <code ><main/></code > tags:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Keyword Element"- ><apply</span- ><span class="Others Attribute"- > template=</span- ><span class="String Value"- >"default"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><bind</span- ><span class="Others Attribute"- > tag=</span- ><span class="String Value"- >"header"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >XYZ Inc.</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></bind></span- ><br- /><span class="Normal NormalText"- > Some in-between text.</span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><bind</span- ><span class="Others Attribute"- > tag=</span- ><span class="String Value"- >"main"</span- ><span class="Keyword Element"- >></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><h1></span- ><span class="Normal NormalText"- >Home Page</span- ><span class="Keyword Element"- ></h1></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><p></span- ><span class="Normal NormalText"- >Welcome to XYZ Inc</span- ><span class="Keyword Element"- ></p></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ></bind></span- ><br- /><span class="Keyword Element"- ></apply></span- ><br- /></code+ ><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>+</code ></pre ><p >The result template for this example is the same as the previous example.</p@@ -963,37 +323,23 @@ > tags inside the apply will disappear. If we changed <code >default.tpl</code > to the following:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Keyword Element"- ><foo></span- ><br- /><span class="Normal NormalText"- > </span- ><span class="Keyword Element"- ><content/></span- ><br- /><span class="Keyword Element"- ></foo></span- ><br- /></code+ ><foo>+ <content/>+</foo>+</code ></pre ><p >Then the above <code >home.tpl</code > template would render like this:</p- ><pre class="sourceCode html"+ ><pre class="html" ><code- ><span class="Keyword Element"- ><foo></span- ><br- /><span class="Normal NormalText"- > Some in-between text.</span- ><br- /><span class="Keyword Element"- ></foo></span- ><br- /></code+ ><foo>+ Some in-between text.+</foo>+</code ></pre ></div ><div id="the-ignore-tag"
heist.cabal view
@@ -1,5 +1,5 @@ name: heist-version: 0.1.2+version: 0.2.0 synopsis: An xhtml templating system license: BSD3 license-file: LICENSE@@ -83,20 +83,22 @@ other-modules: Text.Templating.Heist.Internal,- Text.Templating.Heist.Constants+ Text.Templating.Heist.Constants,+ Text.Templating.Heist.Types build-depends:+ attoparsec >= 0.8.0.2 && < 0.9, base >= 4 && < 5, bytestring, containers, directory, directory-tree, filepath,- process, hexpat >= 0.16 && <0.17,+ MonadCatchIO-transformers >= 0.2.1 && < 0.3, monads-fd,+ process, random,- MonadCatchIO-transformers >= 0.2.1 && < 0.3, transformers if impl(ghc >= 6.12.0)
src/Text/Templating/Heist.hs view
@@ -64,8 +64,8 @@ ( -- * Types Node- , Splice , Template+ , Splice , TemplateMonad , TemplateState @@ -90,27 +90,22 @@ , getContext -- * Functions for running splices and templates- , runTemplate , evalTemplate , callTemplate , renderTemplate , bindStrings -- * Misc functions- , runSplice- , runRawTemplate , getDoc , bindStaticTag - , heistExpatOptions- , module Text.Templating.Heist.Constants ) where import Control.Monad.Trans import qualified Data.Map as Map import Text.Templating.Heist.Internal-import Text.Templating.Heist.Constants import Text.Templating.Heist.Splices+import Text.Templating.Heist.Types ------------------------------------------------------------------------------@@ -129,7 +124,7 @@ -- @\<apply\>@) mapped. emptyTemplateState :: MonadIO m => TemplateState m emptyTemplateState = TemplateState defaultSpliceMap Map.empty True [] 0- return return return+ return return return [] -- $hookDoc
src/Text/Templating/Heist/Constants.hs view
@@ -4,7 +4,20 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.Map as Map import Data.Map (Map)+import Text.XML.Expat.Tree ++------------------------------------------------------------------------------+-- | Options passed to hexpat for XML parsing.+heistExpatOptions :: ParserOptions ByteString ByteString+heistExpatOptions =+ defaultParserOptions {+ parserEncoding = Just UTF8+ , entityDecoder = Just (\k -> Map.lookup k htmlEntityLookupTable)+ }++------------------------------------------------------------------------------+-- | Character entity references for HTML. htmlEntityLookupTable :: Map ByteString ByteString htmlEntityLookupTable = Map.fromList [ ("acute" , "\xc2\xb4")
src/Text/Templating/Heist/Internal.hs view
@@ -5,9 +5,11 @@ module Text.Templating.Heist.Internal where ------------------------------------------------------------------------------+import Control.Applicative import Control.Exception (SomeException) import Control.Monad.CatchIO import Control.Monad.RWS.Strict+import qualified Data.Attoparsec.Char8 as AP import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as L@@ -15,124 +17,38 @@ import qualified Data.Foldable as F import Data.List import qualified Data.Map as Map-import Data.Map (Map)+import Data.Maybe import Prelude hiding (catch) import System.Directory.Tree hiding (name)+import System.FilePath import Text.XML.Expat.Format import qualified Text.XML.Expat.Tree as X ------------------------------------------------------------------------------ import Text.Templating.Heist.Constants----------------------------------------------------------------------------------- Types----------------------------------------------------------------------------------- | Heist templates are XML documents. The hexpat library is polymorphic over--- the type of strings, so here we define a 'Node' alias to fix the string--- types of the tag names and tag bodies to 'ByteString'.-type Node = X.Node ByteString ByteString------------------------------------------------------------------------------------ | A 'Template' is a forest of XML nodes.-type Template = [Node]------------------------------------------------------------------------------------ | Reversed list of directories-type TPath = [ByteString]----------------------------------------------------------------------------------type TemplateMap = Map TPath Template------------------------------------------------------------------------------------ | Holds all the state information needed for template processing:------ * a collection of named templates. If you use the @\<apply--- template=\"foo\"\>@ tag to include another template by name, @\"foo\"@--- is looked up in here.------ * the mapping from tag names to 'Splice's.------ * a flag to control whether we will recurse during splice processing.------ We'll illustrate the recursion flag with a small example template:------ > <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@; if the recursion flag is on we--- will recursively scan @L@ for splices, otherwise @L@ will be included in the--- output verbatim.-data TemplateState m = TemplateState {- -- | A mapping of splice names to splice actions- _spliceMap :: SpliceMap m- -- | A mapping of template names to templates- , _templateMap :: TemplateMap- -- | A flag to control splice recursion- , _recurse :: Bool- , _curContext :: TPath- , _recursionDepth :: Int- , _onLoadHook :: Template -> IO Template- , _preRunHook :: Template -> m Template- , _postRunHook :: Template -> m Template-}----------------------------------------------------------------------------------instance Eq (TemplateState m) where- a == b = (_recurse a == _recurse b) &&- (_templateMap a == _templateMap b) &&- (_curContext a == _curContext b)------------------------------------------------------------------------------------ | 'TemplateMonad' is a monad transformer that gives you access to the 'Node'--- being processed (using the 'MonadReader' instance) as well as holding the--- 'TemplateState' that contains splice and template mappings (accessible--- using the 'MonadState' instance.-newtype TemplateMonad m a = TemplateMonad (RWST Node () (TemplateState m) m a)- deriving ( Monad- , MonadIO- , MonadCatchIO- , MonadReader Node- , MonadState (TemplateState m) )----------------------------------------------------------------------------------instance (Monad m) => Monoid (TemplateState m) where- mempty = TemplateState Map.empty Map.empty True [] 0- return return return-- (TemplateState s1 t1 r1 _ d1 o1 b1 a1) `mappend`- (TemplateState s2 t2 r2 c2 d2 o2 b2 a2) =- TemplateState s t r c2 d (o1 >=> o2) (b1 >=> b2) (a1 >=> a2)- where- s = s1 `mappend` s2- t = t1 `mappend` t2- r = r1 && r2- d = max d1 d2+import Text.Templating.Heist.Types -------------------------------------------------------------------------------instance MonadTrans TemplateMonad where- lift = TemplateMonad . lift----------------------------------------------------------------------------------- | A Splice is a TemplateMonad computation that returns [Node].-type Splice m = TemplateMonad m Template+-- | Restores the components of TemplateState that can get modified in+-- template calls. You should use this function instead of @putTS@ to restore+-- an old state. Thas 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.+restoreState :: Monad m => TemplateState m -> TemplateMonad m ()+restoreState ts1 = + modifyTS (\ts2 -> ts2+ { _recursionDepth = _recursionDepth ts1+ , _curContext = _curContext ts1+ , _spliceMap = _spliceMap ts1+ }) --------------------------------------------------------------------------------- | SpliceMap associates a name and a Splice.-type SpliceMap m = Map ByteString (Splice m)+-- | Mappends a doctype to the state.+addDoctype :: Monad m => [ByteString] -> TemplateMonad m ()+addDoctype dt = do+ modifyTS (\s -> s { _doctypes = _doctypes s `mappend` dt }) ------------------------------------------------------------------------------@@ -192,18 +108,30 @@ -- leave @\"\"@ as the last element of the TPath. -- -- FIXME @\"..\"@ currently doesn't work in paths, the solution is non-trivial-splitPaths :: ByteString -> TPath-splitPaths p = if B.null p then [] else (reverse $ B.split '/' path)+splitPathWith :: Char -> ByteString -> TPath+splitPathWith s p = if B.null p then [] else (reverse $ B.split s path) where- path = if B.head p == '/' then B.tail p else p+ path = if B.head p == s then B.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 '/'++ ------------------------------------------------------------------------------ -- | Does a single template lookup without cascading up. singleLookup :: TemplateMap -> TPath -> ByteString- -> Maybe (Template, TPath)+ -> Maybe (InternalTemplate, TPath) singleLookup tm path name = fmap (\a -> (a,path)) $ Map.lookup (name:path) tm @@ -213,7 +141,7 @@ traversePath :: TemplateMap -> TPath -> ByteString- -> Maybe (Template, TPath)+ -> Maybe (InternalTemplate, TPath) traversePath tm [] name = fmap (\a -> (a,[])) (Map.lookup [name] tm) traversePath tm path name = singleLookup tm path name `mplus`@@ -225,10 +153,10 @@ lookupTemplate :: Monad m => ByteString -> TemplateState m- -> Maybe (Template, TPath)+ -> Maybe (InternalTemplate, TPath) lookupTemplate nameStr ts = f (_templateMap ts) path name- where (name:p) = case splitPaths nameStr of+ where (name:p) = case splitTemplatePath nameStr of [] -> [""] ps -> ps path = p ++ (_curContext ts)@@ -247,7 +175,7 @@ -- | Adds a template to the template state. insertTemplate :: Monad m => TPath- -> Template+ -> InternalTemplate -> TemplateState m -> TemplateState m insertTemplate p t st =@@ -258,60 +186,125 @@ -- | Adds a template to the template state. addTemplate :: Monad m => ByteString- -> Template+ -> InternalTemplate -> TemplateState m -> TemplateState m-addTemplate n t st = insertTemplate (splitPaths n) t st------------------------------------------------------------------------------------ | Gets the node currently being processed.-getParamNode :: Monad m => TemplateMonad m Node-getParamNode = ask+addTemplate n t st = insertTemplate (splitTemplatePath n) t st --------------------------------------------------------------------------------- | Stops the recursive processing of splices.+-- | 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 => TemplateMonad m ()-stopRecursion = modify (\st -> st { _recurse = False })+stopRecursion = modifyTS (\st -> st { _recurse = False }) ------------------------------------------------------------------------------ -- | Sets the current context setContext :: Monad m => TPath -> TemplateMonad m ()-setContext c = modify (\st -> st { _curContext = c })+setContext c = modifyTS (\st -> st { _curContext = c }) ------------------------------------------------------------------------------ -- | Gets the current context getContext :: Monad m => TemplateMonad m TPath-getContext = gets _curContext+getContext = getsTS _curContext --------------------------------------------------------------------------------- | Performs splice processing on a list of nodes.-runNodeList :: Monad m => [Node] -> Splice m-runNodeList nodes = liftM concat $ sequence (map runNode nodes)--------------------------------------------------------------------------------- -- | Performs splice processing on a single node. runNode :: Monad m => Node -> Splice m runNode n@(X.Text _) = return [n]-runNode n@(X.Element nm _ ch) = do- s <- liftM (lookupSplice nm) get+runNode n@(X.Element nm at ch) = do+ s <- liftM (lookupSplice nm) getTS maybe runChildren (recurseSplice n) s-+ where runChildren = do newKids <- runNodeList ch- return [X.modifyChildren (const newKids) n]+ newAtts <- mapM attSubst at+ return [X.Element nm newAtts newKids] ------------------------------------------------------------------------------+-- | Helper function for substituting a parsed attribute into an attribute+-- tuple.+attSubst :: (Monad m) => (t, ByteString) -> TemplateMonad m (t, ByteString)+attSubst (n,v) = do+ v' <- parseAtt v+ return (n,v')+++------------------------------------------------------------------------------+-- | Parses an attribute for any identifier expressions and performs+-- appropriate substitution.+parseAtt :: (Monad m) => ByteString -> TemplateMonad m ByteString+parseAtt bs = do+ let ast = case AP.feed (AP.parse attParser bs) "" of+ (AP.Fail _ _ _) -> []+ (AP.Done _ res) -> res+ (AP.Partial _) -> []+ chunks <- mapM cvt ast+ return $ B.concat chunks+ where+ cvt (Literal x) = return x+ cvt (Ident x) = getAttributeSplice x+++------------------------------------------------------------------------------+-- | AST to hold attribute parsing structure. This is necessary because+-- attoparsec doesn't support parsers running in another monad.+data AttAST = Literal ByteString |+ Ident ByteString+ deriving (Show)+++------------------------------------------------------------------------------+-- | Parser for attribute variable substitution.+attParser :: AP.Parser [AttAST]+attParser = AP.many1 (identParser <|> litParser)+ where+ escChar = (AP.char '\\' *> AP.anyChar) <|>+ AP.satisfy (AP.notInClass "\\$")+ litParser = Literal <$> (B.pack <$> AP.many1 escChar)+ identParser = AP.string "$(" *>+ (Ident <$> AP.takeWhile (/=')')) <* AP.string ")"+++------------------------------------------------------------------------------+-- | Get's the attribute value. This is just a normal splice lookup with the+-- added restriction that the splice's result list has to contain a single+-- text element. Otherwise the attribute evaluates to the empty string.+getAttributeSplice :: Monad m => ByteString -> TemplateMonad m ByteString+getAttributeSplice name = do+ s <- liftM (lookupSplice name) getTS+ nodes <- maybe (return []) id s+ return $ check nodes+ where+ check ((X.Text t):_) = t+ check _ = ""++------------------------------------------------------------------------------+-- | Performs splice processing on a list of nodes.+runNodeList :: Monad m => [Node] -> Splice m+runNodeList nodes = liftM concat $ sequence (map runNode nodes)+++------------------------------------------------------------------------------ -- | The maximum recursion depth. (Used to prevent infinite loops.) mAX_RECURSION_DEPTH :: Int-mAX_RECURSION_DEPTH = 20+mAX_RECURSION_DEPTH = 50 ------------------------------------------------------------------------------@@ -319,63 +312,61 @@ -- deeper than mAX_RECURSION_DEPTH to avoid infinite loops. recurseSplice :: Monad m => Node -> Splice m -> Splice m recurseSplice node splice = do- result <- local (const node) splice- ts' <- get+ result <- localParamNode (const node) splice+ ts' <- getTS if _recurse ts' && _recursionDepth ts' < mAX_RECURSION_DEPTH- then do modify (\st -> st { _recursionDepth = _recursionDepth st + 1 })+ then do modRecursionDepth (+1) res <- runNodeList result- put ts'+ restoreState ts' return res else return result------------------------------------------------------------------------------------ | Runs a splice in the underlying monad. Splices require two--- parameters, the template state, and an input node.-runSplice :: Monad m =>- TemplateState m -- ^ The initial template state- -> Node -- ^ The splice's input node- -> Splice m -- ^ The splice- -> m [Node]-runSplice ts node (TemplateMonad splice) = do- (result,_,_) <- runRWST splice node ts- return result+ where+ modRecursionDepth :: Monad m => (Int -> Int) -> TemplateMonad m ()+ modRecursionDepth f =+ modifyTS (\st -> st { _recursionDepth = f (_recursionDepth st) }) --------------------------------------------------------------------------------- | Runs a template in the underlying monad. Similar to runSplice--- except that templates don't require a Node as a parameter.-runRawTemplate :: Monad m => TemplateState m -> Template -> m [Node]-runRawTemplate ts template =- _preRunHook ts template >>=- runSplice ts (X.Text "") . runNodeList >>=- _postRunHook ts+-- | Looks up a template name runs a TemplateMonad computation on it.+lookupAndRun :: Monad m+ => ByteString+ -> ((InternalTemplate, TPath) -> TemplateMonad m (Maybe a))+ -> TemplateMonad m (Maybe a)+lookupAndRun name k = do+ ts <- getTS+ maybe (return Nothing) k+ (lookupTemplate name ts) --------------------------------------------------------------------------------- | Looks up a template name in the supplied 'TemplateState' and runs--- it in the underlying monad.-runTemplate :: Monad m- => TemplateState m- -> ByteString- -> m (Maybe [Node])-runTemplate ts name =- maybe (return Nothing)- (\(t,ctx) ->- return . Just =<<- runRawTemplate (ts {_curContext = ctx}) t)- (lookupTemplate name ts)+-- | Looks up a template name evaluates it by calling runNodeList.+evalTemplate :: Monad m+ => ByteString+ -> TemplateMonad m (Maybe Template)+evalTemplate name = lookupAndRun name+ (\(t,ctx) -> do+ ts <- getTS+ putTS (ts {_curContext = ctx})+ res <- runNodeList $ _itNodes t+ restoreState ts+ return $ Just res) --------------------------------------------------------------------------------- | Looks up a template name evaluates it. Same as runTemplate except it--- runs in TemplateMonad instead of m.-evalTemplate :: Monad m+-- | Looks up a template name evaluates it by calling runNodeList. This also+-- executes pre- and post-run hooks and adds the doctype.+evalWithHooks :: Monad m => ByteString- -> TemplateMonad m (Maybe [Node])-evalTemplate name = do- ts <- get- lift $ runTemplate ts name+ -> TemplateMonad m (Maybe Template)+evalWithHooks name = lookupAndRun name+ (\(t,ctx) -> do+ addDoctype $ maybeToList $ _itDoctype t+ ts <- getTS+ nodes <- lift $ _preRunHook ts $ _itNodes t+ putTS (ts {_curContext = ctx})+ res <- runNodeList nodes+ restoreState ts+ return . Just =<< lift (_postRunHook ts res)) ------------------------------------------------------------------------------@@ -398,42 +389,64 @@ -- (name,value) parameter pairs -> TemplateMonad m (Maybe Template) callTemplate name params = do- modify $ bindStrings params+ modifyTS $ bindStrings params evalTemplate name ------------------------------------------------------------------------------+-- | Converts a Template to an InternalTemplate. This can only be done inside+-- TemplateMonad where the doctype is available.+toInternalTemplate :: Monad m => Template -> TemplateMonad m InternalTemplate+toInternalTemplate t = do+ dts <- getsTS _doctypes+ return $ InternalTemplate {+ _itDoctype = listToMaybe dts,+ _itNodes = t+ }+++------------------------------------------------------------------------------+-- | Renders an internal template by prepending the appropriate doctype.+renderInternal :: Monad m => InternalTemplate -> TemplateMonad m ByteString+renderInternal (InternalTemplate dt nodes) =+ return $ maybe bs (flip B.append bs) dt+ where+ bs = formatList' nodes+++------------------------------------------------------------------------------ -- | Renders a template from the specified TemplateState. renderTemplate :: Monad m => TemplateState m -> ByteString -> m (Maybe ByteString) renderTemplate ts name = do- ns <- runTemplate ts name- return $ (Just . formatList') =<< ns----------------------------------------------------------------------------------heistExpatOptions :: X.ParserOptions ByteString ByteString-heistExpatOptions =- X.defaultParserOptions {- X.parserEncoding = Just X.UTF8- , X.entityDecoder = Just (\k -> Map.lookup k htmlEntityLookupTable)- }+ evalTemplateMonad+ (do mt <- evalWithHooks name+ maybe (return Nothing)+ (\t -> liftM Just $ renderInternal =<< toInternalTemplate t)+ mt+ ) (X.Text "") ts ------------------------------------------------------------------------------ -- Template loading ------------------------------------------------------------------------------ -- | Reads an XML document from disk.-getDoc :: String -> IO (Either String Template)+getDoc :: String -> IO (Either String InternalTemplate) getDoc f = do bs <- catch (liftM Right $ B.readFile f) (\(e::SomeException) -> return $ Left $ show e)- let wrap b = "<snap:root>\n" `B.append` b `B.append` "\n</snap:root>"- return $ (mapRight X.getChildren .- mapLeft genErrorMsg .- X.parse' heistExpatOptions . wrap) =<< bs+ return $ do+ (doctype, rest) <- liftM extractDoctype bs+ let wrap b = "<snap:root>\n" `B.append` b `B.append` "\n</snap:root>"+ toTemplate t = InternalTemplate {+ _itDoctype = doctype,+ _itNodes = t+ }+ mapRight (toTemplate . X.getChildren) .+ mapLeft genErrorMsg .+ X.parse' heistExpatOptions . wrap $ rest where genErrorMsg (X.XMLParseError str loc) = f ++ " " ++ locMsg loc ++ ": " ++ translate str locMsg (X.XMLParseLocation line col _ _) =@@ -441,7 +454,25 @@ translate "junk after document element" = "document must have a single root element" translate s = s + ------------------------------------------------------------------------------+-- | Checks whether the bytestring has a doctype.+hasDoctype :: ByteString -> Bool+hasDoctype bs = "<!DOCTYPE" `B.isPrefixOf` bs+++------------------------------------------------------------------------------+-- | Converts a ByteString into a tuple containing a possible doctype+-- ByteString and the rest of the document.+extractDoctype :: ByteString -> (Maybe ByteString, ByteString)+extractDoctype bs = + if hasDoctype bs+ then (Just $ B.snoc (B.takeWhile p bs) '>', B.tail $ B.dropWhile p bs)+ else (Nothing, bs)+ where+ p = (/='>')++------------------------------------------------------------------------------ mapLeft :: (a -> b) -> Either a c -> Either b c mapLeft g = either (Left . g) Right mapRight :: (b -> c) -> Either a b -> Either a c@@ -453,14 +484,15 @@ -- template is only loaded if it has a ".tpl" extension. loadTemplate :: String -- ^ path of the template root -> String -- ^ full file path (includes the template root)- -> IO [Either String (TPath, Template)] --TemplateMap+ -> IO [Either String (TPath, InternalTemplate)] --TemplateMap loadTemplate templateRoot fname | ".tpl" `isSuffixOf` fname = do c <- getDoc fname- return [fmap (\t -> (splitPaths $ B.pack tName, t)) c]+ return [fmap (\t -> (splitLocalPath $ B.pack tName, t)) c] | otherwise = return [] where -- tName is path relative to the template root directory- tName = drop ((length templateRoot)+1) $+ correction = if last templateRoot == '/' then 0 else 1+ tName = drop ((length templateRoot)+correction) $ -- We're only dropping the template root, not the whole path take ((length fname) - 4) fname @@ -479,11 +511,21 @@ ------------------------------------------------------------------------------+-- | Reversed list of directories. This holds the path to the template+runHookInternal :: Monad m => (Template -> m Template)+ -> InternalTemplate+ -> m InternalTemplate+runHookInternal f t = do+ n <- f $ _itNodes t+ return $ t { _itNodes = n }+++------------------------------------------------------------------------------ -- | Runs the onLoad hook on the template and returns the `TemplateState` -- with the result inserted.-loadHook :: Monad m => TemplateState m -> (TPath, Template) -> IO (TemplateState m)+loadHook :: Monad m => TemplateState m -> (TPath, InternalTemplate) -> IO (TemplateState m) loadHook ts (tp, t) = do- t' <- _onLoadHook ts t+ t' <- runHookInternal (_onLoadHook ts) t return $ insertTemplate tp t' ts
src/Text/Templating/Heist/Splices/Apply.hs view
@@ -6,10 +6,12 @@ import Control.Monad.RWS.Strict import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B+import Data.Maybe import qualified Text.XML.Expat.Tree as X ------------------------------------------------------------------------------ import Text.Templating.Heist.Internal+import Text.Templating.Heist.Types ------------------------------------------------------------------------------ -- | Default name for the apply splice.@@ -31,14 +33,16 @@ case X.getAttribute node applyAttr of Nothing -> return [] -- TODO: error handling Just attr -> do - st <- get- processedChildren <- runNodeList $ X.getChildren node- modify (bindSplice "content" $ return processedChildren)+ st <- getTS maybe (return []) -- TODO: error handling- (\(t,ctx) -> do setContext ctx- result <- runNodeList t- put st- return result)+ (\(t,ctx) -> do+ addDoctype $ maybeToList $ _itDoctype t+ processedChildren <- runNodeList $ X.getChildren node+ modifyTS (bindSplice "content" $ return processedChildren)+ setContext ctx+ result <- runNodeList $ _itNodes t+ restoreState st+ return result) (lookupTemplate attr (st {_curContext = nextCtx attr st})) where nextCtx name st | B.isPrefixOf "/" name = []
src/Text/Templating/Heist/Splices/Bind.hs view
@@ -9,6 +9,7 @@ ------------------------------------------------------------------------------ import Text.Templating.Heist.Internal+import Text.Templating.Heist.Types -- | Default name for the bind splice. bindTag :: ByteString@@ -32,6 +33,6 @@ return [] where- add node nm = modify $ bindSplice nm (return $ X.getChildren node)+ add node nm = modifyTS $ bindSplice nm (return $ X.getChildren node)
src/Text/Templating/Heist/Splices/Ignore.hs view
@@ -6,7 +6,7 @@ import Data.ByteString.Char8 (ByteString) -------------------------------------------------------------------------------import Text.Templating.Heist.Internal+import Text.Templating.Heist.Types ------------------------------------------------------------------------------
src/Text/Templating/Heist/Splices/Markdown.hs view
@@ -2,12 +2,13 @@ module Text.Templating.Heist.Splices.Markdown where +------------------------------------------------------------------------------ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.Maybe import Control.Concurrent-import Control.Exception (evaluate, throwIO)+import Control.Exception (throwIO) import Control.Monad import Control.Monad.CatchIO import Control.Monad.Trans@@ -17,9 +18,11 @@ import System.Exit import System.IO import System.Process-import Text.Templating.Heist.Internal import Text.XML.Expat.Tree hiding (Node) +------------------------------------------------------------------------------+import Text.Templating.Heist.Constants+import Text.Templating.Heist.Types data PandocMissingException = PandocMissingException deriving (Typeable)
src/Text/Templating/Heist/Splices/Static.hs view
@@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ import Text.Templating.Heist.Internal+import Text.Templating.Heist.Types ------------------------------------------------------------------------------
+ src/Text/Templating/Heist/Types.hs view
@@ -0,0 +1,346 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{-|++This module contains the core Heist data types. TemplateMonad intentionally+does not expose any of it's functionality via MonadState or MonadReader+functions. We define passthrough instances for the most common types of+monads. These instances allow the user to use TemplateMonad in a monad stack+without needing calls to `lift`.++Edward Kmett wrote most of the TemplateMonad code and associated instances,+liberating us from the unused writer portion of RWST.++-}++module Text.Templating.Heist.Types where++------------------------------------------------------------------------------+import Control.Applicative+import Control.Monad.Cont+import Control.Monad.Error+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Trans+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as B+import qualified Data.Map as Map+import Data.Map (Map)+import Data.Monoid+import Data.Typeable+import Prelude hiding (catch)+import qualified Text.XML.Expat.Tree as X+++------------------------------------------------------------------------------+-- | Heist templates are XML documents. The hexpat library is polymorphic over+-- the type of strings, so here we define a 'Node' alias to fix the string+-- types of the tag names and tag bodies to 'ByteString'.+type Node = X.Node ByteString ByteString+++------------------------------------------------------------------------------+-- | 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 fragments of a document that may not have a single root.+type Template = [Node]+++------------------------------------------------------------------------------+-- | An 'InternalTemplate' carries a doctype with it that we get from the+-- template at load time. The tricks that we're playing so templates don't+-- have to have a single root node screw up doctypes, so we have to handle+-- them manually.+data InternalTemplate = InternalTemplate {+ _itDoctype :: Maybe ByteString,+ _itNodes :: [Node]+} deriving (Eq, Show)+++------------------------------------------------------------------------------+-- | Reversed list of directories. This holds the path to the template+-- currently being processed.+type TPath = [ByteString]+++------------------------------------------------------------------------------+-- | All templates are stored in a map.+type TemplateMap = Map TPath InternalTemplate+++------------------------------------------------------------------------------+-- | A Splice is a TemplateMonad computation that returns a 'Template'.+type Splice m = TemplateMonad m Template+++------------------------------------------------------------------------------+-- | SpliceMap associates a name and a Splice.+type SpliceMap m = Map ByteString (Splice m)+++------------------------------------------------------------------------------+-- | Holds all the state information needed for template processing. You will+-- build a @TemplateState@ using any of Heist's @TemplateState m ->+-- TemplateState m@ \"filter\" functions. Then you use the resulting+-- @TemplateState@ in calls to @renderTemplate@.+data TemplateState m = TemplateState {+ -- | A mapping of splice names to splice actions+ _spliceMap :: SpliceMap m+ -- | A mapping of template names to templates+ , _templateMap :: TemplateMap+ -- | A flag to control splice recursion+ , _recurse :: Bool+ -- | The path to the template currently being processed.+ , _curContext :: TPath+ -- | A counter keeping track of the current recursion depth to prevent+ -- infinite loops.+ , _recursionDepth :: Int+ -- | A hook run on all templates at load time.+ , _onLoadHook :: Template -> IO Template+ -- | A hook run on all templates just before they are rendered.+ , _preRunHook :: Template -> m Template+ -- | A hook run on all templates just after they are rendered.+ , _postRunHook :: Template -> m Template+ -- | The doctypes encountered during template processing.+ , _doctypes :: [ByteString]+}+++------------------------------------------------------------------------------+instance (Monad m) => Monoid (TemplateState m) where+ mempty = TemplateState Map.empty Map.empty True [] 0+ return return return []++ (TemplateState s1 t1 r1 _ d1 o1 b1 a1 dt1) `mappend`+ (TemplateState s2 t2 r2 c2 d2 o2 b2 a2 dt2) =+ TemplateState s t r c2 d (o1 >=> o2) (b1 >=> b2) (a1 >=> a2)+ (dt1 `mappend` dt2)+ where+ s = s1 `mappend` s2+ t = t1 `mappend` t2+ r = r1 && r2+ d = max d1 d2+++------------------------------------------------------------------------------+instance Eq (TemplateState m) where+ a == b = (_recurse a == _recurse b) &&+ (_templateMap a == _templateMap b) &&+ (_curContext a == _curContext b)+++------------------------------------------------------------------------------+-- | TemplateMonad is a combination of the reader and state monads. The+-- reader environment is the contents of the node being spliced. The state is+-- the TemplateState data structure.+newtype TemplateMonad m a = TemplateMonad {+ runTemplateMonad :: Node+ -> TemplateState m+ -> m (a, TemplateState m)+}+++------------------------------------------------------------------------------+-- | Helper function for the functor instance+evalTemplateMonad :: Monad m+ => TemplateMonad m a+ -> Node+ -> TemplateState m+ -> m a+evalTemplateMonad m r s = do+ (a, _) <- runTemplateMonad m r s+ return a+ +------------------------------------------------------------------------------+-- | Helper function for the functor instance+first :: (a -> b) -> (a, c) -> (b, c)+first f (a,b) = (f a, b)+++------------------------------------------------------------------------------+-- | Functor instance+instance Functor m => Functor (TemplateMonad m) where+ fmap f (TemplateMonad m) = TemplateMonad $ \r s -> first f <$> m r s+++------------------------------------------------------------------------------+-- | Applicative instance+instance (Monad m, Functor m) => Applicative (TemplateMonad m) where+ pure = return+ (<*>) = ap+++------------------------------------------------------------------------------+-- | Monad instance+instance Monad m => Monad (TemplateMonad m) where+ return a = TemplateMonad (\_ s -> return (a, s))+ TemplateMonad m >>= k = TemplateMonad $ \r s -> do+ (a, s') <- m r s+ runTemplateMonad (k a) r s'+++------------------------------------------------------------------------------+-- | MonadIO instance+instance MonadIO m => MonadIO (TemplateMonad m) where+ liftIO = lift . liftIO+++------------------------------------------------------------------------------+-- | MonadTrans instance+instance MonadTrans TemplateMonad where+ lift m = TemplateMonad $ \_ s -> do+ a <- m+ return (a, s)+++------------------------------------------------------------------------------+-- | MonadFix passthrough instance+instance MonadFix m => MonadFix (TemplateMonad m) where+ mfix f = TemplateMonad $ \r s ->+ mfix $ \ (a, _) -> runTemplateMonad (f a) r s+++------------------------------------------------------------------------------+-- | Alternative passthrough instance+instance (Functor m, MonadPlus m) => Alternative (TemplateMonad m) where+ empty = mzero+ (<|>) = mplus+++------------------------------------------------------------------------------+-- | MonadPlus passthrough instance+instance MonadPlus m => MonadPlus (TemplateMonad m) where+ mzero = lift mzero+ m `mplus` n = TemplateMonad $ \r s ->+ runTemplateMonad m r s `mplus` runTemplateMonad n r s+++------------------------------------------------------------------------------+-- | MonadState passthrough instance+instance MonadState s m => MonadState s (TemplateMonad m) where+ get = lift get+ put = lift . put+++------------------------------------------------------------------------------+-- | MonadReader passthrough instance+instance MonadReader r m => MonadReader r (TemplateMonad m) where+ ask = TemplateMonad $ \_ s -> do+ r <- ask+ return (r,s)+ local f (TemplateMonad m) =+ TemplateMonad $ \r s -> local f (m r s)+++------------------------------------------------------------------------------+-- | Helper for MonadError instance.+liftCatch :: (m (a,TemplateState m)+ -> (e -> m (a,TemplateState m))+ -> m (a,TemplateState m))+ -> TemplateMonad m a+ -> (e -> TemplateMonad m a)+ -> TemplateMonad m a+liftCatch ce m h =+ TemplateMonad $ \r s ->+ (runTemplateMonad m r s `ce`+ (\e -> runTemplateMonad (h e) r s))+++------------------------------------------------------------------------------+-- | MonadError passthrough instance+instance (MonadError e m) => MonadError e (TemplateMonad m) where+ throwError = lift . throwError+ catchError = liftCatch catchError+++------------------------------------------------------------------------------+-- | Helper for MonadCont instance.+liftCallCC :: ((((a,TemplateState m) -> m (b, TemplateState m))+ -> m (a, TemplateState m))+ -> m (a, TemplateState m))+ -> ((a -> TemplateMonad m b) -> TemplateMonad m a)+ -> TemplateMonad m a+liftCallCC ccc f = TemplateMonad $ \r s ->+ ccc $ \c ->+ runTemplateMonad (f (\a -> TemplateMonad $ \_ _ -> c (a, s))) r s+++------------------------------------------------------------------------------+-- | MonadCont passthrough instance+instance (MonadCont m) => MonadCont (TemplateMonad m) where+ callCC = liftCallCC callCC+++------------------------------------------------------------------------------+-- | The Typeable instance is here so Heist can be dynamically executed with+-- Hint.+instance (Typeable1 m, Typeable a) => Typeable (TemplateMonad m a) where+ typeOf _ = mkTyConApp tCon [mRep, aRep]+ where+ tCon = mkTyCon "TemplateMonad"+ maRep = typeOf (undefined :: m a)+ (mCon, [aRep]) = splitTyConApp maRep+ mRep = mkTyConApp mCon []+++------------------------------------------------------------------------------+-- 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 >>=+-- getChildren@ returns a list containing one 'Text' node containing part of+-- Hamlet's speech. @getParamNode >>= getAttribute \"author\"@ would return+-- @Just "Shakespeare"@.+getParamNode :: Monad m => TemplateMonad m Node+getParamNode = TemplateMonad $ \r s -> return (r,s)+++------------------------------------------------------------------------------+-- | +localParamNode :: Monad m+ => (Node -> Node)+ -> TemplateMonad m a+ -> TemplateMonad m a+localParamNode f m = TemplateMonad $ \r s -> runTemplateMonad m (f r) s+++------------------------------------------------------------------------------+-- | +getsTS :: Monad m => (TemplateState m -> r) -> TemplateMonad m r+getsTS f = TemplateMonad $ \_ s -> return (f s, s)+++------------------------------------------------------------------------------+-- | +getTS :: Monad m => TemplateMonad m (TemplateState m)+getTS = TemplateMonad $ \_ s -> return (s, s)+++------------------------------------------------------------------------------+-- | +putTS :: Monad m => TemplateState m -> TemplateMonad m ()+putTS s = TemplateMonad $ \_ _ -> return ((), s)+++------------------------------------------------------------------------------+-- | +modifyTS :: Monad m+ => (TemplateState m -> TemplateState m)+ -> TemplateMonad m ()+modifyTS f = TemplateMonad $ \_ s -> return ((), f s)++
test/heist-testsuite.cabal view
@@ -9,6 +9,7 @@ build-depends: QuickCheck >= 2,+ attoparsec >= 0.8.0.2 && < 0.9, base >= 4 && < 5, bytestring, containers,
test/suite/Text/Templating/Heist/Tests.hs view
@@ -4,26 +4,28 @@ , quickRender ) where -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 Control.Monad.State- import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as Map import Data.Maybe import Data.Monoid- 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 Text.Templating.Heist import Text.Templating.Heist.Internal+import Text.Templating.Heist.Types+import Text.Templating.Heist.Splices.Apply import Text.XML.Expat.Cursor import Text.XML.Expat.Format import qualified Text.XML.Expat.Tree as X@@ -37,8 +39,18 @@ , testCase "loadTest" loadTest , testCase "fsLoadTest" fsLoadTest , testCase "renderNoNameTest" renderNoNameTest+ , testCase "doctypeTest" doctypeTest+ , testCase "attributeSubstitution" attrSubst+ , testCase "applyTest" applyTest ] +applyTest :: H.Assertion+applyTest = do+ let es = emptyTemplateState :: TemplateState IO+ res <- evalTemplateMonad applyImpl+ (X.Element "apply" [("template", "nonexistant")] []) es+ H.assertEqual "apply nothing" res []+ monoidTest :: IO () monoidTest = do H.assertBool "left monoid identity" $ mempty `mappend` es == es@@ -47,9 +59,9 @@ addTest :: IO () addTest = do- H.assertBool "lookup test" $ Just [] == (fmap fst $ lookupTemplate "aoeu" ts)+ H.assertBool "lookup test" $ Just [] == (fmap (_itNodes . fst) $ lookupTemplate "aoeu" ts) H.assertBool "splice touched" $ Map.size (_spliceMap ts) == 0- where ts = addTemplate "aoeu" [] (mempty::TemplateState IO)+ where ts = addTemplate "aoeu" (InternalTemplate Nothing []) (mempty::TemplateState IO) isLeft :: Either a b -> Bool isLeft (Left _) = True@@ -64,7 +76,7 @@ ets <- loadT "templates" either (error "Error loading templates") (\ts -> do let tm = _templateMap ts- H.assertBool "loadTest size" $ Map.size tm == 12+ H.assertBool "loadTest size" $ Map.size tm == 15 ) ets renderNoNameTest :: H.Assertion@@ -93,6 +105,30 @@ f isJust "bar/a" f isJust "/bar/a" +doctypeTest :: H.Assertion+doctypeTest = do+ ets <- loadT "templates"+ let ts = either (error "Error loading templates") id ets+ index <- renderTemplate ts "index"+ H.assertBool "doctype test index" $ hasDoctype $ fromJust index+ ioc <- renderTemplate ts "ioc"+ H.assertBool "doctype test ioc" $ hasDoctype $ fromJust ioc++attrSubst :: H.Assertion+attrSubst = do+ ets <- loadT "templates"+ let ts = either (error "Error loading templates") id ets+ check (setTs "meaning_of_everything" ts) "pre_meaning_of_everything_post"+ check ts "pre__post"+ where+ setTs val = bindSplice "foo" (return [X.Text val])+ check ts str = do+ res <- renderTemplate ts "attrs"+ H.assertBool ("attr subst "++(show str)) $+ not $ B.null $ snd $ B.breakSubstring str $ fromJust res+ H.assertBool ("attr subst foo") $+ not $ B.null $ snd $ B.breakSubstring "$(foo)" $ fromJust res+ -- dotdotTest :: H.Assertion -- dotdotTest = do -- ets <- loadT "templates"@@ -201,7 +237,8 @@ ,L.unpack $ L.concat $ map formatNode $ buildResult b ,"Splice result:" ,L.unpack $ L.concat $ map formatNode $ unsafePerformIO $- runRawTemplate emptyTemplateState $ buildBindTemplate b+ evalTemplateMonad (runNodeList $ buildBindTemplate b)+ (X.Text "") emptyTemplateState ,"Template:" ,L.unpack $ L.concat $ map formatNode $ buildBindTemplate b ]@@ -243,7 +280,10 @@ prop_simpleBindTest bind = do let template = buildBindTemplate bind result = buildResult bind- spliceResult <- run $ runRawTemplate emptyTemplateState template+ spliceResult <- run $ evalTemplateMonad (runNodeList template)+ (X.Text "")+ emptyTemplateState+ assert $ result == spliceResult {-@@ -277,8 +317,12 @@ calcResult :: (MonadIO m) => Apply -> m [Node] calcResult apply@(Apply name _ callee _ _) =- runRawTemplate ts $ buildApplyCaller apply- where ts = setTemplates (Map.singleton [unName name] callee) emptyTemplateState+ evalTemplateMonad (runNodeList $ buildApplyCaller apply)+ (X.Text "") ts+ + where ts = setTemplates (Map.singleton [unName name]+ (InternalTemplate Nothing callee))+ emptyTemplateState prop_simpleApplyTest :: Apply -> PropertyM IO () prop_simpleApplyTest apply = do@@ -287,15 +331,18 @@ assert $ correct == result +loadTS :: FilePath -> IO (TemplateState IO)+loadTS baseDir = do+ etm <- loadTemplates baseDir emptyTemplateState+ return $ either error id etm+ ------------------------------------------------------------------------------ -- | Reloads the templates from disk and renders the specified -- template. (Old convenience code.) quickRender :: FilePath -> ByteString -> IO (Maybe ByteString) quickRender baseDir name = do- etm <- loadTemplates baseDir emptyTemplateState- let ts = either (const emptyTemplateState) id etm- ns <- runTemplate ts name- return $ (Just . formatList') =<< ns+ ts <- loadTS baseDir+ renderTemplate ts name {-@@ -321,7 +368,7 @@ r name etm = do let ts = either (error "Danger Will Robinson!") id etm- ns <- runTemplate ts name+ ns <- runNodeList ts name return $ (Just . formatList') =<< ns
test/templates/index.tpl view
@@ -1,1 +1,8 @@-<root>/index</root>+<!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/noroot.tpl view
@@ -1,1 +1,3 @@+<apply> noroot+</apply>