summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2010-01-12 12:26:07 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2010-01-12 12:26:07 +0100
commitef7ccb15149862e1213ed66a31d65fc577c32d58 (patch)
tree20571a199fb4f63eee5183c9f05b449afc467cd1 /src/Text
parent36b0b72b63cb0fa9eb5861a961c14b41543b1d81 (diff)
downloadhakyll-ef7ccb15149862e1213ed66a31d65fc577c32d58.tar.gz
Added pure render function.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Hakyll/Render.hs57
-rw-r--r--src/Text/Hakyll/Render/Internal.hs68
2 files changed, 73 insertions, 52 deletions
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 58a8d4d..649ad4b 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -10,22 +10,18 @@ module Text.Hakyll.Render
, css
) where
-import qualified Data.Map as M
-import Data.List (isPrefixOf)
import Control.Monad (unless, liftM, foldM)
-import Data.Char (isAlpha)
-import Data.Maybe (fromMaybe)
import System.Directory (copyFile)
import System.IO
-import Text.Hakyll.Context (Context, ContextManipulation)
+import Text.Hakyll.Context (ContextManipulation)
import Text.Hakyll.Page
import Text.Hakyll.Renderable
import Text.Hakyll.File
import Text.Hakyll.CompressCSS
-import Control.Parallel.Strategies (rnf, ($|))
+import Text.Hakyll.Render.Internal
-- | Execute an IO action only when the cache is invalid.
depends :: FilePath -- ^ File to be rendered or created.
@@ -36,30 +32,6 @@ depends file dependencies action = do
valid <- isCacheValid (toDestination file) dependencies
unless valid action
--- | Substitutes `$identifiers` in the given string by values from the given
--- "Context". When a key is not found, it is left as it is. You can here
--- specify the characters used to replace escaped dollars `$$`.
-substitute :: String -> String -> Context -> String
-substitute _ [] _ = []
-substitute escaper string context
- | "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')
- | "$" `isPrefixOf` string = substituteKey
- | otherwise = (head string) : (substitute' tail')
- where
- tail' = tail string
- (key, rest) = break (not . isAlpha) tail'
- replacement = fromMaybe ('$' : key) $ M.lookup key context
- substituteKey = replacement ++ substitute' rest
- substitute' str = substitute escaper str context
-
--- | "substitute" for use during a chain.
-regularSubstitute :: String -> Context -> String
-regularSubstitute = substitute "$$"
-
--- | "substitute" for the end of a chain (just before writing).
-finalSubstitute :: String -> Context -> String
-finalSubstitute = substitute "$"
-
-- | Render to a Page.
render :: Renderable a
=> FilePath -- ^ Template to use for rendering.
@@ -75,16 +47,9 @@ renderWith :: Renderable a
-> a -- ^ Renderable object to render with given template.
-> IO Page -- ^ The body of the result will contain the render.
renderWith manipulation templatePath renderable = do
- handle <- openFile templatePath ReadMode
- templateString <- hGetContents handle
- context <- liftM manipulation $ toContext renderable
- -- Ignore $root when substituting here. We will only replace that in the
- -- final render (just before writing).
- let contextIgnoringRoot = M.insert "root" "$root" context
- body = regularSubstitute templateString contextIgnoringRoot
- -- Force the body to be rendered before closing the handle.
- seq (($|) id rnf body) $ hClose handle
- return $ fromContext (M.insert "body" body context)
+ template <- readFile templatePath
+ context <- toContext renderable
+ return $ pureRenderWith manipulation template context
-- | Render each renderable with the given template, then concatenate the
-- result.
@@ -124,18 +89,6 @@ renderChainWith manipulation templates renderable =
result <- foldM (flip render) (fromContext initialPage) templates
writePage result
--- | Write a page to the site destination.
-writePage :: Page -> IO ()
-writePage page = do
- let destination = toDestination url
- makeDirectories destination
- writeFile destination body
- where
- url = getURL page
-    -- Substitute $root here, just before writing.
-    body = finalSubstitute (getBody page)
-                           (M.singleton "root" $ toRoot url)
-
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
static :: FilePath -> IO ()
diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs
new file mode 100644
index 0000000..5b3e0a2
--- /dev/null
+++ b/src/Text/Hakyll/Render/Internal.hs
@@ -0,0 +1,68 @@
+-- | Internal module do some low-level rendering.
+module Text.Hakyll.Render.Internal
+ ( substitute
+ , regularSubstitute
+ , finalSubstitute
+ , pureRenderWith
+ , writePage
+ ) where
+
+import qualified Data.Map as M
+import Text.Hakyll.Context (Context, ContextManipulation)
+import Data.List (isPrefixOf)
+import Data.Char (isAlpha)
+import Data.Maybe (fromMaybe)
+import Control.Parallel.Strategies (rnf, ($|))
+import Text.Hakyll.Renderable
+import Text.Hakyll.Page
+import Text.Hakyll.File
+
+-- | Substitutes `$identifiers` in the given string by values from the given
+-- "Context". When a key is not found, it is left as it is. You can here
+-- specify the characters used to replace escaped dollars `$$`.
+substitute :: String -> String -> Context -> String
+substitute _ [] _ = []
+substitute escaper string context
+ | "$$" `isPrefixOf` string = escaper ++ substitute' (tail tail')
+ | "$" `isPrefixOf` string = substituteKey
+ | otherwise = (head string) : (substitute' tail')
+ where
+ tail' = tail string
+ (key, rest) = break (not . isAlpha) tail'
+ replacement = fromMaybe ('$' : key) $ M.lookup key context
+ substituteKey = replacement ++ substitute' rest
+ substitute' str = substitute escaper str context
+
+-- | "substitute" for use during a chain.
+regularSubstitute :: String -> Context -> String
+regularSubstitute = substitute "$$"
+
+-- | "substitute" for the end of a chain (just before writing).
+finalSubstitute :: String -> Context -> String
+finalSubstitute = substitute "$"
+
+-- | A pure render function.
+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.
+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)
+
+-- | Write a page to the site destination. Final action after render
+-- chains and such.
+writePage :: Page -> IO ()
+writePage page = do
+ let destination = toDestination url
+ makeDirectories destination
+ writeFile destination body
+ where
+ url = getURL page
+    -- Substitute $root here, just before writing.
+    body = finalSubstitute (getBody page)
+                           (M.singleton "root" $ toRoot url)