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