From 02dd1cf2360cb2a650cb61c5e6ae2ca573eb5125 Mon Sep 17 00:00:00 2001 From: samgd Date: Fri, 22 Jul 2016 16:39:22 +0200 Subject: Add Trim_ data constructors. Add If test for Trim --- src/Hakyll/Web/Template/Internal.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index 45db2e4..2f702f9 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -64,6 +64,8 @@ data TemplateElement | If TemplateExpr Template (Maybe Template) -- expr, then, else | For TemplateExpr Template (Maybe Template) -- expr, body, separator | Partial TemplateExpr -- filename + | TrimL + | TrimR deriving (Show, Eq, Typeable) @@ -71,10 +73,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 @@ -83,8 +87,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" -------------------------------------------------------------------------------- @@ -114,8 +119,7 @@ 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" -------------------------------------------------------------------------------- -- cgit v1.2.3 From 6c0be2e2d3b8992263573540b3498ea51b10b2e6 Mon Sep 17 00:00:00 2001 From: samgd Date: Sat, 23 Jul 2016 12:19:27 +0200 Subject: If Trim parsing --- src/Hakyll/Web/Template/Internal.hs | 72 +++++++++++++++++++++++++++++++------ tests/Hakyll/Web/Template/Tests.hs | 13 ++++--- 2 files changed, 69 insertions(+), 16 deletions(-) (limited to 'src') 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 @@ -34,6 +35,12 @@ newtype Template = Template } deriving (Show, Eq, Binary, Typeable) +-------------------------------------------------------------------------------- +instance Monoid Template where + mempty = Template [] + (Template xs) `mappend` (Template ys) = Template (xs `mappend` ys) + + -------------------------------------------------------------------------------- instance Writable Template where -- Writing a template is impossible @@ -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 -- cgit v1.2.3 From 6e14d33a101e4ea9559d13d7a562da7ebc72acf2 Mon Sep 17 00:00:00 2001 From: samgd Date: Sat, 23 Jul 2016 12:41:41 +0200 Subject: For trimming --- src/Hakyll/Web/Template/Internal.hs | 24 ++++++++++++++++++------ tests/Hakyll/Web/Template/Tests.hs | 16 +++++++++++++--- 2 files changed, 31 insertions(+), 9 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index 89bda52..983bd16 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -141,7 +141,7 @@ template :: P.Parser Template template = mconcat <$> P.many (P.choice [ lift chunk , lift escaped , conditional - , lift for + , for , lift partial , lift expr ]) @@ -222,15 +222,27 @@ conditional = P.try $ do -------------------------------------------------------------------------------- -for :: P.Parser TemplateElement +for :: P.Parser Template for = P.try $ do - void $ P.string "$for(" + trimLFor <- trimOpen + void $ P.string "for(" e <- expr' - void $ P.string ")$" + void $ P.char ')' + trimRFor <- trimClose + body <- template sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template - void $ P.string "$endfor$" - return $ For e body sep + + trimLEnd <- trimOpen + void $ P.string "endfor" + trimREnd <- trimClose + + pure $ Template $ mconcat [ [TrimL | trimLFor] + , [TrimR | trimRFor] + , [For e body sep] + , [TrimL | trimLEnd] + , [TrimR | trimREnd] + ] -------------------------------------------------------------------------------- diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs index c1991a0..b6a3a1d 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, (@=?), (@?=)) @@ -33,12 +32,12 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat , fromAssertions "readTemplate" [ Template [Chunk "Hello ", Expr (Call "guest" [])] - @=? readTemplate "Hello $guest()$" + @=? readTemplate "Hello $guest()$" , Template [If (Call "a" [StringLiteral "bar"]) (Template [Chunk "foo"]) Nothing] - @=? readTemplate "$if(a(\"bar\"))$foo$endif$" + @=? readTemplate "$if(a(\"bar\"))$foo$endif$" -- 'If' trim check. , Template [ TrimL @@ -58,6 +57,17 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat , TrimR ] @=? readTemplate "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$" + -- 'For' trim check. + , Template + [ TrimL + , TrimR + , For (Ident (TemplateKey "authors")) + (Template [Chunk "\n body \n"]) + Nothing + , TrimL + , TrimR + ] + @=? readTemplate "$-for(authors)-$\n body \n$-endfor-$" ] ] -- cgit v1.2.3 From 430a0a8849191edfa7b53dcf76a0fb72f12ebde7 Mon Sep 17 00:00:00 2001 From: samgd Date: Sat, 23 Jul 2016 12:52:55 +0200 Subject: Partial trimming --- src/Hakyll/Web/Template/Internal.hs | 16 +++++++++++----- tests/Hakyll/Web/Template/Tests.hs | 7 +++++++ 2 files changed, 18 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index 983bd16..6ccad74 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -142,7 +142,7 @@ template = mconcat <$> P.many (P.choice [ lift chunk , lift escaped , conditional , for - , lift partial + , partial , lift expr ]) where lift = fmap (Template . (:[])) @@ -246,12 +246,18 @@ for = P.try $ do -------------------------------------------------------------------------------- -partial :: P.Parser TemplateElement +partial :: P.Parser Template partial = P.try $ do - void $ P.string "$partial(" + trimLPartial <- trimOpen + void $ P.string "partial(" e <- expr' - void $ P.string ")$" - return $ Partial e + void $ P.char ')' + trimRPartial <- trimClose + + pure $ Template $ mconcat [ [TrimL | trimLPartial] + , [Partial e] + , [TrimR | trimRPartial] + ] -------------------------------------------------------------------------------- diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs index b6a3a1d..1ace2d4 100644 --- a/tests/Hakyll/Web/Template/Tests.hs +++ b/tests/Hakyll/Web/Template/Tests.hs @@ -68,6 +68,13 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat , TrimR ] @=? readTemplate "$-for(authors)-$\n body \n$-endfor-$" + -- 'Partial' trim check. + , Template + [ TrimL + , Partial (StringLiteral "path") + , TrimR + ] + @=? readTemplate "$-partial(\"path\")-$" ] ] -- cgit v1.2.3 From 9867094bd27ed170315e7e02b788243d654c6bc1 Mon Sep 17 00:00:00 2001 From: samgd Date: Sat, 23 Jul 2016 14:46:15 +0200 Subject: Expr trimming. '-' binds to '$'. --- src/Hakyll/Core/Util/Parser.hs | 11 +++++++++-- src/Hakyll/Web/Template/Internal.hs | 13 ++++++++----- tests/Hakyll/Web/Template/Tests.hs | 7 +++++++ 3 files changed, 24 insertions(+), 7 deletions(-) (limited to 'src') 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/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index 6ccad74..fce163f 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -143,7 +143,7 @@ template = mconcat <$> P.many (P.choice [ lift chunk , conditional , for , partial - , lift expr + , expr ]) where lift = fmap (Template . (:[])) @@ -154,12 +154,15 @@ chunk = Chunk <$> P.many1 (P.noneOf "$") -------------------------------------------------------------------------------- -expr :: P.Parser TemplateElement +expr :: P.Parser Template expr = P.try $ do - void $ P.char '$' + trimLExpr <- trimOpen e <- expr' - void $ P.char '$' - return $ Expr e + trimRExpr <- trimClose + return $ Template $ mconcat [ [TrimL | trimLExpr] + , [Expr e] + , [TrimR | trimRExpr] + ] -------------------------------------------------------------------------------- diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs index 1ace2d4..a7b31a7 100644 --- a/tests/Hakyll/Web/Template/Tests.hs +++ b/tests/Hakyll/Web/Template/Tests.hs @@ -75,6 +75,13 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat , TrimR ] @=? readTemplate "$-partial(\"path\")-$" + -- 'Expr' trim check. + , Template + [ TrimL + , Expr (Ident (TemplateKey "foo")) + , TrimR + ] + @=? readTemplate "$-foo-$" ] ] -- cgit v1.2.3 From a04f722eb1cd426f5285d7ab32e8670efd542446 Mon Sep 17 00:00:00 2001 From: samgd Date: Sat, 23 Jul 2016 15:50:53 +0200 Subject: Canonicalize file + initial if/for planning --- hakyll.cabal | 1 + src/Hakyll/Web/Template/Canonicalize.hs | 86 +++++++++++++++++++++++++++++++++ 2 files changed, 87 insertions(+) create mode 100644 src/Hakyll/Web/Template/Canonicalize.hs (limited to 'src') diff --git a/hakyll.cabal b/hakyll.cabal index 94727f4..b2d4ce5 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.Canonicalize Hakyll.Web.Template.Context Hakyll.Web.Template.List diff --git a/src/Hakyll/Web/Template/Canonicalize.hs b/src/Hakyll/Web/Template/Canonicalize.hs new file mode 100644 index 0000000..13f9d67 --- /dev/null +++ b/src/Hakyll/Web/Template/Canonicalize.hs @@ -0,0 +1,86 @@ +-------------------------------------------------------------------------------- +-- | TODO +module Hakyll.Web.Template.Canonicalize + ( canonicalize + ) where + + +-------------------------------------------------------------------------------- +import Hakyll.Web.Template.Internal + + +-------------------------------------------------------------------------------- +-- +-- Some initial implementation notes. Note: Not valid syntax etc. +-- +-- +-- Top level ONLY: +-- [TrimL, t, TrimR] = [t] +-- +-- Dedupe: +-- +-- List: +-- +-- [t1, TrimR, TrimR, t2] = [t1, TrimR, t2] +-- +-- [t1, TrimL, TrimL, t2] = [t1, TrimL, t2] +-- +-- If: +-- +-- [t1, TrimR, If ex [TrimR, t] e, t2] = [t1, If ex [TrimR, t] e, t2] +-- +-- [t1, If ex t [e, TrimL], TrimL, t2] = [t1, If ex t [e, TrimL], t2] +-- +-- [t1, If ex [t, TrimL] Nothing, TrimL, t2] = [t1, If ex [t, TrimL] Nothing, t2] +-- +-- For: +-- +-- [t1, TrimR, For e [TrimR, b] sep, t2] = [t1, For e [TrimR, b] sep, t2] +-- +-- [t1, For e b [sep, TrimL], TrimL, t2] = [t1, For e b [sep, TrimL], t2] +-- +-- [t1, For e [b, TrimL] Nothing, TrimL, t2] = [t1, For e [b, TrimL] Nothing, t2] +-- +-- +-- Sink: +-- +-- If: +-- +-- [t1, TrimR, If ex t e, t2] = [t1, If ex [TrimR, t] e, t2] +-- +-- [t1, If ex t e, TrimL, t2] = if isJust e +-- then [t1, If ex t [e, TrimL], t2] +-- else [t1, If ex [t, TrimL] e, t2] +-- +-- For: +-- +-- [t1, TrimR, For e b sep, t2] = [t1, For e [TrimR, b] sep, t2] +-- +-- [t1, For e b sep, TrimL, t2] = if isJust sep +-- then [t1, For e b [sep, TrimL], t2] +-- else [t1, For e [b, TrimL] sep, t2] +-- +-- +-- Shift/Lift: +-- +-- If: +-- +-- If ex [t1, TrimR] (Just e) = If ex t1 [TrimR, e] +-- +-- If ex [t1, TrimR] Nothing = [If ex t1 Nothing, TrimR] +-- +-- If ex t [TrimL, e] = If ex [t, TrimL] e +-- +-- +-- For: +-- +-- For e [t1, TrimR] (Just sep) = For e t1 [TrimR, sep] +-- +-- For e [t1, TrimR] Nothing = For e t1 [TrimR, sep] +-- +-- For e b [TrimL, sep] = For e [b, TrimL] sep +-- +-- +-- +canonicalize :: Template -> Template +canonicalize = undefined -- cgit v1.2.3 From ca7b78ee428a43bb307ecefb65529d5106751192 Mon Sep 17 00:00:00 2001 From: samgd Date: Sun, 24 Jul 2016 15:10:12 +0200 Subject: Working trimming but module loop and formatting req. --- hakyll.cabal | 2 +- src/Hakyll/Web/Template/Canonicalize.hs | 86 --------------- src/Hakyll/Web/Template/Internal.hs | 112 +++++++++++++------- src/Hakyll/Web/Template/Trim.hs | 178 ++++++++++++++++++++++++++++++++ tests/Hakyll/Web/Template/Tests.hs | 16 +-- 5 files changed, 261 insertions(+), 133 deletions(-) delete mode 100644 src/Hakyll/Web/Template/Canonicalize.hs create mode 100644 src/Hakyll/Web/Template/Trim.hs (limited to 'src') diff --git a/hakyll.cabal b/hakyll.cabal index b2d4ce5..85b8428 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -117,7 +117,7 @@ Library Hakyll.Web.Paginate Hakyll.Web.Template Hakyll.Web.Template.Internal - Hakyll.Web.Template.Canonicalize + Hakyll.Web.Template.Trim Hakyll.Web.Template.Context Hakyll.Web.Template.List diff --git a/src/Hakyll/Web/Template/Canonicalize.hs b/src/Hakyll/Web/Template/Canonicalize.hs deleted file mode 100644 index 13f9d67..0000000 --- a/src/Hakyll/Web/Template/Canonicalize.hs +++ /dev/null @@ -1,86 +0,0 @@ --------------------------------------------------------------------------------- --- | TODO -module Hakyll.Web.Template.Canonicalize - ( canonicalize - ) where - - --------------------------------------------------------------------------------- -import Hakyll.Web.Template.Internal - - --------------------------------------------------------------------------------- --- --- Some initial implementation notes. Note: Not valid syntax etc. --- --- --- Top level ONLY: --- [TrimL, t, TrimR] = [t] --- --- Dedupe: --- --- List: --- --- [t1, TrimR, TrimR, t2] = [t1, TrimR, t2] --- --- [t1, TrimL, TrimL, t2] = [t1, TrimL, t2] --- --- If: --- --- [t1, TrimR, If ex [TrimR, t] e, t2] = [t1, If ex [TrimR, t] e, t2] --- --- [t1, If ex t [e, TrimL], TrimL, t2] = [t1, If ex t [e, TrimL], t2] --- --- [t1, If ex [t, TrimL] Nothing, TrimL, t2] = [t1, If ex [t, TrimL] Nothing, t2] --- --- For: --- --- [t1, TrimR, For e [TrimR, b] sep, t2] = [t1, For e [TrimR, b] sep, t2] --- --- [t1, For e b [sep, TrimL], TrimL, t2] = [t1, For e b [sep, TrimL], t2] --- --- [t1, For e [b, TrimL] Nothing, TrimL, t2] = [t1, For e [b, TrimL] Nothing, t2] --- --- --- Sink: --- --- If: --- --- [t1, TrimR, If ex t e, t2] = [t1, If ex [TrimR, t] e, t2] --- --- [t1, If ex t e, TrimL, t2] = if isJust e --- then [t1, If ex t [e, TrimL], t2] --- else [t1, If ex [t, TrimL] e, t2] --- --- For: --- --- [t1, TrimR, For e b sep, t2] = [t1, For e [TrimR, b] sep, t2] --- --- [t1, For e b sep, TrimL, t2] = if isJust sep --- then [t1, For e b [sep, TrimL], t2] --- else [t1, For e [b, TrimL] sep, t2] --- --- --- Shift/Lift: --- --- If: --- --- If ex [t1, TrimR] (Just e) = If ex t1 [TrimR, e] --- --- If ex [t1, TrimR] Nothing = [If ex t1 Nothing, TrimR] --- --- If ex t [TrimL, e] = If ex [t, TrimL] e --- --- --- For: --- --- For e [t1, TrimR] (Just sep) = For e t1 [TrimR, sep] --- --- For e [t1, TrimR] Nothing = For e t1 [TrimR, sep] --- --- For e b [TrimL, sep] = For e [b, TrimL] sep --- --- --- -canonicalize :: Template -> Template -canonicalize = undefined diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index fce163f..5905c93 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -129,6 +129,20 @@ instance Binary TemplateExpr where _ -> error "Hakyll.Web.Template.Internal: Error reading cached template" +-------------------------------------------------------------------------------- +(.~) :: [TemplateElement] -> Template -> Template +ts .~ (Template t) = Template (ts ++ t) + +infixr 6 .~ + + +-------------------------------------------------------------------------------- +(~.) :: Template -> [TemplateElement] -> Template +(Template t) ~. ts = Template (t ++ ts) + +infixl 5 ~. + + -------------------------------------------------------------------------------- readTemplate :: String -> Template readTemplate input = case P.parse template "" input of @@ -159,10 +173,7 @@ expr = P.try $ do trimLExpr <- trimOpen e <- expr' trimRExpr <- trimClose - return $ Template $ mconcat [ [TrimL | trimLExpr] - , [Expr e] - , [TrimR | trimRExpr] - ] + return $ [TrimL | trimLExpr] .~ Template [Expr e] ~. [TrimR | trimRExpr] -------------------------------------------------------------------------------- @@ -194,73 +205,87 @@ trimClose = do -------------------------------------------------------------------------------- conditional :: P.Parser Template conditional = P.try $ do + -- if trimLIf <- trimOpen void $ P.string "if(" e <- expr' void $ P.char ')' trimRIf <- trimClose - + -- then thenBranch <- template - - 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] - ] - + -- else + elseParse <- opt "else" + -- endif trimLEnd <- trimOpen void $ P.string "endif" trimREnd <- trimClose - pure $ Template $ mconcat [ [TrimL | trimLIf] - , [TrimR | trimRIf] - , [If e thenBranch elseBranch] - , [TrimL | trimLEnd] - , [TrimR | trimREnd] - ] + -- 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] + .~ Template [If e thenBody elseBody] + ~. [TrimR | trimREnd] -------------------------------------------------------------------------------- for :: P.Parser Template for = P.try $ do + -- for trimLFor <- trimOpen void $ P.string "for(" e <- expr' void $ P.char ')' trimRFor <- trimClose - - body <- template - sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template - + -- body + bodyBranch <- template + -- sep + sepParse <- opt "sep" + -- endfor trimLEnd <- trimOpen void $ P.string "endfor" trimREnd <- trimClose - pure $ Template $ mconcat [ [TrimL | trimLFor] - , [TrimR | trimRFor] - , [For e body sep] - , [TrimL | trimLEnd] - , [TrimR | trimREnd] - ] + -- 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] + .~ Template [For e forBody sepBody] + ~. [TrimR | trimREnd] -------------------------------------------------------------------------------- partial :: P.Parser Template partial = P.try $ do - trimLPartial <- trimOpen + trimLPart <- trimOpen void $ P.string "partial(" e <- expr' void $ P.char ')' - trimRPartial <- trimClose + trimRPart <- trimClose - pure $ Template $ mconcat [ [TrimL | trimLPartial] - , [Partial e] - , [TrimR | trimRPartial] - ] + pure $ [TrimL | trimLPart] .~ Template [Partial e] ~. [TrimR | trimRPart] -------------------------------------------------------------------------------- @@ -294,3 +319,14 @@ stringLiteral = do -------------------------------------------------------------------------------- key :: P.Parser TemplateKey key = TemplateKey <$> metadataKey + + +-------------------------------------------------------------------------------- +opt :: String -> P.Parser (Maybe (Bool, Template, Bool)) +opt clause = P.optionMaybe $ P.try $ do + trimL <- trimOpen + void $ P.string clause + trimR <- trimClose + branch <- template + 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..6b7c6c8 --- /dev/null +++ b/src/Hakyll/Web/Template/Trim.hs @@ -0,0 +1,178 @@ +-------------------------------------------------------------------------------- +-- | TODO +module Hakyll.Web.Template.Internal.Trim + ( trim + ) where + + +-------------------------------------------------------------------------------- +import Data.Char (isSpace) +import Data.List (dropWhileEnd) + + +-------------------------------------------------------------------------------- +import Hakyll.Web.Template.Internal + + +-------------------------------------------------------------------------------- +trim :: Template -> Template +trim = cleanse . canonicalize + + +-------------------------------------------------------------------------------- +cleanse :: Template -> Template +cleanse = tmap (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 + + lstrip = dropWhile isSpace + rstrip = dropWhileEnd isSpace + +-------------------------------------------------------------------------------- +-- +-- Invariant: Every TrimL should have a Chunk to its Left +-- Every TrimR should have a Chunk to its Right +-- +-- +-- Some initial implementation notes. Note: Not valid syntax etc. +-- +-- +-- +-- +-------------------------------------------------------------------------------- +canonicalize :: Template -> Template +canonicalize = go + where go t = let t' = redundant . swap . dedupe $ sink t + in if t == t' then t else go t' + + +-------------------------------------------------------------------------------- +-- | 'redundant' removes the redundant 'TrimR's and 'TrimL's from the +-- 'Template's list of 'TemplateExpr's. It does _not_ recurse down the AST. +-- +-- Note: Should _only_ be used on the top level 'Template'. +-- +redundant :: Template -> Template +redundant = tmap (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 t ts = t:ts + + +-------------------------------------------------------------------------------- +-- Commute: +-- +-- List: +-- +-- [t1, TrimR, TrimL, t2] = [t1, TrimL, TrimR, t2] +-- +-- Rest should come for free provided Trim's are Sunk/Shifted etc I think. +-- +swap :: Template -> Template +swap = tmap (recurse swap . process) + where process [] = [] + process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts) + process (t:ts) = t:process ts + + +-------------------------------------------------------------------------------- +-- +-- Dedupe: +-- +-- List: +-- +-- [t1, TrimR, TrimR, t2] = [t1, TrimR, t2] +-- +-- [t1, TrimL, TrimL, t2] = [t1, TrimL, t2] +-- +-- If: Should come for free after Trim_'s have been sunk. +-- +-- [t1, TrimR, If ex [TrimR, t] e, t2] = [t1, If ex [TrimR, t] e, t2] +-- +-- [t1, If ex t [e, TrimL], TrimL, t2] = [t1, If ex t [e, TrimL], t2] +-- +-- [t1, If ex [t, TrimL] Nothing, TrimL, t2] = [t1, If ex [t, TrimL] Nothing, t2] +-- +-- For: +-- +-- [t1, TrimR, For e [TrimR, b] sep, t2] = [t1, For e [TrimR, b] sep, t2] +-- +-- [t1, For e b [sep, TrimL], TrimL, t2] = [t1, For e b [sep, TrimL], t2] +-- +-- [t1, For e [b, TrimL] Nothing, TrimL, t2] = [t1, For e [b, TrimL] Nothing, t2] +-- +dedupe :: Template -> Template +dedupe = tmap (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 + + +-------------------------------------------------------------------------------- +-- +-- Sink: +-- +-- If: +-- +-- [t1, TrimR, If ex t e, t2] = [t1, If ex [TrimR, t] e, t2] +-- +-- [t1, If ex t e, TrimL, t2] = if isJust e +-- then [t1, If ex t [e, TrimL], t2] +-- else [t1, If ex [t, TrimL] e, t2] +-- +-- For: +-- +-- [t1, TrimR, For e b sep, t2] = [t1, For e [TrimR, b] sep, t2] +-- +-- [t1, For e b sep, TrimL, t2] = if isJust sep +-- then [t1, For e b [sep, TrimL], t2] +-- else [t1, For e [b, TrimL] sep, t2] +-- +-- +sink :: Template -> Template +sink = tmap (recurse sink . process) + where process [] = [] + -- Right sink TrimR into If thenbody. + process (TrimR:If e (Template tb) eb:ts) + = If e (Template (TrimR:tb)) eb:process ts + -- Left sink TrimL into If thenbody. + process (If e (Template tb) Nothing:TrimL:ts) + = If e (Template (tb ++ [TrimL])) Nothing:process ts + -- Left sink TrimL into If elsebody. + process (If e tb (Just (Template eb)):TrimL:ts) + = If e tb (Just (Template (eb ++ [TrimL]))):process ts + -- Right sink TrimR into For body. + process (TrimR:For e (Template b) sep:ts) + = For e (Template (TrimR:b)) sep:process ts + -- Left sink TrimL into For body. + process (For e (Template b) Nothing:TrimL:ts) + = For e (Template (b ++ [TrimL])) Nothing:process ts + -- Left sink TrimL into For sep. + process (For e b (Just (Template sep)):TrimL:ts) + = For e b (Just (Template (sep ++ [TrimL]))):process ts + -- Otherwise move on. + process (t:ts) = t:process ts + + +-------------------------------------------------------------------------------- +tmap :: ([TemplateElement] -> [TemplateElement]) -> Template -> Template +tmap f (Template t) = Template (f t) + + +-------------------------------------------------------------------------------- +recurse :: (Template -> Template) -> [TemplateElement] -> [TemplateElement] +recurse f [] = [] +recurse f (x:xs) = process x:recurse f xs + where process x = case x of + If e tb eb -> If e (f tb) (f <$> eb) + For e t s -> For e (f t) (f <$> s) + _ -> x + + +-------------------------------------------------------------------------------- diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs index a7b31a7..087e0cb 100644 --- a/tests/Hakyll/Web/Template/Tests.hs +++ b/tests/Hakyll/Web/Template/Tests.hs @@ -41,30 +41,30 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat -- 'If' trim check. , Template [ TrimL - , TrimR , If (Ident (TemplateKey "body")) - (Template [ Chunk "\n" + (Template [ TrimR + , Chunk "\n" , Expr (Ident (TemplateKey "body")) , Chunk "\n" + , TrimL ]) - (Just (Template [ TrimL - , TrimR + (Just (Template [ TrimR , Chunk "\n" , Expr (Ident (TemplateKey "body")) , Chunk "\n" + , TrimL ])) - , TrimL , TrimR ] @=? readTemplate "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$" -- 'For' trim check. , Template [ TrimL - , TrimR , For (Ident (TemplateKey "authors")) - (Template [Chunk "\n body \n"]) + (Template [ TrimR + , Chunk "\n body \n" + , TrimL]) Nothing - , TrimL , TrimR ] @=? readTemplate "$-for(authors)-$\n body \n$-endfor-$" -- cgit v1.2.3 From 43c969f326082d29d8e340ee865414deb87b8ac5 Mon Sep 17 00:00:00 2001 From: samgd Date: Sun, 24 Jul 2016 17:30:47 +0200 Subject: Fix module layout --- src/Hakyll/Web/Template.hs | 46 +++++++++--- src/Hakyll/Web/Template/Internal.hs | 113 +++++++++------------------- src/Hakyll/Web/Template/Trim.hs | 145 +++++++----------------------------- tests/Hakyll/Web/Template/Tests.hs | 87 ++++++++++------------ 4 files changed, 139 insertions(+), 252 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 65c4ac9..204878c 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -115,7 +115,8 @@ -- That is, calling @$partial$@ is equivalent to just copying and pasting -- template code. -- -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} module Hakyll.Web.Template ( Template , templateBodyCompiler @@ -128,9 +129,11 @@ module Hakyll.Web.Template -------------------------------------------------------------------------------- -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,8 +141,33 @@ 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 + + +-------------------------------------------------------------------------------- +readTemplate :: String -> Template +readTemplate = Template . trim . readTemplateElems -------------------------------------------------------------------------------- @@ -163,23 +191,23 @@ 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 --------------------------------------------------------------------------- diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index 5905c93..6a9947f 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -1,13 +1,12 @@ -------------------------------------------------------------------------------- -- | Module containing the template data structure -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Web.Template.Internal - ( Template (..) - , TemplateKey (..) + ( TemplateKey (..) , TemplateExpr (..) , TemplateElement (..) - , readTemplate + , templateElems + , readTemplateElems ) where @@ -25,31 +24,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 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 () - - --------------------------------------------------------------------------------- -instance IsString Template where - fromString = readTemplate -------------------------------------------------------------------------------- @@ -68,9 +42,12 @@ 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) @@ -130,36 +107,22 @@ instance Binary TemplateExpr where -------------------------------------------------------------------------------- -(.~) :: [TemplateElement] -> Template -> Template -ts .~ (Template t) = Template (ts ++ t) - -infixr 6 .~ - - --------------------------------------------------------------------------------- -(~.) :: Template -> [TemplateElement] -> Template -(Template t) ~. ts = Template (t ++ ts) - -infixl 5 ~. - - --------------------------------------------------------------------------------- -readTemplate :: String -> Template -readTemplate input = case P.parse template "" input of +readTemplateElems :: String -> [TemplateElement] +readTemplateElems input = case P.parse templateElems "" input of Left err -> error $ "Cannot parse template: " ++ show err Right t -> t -------------------------------------------------------------------------------- -template :: P.Parser Template -template = mconcat <$> P.many (P.choice [ lift chunk +templateElems :: P.Parser [TemplateElement] +templateElems = mconcat <$> P.many (P.choice [ lift chunk , lift escaped , conditional , for , partial , expr ]) - where lift = fmap (Template . (:[])) + where lift = fmap (:[]) -------------------------------------------------------------------------------- @@ -168,12 +131,12 @@ chunk = Chunk <$> P.many1 (P.noneOf "$") -------------------------------------------------------------------------------- -expr :: P.Parser Template +expr :: P.Parser [TemplateElement] expr = P.try $ do trimLExpr <- trimOpen e <- expr' trimRExpr <- trimClose - return $ [TrimL | trimLExpr] .~ Template [Expr e] ~. [TrimR | trimRExpr] + return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr] -------------------------------------------------------------------------------- @@ -203,7 +166,7 @@ trimClose = do -------------------------------------------------------------------------------- -conditional :: P.Parser Template +conditional :: P.Parser [TemplateElement] conditional = P.try $ do -- if trimLIf <- trimOpen @@ -212,7 +175,7 @@ conditional = P.try $ do void $ P.char ')' trimRIf <- trimClose -- then - thenBranch <- template + thenBranch <- templateElems -- else elseParse <- opt "else" -- endif @@ -223,24 +186,22 @@ conditional = P.try $ do -- 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] + [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd] thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB) where thenB = [TrimR | trimRIf] - .~ thenBranch - ~. [TrimL | trimLElse] + ++ thenBranch + ++ [TrimL | trimLElse] elseB = Just $ [TrimR | trimRElse] - .~ elseBranch - ~. [TrimL | trimLEnd] + ++ elseBranch + ++ [TrimL | trimLEnd] - pure $ [TrimL | trimLIf] - .~ Template [If e thenBody elseBody] - ~. [TrimR | trimREnd] + pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd] -------------------------------------------------------------------------------- -for :: P.Parser Template +for :: P.Parser [TemplateElement] for = P.try $ do -- for trimLFor <- trimOpen @@ -249,7 +210,7 @@ for = P.try $ do void $ P.char ')' trimRFor <- trimClose -- body - bodyBranch <- template + bodyBranch <- templateElems -- sep sepParse <- opt "sep" -- endfor @@ -260,24 +221,22 @@ for = P.try $ do -- 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] + [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd] forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB) where forB = [TrimR | trimRFor] - .~ bodyBranch - ~. [TrimL | trimLSep] + ++ bodyBranch + ++ [TrimL | trimLSep] sepB = Just $ [TrimR | trimRSep] - .~ sepBranch - ~. [TrimL | trimLEnd] + ++ sepBranch + ++ [TrimL | trimLEnd] - pure $ [TrimL | trimLFor] - .~ Template [For e forBody sepBody] - ~. [TrimR | trimREnd] + pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd] -------------------------------------------------------------------------------- -partial :: P.Parser Template +partial :: P.Parser [TemplateElement] partial = P.try $ do trimLPart <- trimOpen void $ P.string "partial(" @@ -285,7 +244,7 @@ partial = P.try $ do void $ P.char ')' trimRPart <- trimClose - pure $ [TrimL | trimLPart] .~ Template [Partial e] ~. [TrimR | trimRPart] + pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart] -------------------------------------------------------------------------------- @@ -322,11 +281,11 @@ key = TemplateKey <$> metadataKey -------------------------------------------------------------------------------- -opt :: String -> P.Parser (Maybe (Bool, Template, Bool)) +opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool)) opt clause = P.optionMaybe $ P.try $ do trimL <- trimOpen void $ P.string clause trimR <- trimClose - branch <- template + branch <- templateElems pure (trimL, branch, trimR) diff --git a/src/Hakyll/Web/Template/Trim.hs b/src/Hakyll/Web/Template/Trim.hs index 6b7c6c8..4ea3438 100644 --- a/src/Hakyll/Web/Template/Trim.hs +++ b/src/Hakyll/Web/Template/Trim.hs @@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- --- | TODO -module Hakyll.Web.Template.Internal.Trim +-- | Module for trimming whitespace. +module Hakyll.Web.Template.Trim ( trim ) where @@ -15,13 +15,13 @@ import Hakyll.Web.Template.Internal -------------------------------------------------------------------------------- -trim :: Template -> Template +trim :: [TemplateElement] -> [TemplateElement] trim = cleanse . canonicalize -------------------------------------------------------------------------------- -cleanse :: Template -> Template -cleanse = tmap (recurse cleanse . process) +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 @@ -31,83 +31,43 @@ cleanse = tmap (recurse cleanse . process) rstrip = dropWhileEnd isSpace -------------------------------------------------------------------------------- +-- | Enforce the invariant that: -- --- Invariant: Every TrimL should have a Chunk to its Left --- Every TrimR should have a Chunk to its Right +-- * Every 'TrimL' has a 'Chunk' to its left. +-- * Every 'TrimR' has a 'Chunk' to its right. -- --- --- Some initial implementation notes. Note: Not valid syntax etc. --- --- --- --- --------------------------------------------------------------------------------- -canonicalize :: Template -> Template +canonicalize :: [TemplateElement] -> [TemplateElement] canonicalize = go - where go t = let t' = redundant . swap . dedupe $ sink t + where go t = let t' = redundant . swap $ dedupe t in if t == t' then t else go t' -------------------------------------------------------------------------------- --- | 'redundant' removes the redundant 'TrimR's and 'TrimL's from the --- 'Template's list of 'TemplateExpr's. It does _not_ recurse down the AST. --- --- Note: Should _only_ be used on the top level 'Template'. --- -redundant :: Template -> Template -redundant = tmap (recurse redundant . process) +-- | 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 t ts = t:ts + trailing x xs = x:xs -------------------------------------------------------------------------------- --- Commute: --- --- List: --- --- [t1, TrimR, TrimL, t2] = [t1, TrimL, TrimR, t2] --- --- Rest should come for free provided Trim's are Sunk/Shifted etc I think. --- -swap :: Template -> Template -swap = tmap (recurse swap . process) +-- >>> 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 -------------------------------------------------------------------------------- --- --- Dedupe: --- --- List: --- --- [t1, TrimR, TrimR, t2] = [t1, TrimR, t2] --- --- [t1, TrimL, TrimL, t2] = [t1, TrimL, t2] --- --- If: Should come for free after Trim_'s have been sunk. --- --- [t1, TrimR, If ex [TrimR, t] e, t2] = [t1, If ex [TrimR, t] e, t2] --- --- [t1, If ex t [e, TrimL], TrimL, t2] = [t1, If ex t [e, TrimL], t2] --- --- [t1, If ex [t, TrimL] Nothing, TrimL, t2] = [t1, If ex [t, TrimL] Nothing, t2] --- --- For: --- --- [t1, TrimR, For e [TrimR, b] sep, t2] = [t1, For e [TrimR, b] sep, t2] --- --- [t1, For e b [sep, TrimL], TrimL, t2] = [t1, For e b [sep, TrimL], t2] --- --- [t1, For e [b, TrimL] Nothing, TrimL, t2] = [t1, For e [b, TrimL] Nothing, t2] --- -dedupe :: Template -> Template -dedupe = tmap (recurse dedupe . process) +-- | 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) @@ -115,64 +75,13 @@ dedupe = tmap (recurse dedupe . process) -------------------------------------------------------------------------------- --- --- Sink: --- --- If: --- --- [t1, TrimR, If ex t e, t2] = [t1, If ex [TrimR, t] e, t2] --- --- [t1, If ex t e, TrimL, t2] = if isJust e --- then [t1, If ex t [e, TrimL], t2] --- else [t1, If ex [t, TrimL] e, t2] --- --- For: --- --- [t1, TrimR, For e b sep, t2] = [t1, For e [TrimR, b] sep, t2] --- --- [t1, For e b sep, TrimL, t2] = if isJust sep --- then [t1, For e b [sep, TrimL], t2] --- else [t1, For e [b, TrimL] sep, t2] --- --- -sink :: Template -> Template -sink = tmap (recurse sink . process) - where process [] = [] - -- Right sink TrimR into If thenbody. - process (TrimR:If e (Template tb) eb:ts) - = If e (Template (TrimR:tb)) eb:process ts - -- Left sink TrimL into If thenbody. - process (If e (Template tb) Nothing:TrimL:ts) - = If e (Template (tb ++ [TrimL])) Nothing:process ts - -- Left sink TrimL into If elsebody. - process (If e tb (Just (Template eb)):TrimL:ts) - = If e tb (Just (Template (eb ++ [TrimL]))):process ts - -- Right sink TrimR into For body. - process (TrimR:For e (Template b) sep:ts) - = For e (Template (TrimR:b)) sep:process ts - -- Left sink TrimL into For body. - process (For e (Template b) Nothing:TrimL:ts) - = For e (Template (b ++ [TrimL])) Nothing:process ts - -- Left sink TrimL into For sep. - process (For e b (Just (Template sep)):TrimL:ts) - = For e b (Just (Template (sep ++ [TrimL]))):process ts - -- Otherwise move on. - process (t:ts) = t:process ts - - --------------------------------------------------------------------------------- -tmap :: ([TemplateElement] -> [TemplateElement]) -> Template -> Template -tmap f (Template t) = Template (f t) - - --------------------------------------------------------------------------------- -recurse :: (Template -> Template) -> [TemplateElement] -> [TemplateElement] -recurse f [] = [] +recurse :: ([TemplateElement] -> [TemplateElement]) + -> [TemplateElement] + -> [TemplateElement] +recurse _ [] = [] recurse f (x:xs) = process x:recurse f xs - where process x = case x of + 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) - _ -> x + _ -> y - --------------------------------------------------------------------------------- diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs index 087e0cb..54d5406 100644 --- a/tests/Hakyll/Web/Template/Tests.hs +++ b/tests/Hakyll/Web/Template/Tests.hs @@ -31,57 +31,48 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat ] , 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. - , Template - [ TrimL - , If (Ident (TemplateKey "body")) - (Template [ TrimR - , Chunk "\n" - , Expr (Ident (TemplateKey "body")) - , Chunk "\n" - , TrimL - ]) - (Just (Template [ TrimR - , Chunk "\n" - , Expr (Ident (TemplateKey "body")) - , Chunk "\n" - , TrimL - ])) - , TrimR - ] - @=? readTemplate "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$" + , [ 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. - , Template - [ TrimL - , For (Ident (TemplateKey "authors")) - (Template [ TrimR - , Chunk "\n body \n" - , TrimL]) - Nothing - , TrimR - ] - @=? readTemplate "$-for(authors)-$\n body \n$-endfor-$" + , [ TrimL + , For (Ident (TemplateKey "authors")) + [TrimR, Chunk "\n body \n", TrimL] + Nothing + , TrimR + ] + @=? readTemplateElems "$-for(authors)-$\n body \n$-endfor-$" -- 'Partial' trim check. - , Template - [ TrimL - , Partial (StringLiteral "path") - , TrimR - ] - @=? readTemplate "$-partial(\"path\")-$" + , [ TrimL + , Partial (StringLiteral "path") + , TrimR + ] + @=? readTemplateElems "$-partial(\"path\")-$" -- 'Expr' trim check. - , Template - [ TrimL - , Expr (Ident (TemplateKey "foo")) - , TrimR - ] - @=? readTemplate "$-foo-$" + , [ TrimL + , Expr (Ident (TemplateKey "foo")) + , TrimR + ] + @=? readTemplateElems "$-foo-$" ] ] @@ -126,4 +117,4 @@ testApplyJoinTemplateList = do where i1 = Item "item1" "Hello" i2 = Item "item2" "World" - tpl = Template [Chunk "", Expr (Ident "body"), Chunk ""] + tpl = readTemplate "$body$" -- cgit v1.2.3 From 82d6402ba38b9e1ea789e83c5ea7d08bcbeff467 Mon Sep 17 00:00:00 2001 From: samgd Date: Mon, 25 Jul 2016 12:47:30 +0200 Subject: Trim instructions. TrimRd chunk might need TrimL. Trim tests. --- src/Hakyll/Web/Template.hs | 30 ++++++++++++++++++++++++++++++ src/Hakyll/Web/Template/Trim.hs | 20 ++++++++++++++------ tests/Hakyll/Web/Template/Tests.hs | 14 ++++++++------ tests/data/strip.html | 34 ++++++++++++++++++++++++++++++++++ tests/data/strip.html.out | 18 ++++++++++++++++++ 5 files changed, 104 insertions(+), 12 deletions(-) create mode 100644 tests/data/strip.html create mode 100644 tests/data/strip.html.out (limited to 'src') diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 204878c..13d5d35 100644 --- a/src/Hakyll/Web/Template.hs +++ b/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 +-- +-- >

+-- > $for(counts)-$ +-- > $count$ +-- > $-sep-$... +-- > $-endfor$ +-- >

+-- +-- the resulting page would look like +-- +-- >

+-- > 3...2...1 +-- >

+-- {-# 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 diff --git a/src/Hakyll/Web/Template/Trim.hs b/src/Hakyll/Web/Template/Trim.hs index 4ea3438..bc7e691 100644 --- a/src/Hakyll/Web/Template/Trim.hs +++ b/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 + + process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str + in if null str' + then process ts + else Chunk str':process ts - lstrip = dropWhile isSpace - rstrip = dropWhileEnd isSpace + 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] diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs index 54d5406..994d9ca 100644 --- a/tests/Hakyll/Web/Template/Tests.hs +++ b/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 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 @@ +
+ 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$ + +
    + $for(authors)-$ +
  • $name$
    • + $endfor-$ +
+ + $for(authors)-$ + $name-$ + $sep$, + $-endfor$ + + $body$ +
+ 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 @@ +
+ I'm so rich I have $3. + + ooffoo + + I have body + should be printed + +
    +
  • Jan
    • +
  • Piet
    • +
+ + Jan,Piet + +

This is an example.

+
+ -- cgit v1.2.3 From a31a5654036c8d8b43d24d3d8cef4e342c517a47 Mon Sep 17 00:00:00 2001 From: samgd Date: Mon, 25 Jul 2016 18:49:32 +0200 Subject: s/that/that the/ --- src/Hakyll/Web/Template.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 4a8d94c..8118fff 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -115,7 +115,7 @@ -- 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 +-- In the examples above you can see that the 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 -- cgit v1.2.3