@@ -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 (..)
@@ -39,7 +18,6 @@ module Hakyll.Web.Template.Context
39 , urlField
18 , urlField
40 , pathField
19 , pathField
41 , titleField
20 , titleField
43 , dateField
21 , dateField
44 , dateFieldWith
22 , dateFieldWith
45 , getItemUTC
23 , getItemUTC
@@ -49,21 +27,22 @@ module Hakyll.Web.Template.Context
49 , teaserField
27 , teaserField
50 , teaserFieldWithSeparator
28 , teaserFieldWithSeparator
51 , missingField
29 , missingField
56--------------------------------------------------------------------------------
33--------------------------------------------------------------------------------
57−import Control.Applicative (Alternative (..))
34+import Control.Applicative (Alternative (..), pure, (<$>))
58import Control.Monad (msum)
35import Control.Monad (msum)
59−import Data.List (intercalate, tails)
36+import Data.List (intercalate)
60−#if MIN_VERSION_base(4,9,0)
37+import qualified Data.Map as M
61−import Data.Semigroup (Semigroup (..))
38+import Data.Monoid (Monoid (..))
63import Data.Time.Clock (UTCTime (..))
39import Data.Time.Clock (UTCTime (..))
64import Data.Time.Format (formatTime)
40import Data.Time.Format (formatTime)
65import qualified Data.Time.Format as TF
41import qualified Data.Time.Format as TF
66import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
42import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
43+import System.FilePath (splitDirectories, takeBaseName)
45+--------------------------------------------------------------------------------
67import Hakyll.Core.Compiler
46import Hakyll.Core.Compiler
68import Hakyll.Core.Compiler.Internal
47import Hakyll.Core.Compiler.Internal
69import Hakyll.Core.Identifier
48import Hakyll.Core.Identifier
@@ -72,16 +51,12 @@ import Hakyll.Core.Metadata
72import Hakyll.Core.Provider
51import Hakyll.Core.Provider
73import Hakyll.Core.Util.String (needlePrefix, splitAll)
52import Hakyll.Core.Util.String (needlePrefix, splitAll)
74import Hakyll.Web.Html
53import Hakyll.Web.Html
75−import Prelude hiding (id)
76−import System.FilePath (dropExtension, splitDirectories,
80--------------------------------------------------------------------------------
56--------------------------------------------------------------------------------
81-- | Mostly for internal usage
57-- | Mostly for internal usage
82data ContextField
58data ContextField
84− | StringField String
59+ = StringField String
85 | forall a. ListField (Context a) [Item a]
60 | forall a. ListField (Context a) [Item a]
@@ -106,140 +81,72 @@ newtype Context a = Context
108--------------------------------------------------------------------------------
83--------------------------------------------------------------------------------
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
84instance Monoid (Context a) where
120 mempty = missingField
85 mempty = missingField
121 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
86 mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
125--------------------------------------------------------------------------------
89--------------------------------------------------------------------------------
126field' :: String -> (Item a -> Compiler ContextField) -> Context a
90field' :: String -> (Item a -> Compiler ContextField) -> Context a
127−field' key value = Context $ \k _ i ->
91+field' key value = Context $ \k _ i -> if k == key then value i else empty
130− else noResult $ "Tried field " ++ key
133--------------------------------------------------------------------------------
94--------------------------------------------------------------------------------
134−-- | Constructs a new field for a 'Context'.
95+-- | 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
97 :: String -- ^ Key
145 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
98 -> (Item a -> Compiler String) -- ^ Function that constructs a value based
146− -- on the item (e.g. accessing metadata)
99+ -- on the item
147 -> Context a
100 -> Context a
148field key value = field' key (fmap StringField . value)
101field key value = field' key (fmap StringField . value)
151--------------------------------------------------------------------------------
104--------------------------------------------------------------------------------
152-- | Creates a 'field' to use with the @$if()$@ template macro.
105-- | 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
107 :: String
156 -> (Item a -> Bool)
108 -> (Item a -> Bool)
157 -> Context a
109 -> Context a
158−boolField name f = field' name (\i -> if f i
110+boolField name f = field name (\i -> if f i
159− then return EmptyField
111+ then pure (error $ unwords ["no string value for bool field:",name])
160− else noResult $ "Field " ++ name ++ " is false")
112+ else empty)
163--------------------------------------------------------------------------------
115--------------------------------------------------------------------------------
164−-- | Creates a 'field' that does not depend on the 'Item' but always yields
116+-- | Creates a 'field' that does not depend on the 'Item'
166−constField :: String -- ^ Key
117+constField :: String -> String -> Context a
167− -> String -- ^ Value
169constField key = field key . const . return
118constField key = field key . const . return
172--------------------------------------------------------------------------------
121--------------------------------------------------------------------------------
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
122listField :: String -> Context a -> Compiler [Item a] -> Context b
177listField key c xs = listFieldWith key c (const xs)
123listField key c xs = listFieldWith key c (const xs)
180--------------------------------------------------------------------------------
126--------------------------------------------------------------------------------
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
127listFieldWith
188 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
128 :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
189listFieldWith key c f = field' key $ fmap (ListField c) . f
129listFieldWith key c f = field' key $ fmap (ListField c) . f
192--------------------------------------------------------------------------------
132--------------------------------------------------------------------------------
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
133+functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
200functionField name value = Context $ \k args i ->
134functionField name value = Context $ \k args i ->
201 if k == name
135 if k == name
202 then StringField <$> value args i
136 then StringField <$> value args i
203− else noResult $ "Tried function field " ++ name
137+ else empty
206--------------------------------------------------------------------------------
140--------------------------------------------------------------------------------
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
141mapContext :: (String -> String) -> Context a -> Context a
217mapContext f (Context c) = Context $ \k a i -> do
142mapContext f (Context c) = Context $ \k a i -> do
218 fld <- c k a i
143 fld <- c k a i
219 case fld of
144 case fld of
220− EmptyField -> wrongType "boolField"
221 StringField str -> return $ StringField (f str)
145 StringField str -> return $ StringField (f str)
222− _ -> wrongType "ListField"
146+ ListField _ _ -> fail $
224− wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++
147+ "Hakyll.Web.Template.Context.mapContext: " ++
225− "can't map over a " ++ typ ++ "!"
148+ "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--------------------------------------------------------------------------------
151--------------------------------------------------------------------------------
245-- | A context that contains (in that order)
152-- | A context that contains (in that order)
@@ -259,7 +166,8 @@ defaultContext =
259 metadataField `mappend`
166 metadataField `mappend`
260 urlField "url" `mappend`
167 urlField "url" `mappend`
261 pathField "path" `mappend`
168 pathField "path" `mappend`
262− titleField "title"
169+ titleField "title" `mappend`
265--------------------------------------------------------------------------------
173--------------------------------------------------------------------------------
@@ -277,20 +185,15 @@ bodyField key = field key $ return . itemBody
277-- | Map any field to its metadata value, if present
185-- | Map any field to its metadata value, if present
278metadataField :: Context a
186metadataField :: Context a
279metadataField = Context $ \k _ i -> do
187metadataField = 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
188+ value <- getMetadataField (itemIdentifier i) k
284− maybe empty' (return . StringField) value
189+ maybe empty (return . StringField) value
287--------------------------------------------------------------------------------
192--------------------------------------------------------------------------------
288-- | Absolute url to the resulting item
193-- | Absolute url to the resulting item
289urlField :: String -> Context a
194urlField :: String -> Context a
290−urlField key = field key $ \i -> do
195+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
196+ fmap (maybe empty toUrl) . getRoute . itemIdentifier
296--------------------------------------------------------------------------------
199--------------------------------------------------------------------------------
@@ -341,12 +244,6 @@ titleField = mapContext takeBaseName . pathField
341-- that begins with @yyyy-mm-dd@ . For example:
244-- that begins with @yyyy-mm-dd@ . For example:
342-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
245-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
343-- In case of multiple matches, the rightmost one is used.
246-- 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
248dateField :: String -- ^ Key in which the rendered date should be placed
352 -> String -- ^ Format to use on the date
249 -> String -- ^ Format to use on the date
@@ -357,7 +254,7 @@ dateField = dateFieldWith defaultTimeLocale
357--------------------------------------------------------------------------------
254--------------------------------------------------------------------------------
358-- | This is an extended version of 'dateField' that allows you to
255-- | 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
256-- specify a time locale that is used for outputting the date. For more
360−-- details, see 'dateField' and 'formatTime'.
257+-- details, see 'dateField'.
361dateFieldWith :: TimeLocale -- ^ Output time locale
258dateFieldWith :: TimeLocale -- ^ Output time locale
362 -> String -- ^ Destination key
259 -> String -- ^ Destination key
363 -> String -- ^ Format to use on the date
260 -> String -- ^ Format to use on the date
@@ -377,14 +274,13 @@ getItemUTC :: MonadMetadata m
377 -> m UTCTime -- ^ Parsed UTCTime
274 -> m UTCTime -- ^ Parsed UTCTime
378getItemUTC locale id' = do
275getItemUTC locale id' = do
379 metadata <- getMetadata id'
276 metadata <- getMetadata id'
380− let tryField k fmt = lookupString k metadata >>= parseTime' fmt
277+ let tryField k fmt = M.lookup k metadata >>= parseTime' fmt
381− paths = splitDirectories $ (dropExtension . toFilePath) id'
278+ paths = splitDirectories $ toFilePath id'
383 maybe empty' return $ msum $
280 maybe empty' return $ msum $
384 [tryField "published" fmt | fmt <- formats] ++
281 [tryField "published" fmt | fmt <- formats] ++
385 [tryField "date" fmt | fmt <- formats] ++
282 [tryField "date" fmt | fmt <- formats] ++
386− [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths] ++
283+ [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: " ++
285 empty' = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
390 "could not parse time for " ++ show id'
286 "could not parse time for " ++ show id'
@@ -412,16 +308,13 @@ getItemModificationTime identifier = do
414--------------------------------------------------------------------------------
310--------------------------------------------------------------------------------
415−-- | Creates a field with the last modification date of the underlying item.
416modificationTimeField :: String -- ^ Key
311modificationTimeField :: String -- ^ Key
417 -> String -- ^ Format
312 -> String -- ^ Format
418− -> Context a -- ^ Resulting context
313+ -> Context a -- ^ Resuting context
419modificationTimeField = modificationTimeFieldWith defaultTimeLocale
314modificationTimeField = modificationTimeFieldWith defaultTimeLocale
422--------------------------------------------------------------------------------
317--------------------------------------------------------------------------------
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
318modificationTimeFieldWith :: TimeLocale -- ^ Time output locale
426 -> String -- ^ Key
319 -> String -- ^ Key
427 -> String -- ^ Format
320 -> String -- ^ Format
@@ -460,11 +353,10 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
462--------------------------------------------------------------------------------
355--------------------------------------------------------------------------------
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
356missingField :: Context a
466−missingField = Context $ \k _ _ -> noResult $
357+missingField = Context $ \k _ i -> fail $
467− "Missing field '" ++ k ++ "' in context"
358+ "Missing field $" ++ k ++ "$ in context for item " ++
359+ show (itemIdentifier i)
469parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
361parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
470#if MIN_VERSION_time(1,5,0)
362#if MIN_VERSION_time(1,5,0)
@@ -472,10 +364,3 @@ parseTimeM = TF.parseTimeM
473parseTimeM _ = TF.parseTime
365parseTimeM _ = 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