From 0204dd678a4da1589126868f4e8e588fa132b07d Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Tue, 9 Mar 2010 18:26:53 +0100
Subject: Added Arrow implementation for RenderAction.

---
 src/Text/Hakyll/RenderAction.hs | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'src/Text/Hakyll')

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)
+        }
-- 
cgit v1.2.3