1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
-- | This module provides means for reading and applying 'Template's.
--
-- Templates are tools to convert items into a string. They are perfectly suited
-- for laying out your site.
--
-- Let's look at an example template:
--
-- > <html>
-- > <head>
-- > <title>My crazy homepage - $title$</title>
-- > </head>
-- > <body>
-- > <div id="header">
-- > <h1>My crazy homepage - $title$</h1>
-- > </div>
-- > <div id="content">
-- > $body$
-- > </div>
-- > <div id="footer">
-- > By reading this you agree that I now own your soul
-- > </div>
-- > </body>
-- > </html>
--
-- As you can see, the format is very simple -- @$key$@ is used to render the
-- @$key$@ field from the page, everything else is literally copied. If you want
-- to literally insert @\"$key$\"@ into your page (for example, when you're
-- writing a Hakyll tutorial) you can use
--
-- > <p>
-- > A literal $$key$$.
-- > </p>
--
-- Because of it's simplicity, these templates can be used for more than HTML:
-- you could make, for example, CSS or JS templates as well.
module Hakyll.Web.Template
( Template
, templateCompiler
, applyTemplate
, loadAndApplyTemplate
, applyAsTemplate
, applyTemplateWith
) where
--------------------------------------------------------------------------------
import Control.Monad (liftM)
import Control.Monad.Error (MonadError(..))
import Data.Monoid (mappend)
import Prelude hiding (id)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
import Hakyll.Core.Item
import Hakyll.Web.Template.Context
import Hakyll.Web.Template.Internal
import Hakyll.Web.Template.Read
--------------------------------------------------------------------------------
-- | Read a template.
templateCompiler :: Compiler (Item Template)
templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
item <- getResourceString
return $ fmap readTemplate item
--------------------------------------------------------------------------------
applyTemplate :: Template -- ^ Template
-> Context a -- ^ Context
-> Item a -- ^ Page
-> Compiler (Item String) -- ^ Resulting item
applyTemplate tpl context item = do
-- Appending missingField gives better error messages
let context' k x = unContext (context `mappend` missingField) k x
body <- applyTemplateWith context' tpl item
return $ itemSetBody body item
--------------------------------------------------------------------------------
-- | The following pattern is so common:
--
-- > tpl <- loadBody "templates/foo.html"
-- > someCompiler
-- > >>= applyTemplate tpl context
--
-- That we have a single function which does this:
--
-- > someCompiler
-- > >>= loadAndApplyTemplate "templates/foo.html" context
loadAndApplyTemplate :: Identifier -- ^ Template identifier
-> Context a -- ^ Context
-> Item a -- ^ Page
-> Compiler (Item String) -- ^ Resulting item
loadAndApplyTemplate identifier context item = do
tpl <- loadBody identifier
applyTemplate tpl context item
--------------------------------------------------------------------------------
-- | It is also possible that you want to substitute @$key$@s within the body of
-- an item. This function does that by interpreting the item body as a template,
-- and then applying it to itself.
applyAsTemplate :: Context String -- ^ Context
-> Item String -- ^ Item and template
-> Compiler (Item String) -- ^ Resulting item
applyAsTemplate context item =
let tpl = readTemplate $ itemBody item
in applyTemplate tpl context item
--------------------------------------------------------------------------------
-- | Overloaded apply template function to work in an arbitrary Monad.
applyTemplateWith :: MonadError e m
=> (String -> a -> m String)
-> Template -> a -> m String
applyTemplateWith context tpl x = go tpl
where
go = liftM concat . mapM applyElem . unTemplate
applyElem (Chunk c) = return c
applyElem Escaped = return "$"
applyElem (Key k) = context k x
applyElem (If k t mf) = (context k x >> go t) `catchError` handler
where
handler _ = case mf of
Nothing -> return ""
Just f -> go f
|
