summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2010-03-09 18:26:53 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2010-03-09 18:26:53 +0100
commit0204dd678a4da1589126868f4e8e588fa132b07d (patch)
tree833a18ccd8d10c58269276d8f2ff2824e8fce7ba
parent4756b82329a086ad6666ccc8578c0cb1d14873e3 (diff)
downloadhakyll-0204dd678a4da1589126868f4e8e588fa132b07d.tar.gz
Added Arrow implementation for RenderAction.
-rw-r--r--src/Text/Hakyll/RenderAction.hs11
1 files changed, 11 insertions, 0 deletions
diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs
index e458eac..a5a6f26 100644
--- a/src/Text/Hakyll/RenderAction.hs
+++ b/src/Text/Hakyll/RenderAction.hs
@@ -11,6 +11,7 @@ module Text.Hakyll.RenderAction
, Renderable
) where
+import Control.Arrow
import Control.Category
import Control.Monad ((<=<), mplus, unless)
import Control.Monad.Reader (liftIO)
@@ -96,3 +97,13 @@ instance Category RenderAction where
, actionUrl = actionUrl y `mplus` actionUrl x
, actionFunction = actionFunction x <=< actionFunction y
}
+
+instance Arrow RenderAction where
+ arr f = id { actionFunction = \x -> return (f x) }
+
+ first x = RenderAction
+ { actionDependencies = actionDependencies x
+ , actionUrl = actionUrl x
+ , actionFunction = \(y, z) -> do y' <- (actionFunction x) y
+ return (y', z)
+ }