module Text.Hakyll.HakyllAction
( HakyllAction (..)
, createHakyllAction
, createSimpleHakyllAction
, createFileHakyllAction
, chain
, runHakyllAction
, runHakyllActionIfNeeded
) where
import Control.Arrow
import Control.Category
import Control.Monad ((<=<), unless)
import Prelude hiding ((.), id)
import Text.Hakyll.File (toDestination, isFileMoreRecent)
import Text.Hakyll.HakyllMonad
data HakyllAction a b = HakyllAction
{
actionDependencies :: [FilePath]
,
actionUrl :: Either (Hakyll FilePath)
(Hakyll FilePath -> Hakyll FilePath)
,
actionFunction :: a -> Hakyll b
}
createHakyllAction :: (a -> Hakyll b)
-> HakyllAction a b
createHakyllAction f = id { actionFunction = f }
createSimpleHakyllAction :: Hakyll b
-> HakyllAction () b
createSimpleHakyllAction = createHakyllAction . const
createFileHakyllAction :: FilePath
-> Hakyll b
-> HakyllAction () b
createFileHakyllAction path action = HakyllAction
{ actionDependencies = [path]
, actionUrl = Left $ return path
, actionFunction = const action
}
runHakyllAction :: HakyllAction () a
-> Hakyll a
runHakyllAction action = actionFunction action ()
runHakyllActionIfNeeded :: HakyllAction () ()
-> Hakyll ()
runHakyllActionIfNeeded action = do
url <- case actionUrl action of
Left u -> u
Right _ -> error "No url when checking dependencies."
destination <- toDestination url
valid <- isFileMoreRecent destination $ actionDependencies action
unless valid $ do logHakyll $ "Rendering " ++ destination
runHakyllAction action
chain :: [HakyllAction a a]
-> HakyllAction a a
chain [] = id
chain list = foldl1 (>>>) list
instance Category HakyllAction where
id = HakyllAction
{ actionDependencies = []
, actionUrl = Right id
, actionFunction = return
}
x . y = HakyllAction
{ actionDependencies = actionDependencies x ++ actionDependencies y
, actionUrl = case actionUrl x of
Left ux -> Left ux
Right fx -> case actionUrl y of
Left uy -> Left (fx uy)
Right fy -> Right (fx . fy)
, actionFunction = actionFunction x <=< actionFunction y
}
instance Arrow HakyllAction where
arr f = id { actionFunction = return . f }
first x = x
{ actionFunction = \(y, z) -> do y' <- actionFunction x y
return (y', z)
}