-- | Internal module do some low-level rendering. module Text.Hakyll.Render.Internal ( substitute , regularSubstitute , finalSubstitute , pureRenderWith , pureRenderAndConcatWith , pureRenderChainWith , writePage ) where import qualified Data.Map as M import Text.Hakyll.Context (Context, ContextManipulation) import Data.List (isPrefixOf, foldl') import Data.Char (isAlpha) import Data.Maybe (fromMaybe) import Control.Parallel.Strategies (rdeepseq, ($|)) 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. -> 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 ($|) id rdeepseq (M.insert "body" body context) -- | A pure renderAndConcat function. pureRenderAndConcatWith :: ContextManipulation -> String -- ^ Template to use. -> [Context] -- ^ Different renderables. -> String pureRenderAndConcatWith manipulation template contexts = foldl' renderAndConcat [] contexts where renderAndConcat chunk context = let rendered = pureRenderWith manipulation template context in chunk ++ fromMaybe "" (M.lookup "body" rendered) -- | 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. 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)