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