diff options
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Hakyll/Feed.hs | 2 | ||||
-rw-r--r-- | src/Text/Hakyll/Internal/Render.hs | 39 | ||||
-rw-r--r-- | src/Text/Hakyll/Render.hs | 30 |
3 files changed, 28 insertions, 43 deletions
diff --git a/src/Text/Hakyll/Feed.hs b/src/Text/Hakyll/Feed.hs index db275f6..67d7320 100644 --- a/src/Text/Hakyll/Feed.hs +++ b/src/Text/Hakyll/Feed.hs @@ -28,7 +28,7 @@ import Control.Monad.Reader (liftIO) import Data.Maybe (fromMaybe) import qualified Data.Map as M -import Text.Hakyll.Context (ContextManipulation, renderDate) +import Text.Hakyll.Context (renderDate) import Text.Hakyll.Hakyll (Hakyll, Context) import Text.Hakyll.Render (render, renderChain) import Text.Hakyll.Renderables (createListing) diff --git a/src/Text/Hakyll/Internal/Render.hs b/src/Text/Hakyll/Internal/Render.hs deleted file mode 100644 index a771556..0000000 --- a/src/Text/Hakyll/Internal/Render.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | Internal module do some low-level rendering. -module Text.Hakyll.Internal.Render - ( pureRender - , writePage - ) where - -import qualified Data.Map as M -import Control.Monad.Reader (liftIO) -import Data.Maybe (fromMaybe) - -import Text.Hakyll.File -import Text.Hakyll.Hakyll -import Text.Hakyll.HakyllAction -import Text.Hakyll.Internal.Template - --- | A pure render function. -pureRender :: Template -- ^ Template to use for rendering. - -> Context -- ^ Renderable object to render with given template. - -> Context -- ^ The body of the result will contain the render. -pureRender 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" context - body = regularSubstitute template contextIgnoringRoot - in M.insert "body" body context - --- | Write a page to the site destination. Final action after render --- chains and such. -writePage :: HakyllAction Context () -writePage = createHakyllAction $ \initialContext -> do - additionalContext' <- askHakyll getAdditionalContext - let url = fromMaybe (error "No url defined at write time.") - (M.lookup "url" initialContext) - body = fromMaybe "" (M.lookup "body" initialContext) - let context = additionalContext' `M.union` M.singleton "root" (toRoot url) - destination <- toDestination url - makeDirectories destination - -- Substitute $root here, just before writing. - liftIO $ writeFile destination $ finalSubstitute (fromString body) context diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index 96d2ffb..a81ec2f 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -14,12 +14,22 @@ import System.Directory (copyFile) import Data.Maybe (fromMaybe) import qualified Data.Map as M -import Text.Hakyll.Hakyll (Hakyll, Context) +import Text.Hakyll.Hakyll (Hakyll, Context, askHakyll, getAdditionalContext) import Text.Hakyll.File import Text.Hakyll.HakyllAction import Text.Hakyll.Internal.CompressCss -import Text.Hakyll.Internal.Render -import Text.Hakyll.Internal.Template (readTemplate) +import Text.Hakyll.Internal.Template + +-- | A pure render function. +pureRender :: Template -- ^ Template to use for rendering. + -> Context -- ^ Renderable object to render with given template. + -> Context -- ^ The body of the result will contain the render. +pureRender 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" context + body = regularSubstitute template contextIgnoringRoot + in M.insert "body" body context -- | Render to a Page. render :: FilePath -- ^ Template to use for rendering. @@ -101,3 +111,17 @@ css source = runHakyllActionIfNeeded css' destination <- toDestination source makeDirectories destination liftIO $ writeFile destination (compressCss contents) + +-- | Write a page to the site destination. Final action after render +-- chains and such. +writePage :: HakyllAction Context () +writePage = createHakyllAction $ \initialContext -> do + additionalContext' <- askHakyll getAdditionalContext + let url = fromMaybe (error "No url defined at write time.") + (M.lookup "url" initialContext) + body = fromMaybe "" (M.lookup "body" initialContext) + let context = additionalContext' `M.union` M.singleton "root" (toRoot url) + destination <- toDestination url + makeDirectories destination + -- Substitute $root here, just before writing. + liftIO $ writeFile destination $ finalSubstitute (fromString body) context |