summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Web')
-rw-r--r--src/Hakyll/Web/Template/Canonicalize.hs86
-rw-r--r--src/Hakyll/Web/Template/Internal.hs112
-rw-r--r--src/Hakyll/Web/Template/Trim.hs178
3 files changed, 252 insertions, 124 deletions
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
+
+
+--------------------------------------------------------------------------------
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-07 02:30:30 +0000