diff options
| -rw-r--r-- | src/Hakyll/Web/Template/Internal.hs | 72 | ||||
| -rw-r--r-- | tests/Hakyll/Web/Template/Tests.hs | 13 |
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 |