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