Working trimming but module loop and formatting req.
This commit is contained in:
samgd
parent
a04f722eb1
commit
ca7b78ee42
5 changed files with 261 additions and 133 deletions
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -129,6 +129,20 @@ instance Binary TemplateExpr where
|
|||
_ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
(.~) :: [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
|
||||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
178
src/Hakyll/Web/Template/Trim.hs
Normal file
178
src/Hakyll/Web/Template/Trim.hs
Normal file
|
|
@ -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
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -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-$"
|
||||
|
|
|
|||
Loading…
Reference in a new issue