summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll/Render.hs
blob: ef7493ccc3c1fb233e66ca5f2459b4f422d8a6ab (plain)
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 containing rendering functions. All these functions are used to
--   render files to the @_site@ directory.
module Text.Hakyll.Render 
    ( depends
    , render
    , renderWith
    , renderAndConcat
    , renderAndConcatWith
    , renderChain
    , renderChainWith
    , static
    , css
    ) where

import Control.Monad (unless)
import Control.Arrow ((>>>))
import Control.Monad.Reader (liftIO)
import System.Directory (copyFile)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M

import Text.Hakyll.Hakyll (Hakyll)
import Text.Hakyll.Context (ContextManipulation, Context)
import Text.Hakyll.File
import Text.Hakyll.RenderAction
import Text.Hakyll.Internal.CompressCss
import Text.Hakyll.Internal.Render
import Text.Hakyll.Internal.Template (readTemplate)

-- | Execute an IO action only when the cache is invalid.
depends :: FilePath   -- ^ File to be rendered or created.
        -> [FilePath] -- ^ Files the render depends on.
        -> Hakyll ()  -- ^ Action to execute when the file is out of date.
        -> Hakyll ()
depends file dependencies action = do
    destination <- toDestination file
    valid <- isFileMoreRecent destination dependencies
    unless valid action

-- | Render to a Page.
render :: FilePath                     -- ^ Template to use for rendering.
       -> RenderAction Context Context -- ^ The render computation.
render = renderWith id

-- | Render to a Page. This function allows you to manipulate the context
--   first.
renderWith :: ContextManipulation          -- ^ Manipulation to apply first.
           -> FilePath                     -- ^ Template to use for rendering.
           -> RenderAction Context Context -- ^ The render computation.
renderWith manipulation templatePath = RenderAction
    { actionDependencies = [templatePath]
    , actionUrl          = Nothing
    , actionFunction     = actionFunction'
    }
  where
    actionFunction' context = do
        template <- readTemplate templatePath
        return $ pureRenderWith manipulation template context

-- | Render each renderable with the given templates, then concatenate the
--   result. So, basically this function:
--
--   * Takes every renderable.
--
--   * Renders every renderable with all given templates. This is comparable
--     with a renderChain action.
--
--   * Concatenates the result.
--
renderAndConcat :: [FilePath] -- ^ Templates to apply on every renderable.
                -> [RenderAction () Context] -- ^ Renderables to render.
                -> RenderAction () String
renderAndConcat = renderAndConcatWith id

-- | Render each renderable with the given templates, then concatenate the
--   result. This function allows you to specify a @ContextManipulation@ to
--   apply on every @Renderable@.
renderAndConcatWith :: ContextManipulation
                    -> [FilePath]
                    -> [RenderAction () Context]
                    -> RenderAction () String
renderAndConcatWith manipulation templatePaths renderables = RenderAction
    { actionDependencies = renders >>= actionDependencies
    , actionUrl           = Nothing
    , actionFunction     = actionFunction'
    }
  where
    render' = chain (map render templatePaths)
    renders = map (>>> manipulationAction >>> render') renderables
    manipulationAction = createManipulationAction manipulation

    actionFunction' _ = do
        contexts <- mapM runRenderAction renders
        return $ concatMap (fromMaybe "" . M.lookup "body") 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] -> RenderAction () Context -> Hakyll ()
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 :: ContextManipulation
                -> [FilePath]
                -> RenderAction () Context
                -> Hakyll ()
renderChainWith manipulation templatePaths initial =
    runRenderAction renderChainWith'
  where
    renderChainWith' :: RenderAction () ()
    renderChainWith' = initial >>> manipulationAction >>> chain' >>> writePage

    chain' = chain (map render templatePaths)
    manipulationAction = createManipulationAction manipulation


-- | Mark a certain file as static, so it will just be copied when the site is
--   generated.
static :: FilePath -> Hakyll ()
static source = runRenderAction static'
  where
    static' = RenderAction
        { actionDependencies = [source]
        , actionUrl          = Just $ return source
        , actionFunction     = actionFunction'
        }

    actionFunction' _ = do
        destination <- toDestination source
        makeDirectories destination
        liftIO $ copyFile source destination

-- | Render a css file, compressing it.
css :: FilePath -> Hakyll ()
css source = runRenderAction css'
  where
    css' = RenderAction
        { actionDependencies = [source]
        , actionUrl          = Just $ return source
        , actionFunction     = actionFunction'
        }

    actionFunction' _ = do
        contents <- liftIO $ readFile source
        destination <- toDestination source
        makeDirectories destination
        liftIO $ writeFile destination (compressCss contents)