[project @ 2004-09-22 08:37:01 by panne]

[ghc-base.git] / Control / Arrow.hs

diff --git a/Control/Arrow.hs b/Control/Arrow.hs
index 34783e0..316ef06 100644 (file)
--- a/Control/Arrow.hs
+++ b/Control/Arrow.hs
@@ -8,8 +8,6 @@
 -- Stability   :  experimental
 -- Portability :  portable
 --
--- $Id: Arrow.hs,v 1.2 2002/04/24 17:57:55 ross Exp $
---
 -- Basic arrow definitions, based on
 --     /Generalising Monads to Arrows/, by John Hughes,
 --     /Science of Computer Programming/ 37, pp67-111, May 2000.
@@ -18,9 +16,24 @@
 --     Firenze, Italy, pp229-240.
 -- See these papers for the equations these combinators are expected to
 -- satisfy.  These papers and more information on arrows can be found at
--- <http://www.soi.city.ac.uk/~ross/arrows/>.
-
-module Control.Arrow where
+-- <http://www.haskell.org/arrows/>.
+
+module Control.Arrow (
+               -- * Arrows
+               Arrow(..), Kleisli(..),
+               -- ** Derived combinators
+               returnA, (<<<),
+               -- * Monoid operations
+               ArrowZero(..), ArrowPlus(..),
+               -- * Conditionals
+               ArrowChoice(..),
+               -- * Arrow application
+               ArrowApply(..), ArrowMonad(..), leftApp,
+               -- * Feedback
+               ArrowLoop(..)
+       ) where
+
+import Prelude
 
 import Control.Monad
 import Control.Monad.Fix
@@ -33,9 +46,6 @@ infixr 2 |||
 infixr 1 >>>
 infixr 1 <<<
 
------------------------------------------------------------------------------
--- * Arrows
-
 -- | The basic arrow class.
 --   Any instance must define either 'arr' or 'pure' (which are synonyms),
 --   as well as '>>>' and 'first'.  The other combinators have sensible
@@ -83,6 +93,23 @@ class Arrow a where
        (&&&) :: a b c -> a b c' -> a b (c,c')
        f &&& g = arr (\b -> (b,b)) >>> f *** g
 
+{-# RULES
+"compose/arr"  forall f g .
+               arr f >>> arr g = arr (f >>> g)
+"first/arr"    forall f .
+               first (arr f) = arr (first f)
+"second/arr"   forall f .
+               second (arr f) = arr (second f)
+"product/arr"  forall f g .
+               arr f *** arr g = arr (f *** g)
+"fanout/arr"   forall f g .
+               arr f &&& arr g = arr (f &&& g)
+"compose/first"        forall f g .
+               first f >>> first g = first (f >>> g)
+"compose/second" forall f g .
+               second f >>> second g = second (f >>> g)
+ #-}
+
 -- Ordinary functions are arrows.
 
 instance Arrow (->) where
@@ -90,7 +117,9 @@ instance Arrow (->) where
        f >>> g = g . f
        first f = f *** id
        second f = id *** f
-       (f *** g) ~(x,y) = (f x, g y)
+--     (f *** g) ~(x,y) = (f x, g y)
+--     sorry, although the above defn is fully H'98, nhc98 can't parse it.
+       (***) f g ~(x,y) = (f x, g y)
 
 -- | Kleisli arrows of a monad.
 
@@ -102,9 +131,6 @@ instance Monad m => Arrow (Kleisli m) where
        first (Kleisli f) = Kleisli (\ ~(b,d) -> f b >>= \c -> return (c,d))
        second (Kleisli f) = Kleisli (\ ~(d,b) -> f b >>= \c -> return (d,c))
 
------------------------------------------------------------------------------
--- ** Derived combinators
-
 -- | The identity arrow, which plays the role of 'return' in arrow notation.
 
 returnA :: Arrow a => a b b
@@ -115,9 +141,6 @@ returnA = arr id
 (<<<) :: Arrow a => a c d -> a b c -> a b d
 f <<< g = g >>> f
 
------------------------------------------------------------------------------
--- * Monoid operations
-
 class Arrow a => ArrowZero a where
        zeroArrow :: a b c
 
@@ -130,11 +153,8 @@ class ArrowZero a => ArrowPlus a where
 instance MonadPlus m => ArrowPlus (Kleisli m) where
        Kleisli f <+> Kleisli g = Kleisli (\x -> f x `mplus` g x)
 
------------------------------------------------------------------------------
--- * Conditionals
-
 -- | Choice, for arrows that support it.  This class underlies the
---   [if] and [case] constructs in arrow notation.
+--   @if@ and @case@ constructs in arrow notation.
 --   Any instance must define 'left'.  The other combinators have sensible
 --   default definitions, which may be overridden for efficiency.
 
@@ -172,6 +192,21 @@ class Arrow a => ArrowChoice a where
                        where   untag (Left x) = x
                                untag (Right y) = y
 
+{-# RULES
+"left/arr"     forall f .
+               left (arr f) = arr (left f)
+"right/arr"    forall f .
+               right (arr f) = arr (right f)
+"sum/arr"      forall f g .
+               arr f +++ arr g = arr (f +++ g)
+"fanin/arr"    forall f g .
+               arr f ||| arr g = arr (f ||| g)
+"compose/left" forall f g .
+               left f >>> left g = left (f >>> g)
+"compose/right"        forall f g .
+               right f >>> right g = right (f >>> g)
+ #-}
+
 instance ArrowChoice (->) where
        left f = f +++ id
        right f = id +++ f
@@ -184,9 +219,6 @@ instance Monad m => ArrowChoice (Kleisli m) where
        f +++ g = (f >>> arr Left) ||| (g >>> arr Right)
        Kleisli f ||| Kleisli g = Kleisli (either f g)
 
------------------------------------------------------------------------------
--- * Arrow application
-
 -- | Some arrows allow application of arrow inputs to other inputs.
 
 class Arrow a => ArrowApply a where
@@ -216,12 +248,9 @@ leftApp :: ArrowApply a => a b c -> a (Either b d) (Either c d)
 leftApp f = arr ((\b -> (arr (\() -> b) >>> f >>> arr Left, ())) |||
                 (\d -> (arr (\() -> d) >>> arr Right, ()))) >>> app
 
------------------------------------------------------------------------------
--- * Feedback
-
 -- | The 'loop' operator expresses computations in which an output value is
 --   fed back as input, even though the computation occurs only once.
---   It underlies the [rec] value recursion construct in arrow notation.
+--   It underlies the @rec@ value recursion construct in arrow notation.
 
 class Arrow a => ArrowLoop a where
        loop :: a (b,d) (c,d) -> a b c