diff options
| -rw-r--r-- | src/Text/Hakyll/Render.hs | 57 | ||||
| -rw-r--r-- | src/Text/Hakyll/Render/Internal.hs | 68 |
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) |