Added pure renderChain function.

This commit is contained in:
Jasper Van der Jeugt 2010-01-12 13:09:50 +01:00
parent ef7ccb1514
commit ecd00b386e
3 changed files with 22 additions and 10 deletions

View file

@ -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

View file

@ -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.

View file

@ -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.