From 4cb6f9241435fae7a23a7f9fbbdab99e65285eff Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 9 Nov 2012 18:13:51 +0100 Subject: Rewrite template application --- src/Hakyll/Core/Util/Arrow.hs | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) (limited to 'src/Hakyll/Core/Util') 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 () -- cgit v1.2.3