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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
module Text.Hakyll.Render
( depends
, render
, renderWith
, renderAndConcat
, renderAndConcatWith
, renderChain
, renderChainWith
, static
, css
) where
import qualified Data.Map as M
import Data.List (isPrefixOf)
import Control.Monad (unless, liftM, foldM)
import Data.Char (isAlpha)
import Data.Maybe (fromMaybe)
import System.Directory (copyFile)
import System.IO
import Text.Hakyll.Context (Context, ContextManipulation)
import Text.Hakyll.Page
import Text.Hakyll.Renderable
import Text.Hakyll.File
import Text.Hakyll.CompressCSS
import Control.Parallel.Strategies (rnf, ($|))
-- | Execute an IO action only when the cache is invalid.
depends :: FilePath -- ^ File to be rendered or created.
-> [FilePath] -- ^ Files the render depends on.
-> IO () -- ^ IO action to execute when the file is out of date.
-> IO ()
depends file dependencies action = do
valid <- isCacheValid (toDestination file) dependencies
unless valid action
-- | Substitutes `$identifiers` in the given string by values from the given
-- "Context". When a key is not found, it is left as it is. You can here
-- specify the characters used to replace escaped dollars `$$`.
substitute :: String -> String -> Context -> String
substitute _ [] _ = []
substitute escaper string context
| "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')
| "$" `isPrefixOf` string = substituteKey
| otherwise = (head string) : (substitute' tail')
where
tail' = tail string
(key, rest) = break (not . isAlpha) tail'
replacement = fromMaybe ('$' : key) $ M.lookup key context
substituteKey = replacement ++ substitute' rest
substitute' str = substitute escaper str context
-- | "substitute" for use during a chain.
regularSubstitute :: String -> Context -> String
regularSubstitute = substitute "$$"
-- | "substitute" for the end of a chain (just before writing).
finalSubstitute :: String -> Context -> String
finalSubstitute = substitute "$"
-- | Render to a Page.
render :: Renderable a
=> FilePath -- ^ Template to use for rendering.
-> a -- ^ Renderable object to render with given template.
-> IO Page -- ^ The body of the result will contain the render.
render = renderWith id
-- | Render to a Page. This function allows you to manipulate the context
-- first.
renderWith :: Renderable a
=> ContextManipulation -- ^ Manipulation to apply on the context.
-> FilePath -- ^ Template to use for rendering.
-> a -- ^ Renderable object to render with given template.
-> IO Page -- ^ The body of the result will contain the render.
renderWith manipulation templatePath renderable = do
handle <- openFile templatePath ReadMode
templateString <- hGetContents handle
context <- liftM manipulation $ toContext renderable
-- Ignore $root when substituting here. We will only replace that in the
-- final render (just before writing).
let contextIgnoringRoot = M.insert "root" "$root" context
body = regularSubstitute templateString contextIgnoringRoot
-- Force the body to be rendered before closing the handle.
seq (($|) id rnf body) $ hClose handle
return $ fromContext (M.insert "body" body context)
-- | Render each renderable with the given template, then concatenate the
-- result.
renderAndConcat :: Renderable a => FilePath -> [a] -> IO String
renderAndConcat = renderAndConcatWith id
-- | Render each renderable with the given template, then concatenate the
-- result. This function allows you to specify a "ContextManipulation" to
-- apply on every "Renderable".
renderAndConcatWith :: Renderable a
=> ContextManipulation
-> FilePath
-> [a]
-> IO String
renderAndConcatWith manipulation templatePath renderables =
foldM concatRender' [] renderables
where
concatRender' :: Renderable a => String -> a -> IO String
concatRender' chunk renderable = do
rendered <- renderWith manipulation templatePath renderable
let body = getBody rendered
return $ chunk ++ body
-- | Chain a render action for a page with a number of templates. This will
-- also write the result to the site destination. This is the preferred way
-- to do general rendering.
renderChain :: Renderable a => [FilePath] -> a -> IO ()
renderChain = renderChainWith id
-- | A more custom render chain that allows you to specify a
-- "ContextManipulation" which to apply on the context when it is read first.
renderChainWith :: Renderable a
=> ContextManipulation -> [FilePath] -> a -> IO ()
renderChainWith manipulation templates renderable =
depends (getURL renderable) (getDependencies renderable ++ templates) $
do initialPage <- liftM manipulation $ toContext renderable
result <- foldM (flip render) (fromContext initialPage) templates
writePage result
-- | Write a page to the site destination.
writePage :: Page -> IO ()
writePage page = do
let destination = toDestination url
makeDirectories destination
writeFile destination body
where
url = getURL page
-- Substitute $root here, just before writing.
body = finalSubstitute (getBody page)
(M.singleton "root" $ toRoot url)
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
static :: FilePath -> IO ()
static source = depends destination [source] action
where
destination = toDestination source
action = do makeDirectories destination
copyFile source destination
-- | Render a css file, compressing it.
css :: FilePath -> IO ()
css source = depends destination [source] css'
where
destination = toDestination source
css' = do contents <- readFile source
makeDirectories destination
writeFile destination (compressCSS contents)
|
