Fix module layout

4 files changed, 139 insertions, 252 deletions

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 "<b>", Expr (Ident "body"), Chunk "</b>"]
+    tpl = readTemplate "<b>$body$</b>"