summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--hakyll.cabal1
-rw-r--r--src/Hakyll/Core/Util/Parser.hs11
-rw-r--r--src/Hakyll/Web/Feed.hs14
-rw-r--r--src/Hakyll/Web/Template.hs96
-rw-r--r--src/Hakyll/Web/Template/Internal.hs208
-rw-r--r--src/Hakyll/Web/Template/Trim.hs95
-rw-r--r--tests/Hakyll/Web/Template/Tests.hs68
-rw-r--r--tests/data/strip.html34
-rw-r--r--tests/data/strip.html.out18
9 files changed, 431 insertions, 114 deletions
diff --git a/hakyll.cabal b/hakyll.cabal
index 94727f4..85b8428 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -117,6 +117,7 @@ Library
Hakyll.Web.Paginate
Hakyll.Web.Template
Hakyll.Web.Template.Internal
+ Hakyll.Web.Template.Trim
Hakyll.Web.Template.Context
Hakyll.Web.Template.List
diff --git a/src/Hakyll/Core/Util/Parser.hs b/src/Hakyll/Core/Util/Parser.hs
index e958b76..c4b2f8d 100644
--- a/src/Hakyll/Core/Util/Parser.hs
+++ b/src/Hakyll/Core/Util/Parser.hs
@@ -8,7 +8,7 @@ module Hakyll.Core.Util.Parser
--------------------------------------------------------------------------------
import Control.Applicative ((<|>))
-import Control.Monad (mzero)
+import Control.Monad (guard, mzero, void)
import qualified Text.Parsec as P
import Text.Parsec.String (Parser)
@@ -16,7 +16,14 @@ import Text.Parsec.String (Parser)
--------------------------------------------------------------------------------
metadataKey :: Parser String
metadataKey = do
- i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf "_-.")
+ -- Ensure trailing '-' binds to '$' if present.
+ let hyphon = P.try $ do
+ void $ P.char '-'
+ x <- P.lookAhead P.anyChar
+ guard $ x /= '$'
+ pure '-'
+
+ i <- (:) <$> P.letter <*> P.many (P.alphaNum <|> P.oneOf "_." <|> hyphon)
if i `elem` reservedKeys then mzero else return i
diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs
index 16b6dc0..f40fa8a 100644
--- a/src/Hakyll/Web/Feed.hs
+++ b/src/Hakyll/Web/Feed.hs
@@ -24,16 +24,11 @@ module Hakyll.Web.Feed
--------------------------------------------------------------------------------
-import Control.Monad ((<=<))
-
-
---------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Item
import Hakyll.Web.Template
import Hakyll.Web.Template.Context
-import Hakyll.Web.Template.Internal
import Hakyll.Web.Template.List
@@ -66,17 +61,16 @@ renderFeed :: FilePath -- ^ Feed template
-> [Item String] -- ^ Input items
-> Compiler (Item String) -- ^ Resulting item
renderFeed feedPath itemPath config itemContext items = do
- feedTpl <- compilerUnsafeIO $ loadTemplate feedPath
- itemTpl <- compilerUnsafeIO $ loadTemplate itemPath
+ feedTpl <- loadTemplate feedPath
+ itemTpl <- loadTemplate itemPath
body <- makeItem =<< applyTemplateList itemTpl itemContext' items
applyTemplate feedTpl feedContext body
where
-- Auxiliary: load a template from a datafile
loadTemplate path = do
- file <- getDataFileName path
- templ <- readFile file
- return $ readTemplateFile file templ
+ file <- compilerUnsafeIO $ getDataFileName path
+ unsafeReadTemplateFile file
itemContext' = mconcat
[ itemContext
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index a662906..4a8d94c 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -115,7 +115,31 @@
-- That is, calling @$partial$@ is equivalent to just copying and pasting
-- template code.
--
-{-# LANGUAGE ScopedTypeVariables #-}
+-- 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
( Template
, templateBodyCompiler
@@ -124,13 +148,16 @@ module Hakyll.Web.Template
, loadAndApplyTemplate
, applyAsTemplate
, readTemplate
+ , unsafeReadTemplateFile
) where
--------------------------------------------------------------------------------
-import Control.Monad (liftM)
import Control.Monad.Except (MonadError (..))
+import Data.Binary (Binary)
import Data.List (intercalate)
+import Data.Typeable (Typeable)
+import GHC.Exts (IsString (..))
import Prelude hiding (id)
@@ -138,17 +165,47 @@ import Prelude hiding (id)
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
import Hakyll.Core.Item
+import Hakyll.Core.Writable
import Hakyll.Web.Template.Context
import Hakyll.Web.Template.Internal
+import Hakyll.Web.Template.Trim
+
+
+--------------------------------------------------------------------------------
+-- | Datatype used for template substitutions.
+newtype Template = Template
+ { unTemplate :: [TemplateElement]
+ } deriving (Show, Eq, Binary, Typeable)
--------------------------------------------------------------------------------
+instance Writable Template where
+ -- Writing a template is impossible
+ write _ _ = return ()
+
+
+--------------------------------------------------------------------------------
+instance IsString Template where
+ fromString = readTemplate
+
+
+--------------------------------------------------------------------------------
+-- | Wrap the constructor to ensure trim is called.
+template :: [TemplateElement] -> Template
+template = Template . trim
+
+
+--------------------------------------------------------------------------------
+readTemplate :: String -> Template
+readTemplate = Template . trim . readTemplateElems
+
+--------------------------------------------------------------------------------
-- | Read a template, without metadata header
templateBodyCompiler :: Compiler (Item Template)
templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
item <- getResourceBody
file <- getResourceFilePath
- return $ fmap (readTemplateFile file) item
+ return $ fmap (template . readTemplateElemsFile file) item
--------------------------------------------------------------------------------
-- | Read complete file contents as a template
@@ -156,7 +213,7 @@ templateCompiler :: Compiler (Item Template)
templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
item <- getResourceString
file <- getResourceFilePath
- return $ fmap (readTemplateFile file) item
+ return $ fmap (template . readTemplateElemsFile file) item
--------------------------------------------------------------------------------
@@ -165,28 +222,35 @@ applyTemplate :: Template -- ^ Template
-> Item a -- ^ Page
-> Compiler (Item String) -- ^ Resulting item
applyTemplate tpl context item = do
- body <- applyTemplate' tpl context item
+ body <- applyTemplate' (unTemplate tpl) context item
return $ itemSetBody body item
--------------------------------------------------------------------------------
applyTemplate'
:: forall a.
- Template -- ^ Template
- -> Context a -- ^ Context
- -> Item a -- ^ Page
- -> Compiler String -- ^ Resulting item
-applyTemplate' tpl context x = go tpl
+ [TemplateElement] -- ^ Unwrapped Template
+ -> Context a -- ^ Context
+ -> Item a -- ^ Page
+ -> Compiler String -- ^ Resulting item
+applyTemplate' tes context x = go tes
where
context' :: String -> [String] -> Item a -> Compiler ContextField
context' = unContext (context `mappend` missingField)
- go = liftM concat . mapM applyElem . unTemplate
+ 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
@@ -261,6 +325,14 @@ applyAsTemplate :: Context String -- ^ Context
-> Item String -- ^ Item and template
-> Compiler (Item String) -- ^ Resulting item
applyAsTemplate context item =
- let tpl = readTemplateFile file (itemBody item)
+ let tpl = template $ readTemplateElemsFile file (itemBody item)
file = toFilePath $ itemIdentifier item
in applyTemplate tpl context item
+
+
+--------------------------------------------------------------------------------
+unsafeReadTemplateFile :: FilePath -> Compiler Template
+unsafeReadTemplateFile file = do
+ tpl <- unsafeCompiler $ readFile file
+ pure $ template $ readTemplateElemsFile file tpl
+
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index a63c40d..15266a0 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -1,14 +1,13 @@
--------------------------------------------------------------------------------
-- | Module containing the template data structure
-{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Web.Template.Internal
- ( Template (..)
- , TemplateKey (..)
+ ( TemplateKey (..)
, TemplateExpr (..)
, TemplateElement (..)
- , readTemplate
- , readTemplateFile
+ , templateElems
+ , readTemplateElems
+ , readTemplateElemsFile
) where
@@ -16,8 +15,9 @@ module Hakyll.Web.Template.Internal
import Control.Applicative ((<|>))
import Control.Monad (void)
import Data.Binary (Binary, get, getWord8, put, putWord8)
+import Data.List (intercalate)
+import Data.Maybe (isJust)
import Data.Typeable (Typeable)
-import Data.List (intercalate)
import GHC.Exts (IsString (..))
import qualified Text.Parsec as P
import qualified Text.Parsec.String as P
@@ -25,25 +25,6 @@ import qualified Text.Parsec.String as P
--------------------------------------------------------------------------------
import Hakyll.Core.Util.Parser
-import Hakyll.Core.Writable
-
-
---------------------------------------------------------------------------------
--- | Datatype used for template substitutions.
-newtype Template = Template
- { unTemplate :: [TemplateElement]
- } deriving (Show, Eq, Binary, Typeable)
-
-
---------------------------------------------------------------------------------
-instance Writable Template where
- -- Writing a template is impossible
- write _ _ = return ()
-
-
---------------------------------------------------------------------------------
-instance IsString Template where
- fromString = readTemplate
--------------------------------------------------------------------------------
@@ -62,9 +43,14 @@ data TemplateElement
= Chunk String
| Expr TemplateExpr
| Escaped
- | If TemplateExpr Template (Maybe Template) -- expr, then, else
- | For TemplateExpr Template (Maybe Template) -- expr, body, separator
- | Partial TemplateExpr -- filename
+ -- expr, then, else
+ | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])
+ -- expr, body, separator
+ | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])
+ -- filename
+ | Partial TemplateExpr
+ | TrimL
+ | TrimR
deriving (Show, Eq, Typeable)
@@ -72,10 +58,12 @@ data TemplateElement
instance Binary TemplateElement where
put (Chunk string) = putWord8 0 >> put string
put (Expr e) = putWord8 1 >> put e
- put (Escaped) = putWord8 2
- put (If e t f ) = putWord8 3 >> put e >> put t >> put f
+ put Escaped = putWord8 2
+ put (If e t f) = putWord8 3 >> put e >> put t >> put f
put (For e b s) = putWord8 4 >> put e >> put b >> put s
put (Partial e) = putWord8 5 >> put e
+ put TrimL = putWord8 6
+ put TrimR = putWord8 7
get = getWord8 >>= \tag -> case tag of
0 -> Chunk <$> get
@@ -84,8 +72,9 @@ instance Binary TemplateElement where
3 -> If <$> get <*> get <*> get
4 -> For <$> get <*> get <*> get
5 -> Partial <$> get
- _ -> error $
- "Hakyll.Web.Template.Internal: Error reading cached template"
+ 6 -> pure TrimL
+ 7 -> pure TrimR
+ _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
--------------------------------------------------------------------------------
@@ -115,48 +104,45 @@ instance Binary TemplateExpr where
0 -> Ident <$> get
1 -> Call <$> get <*> get
2 -> StringLiteral <$> get
- _ -> error $
- "Hakyll.Web.Tamplte.Internal: Error reading cached template"
+ _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
--------------------------------------------------------------------------------
-readTemplate :: String -> Template
-readTemplate = readTemplateFile "{literal}"
+readTemplateElems :: String -> [TemplateElement]
+readTemplateElems = readTemplateElemsFile "{literal}"
--------------------------------------------------------------------------------
-readTemplateFile :: FilePath -> String -> Template
-readTemplateFile file input = case P.parse topLevelTemplate file input of
+readTemplateElemsFile :: FilePath -> String -> [TemplateElement]
+readTemplateElemsFile file input = case P.parse templateElems file input of
Left err -> error $ "Cannot parse template: " ++ show err
Right t -> t
--------------------------------------------------------------------------------
-topLevelTemplate :: P.Parser Template
-topLevelTemplate = Template <$>
- P.manyTill templateElement P.eof
-
---------------------------------------------------------------------------------
-template :: P.Parser Template
-template = Template <$> P.many templateElement
-
---------------------------------------------------------------------------------
-templateElement :: P.Parser TemplateElement
-templateElement = chunk <|> escaped <|> conditional <|> for <|> partial <|> expr
+templateElems :: P.Parser [TemplateElement]
+templateElems = mconcat <$> P.many (P.choice [ lift chunk
+ , lift escaped
+ , conditional
+ , for
+ , partial
+ , expr
+ ])
+ where lift = fmap (:[])
--------------------------------------------------------------------------------
chunk :: P.Parser TemplateElement
-chunk = Chunk <$> (P.many1 $ P.noneOf "$")
+chunk = Chunk <$> P.many1 (P.noneOf "$")
--------------------------------------------------------------------------------
-expr :: P.Parser TemplateElement
+expr :: P.Parser [TemplateElement]
expr = P.try $ do
- void $ P.char '$'
+ trimLExpr <- trimOpen
e <- expr'
- void $ P.char '$'
- return $ Expr e
+ trimRExpr <- trimClose
+ return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]
--------------------------------------------------------------------------------
@@ -166,40 +152,105 @@ expr' = stringLiteral <|> call <|> ident
--------------------------------------------------------------------------------
escaped :: P.Parser TemplateElement
-escaped = Escaped <$ (P.try $ P.string "$$")
+escaped = Escaped <$ P.try (P.string "$$")
--------------------------------------------------------------------------------
-conditional :: P.Parser TemplateElement
+trimOpen :: P.Parser Bool
+trimOpen = do
+ void $ P.char '$'
+ trimLIf <- P.optionMaybe $ P.try (P.char '-')
+ pure $ isJust trimLIf
+
+
+--------------------------------------------------------------------------------
+trimClose :: P.Parser Bool
+trimClose = do
+ trimIfR <- P.optionMaybe $ P.try (P.char '-')
+ void $ P.char '$'
+ pure $ isJust trimIfR
+
+
+--------------------------------------------------------------------------------
+conditional :: P.Parser [TemplateElement]
conditional = P.try $ do
- void $ P.string "$if("
+ -- if
+ trimLIf <- trimOpen
+ void $ P.string "if("
e <- expr'
- void $ P.string ")$"
- thenBranch <- template
- elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template
- void $ P.string "$endif$"
- return $ If e thenBranch elseBranch
+ void $ P.char ')'
+ trimRIf <- trimClose
+ -- then
+ thenBranch <- templateElems
+ -- else
+ elseParse <- opt "else"
+ -- endif
+ trimLEnd <- trimOpen
+ void $ P.string "endif"
+ trimREnd <- trimClose
+
+ -- As else is optional we need to sort out where any Trim_s need to go.
+ let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse
+ where thenNoElse =
+ [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]
+
+ thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)
+ where thenB = [TrimR | trimRIf]
+ ++ thenBranch
+ ++ [TrimL | trimLElse]
+
+ elseB = Just $ [TrimR | trimRElse]
+ ++ elseBranch
+ ++ [TrimL | trimLEnd]
+
+ pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]
--------------------------------------------------------------------------------
-for :: P.Parser TemplateElement
+for :: P.Parser [TemplateElement]
for = P.try $ do
- void $ P.string "$for("
+ -- for
+ trimLFor <- trimOpen
+ void $ P.string "for("
e <- expr'
- void $ P.string ")$"
- body <- template
- sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template
- void $ P.string "$endfor$"
- return $ For e body sep
+ void $ P.char ')'
+ trimRFor <- trimClose
+ -- body
+ bodyBranch <- templateElems
+ -- sep
+ sepParse <- opt "sep"
+ -- endfor
+ trimLEnd <- trimOpen
+ void $ P.string "endfor"
+ trimREnd <- trimClose
+
+ -- As sep is optional we need to sort out where any Trim_s need to go.
+ let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse
+ where forNoSep =
+ [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]
+
+ forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)
+ where forB = [TrimR | trimRFor]
+ ++ bodyBranch
+ ++ [TrimL | trimLSep]
+
+ sepB = Just $ [TrimR | trimRSep]
+ ++ sepBranch
+ ++ [TrimL | trimLEnd]
+
+ pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]
--------------------------------------------------------------------------------
-partial :: P.Parser TemplateElement
+partial :: P.Parser [TemplateElement]
partial = P.try $ do
- void $ P.string "$partial("
+ trimLPart <- trimOpen
+ void $ P.string "partial("
e <- expr'
- void $ P.string ")$"
- return $ Partial e
+ void $ P.char ')'
+ trimRPart <- trimClose
+
+ pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]
--------------------------------------------------------------------------------
@@ -233,3 +284,14 @@ stringLiteral = do
--------------------------------------------------------------------------------
key :: P.Parser TemplateKey
key = TemplateKey <$> metadataKey
+
+
+--------------------------------------------------------------------------------
+opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))
+opt clause = P.optionMaybe $ P.try $ do
+ trimL <- trimOpen
+ void $ P.string clause
+ trimR <- trimClose
+ branch <- templateElems
+ pure (trimL, branch, trimR)
+
diff --git a/src/Hakyll/Web/Template/Trim.hs b/src/Hakyll/Web/Template/Trim.hs
new file mode 100644
index 0000000..bc7e691
--- /dev/null
+++ b/src/Hakyll/Web/Template/Trim.hs
@@ -0,0 +1,95 @@
+--------------------------------------------------------------------------------
+-- | Module for trimming whitespace
+module Hakyll.Web.Template.Trim
+ ( trim
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Data.Char (isSpace)
+import Data.List (dropWhileEnd)
+
+
+--------------------------------------------------------------------------------
+import Hakyll.Web.Template.Internal
+
+
+--------------------------------------------------------------------------------
+trim :: [TemplateElement] -> [TemplateElement]
+trim = cleanse . canonicalize
+
+
+--------------------------------------------------------------------------------
+-- | Apply the Trim nodes to the Chunks.
+cleanse :: [TemplateElement] -> [TemplateElement]
+cleanse = recurse cleanse . process
+ where process [] = []
+ 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
+
+ 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:
+--
+-- * Every 'TrimL' has a 'Chunk' to its left.
+-- * Every 'TrimR' has a 'Chunk' to its right.
+--
+canonicalize :: [TemplateElement] -> [TemplateElement]
+canonicalize = go
+ where go t = let t' = redundant . swap $ dedupe t
+ in if t == t' then t else go t'
+
+
+--------------------------------------------------------------------------------
+-- | Remove the 'TrimR' and 'TrimL's that are no-ops.
+redundant :: [TemplateElement] -> [TemplateElement]
+redundant = recurse redundant . process
+ where -- Remove the leading 'TrimL's.
+ process (TrimL:ts) = process ts
+ -- Remove trailing 'TrimR's.
+ process ts = foldr trailing [] ts
+ where trailing TrimR [] = []
+ trailing x xs = x:xs
+
+
+--------------------------------------------------------------------------------
+-- >>> swap $ [TrimR, TrimL]
+-- [TrimL, TrimR]
+swap :: [TemplateElement] -> [TemplateElement]
+swap = recurse swap . process
+ where process [] = []
+ process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)
+ process (t:ts) = t:process ts
+
+
+--------------------------------------------------------------------------------
+-- | Remove 'TrimR' and 'TrimL' duplication.
+dedupe :: [TemplateElement] -> [TemplateElement]
+dedupe = recurse dedupe . process
+ where process [] = []
+ process (TrimR:TrimR:ts) = process (TrimR:ts)
+ process (TrimL:TrimL:ts) = process (TrimL:ts)
+ process (t:ts) = t:process ts
+
+
+--------------------------------------------------------------------------------
+-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.
+recurse :: ([TemplateElement] -> [TemplateElement])
+ -> [TemplateElement]
+ -> [TemplateElement]
+recurse _ [] = []
+recurse f (x:xs) = process x:recurse f xs
+ where process y = case y of
+ If e tb eb -> If e (f tb) (f <$> eb)
+ For e t s -> For e (f t) (f <$> s)
+ _ -> y
+
diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index a975901..994d9ca 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -6,7 +6,6 @@ module Hakyll.Web.Template.Tests
--------------------------------------------------------------------------------
-import Data.Monoid (mconcat)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (Assertion, (@=?), (@?=))
@@ -14,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
@@ -27,32 +27,67 @@ 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
]
, fromAssertions "readTemplate"
- [ Template [Chunk "Hello ", Expr (Call "guest" [])]
- @=? readTemplate "Hello $guest()$"
- , Template
- [If (Call "a" [StringLiteral "bar"])
- (Template [Chunk "foo"])
- Nothing]
- @=? readTemplate "$if(a(\"bar\"))$foo$endif$"
+ [ [Chunk "Hello ", Expr (Call "guest" [])]
+ @=? readTemplateElems "Hello $guest()$"
+ , [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
+ @=? readTemplateElems "$if(a(\"bar\"))$foo$endif$"
+ -- 'If' trim check.
+ , [ TrimL
+ , If (Ident (TemplateKey "body"))
+ [ TrimR
+ , Chunk "\n"
+ , Expr (Ident (TemplateKey "body"))
+ , Chunk "\n"
+ , TrimL
+ ]
+ (Just [ TrimR
+ , Chunk "\n"
+ , Expr (Ident (TemplateKey "body"))
+ , Chunk "\n"
+ , TrimL
+ ])
+ , TrimR
+ ]
+ @=? readTemplateElems "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
+ -- 'For' trim check.
+ , [ TrimL
+ , For (Ident (TemplateKey "authors"))
+ [TrimR, Chunk "\n body \n", TrimL]
+ Nothing
+ , TrimR
+ ]
+ @=? readTemplateElems "$-for(authors)-$\n body \n$-endfor-$"
+ -- 'Partial' trim check.
+ , [ TrimL
+ , Partial (StringLiteral "path")
+ , TrimR
+ ]
+ @=? readTemplateElems "$-partial(\"path\")-$"
+ -- 'Expr' trim check.
+ , [ TrimL
+ , Expr (Ident (TemplateKey "foo"))
+ , TrimR
+ ]
+ @=? readTemplateElems "$-foo-$"
]
]
--------------------------------------------------------------------------------
-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
@@ -69,7 +104,6 @@ testContext = mconcat
return [n1, n2]
, functionField "rev" $ \args _ -> return $ unwords $ map reverse args
]
- where
--------------------------------------------------------------------------------
@@ -85,4 +119,4 @@ testApplyJoinTemplateList = do
where
i1 = Item "item1" "Hello"
i2 = Item "item2" "World"
- tpl = Template [Chunk "<b>", Expr (Ident "body"), Chunk "</b>"]
+ tpl = readTemplate "<b>$body$</b>"
diff --git a/tests/data/strip.html b/tests/data/strip.html
new file mode 100644
index 0000000..d28571e
--- /dev/null
+++ b/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>
+
diff --git a/tests/data/strip.html.out b/tests/data/strip.html.out
new file mode 100644
index 0000000..9b37e69
--- /dev/null
+++ b/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>
+