Rewrite template application

1 files changed, 26 insertions, 11 deletions

diff --git a/src/Hakyll/Core/Util/Arrow.hs b/src/Hakyll/Core/Util/Arrow.hs
index f46d083..96a5e09 100644
--- a/src/Hakyll/Core/Util/Arrow.hs
+++ b/src/Hakyll/Core/Util/Arrow.hs
@@ -1,25 +1,40 @@
+--------------------------------------------------------------------------------
 -- | Various arrow utility functions
---
 module Hakyll.Core.Util.Arrow
-    ( constA
+    ( ArrowMap (..)
+    , constA
     , sequenceA
     , unitA
     ) where
 
-import Control.Arrow (Arrow, (&&&), arr, (>>^))
 
-constA :: Arrow a
-       => c
-       -> a b c
+--------------------------------------------------------------------------------
+import           Control.Arrow (Arrow, ArrowChoice, arr, (&&&), (>>^))
+
+
+--------------------------------------------------------------------------------
+-- | Additional arrow typeclass for performance reasons.
+class ArrowChoice a => ArrowMap a where
+    mapA :: a b c -> a [b] [c]
+
+
+--------------------------------------------------------------------------------
+instance ArrowMap (->) where
+    mapA = map
+
+
+--------------------------------------------------------------------------------
+constA :: Arrow a => c -> a b c
 constA = arr . const
 
-sequenceA :: Arrow a
-          => [a b c]
-          -> a b [c]
+
+--------------------------------------------------------------------------------
+sequenceA :: Arrow a => [a b c] -> a b [c]
 sequenceA = foldr reduce $ constA []
   where
     reduce xa la = xa &&& la >>^ arr (uncurry (:))
 
-unitA :: Arrow a
-      => a b ()
+
+--------------------------------------------------------------------------------
+unitA :: Arrow a => a b ()
 unitA = constA ()