X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=Control%2FArrow.hs;h=55e004d29eba089373f19f1ea79de774e751e6ae;hb=4966da6b84e60869c917ffcc4ac8245c37b37b8f;hp=0837d6b2d037b5ade9861761e7f7b60f24d6aafe;hpb=e2723a042968e1e947a038bf472a5aefb121376f;p=ghc-base.git

diff --git a/Control/Arrow.hs b/Control/Arrow.hs
index 0837d6b..55e004d 100644
--- a/Control/Arrow.hs
+++ b/Control/Arrow.hs
@@ -33,11 +33,12 @@ module Control.Arrow (
                 -- * Arrow application
                 ArrowApply(..), ArrowMonad(..), leftApp,
                 -- * Feedback
-                ArrowLoop(..)
+                ArrowLoop(..),
+
+                (>>>), (<<<) -- reexported
         ) where
 
 import Prelude hiding (id,(.))
-import qualified Prelude
 
 import Control.Monad
 import Control.Monad.Fix
@@ -52,20 +53,16 @@ infixr 1 ^>>, >>^
 infixr 1 ^<<, <<^
 
 -- | The basic arrow class.
---   Any instance must define either 'arr' or 'pure' (which are synonyms),
---   as well as 'first'.  The other combinators have sensible
---   default definitions, which may be overridden for efficiency.
+--
+--   Minimal complete definition: 'arr' and 'first'.
+--
+--   The other combinators have sensible default definitions,
+--   which may be overridden for efficiency.
 
 class Category a => Arrow a where
 
-        -- | Lift a function to an arrow: you must define either this
-        --   or 'pure'.
+        -- | Lift a function to an arrow.
         arr :: (b -> c) -> a b c
-        arr = pure
-
-        -- | A synonym for 'arr': you must define one or other of them.
-        pure :: (b -> c) -> a b c
-        pure = arr
 
         -- | Send the first component of the input through the argument
         --   arrow, and copy the rest unchanged to the output.
@@ -77,7 +74,8 @@ class Category a => Arrow a where
         --   version if desired.
         second :: a b c -> a (d,b) (d,c)
         second f = arr swap >>> first f >>> arr swap
-                        where   swap ~(x,y) = (y,x)
+                        where   swap :: (x,y) -> (y,x)
+                                swap ~(x,y) = (y,x)
 
         -- | Split the input between the two argument arrows and combine
         --   their output.  Note that this is in general not a functor.
@@ -96,8 +94,6 @@ class Category a => Arrow a where
         f &&& g = arr (\b -> (b,b)) >>> f *** g
 
 {-# RULES
-"identity"
-                arr id = id
 "compose/arr"   forall f g .
                 (arr f) . (arr g) = arr (f . g)
 "first/arr"     forall f .
@@ -162,7 +158,7 @@ class Arrow a => ArrowZero a where
         zeroArrow :: a b c
 
 instance MonadPlus m => ArrowZero (Kleisli m) where
-        zeroArrow = Kleisli (\x -> mzero)
+        zeroArrow = Kleisli (\_ -> mzero)
 
 class ArrowZero a => ArrowPlus a where
         (<+>) :: a b c -> a b c -> a b c
@@ -187,7 +183,8 @@ class Arrow a => ArrowChoice a where
         --   version if desired.
         right :: a b c -> a (Either d b) (Either d c)
         right f = arr mirror >>> left f >>> arr mirror
-                        where   mirror (Left x) = Right x
+                        where   mirror :: Either x y -> Either y x
+                                mirror (Left x) = Right x
                                 mirror (Right y) = Left y
 
         -- | Split the input between the two argument arrows, retagging
@@ -219,9 +216,9 @@ class Arrow a => ArrowChoice a where
 "fanin/arr"     forall f g .
                 arr f ||| arr g = arr (f ||| g)
 "compose/left"  forall f g .
-                left f >>> left g = left (f >>> g)
+                left f . left g = left (f . g)
 "compose/right" forall f g .
-                right f >>> right g = right (f >>> g)
+                right f . right g = right (f . g)
  #-}
 
 instance ArrowChoice (->) where
@@ -253,7 +250,7 @@ instance Monad m => ArrowApply (Kleisli m) where
 newtype ArrowApply a => ArrowMonad a b = ArrowMonad (a () b)
 
 instance ArrowApply a => Monad (ArrowMonad a) where
-        return x = ArrowMonad (arr (\z -> x))
+        return x = ArrowMonad (arr (\_ -> x))
         ArrowMonad m >>= f = ArrowMonad (m >>>
                         arr (\x -> let ArrowMonad h = f x in (h, ())) >>>
                         app)