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
|
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
-- | 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.
substitute :: String -> Context -> String
substitute [] _ = []
substitute string context
| "$$" `isPrefixOf` string = "$$" ++ (substitute (tail tail') context)
| "$" `isPrefixOf` string = substitute'
| otherwise = (head string) : (substitute tail' context)
where tail' = tail string
(key, rest) = break (not . isAlpha) tail'
replacement = fromMaybe ('$' : key) $ M.lookup key context
substitute' = replacement ++ substitute rest context
-- | 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
seq templateString $ hClose 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 = substitute templateString contextIgnoringRoot
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 = substitute (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]
(makeDirectories destination >> copyFile source destination)
where destination = toDestination source
-- | Render a css file, compressing it.
css :: FilePath -> IO ()
css source = depends destination [source] css'
where destination = toDestination source
css' = do h <- openFile source ReadMode
contents <- hGetContents h
makeDirectories destination
writeFile destination (compressCSS contents)
|
