@@ -1,32 +1,9 @@
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--------------------------------------------------------------------------------
23{-# LANGUAGE ExistentialQuantification #-}
2{-# LANGUAGE ExistentialQuantification #-}
24−{-# LANGUAGE RankNTypes #-}
25module Hakyll.Web.Template.Context
3module Hakyll.Web.Template.Context
26 ( ContextField (..)
4 ( ContextField (..)
27 , Context (..)
5 , Context (..)
30 , constField
7 , constField
31 , listField
8 , listField
32 , listFieldWith
9 , listFieldWith
@@ -39,49 +16,43 @@ module Hakyll.Web.Template.Context
39 , urlField
16 , urlField
40 , pathField
17 , pathField
41 , titleField
18 , titleField
43 , dateField
19 , dateField
44 , dateFieldWith
20 , dateFieldWith
45 , getItemUTC
21 , getItemUTC
46− , getItemModificationTime
47 , modificationTimeField
22 , modificationTimeField
48 , modificationTimeFieldWith
23 , modificationTimeFieldWith
49 , teaserField
24 , teaserField
50− , teaserFieldWithSeparator
51 , missingField
25 , missingField
56--------------------------------------------------------------------------------
29--------------------------------------------------------------------------------
57−import Control.Applicative (Alternative (..))
30+import Control.Applicative (Alternative (..), (<$>))
58import Control.Monad (msum)
31import Control.Monad (msum)
59−import Data.List (intercalate, tails)
32+import Data.List (intercalate)
60−#if MIN_VERSION_base(4,9,0)
33+import qualified Data.Map as M
61−import Data.Semigroup (Semigroup (..))
34+import Data.Monoid (Monoid (..))
63import Data.Time.Clock (UTCTime (..))
35import Data.Time.Clock (UTCTime (..))
64−import Data.Time.Format (formatTime)
36+import Data.Time.Format (formatTime, parseTime)
65−import qualified Data.Time.Format as TF
37+import System.FilePath (takeBaseName, splitDirectories)
66−import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
38+import System.Locale (TimeLocale, defaultTimeLocale)
41+--------------------------------------------------------------------------------
67import Hakyll.Core.Compiler
42import Hakyll.Core.Compiler
68import Hakyll.Core.Compiler.Internal
43import Hakyll.Core.Compiler.Internal
69import Hakyll.Core.Identifier
44import Hakyll.Core.Identifier
70import Hakyll.Core.Item
45import Hakyll.Core.Item
71import Hakyll.Core.Metadata
46import Hakyll.Core.Metadata
72import Hakyll.Core.Provider
47import Hakyll.Core.Provider
73−import Hakyll.Core.Util.String (needlePrefix, splitAll)
48+import Hakyll.Core.Util.String (splitAll, needlePrefix)
74import Hakyll.Web.Html
49import Hakyll.Web.Html
75−import Prelude hiding (id)
76−import System.FilePath (dropExtension, splitDirectories,
80--------------------------------------------------------------------------------
52--------------------------------------------------------------------------------
81-- | Mostly for internal usage
53-- | Mostly for internal usage
82data ContextField
54data ContextField
84− | StringField String
55+ = StringField String
85 | forall a. ListField (Context a) [Item a]
56 | forall a. ListField (Context a) [Item a]
@@ -106,140 +77,61 @@ newtype Context a = Context
108--------------------------------------------------------------------------------
79--------------------------------------------------------------------------------
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
80instance Monoid (Context a) where
120 mempty = missingField
81 mempty = missingField
121 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
82 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
125--------------------------------------------------------------------------------
85--------------------------------------------------------------------------------
126field' :: String -> (Item a -> Compiler ContextField) -> Context a
86field' :: String -> (Item a -> Compiler ContextField) -> Context a
127−field' key value = Context $ \k _ i ->
87+field' key value = Context $ \k _ i -> if k == key then value i else empty
130− else noResult $ "Tried field " ++ key
133--------------------------------------------------------------------------------
90--------------------------------------------------------------------------------
134−-- | Constructs a new field for a 'Context'.
91+-- | 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
93 :: String -- ^ Key
145 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
94 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
146− -- on the item (e.g. accessing metadata)
95+ -- on the item
147 -> Context a
96 -> Context a
148field key value = field' key (fmap StringField . value)
97field key value = field' key (fmap StringField . value)
151--------------------------------------------------------------------------------
100--------------------------------------------------------------------------------
152−-- | Creates a 'field' to use with the @$if()$@ template macro.
153−-- Attempting to substitute the field into the template will cause an error.
158−boolField name f = field' name (\i -> if f i
159− then return EmptyField
160− else noResult $ "Field " ++ name ++ " is false")
163−--------------------------------------------------------------------------------
164−-- | Creates a 'field' that does not depend on the 'Item' but always yields
101+-- | Creates a 'field' that does not depend on the 'Item'
166−constField :: String -- ^ Key
102+constField :: String -> String -> Context a
167− -> String -- ^ Value
169constField key = field key . const . return
103constField key = field key . const . return
172--------------------------------------------------------------------------------
106--------------------------------------------------------------------------------
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
107listField :: String -> Context a -> Compiler [Item a] -> Context b
177listField key c xs = listFieldWith key c (const xs)
108listField key c xs = listFieldWith key c (const xs)
180--------------------------------------------------------------------------------
111--------------------------------------------------------------------------------
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
112listFieldWith
188 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
113 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
189listFieldWith key c f = field' key $ fmap (ListField c) . f
114listFieldWith key c f = field' key $ fmap (ListField c) . f
192--------------------------------------------------------------------------------
117--------------------------------------------------------------------------------
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
118+functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
200functionField name value = Context $ \k args i ->
119functionField name value = Context $ \k args i ->
201 if k == name
120 if k == name
202 then StringField <$> value args i
121 then StringField <$> value args i
203− else noResult $ "Tried function field " ++ name
122+ else empty
206--------------------------------------------------------------------------------
125--------------------------------------------------------------------------------
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
126mapContext :: (String -> String) -> Context a -> Context a
217mapContext f (Context c) = Context $ \k a i -> do
127mapContext f (Context c) = Context $ \k a i -> do
218 fld <- c k a i
128 fld <- c k a i
219 case fld of
129 case fld of
220− EmptyField -> wrongType "boolField"
221 StringField str -> return $ StringField (f str)
130 StringField str -> return $ StringField (f str)
222− _ -> wrongType "ListField"
131+ ListField _ _ -> fail $
224− wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++
132+ "Hakyll.Web.Template.Context.mapContext: " ++
225− "can't map over a " ++ typ ++ "!"
133+ "can't map over a ListField!"
227−--------------------------------------------------------------------------------
228−-- | A context that allows snippet inclusion. In processed file, use as:
231−-- > $snippet("path/to/snippet/")$
234−-- The contents of the included file will not be interpolated like @partial@
237−snippetField :: Context String
238−snippetField = functionField "snippet" f
240− f [contentsPath] _ = loadBody (fromFilePath contentsPath)
241− f [] _ = fail "No argument to function 'snippet()'"
242− f _ _ = fail "Too many arguments to function 'snippet()'"
244--------------------------------------------------------------------------------
136--------------------------------------------------------------------------------
245-- | A context that contains (in that order)
137-- | A context that contains (in that order)
@@ -259,7 +151,8 @@ defaultContext =
259 metadataField `mappend`
151 metadataField `mappend`
260 urlField "url" `mappend`
152 urlField "url" `mappend`
261 pathField "path" `mappend`
153 pathField "path" `mappend`
262− titleField "title"
154+ titleField "title" `mappend`
265--------------------------------------------------------------------------------
158--------------------------------------------------------------------------------
@@ -277,20 +170,15 @@ bodyField key = field key $ return . itemBody
277-- | Map any field to its metadata value, if present
170-- | Map any field to its metadata value, if present
278metadataField :: Context a
171metadataField :: Context a
279metadataField = Context $ \k _ i -> do
172metadataField = 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
173+ value <- getMetadataField (itemIdentifier i) k
284− maybe empty' (return . StringField) value
174+ maybe empty (return . StringField) value
287--------------------------------------------------------------------------------
177--------------------------------------------------------------------------------
288-- | Absolute url to the resulting item
178-- | Absolute url to the resulting item
289urlField :: String -> Context a
179urlField :: String -> Context a
290−urlField key = field key $ \i -> do
180+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
181+ fmap (maybe empty toUrl) . getRoute . itemIdentifier
296--------------------------------------------------------------------------------
184--------------------------------------------------------------------------------
@@ -337,16 +225,10 @@ titleField = mapContext takeBaseName . pathField
337-- Alternatively, when the metadata has a field called @path@ in a
225-- Alternatively, when the metadata has a field called @path@ in a
338-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
226-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
339-- and no @published@ metadata field set, this function can render
227-- and no @published@ metadata field set, this function can render
340−-- the date. This pattern matches the file name or directory names
228+-- the date. This pattern matches the file name or directory names
341-- that begins with @yyyy-mm-dd@ . For example:
229-- that begins with @yyyy-mm-dd@ . For example:
342-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
230-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
343-- In case of multiple matches, the rightmost one is used.
231-- 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
233dateField :: String -- ^ Key in which the rendered date should be placed
352 -> String -- ^ Format to use on the date
234 -> String -- ^ Format to use on the date
@@ -357,7 +239,7 @@ dateField = dateFieldWith defaultTimeLocale
357--------------------------------------------------------------------------------
239--------------------------------------------------------------------------------
358-- | This is an extended version of 'dateField' that allows you to
240-- | 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
241-- specify a time locale that is used for outputting the date. For more
360−-- details, see 'dateField' and 'formatTime'.
242+-- details, see 'dateField'.
361dateFieldWith :: TimeLocale -- ^ Output time locale
243dateFieldWith :: TimeLocale -- ^ Output time locale
362 -> String -- ^ Destination key
244 -> String -- ^ Destination key
363 -> String -- ^ Format to use on the date
245 -> String -- ^ Format to use on the date
@@ -377,18 +259,17 @@ getItemUTC :: MonadMetadata m
377 -> m UTCTime -- ^ Parsed UTCTime
259 -> m UTCTime -- ^ Parsed UTCTime
378getItemUTC locale id' = do
260getItemUTC locale id' = do
379 metadata <- getMetadata id'
261 metadata <- getMetadata id'
380− let tryField k fmt = lookupString k metadata >>= parseTime' fmt
262+ let tryField k fmt = M.lookup k metadata >>= parseTime' fmt
381− paths = splitDirectories $ (dropExtension . toFilePath) id'
263+ paths = splitDirectories $ toFilePath id'
383 maybe empty' return $ msum $
265 maybe empty' return $ msum $
384 [tryField "published" fmt | fmt <- formats] ++
266 [tryField "published" fmt | fmt <- formats] ++
385 [tryField "date" fmt | fmt <- formats] ++
267 [tryField "date" fmt | fmt <- formats] ++
386− [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths] ++
268+ [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: " ++
270 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
390 "could not parse time for " ++ show id'
271 "could not parse time for " ++ show id'
391− parseTime' = parseTimeM True locale
272+ parseTime' = parseTime locale
392 formats =
273 formats =
393 [ "%a, %d %b %Y %H:%M:%S %Z"
274 [ "%a, %d %b %Y %H:%M:%S %Z"
394 , "%Y-%m-%dT%H:%M:%S%Z"
275 , "%Y-%m-%dT%H:%M:%S%Z"
@@ -401,33 +282,20 @@ getItemUTC locale id' = do
403--------------------------------------------------------------------------------
284--------------------------------------------------------------------------------
404−-- | Get the time on which the actual file was last modified. This only works if
405−-- there actually is an underlying file, of couse.
406−getItemModificationTime
409−getItemModificationTime identifier = do
410− provider <- compilerProvider <$> compilerAsk
411− return $ resourceModificationTime provider identifier
414−--------------------------------------------------------------------------------
415−-- | Creates a field with the last modification date of the underlying item.
416modificationTimeField :: String -- ^ Key
285modificationTimeField :: String -- ^ Key
417 -> String -- ^ Format
286 -> String -- ^ Format
418− -> Context a -- ^ Resulting context
287+ -> Context a -- ^ Resuting context
419modificationTimeField = modificationTimeFieldWith defaultTimeLocale
288modificationTimeField = modificationTimeFieldWith defaultTimeLocale
422--------------------------------------------------------------------------------
291--------------------------------------------------------------------------------
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
292modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
426 -> String -- ^ Key
293 -> String -- ^ Key
427 -> String -- ^ Format
294 -> String -- ^ Format
428 -> Context a -- ^ Resulting context
295 -> Context a -- ^ Resulting context
429modificationTimeFieldWith locale key fmt = field key $ \i -> do
296modificationTimeFieldWith locale key fmt = field key $ \i -> do
430− mtime <- getItemModificationTime $ itemIdentifier i
297+ provider <- compilerProvider <$> compilerAsk
298+ let mtime = resourceModificationTime provider $ itemIdentifier i
431 return $ formatTime locale fmt mtime
299 return $ formatTime locale fmt mtime
@@ -438,21 +306,9 @@ modificationTimeFieldWith locale key fmt = field key $ \i -> do
438teaserField :: String -- ^ Key to use
306teaserField :: String -- ^ Key to use
439 -> Snapshot -- ^ Snapshot to load
307 -> Snapshot -- ^ Snapshot to load
440 -> Context String -- ^ Resulting context
308 -> Context String -- ^ Resulting context
441−teaserField = teaserFieldWithSeparator teaserSeparator
444−--------------------------------------------------------------------------------
445−-- | A context with "teaser" key which contain a teaser of the item, defined as
446−-- the snapshot content before the teaser separator. The item is loaded from the
447−-- given snapshot (which should be saved in the user code before any templates
449−teaserFieldWithSeparator :: String -- ^ Separator to use
450− -> String -- ^ Key to use
451− -> Snapshot -- ^ Snapshot to load
452− -> Context String -- ^ Resulting context
453−teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
309+teaserField key snapshot = field key $ \item -> do
454 body <- itemBody <$> loadSnapshot (itemIdentifier item) snapshot
310 body <- itemBody <$> loadSnapshot (itemIdentifier item) snapshot
455− case needlePrefix separator body of
311+ case needlePrefix teaserSeparator body of
456 Nothing -> fail $
312 Nothing -> fail $
457 "Hakyll.Web.Template.Context: no teaser defined for " ++
313 "Hakyll.Web.Template.Context: no teaser defined for " ++
458 show (itemIdentifier item)
314 show (itemIdentifier item)
@@ -460,22 +316,7 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
462--------------------------------------------------------------------------------
318--------------------------------------------------------------------------------
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
319missingField :: Context a
466−missingField = Context $ \k _ _ -> noResult $
320+missingField = Context $ \k _ i -> fail $
467− "Missing field '" ++ k ++ "' in context"
321+ "Missing field $" ++ k ++ "$ in context for item " ++
468−
322+ show (itemIdentifier i)
469−parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
470−#if MIN_VERSION_time(1,5,0)
471−parseTimeM = TF.parseTimeM
473−parseTimeM _ = 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