diff options
| -rw-r--r-- | hakyll.cabal | 2 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Canonicalize.hs | 86 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Internal.hs | 112 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Trim.hs | 178 | ||||
| -rw-r--r-- | tests/Hakyll/Web/Template/Tests.hs | 16 |
5 files changed, 261 insertions, 133 deletions
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 @@ -130,6 +130,20 @@ 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 Left err -> error $ "Cannot parse template: " ++ show err @@ -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-$" |