@@ -0,0 +1,178 @@
1+--------------------------------------------------------------------------------
2+-- | TODO
3+module Hakyll.Web.Template.Internal.Trim
4+ ( trim
5+ ) where
6+
7+
8+--------------------------------------------------------------------------------
9+import Data.Char (isSpace)
10+import Data.List (dropWhileEnd)
11+
12+
13+--------------------------------------------------------------------------------
14+import Hakyll.Web.Template.Internal
15+
16+
17+--------------------------------------------------------------------------------
18+trim :: Template -> Template
19+trim = cleanse . canonicalize
20+
21+
22+--------------------------------------------------------------------------------
23+cleanse :: Template -> Template
24+cleanse = tmap (recurse cleanse . process)
25+ where process [] = []
26+ process (TrimR:Chunk str:ts) = Chunk (lstrip str):process ts
27+ process (Chunk str:TrimL:ts) = Chunk (rstrip str):process ts
28+ process (t:ts) = t:process ts
29+
30+ lstrip = dropWhile isSpace
31+ rstrip = dropWhileEnd isSpace
32+
33+--------------------------------------------------------------------------------
34+--
35+-- Invariant: Every TrimL should have a Chunk to its Left
36+-- Every TrimR should have a Chunk to its Right
37+--
38+--
39+-- Some initial implementation notes. Note: Not valid syntax etc.
40+--
41+--
42+--
43+--
44+--------------------------------------------------------------------------------
45+canonicalize :: Template -> Template
46+canonicalize = go
47+ where go t = let t' = redundant . swap . dedupe $ sink t
48+ in if t == t' then t else go t'
49+
50+
51+--------------------------------------------------------------------------------
52+-- | 'redundant' removes the redundant 'TrimR's and 'TrimL's from the
53+-- 'Template's list of 'TemplateExpr's. It does _not_ recurse down the AST.
54+--
55+-- Note: Should _only_ be used on the top level 'Template'.
56+--
57+redundant :: Template -> Template
58+redundant = tmap (recurse redundant . process)
59+ where -- Remove the leading 'TrimL's.
60+ process (TrimL:ts) = process ts
61+ -- Remove trailing 'TrimR's.
62+ process ts = foldr trailing [] ts
63+ where trailing TrimR [] = []
64+ trailing t ts = t:ts
65+
66+
67+--------------------------------------------------------------------------------
68+-- Commute:
69+--
70+-- List:
71+--
72+-- [t1, TrimR, TrimL, t2] = [t1, TrimL, TrimR, t2]
73+--
74+-- Rest should come for free provided Trim's are Sunk/Shifted etc I think.
75+--
76+swap :: Template -> Template
77+swap = tmap (recurse swap . process)
78+ where process [] = []
79+ process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)
80+ process (t:ts) = t:process ts
81+
82+
83+--------------------------------------------------------------------------------
84+--
85+-- Dedupe:
86+--
87+-- List:
88+--
89+-- [t1, TrimR, TrimR, t2] = [t1, TrimR, t2]
90+--
91+-- [t1, TrimL, TrimL, t2] = [t1, TrimL, t2]
92+--
93+-- If: Should come for free after Trim_'s have been sunk.
94+--
95+-- [t1, TrimR, If ex [TrimR, t] e, t2] = [t1, If ex [TrimR, t] e, t2]
96+--
97+-- [t1, If ex t [e, TrimL], TrimL, t2] = [t1, If ex t [e, TrimL], t2]
98+--
99+-- [t1, If ex [t, TrimL] Nothing, TrimL, t2] = [t1, If ex [t, TrimL] Nothing, t2]
100+--
101+-- For:
102+--
103+-- [t1, TrimR, For e [TrimR, b] sep, t2] = [t1, For e [TrimR, b] sep, t2]
104+--
105+-- [t1, For e b [sep, TrimL], TrimL, t2] = [t1, For e b [sep, TrimL], t2]
106+--
107+-- [t1, For e [b, TrimL] Nothing, TrimL, t2] = [t1, For e [b, TrimL] Nothing, t2]
108+--
109+dedupe :: Template -> Template
110+dedupe = tmap (recurse dedupe . process)
111+ where process [] = []
112+ process (TrimR:TrimR:ts) = process (TrimR:ts)
113+ process (TrimL:TrimL:ts) = process (TrimL:ts)
114+ process (t:ts) = t:process ts
115+
116+
117+--------------------------------------------------------------------------------
118+--
119+-- Sink:
120+--
121+-- If:
122+--
123+-- [t1, TrimR, If ex t e, t2] = [t1, If ex [TrimR, t] e, t2]
124+--
125+-- [t1, If ex t e, TrimL, t2] = if isJust e
126+-- then [t1, If ex t [e, TrimL], t2]
127+-- else [t1, If ex [t, TrimL] e, t2]
128+--
129+-- For:
130+--
131+-- [t1, TrimR, For e b sep, t2] = [t1, For e [TrimR, b] sep, t2]
132+--
133+-- [t1, For e b sep, TrimL, t2] = if isJust sep
134+-- then [t1, For e b [sep, TrimL], t2]
135+-- else [t1, For e [b, TrimL] sep, t2]
136+--
137+--
138+sink :: Template -> Template
139+sink = tmap (recurse sink . process)
140+ where process [] = []
141+ -- Right sink TrimR into If thenbody.
142+ process (TrimR:If e (Template tb) eb:ts)
143+ = If e (Template (TrimR:tb)) eb:process ts
144+ -- Left sink TrimL into If thenbody.
145+ process (If e (Template tb) Nothing:TrimL:ts)
146+ = If e (Template (tb ++ [TrimL])) Nothing:process ts
147+ -- Left sink TrimL into If elsebody.
148+ process (If e tb (Just (Template eb)):TrimL:ts)
149+ = If e tb (Just (Template (eb ++ [TrimL]))):process ts
150+ -- Right sink TrimR into For body.
151+ process (TrimR:For e (Template b) sep:ts)
152+ = For e (Template (TrimR:b)) sep:process ts
153+ -- Left sink TrimL into For body.
154+ process (For e (Template b) Nothing:TrimL:ts)
155+ = For e (Template (b ++ [TrimL])) Nothing:process ts
156+ -- Left sink TrimL into For sep.
157+ process (For e b (Just (Template sep)):TrimL:ts)
158+ = For e b (Just (Template (sep ++ [TrimL]))):process ts
159+ -- Otherwise move on.
160+ process (t:ts) = t:process ts
161+
162+
163+--------------------------------------------------------------------------------
164+tmap :: ([TemplateElement] -> [TemplateElement]) -> Template -> Template
165+tmap f (Template t) = Template (f t)
166+
167+
168+--------------------------------------------------------------------------------
169+recurse :: (Template -> Template) -> [TemplateElement] -> [TemplateElement]
170+recurse f [] = []
171+recurse f (x:xs) = process x:recurse f xs
172+ where process x = case x of
173+ If e tb eb -> If e (f tb) (f <$> eb)
174+ For e t s -> For e (f t) (f <$> s)
175+ _ -> x
176+
177+
178+--------------------------------------------------------------------------------