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