module Text.Hakyll.CreateContext
( createPage
, createCustomPage
, createListing
, addField
, combine
, combineWithUrl
) where
import Prelude hiding (id)
import qualified Data.Map as M
import Control.Arrow (second, arr, (&&&), (***))
import Control.Monad (liftM2)
import Control.Applicative ((<$>))
import Control.Arrow ((>>>))
import Control.Category (id)
import Text.Hakyll.Context
import Text.Hakyll.HakyllAction
import Text.Hakyll.Render
import Text.Hakyll.Page
import Text.Hakyll.Pandoc
import Text.Hakyll.Internal.Cache
createPage :: FilePath -> HakyllAction () Context
createPage path = cacheAction "pages" $ readPageAction path >>> renderAction
createCustomPage :: FilePath
-> [(String, Either String (HakyllAction () String))]
-> HakyllAction () Context
createCustomPage url association = HakyllAction
{ actionDependencies = dataDependencies
, actionUrl = Left $ return url
, actionFunction = \_ -> Context . M.fromList <$> assoc'
}
where
mtuple (a, b) = b >>= \b' -> return (a, b')
toHakyllString = second (either return runHakyllAction)
assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association
dataDependencies = map snd association >>= getDependencies
getDependencies (Left _) = []
getDependencies (Right x) = actionDependencies x
createListing :: FilePath
-> [FilePath]
-> [HakyllAction () Context]
-> [(String, Either String (HakyllAction () String))]
-> HakyllAction () Context
createListing url templates renderables additional =
createCustomPage url context
where
context = ("body", Right concatenation) : additional
concatenation = renderAndConcat templates renderables
addField :: String
-> Either String (HakyllAction () String)
-> HakyllAction Context Context
addField key value = arr (const ()) &&& id
>>> value' *** id
>>> arr (uncurry insert)
where
value' = arr (const ()) >>> either (arr . const) id value
insert v = Context . M.insert key v . unContext
combine :: HakyllAction () Context -> HakyllAction () Context
-> HakyllAction () Context
combine x y = HakyllAction
{ actionDependencies = actionDependencies x ++ actionDependencies y
, actionUrl = actionUrl x
, actionFunction = \_ ->
Context <$> liftM2 (M.union) (unContext <$> runHakyllAction x)
(unContext <$> runHakyllAction y)
}
combineWithUrl :: FilePath
-> HakyllAction () Context
-> HakyllAction () Context
-> HakyllAction () Context
combineWithUrl url x y = combine'
{ actionUrl = Left $ return url
, actionFunction = \_ ->
Context . M.insert "url" url . unContext <$> runHakyllAction combine'
}
where
combine' = combine x y