@@ -1,27 +1,6 @@
1−-- | This module provides 'Context's which are used to expand expressions in
2−-- templates and allow for arbitrary customisation.
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.
8−-- For example, you can build a context that contains
10−-- > … <> functionField "concat" (const . concat) <> …
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:
15−-- > $partial(concat("templates/categories/", category))$
17−-- This will evaluate the @category@ field in the context, then prepend he path,
18−-- and include the referenced file as a template.
21--------------------------------------------------------------------------------
1--------------------------------------------------------------------------------
22{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
23{-# LANGUAGE ExistentialQuantification #-}
3{-# LANGUAGE ExistentialQuantification #-}
24−{-# LANGUAGE RankNTypes #-}
25module Hakyll.Web.Template.Context
4module Hakyll.Web.Template.Context
26 ( ContextField (..)
5 ( ContextField (..)
27 , Context (..)
6 , Context (..)
@@ -49,21 +28,22 @@ module Hakyll.Web.Template.Context
49 , teaserField
28 , teaserField
50 , teaserFieldWithSeparator
29 , teaserFieldWithSeparator
51 , missingField
30 , missingField
56--------------------------------------------------------------------------------
34--------------------------------------------------------------------------------
57−import Control.Applicative (Alternative (..))
35+import Control.Applicative (Alternative (..), pure, (<$>))
58import Control.Monad (msum)
36import Control.Monad (msum)
59−import Data.List (intercalate, tails)
37+import Data.List (intercalate)
60−#if MIN_VERSION_base(4,9,0)
38+import qualified Data.Map as M
61−import Data.Semigroup (Semigroup (..))
39+import Data.Monoid (Monoid (..))
63import Data.Time.Clock (UTCTime (..))
40import Data.Time.Clock (UTCTime (..))
64import Data.Time.Format (formatTime)
41import Data.Time.Format (formatTime)
65import qualified Data.Time.Format as TF
42import qualified Data.Time.Format as TF
66import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
43import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
44+import System.FilePath (splitDirectories, takeBaseName)
46+--------------------------------------------------------------------------------
67import Hakyll.Core.Compiler
47import Hakyll.Core.Compiler
68import Hakyll.Core.Compiler.Internal
48import Hakyll.Core.Compiler.Internal
69import Hakyll.Core.Identifier
49import Hakyll.Core.Identifier
@@ -72,16 +52,12 @@ import Hakyll.Core.Metadata
72import Hakyll.Core.Provider
52import Hakyll.Core.Provider
73import Hakyll.Core.Util.String (needlePrefix, splitAll)
53import Hakyll.Core.Util.String (needlePrefix, splitAll)
74import Hakyll.Web.Html
54import Hakyll.Web.Html
75−import Prelude hiding (id)
76−import System.FilePath (dropExtension, splitDirectories,
80--------------------------------------------------------------------------------
57--------------------------------------------------------------------------------
81-- | Mostly for internal usage
58-- | Mostly for internal usage
82data ContextField
59data ContextField
84− | StringField String
60+ = StringField String
85 | forall a. ListField (Context a) [Item a]
61 | forall a. ListField (Context a) [Item a]
@@ -106,123 +82,71 @@ newtype Context a = Context
108--------------------------------------------------------------------------------
84--------------------------------------------------------------------------------
109−-- | Tries to find a key in the left context,
110−-- or when that fails in the right context.
111−#if MIN_VERSION_base(4,9,0)
112−instance Semigroup (Context a) where
113− (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
115−instance Monoid (Context a) where
116− mempty = missingField
119instance Monoid (Context a) where
85instance Monoid (Context a) where
120 mempty = missingField
86 mempty = missingField
121 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
87 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
125--------------------------------------------------------------------------------
90--------------------------------------------------------------------------------
126field' :: String -> (Item a -> Compiler ContextField) -> Context a
91field' :: String -> (Item a -> Compiler ContextField) -> Context a
127−field' key value = Context $ \k _ i ->
92+field' key value = Context $ \k _ i -> if k == key then value i else empty
130− else noResult $ "Tried field " ++ key
133--------------------------------------------------------------------------------
95--------------------------------------------------------------------------------
134−-- | Constructs a new field for a 'Context'.
96+-- | Constructs a new field in the 'Context.'
135−-- If the key matches, the compiler is run and its result is substituted in the
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'.
144 :: String -- ^ Key
98 :: String -- ^ Key
145 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
99 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
146− -- on the item (e.g. accessing metadata)
100+ -- on the item
147 -> Context a
101 -> Context a
148field key value = field' key (fmap StringField . value)
102field key value = field' key (fmap StringField . value)
151--------------------------------------------------------------------------------
105--------------------------------------------------------------------------------
152-- | Creates a 'field' to use with the @$if()$@ template macro.
106-- | Creates a 'field' to use with the @$if()$@ template macro.
153−-- Attempting to substitute the field into the template will cause an error.
155 :: String
108 :: String
156 -> (Item a -> Bool)
109 -> (Item a -> Bool)
157 -> Context a
110 -> Context a
158−boolField name f = field' name (\i -> if f i
111+boolField name f = field name (\i -> if f i
159− then return EmptyField
112+ then pure (error $ unwords ["no string value for bool field:",name])
160− else noResult $ "Field " ++ name ++ " is false")
113+ else empty)
163--------------------------------------------------------------------------------
116--------------------------------------------------------------------------------
164−-- | Creates a 'field' that does not depend on the 'Item' but always yields
117+-- | Creates a 'field' that does not depend on the 'Item'
166−constField :: String -- ^ Key
118+constField :: String -> String -> Context a
167− -> String -- ^ Value
169constField key = field key . const . return
119constField key = field key . const . return
172--------------------------------------------------------------------------------
122--------------------------------------------------------------------------------
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.
176listField :: String -> Context a -> Compiler [Item a] -> Context b
123listField :: String -> Context a -> Compiler [Item a] -> Context b
177listField key c xs = listFieldWith key c (const xs)
124listField key c xs = listFieldWith key c (const xs)
180--------------------------------------------------------------------------------
127--------------------------------------------------------------------------------
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
187listFieldWith
128listFieldWith
188 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
129 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
189listFieldWith key c f = field' key $ fmap (ListField c) . f
130listFieldWith key c f = field' key $ fmap (ListField c) . f
192--------------------------------------------------------------------------------
133--------------------------------------------------------------------------------
193−-- | Creates a variadic function field.
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
134+functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
200functionField name value = Context $ \k args i ->
135functionField name value = Context $ \k args i ->
201 if k == name
136 if k == name
202 then StringField <$> value args i
137 then StringField <$> value args i
203− else noResult $ "Tried function field " ++ name
138+ else empty
206--------------------------------------------------------------------------------
141--------------------------------------------------------------------------------
207−-- | Transform the respective string results of all fields in a context.
210−-- > mapContext (++"c") (constField "x" "a" <> constField "y" "b")
214−-- > constField "x" "ac" <> constField "y" "bc"
216mapContext :: (String -> String) -> Context a -> Context a
142mapContext :: (String -> String) -> Context a -> Context a
217mapContext f (Context c) = Context $ \k a i -> do
143mapContext f (Context c) = Context $ \k a i -> do
218 fld <- c k a i
144 fld <- c k a i
219 case fld of
145 case fld of
220− EmptyField -> wrongType "boolField"
221 StringField str -> return $ StringField (f str)
146 StringField str -> return $ StringField (f str)
222− _ -> wrongType "ListField"
147+ ListField _ _ -> fail $
224− wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++
148+ "Hakyll.Web.Template.Context.mapContext: " ++
225− "can't map over a " ++ typ ++ "!"
149+ "can't map over a ListField!"
227--------------------------------------------------------------------------------
151--------------------------------------------------------------------------------
228-- | A context that allows snippet inclusion. In processed file, use as:
152-- | A context that allows snippet inclusion. In processed file, use as:
@@ -231,15 +155,15 @@ mapContext f (Context c) = Context $ \k a i -> do
231-- > $snippet("path/to/snippet/")$
155-- > $snippet("path/to/snippet/")$
234−-- The contents of the included file will not be interpolated like @partial@
158+-- The contents of the included file will not be interpolated.
237snippetField :: Context String
160snippetField :: Context String
238snippetField = functionField "snippet" f
161snippetField = functionField "snippet" f
240 f [contentsPath] _ = loadBody (fromFilePath contentsPath)
163 f [contentsPath] _ = loadBody (fromFilePath contentsPath)
241− f [] _ = fail "No argument to function 'snippet()'"
164+ f _ i = error $
242− f _ _ = fail "Too many arguments to function 'snippet()'"
165+ "Too many arguments to function 'snippet()' in item " ++
166+ show (itemIdentifier i)
244--------------------------------------------------------------------------------
168--------------------------------------------------------------------------------
245-- | A context that contains (in that order)
169-- | A context that contains (in that order)
@@ -259,7 +183,8 @@ defaultContext =
259 metadataField `mappend`
183 metadataField `mappend`
260 urlField "url" `mappend`
184 urlField "url" `mappend`
261 pathField "path" `mappend`
185 pathField "path" `mappend`
262− titleField "title"
186+ titleField "title" `mappend`
265--------------------------------------------------------------------------------
190--------------------------------------------------------------------------------
@@ -277,20 +202,15 @@ bodyField key = field key $ return . itemBody
277-- | Map any field to its metadata value, if present
202-- | Map any field to its metadata value, if present
278metadataField :: Context a
203metadataField :: Context a
279metadataField = Context $ \k _ i -> do
204metadataField = 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
205+ value <- getMetadataField (itemIdentifier i) k
284− maybe empty' (return . StringField) value
206+ maybe empty (return . StringField) value
287--------------------------------------------------------------------------------
209--------------------------------------------------------------------------------
288-- | Absolute url to the resulting item
210-- | Absolute url to the resulting item
289urlField :: String -> Context a
211urlField :: String -> Context a
290−urlField key = field key $ \i -> do
212+urlField key = field key $
291− let id = itemIdentifier i
292− empty' = fail $ "No route url found for item " ++ show id
293− fmap (maybe empty' toUrl) $ getRoute id
213+ fmap (maybe empty toUrl) . getRoute . itemIdentifier
296--------------------------------------------------------------------------------
216--------------------------------------------------------------------------------
@@ -341,12 +261,6 @@ titleField = mapContext takeBaseName . pathField
341-- that begins with @yyyy-mm-dd@ . For example:
261-- that begins with @yyyy-mm-dd@ . For example:
342-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
262-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
343-- In case of multiple matches, the rightmost one is used.
263-- In case of multiple matches, the rightmost one is used.
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.
351dateField :: String -- ^ Key in which the rendered date should be placed
265dateField :: String -- ^ Key in which the rendered date should be placed
352 -> String -- ^ Format to use on the date
266 -> String -- ^ Format to use on the date
@@ -357,7 +271,7 @@ dateField = dateFieldWith defaultTimeLocale
357--------------------------------------------------------------------------------
271--------------------------------------------------------------------------------
358-- | This is an extended version of 'dateField' that allows you to
272-- | This is an extended version of 'dateField' that allows you to
359-- specify a time locale that is used for outputting the date. For more
273-- specify a time locale that is used for outputting the date. For more
360−-- details, see 'dateField' and 'formatTime'.
274+-- details, see 'dateField'.
361dateFieldWith :: TimeLocale -- ^ Output time locale
275dateFieldWith :: TimeLocale -- ^ Output time locale
362 -> String -- ^ Destination key
276 -> String -- ^ Destination key
363 -> String -- ^ Format to use on the date
277 -> String -- ^ Format to use on the date
@@ -377,14 +291,13 @@ getItemUTC :: MonadMetadata m
377 -> m UTCTime -- ^ Parsed UTCTime
291 -> m UTCTime -- ^ Parsed UTCTime
378getItemUTC locale id' = do
292getItemUTC locale id' = do
379 metadata <- getMetadata id'
293 metadata <- getMetadata id'
380− let tryField k fmt = lookupString k metadata >>= parseTime' fmt
294+ let tryField k fmt = M.lookup k metadata >>= parseTime' fmt
381− paths = splitDirectories $ (dropExtension . toFilePath) id'
295+ paths = splitDirectories $ toFilePath id'
383 maybe empty' return $ msum $
297 maybe empty' return $ msum $
384 [tryField "published" fmt | fmt <- formats] ++
298 [tryField "published" fmt | fmt <- formats] ++
385 [tryField "date" fmt | fmt <- formats] ++
299 [tryField "date" fmt | fmt <- formats] ++
386− [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths] ++
300+ [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]
389 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
302 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
390 "could not parse time for " ++ show id'
303 "could not parse time for " ++ show id'
@@ -412,16 +325,13 @@ getItemModificationTime identifier = do
414--------------------------------------------------------------------------------
327--------------------------------------------------------------------------------
415−-- | Creates a field with the last modification date of the underlying item.
416modificationTimeField :: String -- ^ Key
328modificationTimeField :: String -- ^ Key
417 -> String -- ^ Format
329 -> String -- ^ Format
418− -> Context a -- ^ Resulting context
330+ -> Context a -- ^ Resuting context
419modificationTimeField = modificationTimeFieldWith defaultTimeLocale
331modificationTimeField = modificationTimeFieldWith defaultTimeLocale
422--------------------------------------------------------------------------------
334--------------------------------------------------------------------------------
423−-- | Creates a field with the last modification date of the underlying item
424−-- in a custom localisation format (see 'formatTime').
425modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
335modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
426 -> String -- ^ Key
336 -> String -- ^ Key
427 -> String -- ^ Format
337 -> String -- ^ Format
@@ -460,11 +370,10 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
462--------------------------------------------------------------------------------
372--------------------------------------------------------------------------------
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.
465missingField :: Context a
373missingField :: Context a
466−missingField = Context $ \k _ _ -> noResult $
374+missingField = Context $ \k _ i -> fail $
467− "Missing field '" ++ k ++ "' in context"
375+ "Missing field $" ++ k ++ "$ in context for item " ++
376+ show (itemIdentifier i)
469parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
378parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
470#if MIN_VERSION_time(1,5,0)
379#if MIN_VERSION_time(1,5,0)
@@ -472,10 +381,3 @@ parseTimeM = TF.parseTimeM
473parseTimeM _ = TF.parseTime
382parseTimeM _ = TF.parseTime
476−--------------------------------------------------------------------------------
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