summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll/Render.hs
blob: aa3ef8c2eba67656c48a8f42e4e97d81075d082d (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
-- | 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.ContextManipulations
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 . (>>> takeBody)) renders
        return $ concat 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)