Hackage Search: hakyll-4.16.2.0/lib/Hakyll/Web/Template/Internal/Element.hs

1 --------------------------------------------------------------------------------
2 -- | Module containing the elements used in a template.  A template is generally
3 -- just a list of these elements.
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 module Hakyll.Web.Template.Internal.Element
6     ( TemplateKey (..)
7     , TemplateExpr (..)
8     , TemplateElement (..)
9     , templateElems
10     , parseTemplateElemsFile
11     ) where
12 
13 
14 --------------------------------------------------------------------------------
15 import           Control.Applicative     ((<|>))
16 import           Control.Monad           (void)
17 import           Control.Arrow           (left)
18 import           Data.Binary             (Binary, get, getWord8, put, putWord8)
19 import           Data.List               (intercalate)
20 import           Data.Maybe              (isJust)
21 import           Data.Typeable           (Typeable)
22 import           GHC.Exts                (IsString (..))
23 import qualified Text.Parsec             as P
24 import qualified Text.Parsec.String      as P
25 
26 
27 --------------------------------------------------------------------------------
28 import           Hakyll.Core.Util.Parser
29 
30 
31 --------------------------------------------------------------------------------
32 newtype TemplateKey = TemplateKey String
33     deriving (Binary, Show, Eq, Typeable)
34 
35 
36 --------------------------------------------------------------------------------
37 instance IsString TemplateKey where
38     fromString = TemplateKey
39 
40 
41 --------------------------------------------------------------------------------
42 -- | Elements of a template.
43 data TemplateElement
44     = Chunk String
45     | Expr TemplateExpr
46     | Escaped
47       -- expr, then, else
48     | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])
49       -- expr, body, separator
50     | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])
51       -- filename
52     | Partial TemplateExpr
53     | TrimL
54     | TrimR
55     deriving (Show, Eq, Typeable)
56 
57 
58 --------------------------------------------------------------------------------
59 instance Binary TemplateElement where
60     put (Chunk string) = putWord8 0 >> put string
61     put (Expr e)       = putWord8 1 >> put e
62     put  Escaped       = putWord8 2
63     put (If e t f)     = putWord8 3 >> put e >> put t >> put f
64     put (For e b s)    = putWord8 4 >> put e >> put b >> put s
65     put (Partial e)    = putWord8 5 >> put e
66     put  TrimL         = putWord8 6
67     put  TrimR         = putWord8 7
68 
69     get = getWord8 >>= \tag -> case tag of
70         0 -> Chunk <$> get
71         1 -> Expr <$> get
72         2 -> pure Escaped
73         3 -> If <$> get <*> get <*> get
74         4 -> For <$> get <*> get <*> get
75         5 -> Partial <$> get
76         6 -> pure TrimL
77         7 -> pure TrimR
78         _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
79 
80 
81 --------------------------------------------------------------------------------
82 -- | Expression in a template
83 data TemplateExpr
84     = Ident TemplateKey
85     | Call TemplateKey [TemplateExpr]
86     | StringLiteral String
87     deriving (Eq, Typeable)
88 
89 
90 --------------------------------------------------------------------------------
91 instance Show TemplateExpr where
92     show (Ident (TemplateKey k))   = k
93     show (Call (TemplateKey k) as) =
94         k ++ "(" ++ intercalate ", " (map show as) ++ ")"
95     show (StringLiteral s)         = show s
96 
97 
98 --------------------------------------------------------------------------------
99 instance Binary TemplateExpr where
100     put (Ident k)         = putWord8 0 >> put k
101     put (Call k as)       = putWord8 1 >> put k >> put as
102     put (StringLiteral s) = putWord8 2 >> put s
103 
104     get = getWord8 >>= \tag -> case tag of
105         0 -> Ident         <$> get
106         1 -> Call          <$> get <*> get
107         2 -> StringLiteral <$> get
108         _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
109 
110 --------------------------------------------------------------------------------
111 parseTemplateElemsFile :: FilePath -> String -> Either String [TemplateElement]
112 parseTemplateElemsFile file = left (\e -> "Cannot parse template " ++ show e)
113                             . P.parse (templateElems <* P.eof) file
114 
115 
116 --------------------------------------------------------------------------------
117 templateElems :: P.Parser [TemplateElement]
118 templateElems = mconcat <$> P.many (P.choice [ lift chunk
119                                              , lift escaped
120                                              , conditional
121                                              , for
122                                              , partial
123                                              , expr
124                                              ])
125     where lift = fmap (:[])
126 
127 
128 --------------------------------------------------------------------------------
129 chunk :: P.Parser TemplateElement
130 chunk = Chunk <$> P.many1 (P.noneOf "$")
131 
132 
133 --------------------------------------------------------------------------------
134 expr :: P.Parser [TemplateElement]
135 expr = P.try $ do
136     trimLExpr <- trimOpen
137     e <- expr'
138     trimRExpr <- trimClose
139     return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]
140 
141 
142 --------------------------------------------------------------------------------
143 expr' :: P.Parser TemplateExpr
144 expr' = stringLiteral <|> call <|> ident
145 
146 
147 --------------------------------------------------------------------------------
148 escaped :: P.Parser TemplateElement
149 escaped = Escaped <$ P.try (P.string "$$")
150 
151 
152 --------------------------------------------------------------------------------
153 trimOpen :: P.Parser Bool
154 trimOpen = do
155     void $ P.char '$'
156     trimLIf <- P.optionMaybe $ P.try (P.char '-')
157     pure $ isJust trimLIf
158 
159 
160 --------------------------------------------------------------------------------
161 trimClose :: P.Parser Bool
162 trimClose = do
163     trimIfR <- P.optionMaybe $ (P.char '-')
164     void $ P.char '$'
165     pure $ isJust trimIfR
166 
167 
168 --------------------------------------------------------------------------------
169 conditional :: P.Parser [TemplateElement]
170 conditional = P.try $ do
171     -- if
172     trimLIf <- trimOpen
173     void $ P.string "if("
174     e <- expr'
175     void $ P.char ')'
176     trimRIf <- trimClose
177     -- then
178     thenBranch <- templateElems
179     -- else
180     elseParse <- opt "else"
181     -- endif
182     trimLEnd <- trimOpen
183     void $ P.string "endif"
184     trimREnd <- trimClose
185 
186     -- As else is optional we need to sort out where any Trim_s need to go.
187     let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse
188             where thenNoElse =
189                       [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]
190 
191                   thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)
192                       where thenB = [TrimR | trimRIf]
193                                  ++ thenBranch
194                                  ++ [TrimL | trimLElse]
195 
196                             elseB = Just $ [TrimR | trimRElse]
197                                         ++ elseBranch
198                                         ++ [TrimL | trimLEnd]
199 
200     pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]
201 
202 
203 --------------------------------------------------------------------------------
204 for :: P.Parser [TemplateElement]
205 for = P.try $ do
206     -- for
207     trimLFor <- trimOpen
208     void $ P.string "for("
209     e <- expr'
210     void $ P.char ')'
211     trimRFor <- trimClose
212     -- body
213     bodyBranch <- templateElems
214     -- sep
215     sepParse <- opt "sep"
216     -- endfor
217     trimLEnd <- trimOpen
218     void $ P.string "endfor"
219     trimREnd <- trimClose
220 
221     -- As sep is optional we need to sort out where any Trim_s need to go.
222     let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse
223             where forNoSep =
224                       [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]
225 
226                   forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)
227                       where forB = [TrimR | trimRFor]
228                                 ++ bodyBranch
229                                 ++ [TrimL | trimLSep]
230 
231                             sepB = Just $ [TrimR | trimRSep]
232                                        ++ sepBranch
233                                        ++ [TrimL | trimLEnd]
234 
235     pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]
236 
237 
238 --------------------------------------------------------------------------------
239 partial :: P.Parser [TemplateElement]
240 partial = P.try $ do
241     trimLPart <- trimOpen
242     void $ P.string "partial("
243     e <- expr'
244     void $ P.char ')'
245     trimRPart <- trimClose
246 
247     pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]
248 
249 
250 --------------------------------------------------------------------------------
251 ident :: P.Parser TemplateExpr
252 ident = P.try $ Ident <$> key
253 
254 
255 --------------------------------------------------------------------------------
256 call :: P.Parser TemplateExpr
257 call = P.try $ do
258     f <- key
259     void $ P.char '('
260     P.spaces
261     as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)
262     P.spaces
263     void $ P.char ')'
264     return $ Call f as
265 
266 
267 --------------------------------------------------------------------------------
268 stringLiteral :: P.Parser TemplateExpr
269 stringLiteral = do
270     void $ P.char '\"'
271     str <- P.many $ do
272         x <- P.noneOf "\""
273         if x == '\\' then P.anyChar else return x
274     void $ P.char '\"'
275     return $ StringLiteral str
276 
277 
278 --------------------------------------------------------------------------------
279 key :: P.Parser TemplateKey
280 key = TemplateKey <$> metadataKey
281 
282 
283 --------------------------------------------------------------------------------
284 opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))
285 opt clause = P.optionMaybe $ P.try $ do
286     trimL <- trimOpen
287     void $ P.string clause
288     trimR <- trimClose
289     branch <- templateElems
290     pure (trimL, branch, trimR)
291

1	--------------------------------------------------------------------------------
2	-- \| Module containing the elements used in a template. A template is generally
3	-- just a list of these elements.
4	{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5	module Hakyll.Web.Template.Internal.Element
6	( TemplateKey (..)
7	, TemplateExpr (..)
8	, TemplateElement (..)
9	, templateElems
10	, parseTemplateElemsFile
11	) where
12
13
14	--------------------------------------------------------------------------------
15	import Control.Applicative ((<\|>))
16	import Control.Monad (void)
17	import Control.Arrow (left)
18	import Data.Binary (Binary, get, getWord8, put, putWord8)
19	import Data.List (intercalate)
20	import Data.Maybe (isJust)
21	import Data.Typeable (Typeable)
22	import GHC.Exts (IsString (..))
23	import qualified Text.Parsec as P
24	import qualified Text.Parsec.String as P
25
26
27	--------------------------------------------------------------------------------
28	import Hakyll.Core.Util.Parser
29
30
31	--------------------------------------------------------------------------------
32	newtype TemplateKey = TemplateKey String
33	deriving (Binary, Show, Eq, Typeable)
34
35
36	--------------------------------------------------------------------------------
37	instance IsString TemplateKey where
38	fromString = TemplateKey
39
40
41	--------------------------------------------------------------------------------
42	-- \| Elements of a template.
43	data TemplateElement
44	= Chunk String
45	\| Expr TemplateExpr
46	\| Escaped
47	-- expr, then, else
48	\| If TemplateExpr [TemplateElement] (Maybe [TemplateElement])
49	-- expr, body, separator
50	\| For TemplateExpr [TemplateElement] (Maybe [TemplateElement])
51	-- filename
52	\| Partial TemplateExpr
53	\| TrimL
54	\| TrimR
55	deriving (Show, Eq, Typeable)
56
57
58	--------------------------------------------------------------------------------
59	instance Binary TemplateElement where
60	put (Chunk string) = putWord8 0 >> put string
61	put (Expr e) = putWord8 1 >> put e
62	put Escaped = putWord8 2
63	put (If e t f) = putWord8 3 >> put e >> put t >> put f
64	put (For e b s) = putWord8 4 >> put e >> put b >> put s
65	put (Partial e) = putWord8 5 >> put e
66	put TrimL = putWord8 6
67	put TrimR = putWord8 7
68
69	get = getWord8 >>= \tag -> case tag of
70	0 -> Chunk <$> get
71	1 -> Expr <$> get
72	2 -> pure Escaped
73	3 -> If <$> get <> get <> get
74	4 -> For <$> get <> get <> get
75	5 -> Partial <$> get
76	6 -> pure TrimL
77	7 -> pure TrimR
78	_ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
79
80
81	--------------------------------------------------------------------------------
82	-- \| Expression in a template
83	data TemplateExpr
84	= Ident TemplateKey
85	\| Call TemplateKey [TemplateExpr]
86	\| StringLiteral String
87	deriving (Eq, Typeable)
88
89
90	--------------------------------------------------------------------------------
91	instance Show TemplateExpr where
92	show (Ident (TemplateKey k)) = k
93	show (Call (TemplateKey k) as) =
94	k ++ "(" ++ intercalate ", " (map show as) ++ ")"
95	show (StringLiteral s) = show s
96
97
98	--------------------------------------------------------------------------------
99	instance Binary TemplateExpr where
100	put (Ident k) = putWord8 0 >> put k
101	put (Call k as) = putWord8 1 >> put k >> put as
102	put (StringLiteral s) = putWord8 2 >> put s
103
104	get = getWord8 >>= \tag -> case tag of
105	0 -> Ident <$> get
106	1 -> Call <$> get <*> get
107	2 -> StringLiteral <$> get
108	_ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
109
110	--------------------------------------------------------------------------------
111	parseTemplateElemsFile :: FilePath -> String -> Either String [TemplateElement]
112	parseTemplateElemsFile file = left (\e -> "Cannot parse template " ++ show e)
113	. P.parse (templateElems <* P.eof) file
114
115
116	--------------------------------------------------------------------------------
117	templateElems :: P.Parser [TemplateElement]
118	templateElems = mconcat <$> P.many (P.choice [ lift chunk
119	, lift escaped
120	, conditional
121	, for
122	, partial
123	, expr
124	])
125	where lift = fmap (:[])
126
127
128	--------------------------------------------------------------------------------
129	chunk :: P.Parser TemplateElement
130	chunk = Chunk <$> P.many1 (P.noneOf "$")
131
132
133	--------------------------------------------------------------------------------
134	expr :: P.Parser [TemplateElement]
135	expr = P.try $ do
136	trimLExpr <- trimOpen
137	e <- expr'
138	trimRExpr <- trimClose
139	return $ [TrimL \| trimLExpr] ++ [Expr e] ++ [TrimR \| trimRExpr]
140
141
142	--------------------------------------------------------------------------------
143	expr' :: P.Parser TemplateExpr
144	expr' = stringLiteral <\|> call <\|> ident
145
146
147	--------------------------------------------------------------------------------
148	escaped :: P.Parser TemplateElement
149	escaped = Escaped <$ P.try (P.string "$$")
150
151
152	--------------------------------------------------------------------------------
153	trimOpen :: P.Parser Bool
154	trimOpen = do
155	void $ P.char '$'
156	trimLIf <- P.optionMaybe $ P.try (P.char '-')
157	pure $ isJust trimLIf
158
159
160	--------------------------------------------------------------------------------
161	trimClose :: P.Parser Bool
162	trimClose = do
163	trimIfR <- P.optionMaybe $ (P.char '-')
164	void $ P.char '$'
165	pure $ isJust trimIfR
166
167
168	--------------------------------------------------------------------------------
169	conditional :: P.Parser [TemplateElement]
170	conditional = P.try $ do
171	-- if
172	trimLIf <- trimOpen
173	void $ P.string "if("
174	e <- expr'
175	void $ P.char ')'
176	trimRIf <- trimClose
177	-- then
178	thenBranch <- templateElems
179	-- else
180	elseParse <- opt "else"
181	-- endif
182	trimLEnd <- trimOpen
183	void $ P.string "endif"
184	trimREnd <- trimClose
185
186	-- As else is optional we need to sort out where any Trim_s need to go.
187	let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse
188	where thenNoElse =
189	[TrimR \| trimRIf] ++ thenBranch ++ [TrimL \| trimLEnd]
190
191	thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)
192	where thenB = [TrimR \| trimRIf]
193	++ thenBranch
194	++ [TrimL \| trimLElse]
195
196	elseB = Just $ [TrimR \| trimRElse]
197	++ elseBranch
198	++ [TrimL \| trimLEnd]
199
200	pure $ [TrimL \| trimLIf] ++ [If e thenBody elseBody] ++ [TrimR \| trimREnd]
201
202
203	--------------------------------------------------------------------------------
204	for :: P.Parser [TemplateElement]
205	for = P.try $ do
206	-- for
207	trimLFor <- trimOpen
208	void $ P.string "for("
209	e <- expr'
210	void $ P.char ')'
211	trimRFor <- trimClose
212	-- body
213	bodyBranch <- templateElems
214	-- sep
215	sepParse <- opt "sep"
216	-- endfor
217	trimLEnd <- trimOpen
218	void $ P.string "endfor"
219	trimREnd <- trimClose
220
221	-- As sep is optional we need to sort out where any Trim_s need to go.
222	let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse
223	where forNoSep =
224	[TrimR \| trimRFor] ++ bodyBranch ++ [TrimL \| trimLEnd]
225
226	forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)
227	where forB = [TrimR \| trimRFor]
228	++ bodyBranch
229	++ [TrimL \| trimLSep]
230
231	sepB = Just $ [TrimR \| trimRSep]
232	++ sepBranch
233	++ [TrimL \| trimLEnd]
234
235	pure $ [TrimL \| trimLFor] ++ [For e forBody sepBody] ++ [TrimR \| trimREnd]
236
237
238	--------------------------------------------------------------------------------
239	partial :: P.Parser [TemplateElement]
240	partial = P.try $ do
241	trimLPart <- trimOpen
242	void $ P.string "partial("
243	e <- expr'
244	void $ P.char ')'
245	trimRPart <- trimClose
246
247	pure $ [TrimL \| trimLPart] ++ [Partial e] ++ [TrimR \| trimRPart]
248
249
250	--------------------------------------------------------------------------------
251	ident :: P.Parser TemplateExpr
252	ident = P.try $ Ident <$> key
253
254
255	--------------------------------------------------------------------------------
256	call :: P.Parser TemplateExpr
257	call = P.try $ do
258	f <- key
259	void $ P.char '('
260	P.spaces
261	as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)
262	P.spaces
263	void $ P.char ')'
264	return $ Call f as
265
266
267	--------------------------------------------------------------------------------
268	stringLiteral :: P.Parser TemplateExpr
269	stringLiteral = do
270	void $ P.char '\"'
271	str <- P.many $ do
272	x <- P.noneOf "\""
273	if x == '\\' then P.anyChar else return x
274	void $ P.char '\"'
275	return $ StringLiteral str
276
277
278	--------------------------------------------------------------------------------
279	key :: P.Parser TemplateKey
280	key = TemplateKey <$> metadataKey
281
282
283	--------------------------------------------------------------------------------
284	opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))
285	opt clause = P.optionMaybe $ P.try $ do
286	trimL <- trimOpen
287	void $ P.string clause
288	trimR <- trimClose
289	branch <- templateElems
290	pure (trimL, branch, trimR)
291