Added pure renderChain function.
This commit is contained in:
parent
ef7ccb1514
commit
ecd00b386e
3 changed files with 22 additions and 10 deletions
|
@ -47,3 +47,4 @@ library
|
|||
Text.Hakyll.Context
|
||||
Text.Hakyll.Regex
|
||||
Network.Hakyll.SimpleServer
|
||||
other-modules: Text.Hakyll.Render.Internal
|
||||
|
|
|
@ -10,7 +10,7 @@ module Text.Hakyll.Render
|
|||
, css
|
||||
) where
|
||||
|
||||
import Control.Monad (unless, liftM, foldM)
|
||||
import Control.Monad (unless, mapM, foldM)
|
||||
|
||||
import System.Directory (copyFile)
|
||||
import System.IO
|
||||
|
@ -49,7 +49,7 @@ renderWith :: Renderable a
|
|||
renderWith manipulation templatePath renderable = do
|
||||
template <- readFile templatePath
|
||||
context <- toContext renderable
|
||||
return $ pureRenderWith manipulation template context
|
||||
return $ fromContext $ pureRenderWith manipulation template context
|
||||
|
||||
-- | Render each renderable with the given template, then concatenate the
|
||||
-- result.
|
||||
|
@ -83,11 +83,12 @@ renderChain = renderChainWith id
|
|||
-- "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
|
||||
renderChainWith manipulation templatePaths renderable =
|
||||
depends (getURL renderable) (getDependencies renderable ++ templatePaths) $
|
||||
do templates <- mapM readFile templatePaths
|
||||
context <- toContext renderable
|
||||
let result = pureRenderChainWith manipulation templates context
|
||||
writePage $ fromContext result
|
||||
|
||||
-- | Mark a certain file as static, so it will just be copied when the site is
|
||||
-- generated.
|
||||
|
|
|
@ -4,12 +4,13 @@ module Text.Hakyll.Render.Internal
|
|||
, regularSubstitute
|
||||
, finalSubstitute
|
||||
, pureRenderWith
|
||||
, pureRenderChainWith
|
||||
, writePage
|
||||
) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Text.Hakyll.Context (Context, ContextManipulation)
|
||||
import Data.List (isPrefixOf)
|
||||
import Data.List (isPrefixOf, foldl')
|
||||
import Data.Char (isAlpha)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Control.Parallel.Strategies (rnf, ($|))
|
||||
|
@ -45,14 +46,23 @@ finalSubstitute = substitute "$"
|
|||
pureRenderWith :: ContextManipulation -- ^ Manipulation to apply on the context.
|
||||
-> String -- ^ Template to use for rendering.
|
||||
-> Context -- ^ Renderable object to render with given template.
|
||||
-> Page -- ^ The body of the result will contain the render.
|
||||
-> Context -- ^ The body of the result will contain the render.
|
||||
pureRenderWith manipulation template context =
|
||||
-- Ignore $root when substituting here. We will only replace that in the
|
||||
-- final render (just before writing).
|
||||
let contextIgnoringRoot = M.insert "root" "$root" (manipulation context)
|
||||
body = regularSubstitute template contextIgnoringRoot
|
||||
-- Force the body to be rendered.
|
||||
in ($|) fromContext rnf (M.insert "body" body context)
|
||||
in ($|) id rnf (M.insert "body" body context)
|
||||
|
||||
-- | A pure renderChain function.
|
||||
pureRenderChainWith :: ContextManipulation
|
||||
-> [String]
|
||||
-> Context
|
||||
-> Context
|
||||
pureRenderChainWith manipulation templates context =
|
||||
let initial = manipulation context
|
||||
in foldl' (flip $ pureRenderWith id) initial templates
|
||||
|
||||
-- | Write a page to the site destination. Final action after render
|
||||
-- chains and such.
|
||||
|
|
Loading…
Reference in a new issue