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
|
-- | Module containing rendering functions. All these functions are used to
-- render files to the @_site@ directory.
module Text.Hakyll.Render
( render
, renderAndConcat
, renderChain
, static
, css
, writePage
) where
import Control.Arrow ((>>>))
import Control.Applicative ((<$>))
import Control.Monad.Reader (liftIO)
import System.Directory (copyFile)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Text.Hakyll.Context (Context (..))
import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, getAdditionalContext)
import Text.Hakyll.File
import Text.Hakyll.HakyllAction
import Text.Hakyll.Internal.CompressCss
import Text.Hakyll.Internal.Template
-- | A pure render function - used internally.
pureRender :: Template -- ^ Template to use for rendering.
-> Context -- ^ Renderable object to render with given template.
-> Context -- ^ The body of the result will contain the render.
pureRender template (Context c) =
-- Ignore $root when substituting here. We will only replace that in the
-- final render (just before writing).
let contextIgnoringRoot = Context $ M.insert "root" "$root" c
body = regularSubstitute template $ contextIgnoringRoot
in Context $ M.insert "body" body c
-- | This is the most simple render action. You render a @Context@ with a
-- template, and get back the result.
render :: FilePath -- ^ Template to use for rendering.
-> HakyllAction Context Context -- ^ The render computation.
render templatePath = HakyllAction
{ actionDependencies = [templatePath]
, actionUrl = Right id
, actionFunction = \context ->
flip pureRender context <$> readTemplate templatePath
}
-- | Render each @Context@ with the given templates, then concatenate the
-- result. So, basically this function:
--
-- - Takes every @Context@.
--
-- - Renders every @Context@ with all given templates. This is comparable
-- with a renderChain action.
--
-- - Concatenates the result and returns that as a @String@.
renderAndConcat :: [FilePath]
-> [HakyllAction () Context]
-> HakyllAction () String
renderAndConcat templatePaths renderables = HakyllAction
{ actionDependencies = renders >>= actionDependencies
, actionUrl = Right id
, actionFunction = actionFunction'
}
where
render' = chain (map render templatePaths)
renders = map (>>> render') renderables
actionFunction' _ = do
contexts <- mapM runHakyllAction renders
return $ concatMap (fromMaybe "" . M.lookup "body" . unContext) contexts
-- | 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 [ "templates/notice.html"
-- > , "templates/default.html"
-- > ] $ createPagePath "warning.html"
--
-- This code will first render @warning.html@ using @templates/notice.html@,
-- and will then render the result with @templates/default.html@.
renderChain :: [FilePath]
-> HakyllAction () Context
-> Hakyll ()
renderChain templatePaths initial =
runHakyllActionIfNeeded renderChainWith'
where
renderChainWith' = initial >>> chain' >>> writePage
chain' = chain $ map render templatePaths
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
static :: FilePath -> Hakyll ()
static source = runHakyllActionIfNeeded static'
where
static' = createFileHakyllAction source $ do
destination <- toDestination source
makeDirectories destination
liftIO $ copyFile source destination
-- | Render a css file, compressing it.
css :: FilePath -> Hakyll ()
css source = runHakyllActionIfNeeded css'
where
css' = createFileHakyllAction source $ do
contents <- liftIO $ readFile source
destination <- toDestination source
makeDirectories destination
liftIO $ writeFile destination (compressCss contents)
-- | Write a page to the site destination. Final action after render
-- chains and such.
writePage :: HakyllAction Context ()
writePage = createHakyllAction $ \(Context initialContext) -> do
additionalContext' <- unContext <$> askHakyll getAdditionalContext
let url = fromMaybe (error "No url defined at write time.")
(M.lookup "url" initialContext)
body = fromMaybe "" (M.lookup "body" initialContext)
let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
destination <- toDestination url
makeDirectories destination
-- Substitute $root here, just before writing.
liftIO $ writeFile destination $ finalSubstitute (fromString body)
(Context context)
|
