summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web/Template
diff options
context:
space:
mode:
authorsamgd <sam@samgd.com>2016-07-24 17:30:47 +0200
committersamgd <sam@samgd.com>2016-07-24 17:30:47 +0200
commit43c969f326082d29d8e340ee865414deb87b8ac5 (patch)
tree4730aa3988de5f21505e989702d076ce9a51fc0a /src/Hakyll/Web/Template
parentca7b78ee428a43bb307ecefb65529d5106751192 (diff)
downloadhakyll-43c969f326082d29d8e340ee865414deb87b8ac5.tar.gz
Fix module layout
Diffstat (limited to 'src/Hakyll/Web/Template')
-rw-r--r--src/Hakyll/Web/Template/Internal.hs113
-rw-r--r--src/Hakyll/Web/Template/Trim.hs145
2 files changed, 63 insertions, 195 deletions
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
-
---------------------------------------------------------------------------------