summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll/HakyllAction.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Hakyll/HakyllAction.hs')
-rw-r--r--src/Text/Hakyll/HakyllAction.hs98
1 files changed, 0 insertions, 98 deletions
diff --git a/src/Text/Hakyll/HakyllAction.hs b/src/Text/Hakyll/HakyllAction.hs
deleted file mode 100644
index 491f1f1..0000000
--- a/src/Text/Hakyll/HakyllAction.hs
+++ /dev/null
@@ -1,98 +0,0 @@
--- | This is the module which exports @HakyllAction@.
-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
-
--- | Type used for rendering computations that carry along dependencies.
-data HakyllAction a b = HakyllAction
- { -- | Dependencies of the @HakyllAction@.
- actionDependencies :: [FilePath]
- , -- | URL pointing to the result of this @HakyllAction@.
- actionUrl :: Either (Hakyll FilePath)
- (Hakyll FilePath -> Hakyll FilePath)
- , -- | The actual render function.
- actionFunction :: a -> Hakyll b
- }
-
--- | Create a @HakyllAction@ from a function.
-createHakyllAction :: (a -> Hakyll b) -- ^ Function to execute.
- -> HakyllAction a b
-createHakyllAction f = id { actionFunction = f }
-
--- | Create a @HakyllAction@ from a simple @Hakyll@ value.
-createSimpleHakyllAction :: Hakyll b -- ^ Hakyll value to pass on.
- -> HakyllAction () b
-createSimpleHakyllAction = createHakyllAction . const
-
--- | Create a @HakyllAction@ that operates on one file.
-createFileHakyllAction :: FilePath -- ^ File to operate on.
- -> Hakyll b -- ^ Value to pass on.
- -> HakyllAction () b -- ^ The resulting action.
-createFileHakyllAction path action = HakyllAction
- { actionDependencies = [path]
- , actionUrl = Left $ return path
- , actionFunction = const action
- }
-
--- | Run a @HakyllAction@ now.
-runHakyllAction :: HakyllAction () a -- ^ Render action to run.
- -> Hakyll a -- ^ Result of the action.
-runHakyllAction action = actionFunction action ()
-
--- | Run a @HakyllAction@, but only when it is out-of-date. At this point, the
--- @actionUrl@ field must be set.
-runHakyllActionIfNeeded :: HakyllAction () () -- ^ Action to run.
- -> Hakyll () -- ^ Empty result.
-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 a number of @HakyllAction@ computations.
-chain :: [HakyllAction a a] -- ^ Actions to chain.
- -> HakyllAction a a -- ^ Resulting action.
-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)
- }