From ecd00b386e2848cab19c16afdcaeae3133f39569 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 12 Jan 2010 13:09:50 +0100
Subject: Added pure renderChain function.

---
 src/Text/Hakyll/Render.hs          | 15 ++++++++-------
 src/Text/Hakyll/Render/Internal.hs | 16 +++++++++++++---
 2 files changed, 21 insertions(+), 10 deletions(-)

(limited to 'src')

diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 649ad4b..c55e5d8 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -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.
diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs
index 5b3e0a2..eca15a0 100644
--- a/src/Text/Hakyll/Render/Internal.hs
+++ b/src/Text/Hakyll/Render/Internal.hs
@@ -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.
-- 
cgit v1.2.3