@@ -1,27 +1,6 @@
1−-- | This module provides 'Context's which are used to expand expressions in
2−-- templates and allow for arbitrary customisation.
3−--
4−-- 'Template's define a small expression DSL which consists of strings,
5−-- identifiers and function application. There is no type system, every value is
6−-- a string and on the top level they get substituted verbatim into the page.
7−--
8−-- For example, you can build a context that contains
9−--
10−-- > … <> functionField "concat" (const . concat) <> …
11−--
12−-- which will allow you to use the @concat@ identifier as a function that takes
13−-- arbitrarily many stings and concatenates them to a new string:
14−--
15−-- > $partial(concat("templates/categories/", category))$
16−--
17−-- This will evaluate the @category@ field in the context, then prepend he path,
18−-- and include the referenced file as a template.
19−
20−
211--------------------------------------------------------------------------------
222{-# LANGUAGE CPP #-}
233{-# LANGUAGE ExistentialQuantification #-}
24−{-# LANGUAGE RankNTypes #-}
254module Hakyll.Web.Template.Context
265 ( ContextField (..)
276 , Context (..)
@@ -49,14 +28,13 @@ module Hakyll.Web.Template.Context
4928 , teaserField
5029 , teaserFieldWithSeparator
5130 , missingField
52− , bindItem
5331 ) where
5432
5533
5634--------------------------------------------------------------------------------
5735import Control.Applicative (Alternative (..))
5836import Control.Monad (msum)
59−import Data.List (intercalate, tails)
37+import Data.List (intercalate)
6038#if MIN_VERSION_base(4,9,0)
6139import Data.Semigroup (Semigroup (..))
6240#endif
@@ -72,16 +50,13 @@ import Hakyll.Core.Metadata
7250import Hakyll.Core.Provider
7351import Hakyll.Core.Util.String (needlePrefix, splitAll)
7452import Hakyll.Web.Html
75−import Prelude hiding (id)
76−import System.FilePath (dropExtension, splitDirectories,
77− takeBaseName)
53+import System.FilePath (splitDirectories, takeBaseName)
7854
7955
8056--------------------------------------------------------------------------------
8157-- | Mostly for internal usage
8258data ContextField
83− = EmptyField
84− | StringField String
59+ = StringField String
8560 | forall a. ListField (Context a) [Item a]
8661
8762
@@ -106,8 +81,6 @@ newtype Context a = Context
10681
10782
10883--------------------------------------------------------------------------------
109−-- | Tries to find a key in the left context,
110−-- or when that fails in the right context.
11184#if MIN_VERSION_base(4,9,0)
11285instance Semigroup (Context a) where
11386 (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
@@ -124,105 +97,64 @@ instance Monoid (Context a) where
12497
12598--------------------------------------------------------------------------------
12699field' :: String -> (Item a -> Compiler ContextField) -> Context a
127−field' key value = Context $ \k _ i ->
128− if k == key
129− then value i
130− else noResult $ "Tried field " ++ key
100+field' key value = Context $ \k _ i -> if k == key then value i else empty
131101
132102
133103--------------------------------------------------------------------------------
134−-- | Constructs a new field for a 'Context'.
135−-- If the key matches, the compiler is run and its result is substituted in the
136−-- template.
137−--
138−-- If the compiler fails, the field will be considered non-existent
139−-- in an @$if()$@ macro or ultimately break the template application
140−-- (unless the key is found in another context when using '<>').
141−-- Use 'empty' or 'noResult' for intentional failures of fields used in
142−-- @$if()$@, to distinguish them from exceptions thrown with 'fail'.
104+-- | Constructs a new field in the 'Context.'
143105field
144106 :: String -- ^ Key
145107 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
146− -- on the item (e.g. accessing metadata)
108+ -- on the item
147109 -> Context a
148110field key value = field' key (fmap StringField . value)
149111
150112
151113--------------------------------------------------------------------------------
152114-- | Creates a 'field' to use with the @$if()$@ template macro.
153−-- Attempting to substitute the field into the template will cause an error.
154115boolField
155116 :: String
156117 -> (Item a -> Bool)
157118 -> Context a
158−boolField name f = field' name (\i -> if f i
159− then return EmptyField
160− else noResult $ "Field " ++ name ++ " is false")
119+boolField name f = field name (\i -> if f i
120+ then pure (error $ unwords ["no string value for bool field:",name])
121+ else empty)
161122
162123
163124--------------------------------------------------------------------------------
164−-- | Creates a 'field' that does not depend on the 'Item' but always yields
165−-- the same string
166−constField :: String -- ^ Key
167− -> String -- ^ Value
168− -> Context a
125+-- | Creates a 'field' that does not depend on the 'Item'
126+constField :: String -> String -> Context a
169127constField key = field key . const . return
170128
171129
172130--------------------------------------------------------------------------------
173−-- | Creates a list field to be consumed by a @$for(…)$@ expression.
174−-- The compiler returns multiple items which are rendered in the loop body
175−-- with the supplied context.
176131listField :: String -> Context a -> Compiler [Item a] -> Context b
177132listField key c xs = listFieldWith key c (const xs)
178133
179134
180135--------------------------------------------------------------------------------
181−-- | Produces a new 'Context' which has list field 'key'. All fields from
182−-- 'c' are also accessible from the produced context.
183−-- Be careful when doing @listFieldWith k ca f <> cb@ as any fields in @ca@
184−-- will override fields in @cb@ with the same name.
185−-- Creates a list field like 'listField', but supplies the current page
186−-- to the compiler.
187136listFieldWith
188137 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
189138listFieldWith key c f = field' key $ fmap (ListField c) . f
190139
191140
192141--------------------------------------------------------------------------------
193−-- | Creates a variadic function field.
194−--
195−-- The function will be called with the dynamically evaluated string arguments
196−-- from the template as well as the page that is currently rendered.
197−functionField :: String -- ^ Key
198− -> ([String] -> Item a -> Compiler String) -- ^ Function
199− -> Context a
142+functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
200143functionField name value = Context $ \k args i ->
201144 if k == name
202145 then StringField <$> value args i
203− else noResult $ "Tried function field " ++ name
146+ else empty
204147
205148
206149--------------------------------------------------------------------------------
207−-- | Transform the respective string results of all fields in a context.
208−-- For example,
209−--
210−-- > mapContext (++"c") (constField "x" "a" <> constField "y" "b")
211−--
212−-- is equivalent to
213−--
214−-- > constField "x" "ac" <> constField "y" "bc"
215−--
216150mapContext :: (String -> String) -> Context a -> Context a
217151mapContext f (Context c) = Context $ \k a i -> do
218152 fld <- c k a i
219153 case fld of
220− EmptyField -> wrongType "boolField"
221154 StringField str -> return $ StringField (f str)
222− _ -> wrongType "ListField"
223− where
224− wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++
225− "can't map over a " ++ typ ++ "!"
155+ ListField _ _ -> fail $
156+ "Hakyll.Web.Template.Context.mapContext: " ++
157+ "can't map over a ListField!"
226158
227159--------------------------------------------------------------------------------
228160-- | A context that allows snippet inclusion. In processed file, use as:
@@ -231,15 +163,15 @@ mapContext f (Context c) = Context $ \k a i -> do
231163-- > $snippet("path/to/snippet/")$
232164-- > ...
233165--
234−-- The contents of the included file will not be interpolated like @partial@
235−-- does it.
166+-- The contents of the included file will not be interpolated.
236167--
237168snippetField :: Context String
238169snippetField = functionField "snippet" f
239170 where
240171 f [contentsPath] _ = loadBody (fromFilePath contentsPath)
241− f [] _ = fail "No argument to function 'snippet()'"
242− f _ _ = fail "Too many arguments to function 'snippet()'"
172+ f _ i = error $
173+ "Too many arguments to function 'snippet()' in item " ++
174+ show (itemIdentifier i)
243175
244176--------------------------------------------------------------------------------
245177-- | A context that contains (in that order)
@@ -259,7 +191,8 @@ defaultContext =
259191 metadataField `mappend`
260192 urlField "url" `mappend`
261193 pathField "path" `mappend`
262− titleField "title"
194+ titleField "title" `mappend`
195+ missingField
263196
264197
265198--------------------------------------------------------------------------------
@@ -277,20 +210,15 @@ bodyField key = field key $ return . itemBody
277210-- | Map any field to its metadata value, if present
278211metadataField :: Context a
279212metadataField = Context $ \k _ i -> do
280− let id = itemIdentifier i
281− empty' = noResult $ "No '" ++ k ++ "' field in metadata " ++
282− "of item " ++ show id
283− value <- getMetadataField id k
284− maybe empty' (return . StringField) value
213+ value <- getMetadataField (itemIdentifier i) k
214+ maybe empty (return . StringField) value
285215
286216
287217--------------------------------------------------------------------------------
288218-- | Absolute url to the resulting item
289219urlField :: String -> Context a
290−urlField key = field key $ \i -> do
291− let id = itemIdentifier i
292− empty' = fail $ "No route url found for item " ++ show id
293− fmap (maybe empty' toUrl) $ getRoute id
220+urlField key = field key $
221+ fmap (maybe empty toUrl) . getRoute . itemIdentifier
294222
295223
296224--------------------------------------------------------------------------------
@@ -341,12 +269,6 @@ titleField = mapContext takeBaseName . pathField
341269-- that begins with @yyyy-mm-dd@ . For example:
342270-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
343271-- In case of multiple matches, the rightmost one is used.
344−--
345−-- As another alternative, if none of the above matches, and the file has a
346−-- path which contains nested directories specifying a date, then that date
347−-- will be used. In other words, if the path is of the form
348−-- @**//yyyy//mm//dd//**//main.extension@ .
349−-- As above, in case of multiple matches, the rightmost one is used.
350272
351273dateField :: String -- ^ Key in which the rendered date should be placed
352274 -> String -- ^ Format to use on the date
@@ -357,7 +279,7 @@ dateField = dateFieldWith defaultTimeLocale
357279--------------------------------------------------------------------------------
358280-- | This is an extended version of 'dateField' that allows you to
359281-- specify a time locale that is used for outputting the date. For more
360−-- details, see 'dateField' and 'formatTime'.
282+-- details, see 'dateField'.
361283dateFieldWith :: TimeLocale -- ^ Output time locale
362284 -> String -- ^ Destination key
363285 -> String -- ^ Format to use on the date
@@ -378,13 +300,12 @@ getItemUTC :: MonadMetadata m
378300getItemUTC locale id' = do
379301 metadata <- getMetadata id'
380302 let tryField k fmt = lookupString k metadata >>= parseTime' fmt
381− paths = splitDirectories $ (dropExtension . toFilePath) id'
303+ paths = splitDirectories $ toFilePath id'
382304
383305 maybe empty' return $ msum $
384306 [tryField "published" fmt | fmt <- formats] ++
385307 [tryField "date" fmt | fmt <- formats] ++
386− [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths] ++
387− [parseTime' "%Y-%m-%d" $ intercalate "-" $ fnCand | fnCand <- map (take 3) $ reverse . tails $ paths]
308+ [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths]
388309 where
389310 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
390311 "could not parse time for " ++ show id'
@@ -412,7 +333,6 @@ getItemModificationTime identifier = do
412333
413334
414335--------------------------------------------------------------------------------
415−-- | Creates a field with the last modification date of the underlying item.
416336modificationTimeField :: String -- ^ Key
417337 -> String -- ^ Format
418338 -> Context a -- ^ Resulting context
@@ -420,8 +340,6 @@ modificationTimeField = modificationTimeFieldWith defaultTimeLocale
420340
421341
422342--------------------------------------------------------------------------------
423−-- | Creates a field with the last modification date of the underlying item
424−-- in a custom localisation format (see 'formatTime').
425343modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
426344 -> String -- ^ Key
427345 -> String -- ^ Format
@@ -460,11 +378,10 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
460378
461379
462380--------------------------------------------------------------------------------
463−-- | Constantly reports any field as missing. Mostly for internal usage,
464−-- it is the last choice in every context used in a template application.
465381missingField :: Context a
466−missingField = Context $ \k _ _ -> noResult $
467− "Missing field '" ++ k ++ "' in context"
382+missingField = Context $ \k _ i -> fail $
383+ "Missing field $" ++ k ++ "$ in context for item " ++
384+ show (itemIdentifier i)
468385
469386parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
470387#if MIN_VERSION_time(1,5,0)
@@ -472,10 +389,3 @@ parseTimeM = TF.parseTimeM
472389#else
473390parseTimeM _ = TF.parseTime
474391#endif
475−
476−--------------------------------------------------------------------------------
477−
478−-- | Binds an 'Item' to a given 'Context', allowing it to be combined with any
479−-- other 'Context' of any type.
480−bindItem :: Context a -> Item a -> forall b. Context b
481−bindItem (Context ctx) ia = Context $ \k args _ -> ctx k args ia