module Text.Hakyll.Render
( render
, renderAndConcat
, renderChain
, static
, css
, writePage
) where
import Control.Arrow ((>>>))
import Control.Applicative ((<$>))
import Control.Monad.Reader (liftIO)
import System.Directory (copyFile)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Text.Hakyll.Context (Context (..))
import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, getAdditionalContext)
import Text.Hakyll.File
import Text.Hakyll.HakyllAction
import Text.Hakyll.Internal.CompressCss
import Text.Hakyll.Internal.Template
pureRender :: Template
-> Context
-> Context
pureRender template (Context c) =
let contextIgnoringRoot = Context $ M.insert "root" "$root" c
body = regularSubstitute template $ contextIgnoringRoot
in Context $ M.insert "body" body c
render :: FilePath
-> HakyllAction Context Context
render templatePath = HakyllAction
{ actionDependencies = [templatePath]
, actionUrl = Right id
, actionFunction = \context ->
flip pureRender context <$> readTemplate templatePath
}
renderAndConcat :: [FilePath]
-> [HakyllAction () Context]
-> HakyllAction () String
renderAndConcat templatePaths renderables = HakyllAction
{ actionDependencies = renders >>= actionDependencies
, actionUrl = Right id
, actionFunction = actionFunction'
}
where
render' = chain (map render templatePaths)
renders = map (>>> render') renderables
actionFunction' _ = do
contexts <- mapM runHakyllAction renders
return $ concatMap (fromMaybe "" . M.lookup "body" . unContext) contexts
renderChain :: [FilePath]
-> HakyllAction () Context
-> Hakyll ()
renderChain templatePaths initial =
runHakyllActionIfNeeded renderChainWith'
where
renderChainWith' = initial >>> chain' >>> writePage
chain' = chain $ map render templatePaths
static :: FilePath -> Hakyll ()
static source = runHakyllActionIfNeeded static'
where
static' = createFileHakyllAction source $ do
destination <- toDestination source
makeDirectories destination
liftIO $ copyFile source destination
css :: FilePath -> Hakyll ()
css source = runHakyllActionIfNeeded css'
where
css' = createFileHakyllAction source $ do
contents <- liftIO $ readFile source
destination <- toDestination source
makeDirectories destination
liftIO $ writeFile destination (compressCss contents)
writePage :: HakyllAction Context ()
writePage = createHakyllAction $ \(Context initialContext) -> do
additionalContext' <- unContext <$> 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
liftIO $ writeFile destination $ finalSubstitute (fromString body)
(Context context)