Trim instructions. TrimRd chunk might need TrimL. Trim tests.

src/Hakyll/Web/Template.hs

@@ -115,6 +115,29 @@
 -- That is, calling @$partial$@ is equivalent to just copying and pasting
 -- template code.
 --
+-- In the examples above you can see that outputs contain a lot of leftover
+-- whitespace that you may wish to remove. Using @'$-'@ or @'-$'@ instead of
+-- @'$'@ in a macro strips all whitespace to the left or right of that clause
+-- respectively. Given the context
+--
+-- > listField "counts" (field "count" (return . itemBody))
+-- >    (sequence [makeItem "3", makeItem "2", makeItem "1"])
+--
+-- and a template
+--
+-- > <p>
+-- >     $for(counts)-$
+-- >       $count$
+-- >       $-sep-$...
+-- >     $-endfor$
+-- > </p>
+--
+-- the resulting page would look like
+--
+-- > <p>
+-- >     3...2...1
+-- > </p>
+--
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 module Hakyll.Web.Template
@@ -209,10 +232,17 @@ applyTemplate' tes context x = go tes
 
     go = fmap concat . mapM applyElem
 
+    trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " ++
+        "fully trimmed."
+
     ---------------------------------------------------------------------------
 
     applyElem :: TemplateElement -> Compiler String
 
+    applyElem TrimL = trimError
+
+    applyElem TrimR = trimError
+
     applyElem (Chunk c) = return c
 
     applyElem (Expr e) = applyExpr e >>= getString e

src/Hakyll/Web/Template/Trim.hs

@@ -1,5 +1,5 @@
 --------------------------------------------------------------------------------
--- | Module for trimming whitespace.
+-- | Module for trimming whitespace
 module Hakyll.Web.Template.Trim
     ( trim
     ) where
@@ -20,15 +20,22 @@ trim = cleanse . canonicalize
 
 
 --------------------------------------------------------------------------------
+-- | Apply the Trim nodes to the Chunks.
 cleanse :: [TemplateElement] -> [TemplateElement]
 cleanse = recurse cleanse . process
     where process [] = []
-          process (TrimR:Chunk str:ts) = Chunk (lstrip str):process ts
-          process (Chunk str:TrimL:ts) = Chunk (rstrip str):process ts
-          process (t:ts) = t:process ts
+          process (TrimR:Chunk str:ts) = let str' = dropWhile isSpace str
+                                         in if null str'
+                                                then process ts
+                                                -- Might need to TrimL.
+                                                else process $ Chunk str':ts
 
-          lstrip = dropWhile isSpace
-          rstrip = dropWhileEnd isSpace
+          process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str
+                                         in if null str'
+                                                then process ts
+                                                else Chunk str':process ts
+
+          process (t:ts) = t:process ts
 
 --------------------------------------------------------------------------------
 -- | Enforce the invariant that:
@@ -75,6 +82,7 @@ dedupe = recurse dedupe . process
 
 
 --------------------------------------------------------------------------------
+-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.
 recurse :: ([TemplateElement] -> [TemplateElement])
         -> [TemplateElement]
         -> [TemplateElement]

tests/Hakyll/Web/Template/Tests.hs

@@ -13,6 +13,7 @@ import           Test.HUnit                     (Assertion, (@=?), (@?=))
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
+import           Hakyll.Core.Identifier
 import           Hakyll.Core.Item
 import           Hakyll.Core.Provider
 import           Hakyll.Web.Pandoc
@@ -26,7 +27,8 @@ import           TestSuite.Util
 --------------------------------------------------------------------------------
 tests :: Test
 tests = testGroup "Hakyll.Core.Template.Tests" $ concat
-    [ [ testCase "case01"                case01
+    [ [ testCase "case01" $ test ("template.html.out", "template.html", "example.md")
+      , testCase "case02" $ test ("strip.html.out", "strip.html", "example.md")
       , testCase "applyJoinTemplateList" testApplyJoinTemplateList
       ]
 
@@ -78,14 +80,14 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
 
 
 --------------------------------------------------------------------------------
-case01 :: Assertion
-case01 = do
+test :: (Identifier, Identifier, Identifier) -> Assertion
+test (outf, tplf, itemf) = do
     store    <- newTestStore
     provider <- newTestProvider store
 
-    out  <- resourceString provider "template.html.out"
-    tpl  <- testCompilerDone store provider "template.html" templateBodyCompiler
-    item <- testCompilerDone store provider "example.md" $
+    out  <- resourceString provider outf
+    tpl  <- testCompilerDone store provider tplf templateBodyCompiler
+    item <- testCompilerDone store provider itemf $
         pandocCompiler >>= applyTemplate (itemBody tpl) testContext
 
     out @=? itemBody item

tests/data/strip.html

@@ -0,0 +1,34 @@
+<div>
+    I'm so rich I have $$3.
+
+    $rev("foo")$
+    $-rev(rev("foo"))$
+
+    $if(body)-$
+    I have body
+    $else-$
+    or no
+    $-endif-$
+
+    $if(unbound)$
+    should not be printed
+    $endif$
+
+    $-if(body)-$
+    should be printed
+    $-endif$
+
+    <ul>
+    $for(authors)-$
+        <li>$name$</li>
+    $endfor-$
+    </ul>
+
+    $for(authors)-$
+        $name-$
+        $sep$,
+    $-endfor$
+
+    $body$
+</div>
+

tests/data/strip.html.out

@@ -0,0 +1,18 @@
+<div>
+    I'm so rich I have $3.
+
+    ooffoo
+
+    I have body
+    should be printed
+
+    <ul>
+    <li>Jan</li>
+    <li>Piet</li>
+    </ul>
+
+    Jan,Piet
+
+    <p>This is an example.</p>
+</div>
+