diff options
| -rw-r--r-- | src/Hakyll/Web/Template.hs | 35 | ||||
| -rw-r--r-- | tests/Hakyll/Web/Template/Tests.hs | 32 |
2 files changed, 50 insertions, 17 deletions
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 222ab23..c5c7ff8 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -44,10 +44,12 @@ module Hakyll.Web.Template ( Template , applyTemplate + , applyTemplateWith , applySelf , templateCompiler , templateCompilerWith , applyTemplateCompiler + , applyTemplateCompilerWith ) where import Control.Arrow @@ -65,17 +67,29 @@ import Hakyll.Web.Template.Read import Hakyll.Web.Page.Internal -- | Substitutes @$identifiers@ in the given @Template@ by values from the given --- "Page". When a key is not found, it is left as it is. You can specify --- the characters used to replace escaped dollars (@$$@) here. +-- "Page". When a key is not found, it is left as it is. -- applyTemplate :: Template -> Page String -> Page String -applyTemplate template page = +applyTemplate = applyTemplateWith defaultMissingHandler + +-- | Default solution if a key is missing: render it again +defaultMissingHandler :: String -> String +defaultMissingHandler k = "$" ++ k ++ "$" + +-- | A version of 'applyTemplate' which allows you to give a fallback option, +-- which can produce the value for a key if it is missing. +-- +applyTemplateWith :: (String -> String) -- ^ Fallback if key missing + -> Template -- ^ Template to apply + -> Page String -- ^ Input page + -> Page String -- ^ Resulting page +applyTemplateWith missing template page = fmap (const $ substitute =<< unTemplate template) page where map' = toMap page substitute (Chunk chunk) = chunk - substitute (Key key) = fromMaybe ("$" ++ key ++ "$") $ M.lookup key map' - substitute (Escaped) = "$" + substitute (Key key) = fromMaybe (missing key) $ M.lookup key map' + substitute (Escaped) = "$" -- | Apply a page as it's own template. This is often very useful to fill in -- certain keys like @$root@ and @$url@. @@ -106,4 +120,13 @@ templateCompilerWith settings = applyTemplateCompiler :: Identifier Template -- ^ Template -> Compiler (Page String) (Page String) -- ^ Compiler -applyTemplateCompiler identifier = require identifier (flip applyTemplate) +applyTemplateCompiler = applyTemplateCompilerWith defaultMissingHandler + +-- | A version of 'applyTemplateCompiler' which allows you to pass a function +-- which is called for a key when it is missing. +-- +applyTemplateCompilerWith :: (String -> String) + -> Identifier Template + -> Compiler (Page String) (Page String) +applyTemplateCompilerWith missing identifier = + require identifier (flip $ applyTemplateWith missing) diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs index c772fa8..efbd392 100644 --- a/tests/Hakyll/Web/Template/Tests.hs +++ b/tests/Hakyll/Web/Template/Tests.hs @@ -16,29 +16,39 @@ import TestSuite.Util tests :: [Test] tests = fromAssertions "applyTemplate" -- Hakyll templates - [ applyTemplateAssertion readTemplate + [ applyTemplateAssertion readTemplate applyTemplate "bar" "$foo$" [("foo", "bar")] - , applyTemplateAssertion readTemplate + , applyTemplateAssertion readTemplate applyTemplate "$ barqux" "$$ $foo$$bar$" [("foo", "bar"), ("bar", "qux")] + , applyTemplateAssertion readTemplate applyTemplate + "$foo$" "$foo$" [] + -- Hamlet templates - , applyTemplateAssertion readHamletTemplate + , applyTemplateAssertion readHamletTemplate applyTemplate "<head><title>notice</title></head><body>A paragraph</body>" "<head\n\ \ <title>#{title}\n\ \<body\n\ \ A paragraph\n" [("title", "notice")] + + -- Missing keys + , let missing "foo" = "bar" + missing "bar" = "qux" + missing x = reverse x + in applyTemplateAssertion readTemplate (applyTemplateWith missing) + "bar foo ver" "$foo$ $bar$ $rev$" [("bar", "foo")] ] -- | Utility function to create quick template tests -- -applyTemplateAssertion :: (String -> Template) -- ^ Template parser - -> String -- ^ Expected - -> String -- ^ Template - -> [(String, String)] -- ^ Page - -> Assertion -- ^ Resulting assertion -applyTemplateAssertion parser expected template page = - expected @=? pageBody (applyTemplate (parser template) - (fromMap $ M.fromList page)) +applyTemplateAssertion :: (String -> Template) + -> (Template -> Page String -> Page String) + -> String + -> String + -> [(String, String)] + -> Assertion +applyTemplateAssertion parser apply expected template page = + expected @=? pageBody (apply (parser template) (fromMap $ M.fromList page)) |