summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Hakyll/Web/Template/Internal.hs72
-rw-r--r--tests/Hakyll/Web/Template/Tests.hs13
2 files changed, 69 insertions, 16 deletions
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 2f702f9..89bda52 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -15,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
@@ -35,6 +36,12 @@ newtype Template = Template
--------------------------------------------------------------------------------
+instance Monoid Template where
+ mempty = Template []
+ (Template xs) `mappend` (Template ys) = Template (xs `mappend` ys)
+
+
+--------------------------------------------------------------------------------
instance Writable Template where
-- Writing a template is impossible
write _ _ = return ()
@@ -131,13 +138,19 @@ readTemplate input = case P.parse template "" input of
--------------------------------------------------------------------------------
template :: P.Parser Template
-template = Template <$>
- (P.many $ chunk <|> escaped <|> conditional <|> for <|> partial <|> expr)
+template = mconcat <$> P.many (P.choice [ lift chunk
+ , lift escaped
+ , conditional
+ , lift for
+ , lift partial
+ , lift expr
+ ])
+ where lift = fmap (Template . (:[]))
--------------------------------------------------------------------------------
chunk :: P.Parser TemplateElement
-chunk = Chunk <$> (P.many1 $ P.noneOf "$")
+chunk = Chunk <$> P.many1 (P.noneOf "$")
--------------------------------------------------------------------------------
@@ -156,19 +169,56 @@ expr' = stringLiteral <|> call <|> ident
--------------------------------------------------------------------------------
escaped :: P.Parser TemplateElement
-escaped = Escaped <$ (P.try $ P.string "$$")
+escaped = Escaped <$ P.try (P.string "$$")
+
+
+--------------------------------------------------------------------------------
+trimOpen :: P.Parser Bool
+trimOpen = do
+ void $ P.char '$'
+ trimLIf <- P.optionMaybe $ P.try (P.char '-')
+ pure $ isJust trimLIf
--------------------------------------------------------------------------------
-conditional :: P.Parser TemplateElement
+trimClose :: P.Parser Bool
+trimClose = do
+ trimIfR <- P.optionMaybe $ P.try (P.char '-')
+ void $ P.char '$'
+ pure $ isJust trimIfR
+
+
+--------------------------------------------------------------------------------
+conditional :: P.Parser Template
conditional = P.try $ do
- void $ P.string "$if("
+ trimLIf <- trimOpen
+ void $ P.string "if("
e <- expr'
- void $ P.string ")$"
+ void $ P.char ')'
+ trimRIf <- trimClose
+
thenBranch <- template
- elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template
- void $ P.string "$endif$"
- return $ If e thenBranch elseBranch
+
+ elseBranch <- P.optionMaybe $ P.try $ do
+ trimLElse <- trimOpen
+ void $ P.string "else"
+ trimRElse <- trimClose
+ elseBody <- template
+ pure $ mconcat $ concat [ [Template [TrimL] | trimLElse]
+ , [Template [TrimR] | trimRElse]
+ , [elseBody]
+ ]
+
+ trimLEnd <- trimOpen
+ void $ P.string "endif"
+ trimREnd <- trimClose
+
+ pure $ Template $ mconcat [ [TrimL | trimLIf]
+ , [TrimR | trimRIf]
+ , [If e thenBranch elseBranch]
+ , [TrimL | trimLEnd]
+ , [TrimR | trimREnd]
+ ]
--------------------------------------------------------------------------------
diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index 453cd49..c1991a0 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -39,16 +39,20 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
(Template [Chunk "foo"])
Nothing]
@=? readTemplate "$if(a(\"bar\"))$foo$endif$"
- -- 'If' 'Trim_' test.
+ -- 'If' trim check.
, Template
[ TrimL
+ , TrimR
, If (Ident (TemplateKey "body"))
- (Template [ TrimR
+ (Template [ Chunk "\n"
, Expr (Ident (TemplateKey "body"))
+ , Chunk "\n"
])
(Just (Template [ TrimL
, TrimR
+ , Chunk "\n"
, Expr (Ident (TemplateKey "body"))
+ , Chunk "\n"
]))
, TrimL
, TrimR
@@ -65,9 +69,8 @@ case01 = do
provider <- newTestProvider store
out <- resourceString provider "template.html.out"
- tpl <- testCompilerDone store provider "template.html" $
- templateBodyCompiler
- item <- testCompilerDone store provider "example.md" $
+ tpl <- testCompilerDone store provider "template.html" templateBodyCompiler
+ item <- testCompilerDone store provider "example.md" $
pandocCompiler >>= applyTemplate (itemBody tpl) testContext
out @=? itemBody item