Working trimming but module loop and formatting req.

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-$"