From 986a74b3af664b824a5c67524d2433d7e990f502 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Mon, 7 Feb 2011 11:41:09 +0100
Subject: Add mapA

---
 src/Hakyll/Core/Util/Arrow.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

(limited to 'src/Hakyll')

diff --git a/src/Hakyll/Core/Util/Arrow.hs b/src/Hakyll/Core/Util/Arrow.hs
index d97ba22..49cbf2b 100644
--- a/src/Hakyll/Core/Util/Arrow.hs
+++ b/src/Hakyll/Core/Util/Arrow.hs
@@ -7,7 +7,9 @@ module Hakyll.Core.Util.Arrow
     , mapA
     ) where
 
-import Control.Arrow (Arrow, (&&&), arr, (>>^))
+import Control.Arrow ( Arrow, ArrowChoice, (&&&), arr, (>>^), (|||)
+                     , (>>>), (***)
+                     )
 
 constA :: Arrow a
        => c
@@ -25,7 +27,10 @@ unitA :: Arrow a
       => a b ()
 unitA = constA ()
 
-mapA :: Arrow a
-     => (b -> c)
+mapA :: ArrowChoice a
+     => a b c
      -> a [b] [c]
-mapA = arr . map
+mapA f = arr listEither >>> arr id ||| (f *** mapA f >>> arr (uncurry (:)))
+  where
+    listEither []       = Left []
+    listEither (x : xs) = Right (x, xs)
-- 
cgit v1.2.3