@@ -1,98 +0,0 @@
1−-- | This is the module which exports @HakyllAction@.
2−module Text.Hakyll.HakyllAction
3− ( HakyllAction (..)
4− , createHakyllAction
5− , createSimpleHakyllAction
6− , createFileHakyllAction
7− , chain
8− , runHakyllAction
9− , runHakyllActionIfNeeded
10− ) where
11−
12−import Control.Arrow
13−import Control.Category
14−import Control.Monad ((<=<), unless)
15−import Prelude hiding ((.), id)
16−
17−import Text.Hakyll.File (toDestination, isFileMoreRecent)
18−import Text.Hakyll.HakyllMonad
19−
20−-- | Type used for rendering computations that carry along dependencies.
21−data HakyllAction a b = HakyllAction
22− { -- | Dependencies of the @HakyllAction@.
23− actionDependencies :: [FilePath]
24− , -- | URL pointing to the result of this @HakyllAction@.
25− actionUrl :: Either (Hakyll FilePath)
26− (Hakyll FilePath -> Hakyll FilePath)
27− , -- | The actual render function.
28− actionFunction :: a -> Hakyll b
29− }
30−
31−-- | Create a @HakyllAction@ from a function.
32−createHakyllAction :: (a -> Hakyll b) -- ^ Function to execute.
33− -> HakyllAction a b
34−createHakyllAction f = id { actionFunction = f }
35−
36−-- | Create a @HakyllAction@ from a simple @Hakyll@ value.
37−createSimpleHakyllAction :: Hakyll b -- ^ Hakyll value to pass on.
38− -> HakyllAction () b
39−createSimpleHakyllAction = createHakyllAction . const
40−
41−-- | Create a @HakyllAction@ that operates on one file.
42−createFileHakyllAction :: FilePath -- ^ File to operate on.
43− -> Hakyll b -- ^ Value to pass on.
44− -> HakyllAction () b -- ^ The resulting action.
45−createFileHakyllAction path action = HakyllAction
46− { actionDependencies = [path]
47− , actionUrl = Left $ return path
48− , actionFunction = const action
49− }
50−
51−-- | Run a @HakyllAction@ now.
52−runHakyllAction :: HakyllAction () a -- ^ Render action to run.
53− -> Hakyll a -- ^ Result of the action.
54−runHakyllAction action = actionFunction action ()
55−
56−-- | Run a @HakyllAction@, but only when it is out-of-date. At this point, the
57−-- @actionUrl@ field must be set.
58−runHakyllActionIfNeeded :: HakyllAction () () -- ^ Action to run.
59− -> Hakyll () -- ^ Empty result.
60−runHakyllActionIfNeeded action = do
61− url <- case actionUrl action of
62− Left u -> u
63− Right _ -> error "No url when checking dependencies."
64− destination <- toDestination url
65− valid <- isFileMoreRecent destination $ actionDependencies action
66− unless valid $ do logHakyll $ "Rendering " ++ destination
67− runHakyllAction action
68−
69−-- | Chain a number of @HakyllAction@ computations.
70−chain :: [HakyllAction a a] -- ^ Actions to chain.
71− -> HakyllAction a a -- ^ Resulting action.
72−chain [] = id
73−chain list = foldl1 (>>>) list
74−
75−instance Category HakyllAction where
76− id = HakyllAction
77− { actionDependencies = []
78− , actionUrl = Right id
79− , actionFunction = return
80− }
81−
82− x . y = HakyllAction
83− { actionDependencies = actionDependencies x ++ actionDependencies y
84− , actionUrl = case actionUrl x of
85− Left ux -> Left ux
86− Right fx -> case actionUrl y of
87− Left uy -> Left (fx uy)
88− Right fy -> Right (fx . fy)
89− , actionFunction = actionFunction x <=< actionFunction y
90− }
91−
92−instance Arrow HakyllAction where
93− arr f = id { actionFunction = return . f }
94−
95− first x = x
96− { actionFunction = \(y, z) -> do y' <- actionFunction x y
97− return (y', z)
98− }