on master help sign in
"Allow" missing keys in templates
d61d7f1Jasper Van der Jeugt
src/Hakyll/Web/Template.hs+29−6
@@ -44,10 +44,12 @@
44module Hakyll.Web.Template
44module Hakyll.Web.Template
45 ( Template
45 ( Template
46 , applyTemplate
46 , applyTemplate
47+ , applyTemplateWith
47 , applySelf
48 , applySelf
48 , templateCompiler
49 , templateCompiler
49 , templateCompilerWith
50 , templateCompilerWith
50 , applyTemplateCompiler
51 , applyTemplateCompiler
52+ , applyTemplateCompilerWith
51 ) where
53 ) where
52
54
53import Control.Arrow
55import Control.Arrow
@@ -65,17 +67,29 @@ import Hakyll.Web.Template.Read
65import Hakyll.Web.Page.Internal
67import Hakyll.Web.Page.Internal
66
68
67-- | Substitutes @$identifiers@ in the given @Template@ by values from the given
69-- | Substitutes @$identifiers@ in the given @Template@ by values from the given
68−-- "Page". When a key is not found, it is left as it is. You can specify
70+-- "Page". When a key is not found, it is left as it is.
69−-- the characters used to replace escaped dollars (@$$@) here.
70--
71--
71applyTemplate :: Template -> Page String -> Page String
72applyTemplate :: Template -> Page String -> Page String
72−applyTemplate template page =
73+applyTemplate = applyTemplateWith defaultMissingHandler
74+
75+-- | Default solution if a key is missing: render it again
76+defaultMissingHandler :: String -> String
77+defaultMissingHandler k = "$" ++ k ++ "$"
78+
79+-- | A version of 'applyTemplate' which allows you to give a fallback option,
80+-- which can produce the value for a key if it is missing.
81+--
82+applyTemplateWith :: (String -> String) -- ^ Fallback if key missing
83+ -> Template -- ^ Template to apply
84+ -> Page String -- ^ Input page
85+ -> Page String -- ^ Resulting page
86+applyTemplateWith missing template page =
73 fmap (const $ substitute =<< unTemplate template) page
87 fmap (const $ substitute =<< unTemplate template) page
74 where
88 where
75 map' = toMap page
89 map' = toMap page
76 substitute (Chunk chunk) = chunk
90 substitute (Chunk chunk) = chunk
77− substitute (Key key) = fromMaybe ("$" ++ key ++ "$") $ M.lookup key map'
91+ substitute (Key key) = fromMaybe (missing key) $ M.lookup key map'
78− substitute (Escaped) = "$"
92+ substitute (Escaped) = "$"
79
93
80-- | Apply a page as it's own template. This is often very useful to fill in
94-- | Apply a page as it's own template. This is often very useful to fill in
81-- certain keys like @$root@ and @$url@.
95-- certain keys like @$root@ and @$url@.
@@ -106,4 +120,13 @@ templateCompilerWith settings =
106
120
107applyTemplateCompiler :: Identifier Template -- ^ Template
121applyTemplateCompiler :: Identifier Template -- ^ Template
108 -> Compiler (Page String) (Page String) -- ^ Compiler
122 -> Compiler (Page String) (Page String) -- ^ Compiler
109−applyTemplateCompiler identifier = require identifier (flip applyTemplate)
123+applyTemplateCompiler = applyTemplateCompilerWith defaultMissingHandler
124+
125+-- | A version of 'applyTemplateCompiler' which allows you to pass a function
126+-- which is called for a key when it is missing.
127+--
128+applyTemplateCompilerWith :: (String -> String)
129+ -> Identifier Template
130+ -> Compiler (Page String) (Page String)
131+applyTemplateCompilerWith missing identifier =
132+ require identifier (flip $ applyTemplateWith missing)
tests/Hakyll/Web/Template/Tests.hs+21−11
@@ -16,29 +16,39 @@ import TestSuite.Util
16tests :: [Test]
16tests :: [Test]
17tests = fromAssertions "applyTemplate"
17tests = fromAssertions "applyTemplate"
18 -- Hakyll templates
18 -- Hakyll templates
19− [ applyTemplateAssertion readTemplate
19+ [ applyTemplateAssertion readTemplate applyTemplate
20 "bar" "$foo$" [("foo", "bar")]
20 "bar" "$foo$" [("foo", "bar")]
21
21
22− , applyTemplateAssertion readTemplate
22+ , applyTemplateAssertion readTemplate applyTemplate
23 "$ barqux" "$$ $foo$$bar$" [("foo", "bar"), ("bar", "qux")]
23 "$ barqux" "$$ $foo$$bar$" [("foo", "bar"), ("bar", "qux")]
24
24
25+ , applyTemplateAssertion readTemplate applyTemplate
26+ "$foo$" "$foo$" []
27+
25 -- Hamlet templates
28 -- Hamlet templates
26− , applyTemplateAssertion readHamletTemplate
29+ , applyTemplateAssertion readHamletTemplate applyTemplate
27 "<head><title>notice</title></head><body>A paragraph</body>"
30 "<head><title>notice</title></head><body>A paragraph</body>"
28 "<head\n\
31 "<head\n\
29 \ <title>#{title}\n\
32 \ <title>#{title}\n\
30 \<body\n\
33 \<body\n\
31 \ A paragraph\n"
34 \ A paragraph\n"
32 [("title", "notice")]
35 [("title", "notice")]
36+
37+ -- Missing keys
38+ , let missing "foo" = "bar"
39+ missing "bar" = "qux"
40+ missing x = reverse x
41+ in applyTemplateAssertion readTemplate (applyTemplateWith missing)
42+ "bar foo ver" "$foo$ $bar$ $rev$" [("bar", "foo")]
33 ]
43 ]
34
44
35-- | Utility function to create quick template tests
45-- | Utility function to create quick template tests
36--
46--
37−applyTemplateAssertion :: (String -> Template) -- ^ Template parser
47+applyTemplateAssertion :: (String -> Template)
38− -> String -- ^ Expected
48+ -> (Template -> Page String -> Page String)
39− -> String -- ^ Template
49+ -> String
50+ -> String
40− -> [(String, String)] -- ^ Page
51+ -> [(String, String)]
41− -> Assertion -- ^ Resulting assertion
52+ -> Assertion
42−applyTemplateAssertion parser expected template page =
53+applyTemplateAssertion parser apply expected template page =
43− expected @=? pageBody (applyTemplate (parser template)
54+ expected @=? pageBody (apply (parser template) (fromMap $ M.fromList page))
44− (fromMap $ M.fromList page))