[commit: base] master: Added missing Functor, Applicative, Alternative and MonadPlus instances Added Applicative and Alternative instances for ReadP and ReadPrec Added Functor, Applicative, Alternative and MonadPlust instances for ArrowMonadx (c010103)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/c01010387a0c1d4d71de55f2957800337c00264d

>---------------------------------------------------------------

commit c01010387a0c1d4d71de55f2957800337c00264d
Author: Bas van Dijk <v.dijk.bas at gmail.com>
Date:   Fri Nov 11 18:47:24 2011 +0100

    Added missing Functor, Applicative, Alternative and MonadPlus instances Added Applicative and Alternative instances for ReadP and ReadPrec Added Functor, Applicative, Alternative and MonadPlust instances for ArrowMonadx

>---------------------------------------------------------------

 Control/Applicative.hs |   36 +++++++++++++++++++++++++++++++++++-
 Control/Arrow.hs       |    7 +++++++
 2 files changed, 42 insertions(+), 1 deletions(-)

diff --git a/Control/Applicative.hs b/Control/Applicative.hs
index 3a9db61..04e8e9d 100644
--- a/Control/Applicative.hs
+++ b/Control/Applicative.hs
@@ -48,7 +48,7 @@ module Control.Applicative (
 import Prelude hiding (id,(.))
 
 import Control.Category
-import Control.Arrow (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))
+import Control.Arrow
 import Control.Monad (liftM, ap, MonadPlus(..))
 #ifndef __NHC__
 import Control.Monad.ST.Safe (ST)
@@ -57,6 +57,16 @@ import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST)
 import Data.Functor ((<$>), (<$))
 import Data.Monoid (Monoid(..))
 
+import Text.ParserCombinators.ReadP
+#ifndef __NHC__
+  (ReadP)
+#else
+  (ReadPN)
+#define ReadP (ReadPN b)
+#endif
+
+import Text.ParserCombinators.ReadPrec (ReadPrec)
+
 #ifdef __GLASGOW_HASKELL__
 import GHC.Conc (STM, retry, orElse)
 #endif
@@ -204,6 +214,30 @@ instance Applicative (Either e) where
     Left  e <*> _ = Left e
     Right f <*> r = fmap f r
 
+instance Applicative ReadP where
+    pure = return
+    (<*>) = ap
+
+instance Alternative ReadP where
+    empty = mzero
+    (<|>) = mplus
+
+instance Applicative ReadPrec where
+    pure = return
+    (<*>) = ap
+
+instance Alternative ReadPrec where
+    empty = mzero
+    (<|>) = mplus
+
+instance Arrow a => Applicative (ArrowMonad a) where
+   pure x = ArrowMonad (arr (const x))
+   ArrowMonad f <*> ArrowMonad x = ArrowMonad (f &&& x >>> arr (uncurry id))
+
+instance ArrowPlus a => Alternative (ArrowMonad a) where
+   empty = ArrowMonad zeroArrow
+   ArrowMonad x <|> ArrowMonad y = ArrowMonad (x <+> y)
+
 -- new instances
 
 newtype Const a b = Const { getConst :: a }
diff --git a/Control/Arrow.hs b/Control/Arrow.hs
index 8915f09..73dfe3d 100644
--- a/Control/Arrow.hs
+++ b/Control/Arrow.hs
@@ -296,11 +296,18 @@ instance Monad m => ArrowApply (Kleisli m) where
 
 newtype ArrowMonad a b = ArrowMonad (a () b)
 
+instance Arrow a => Functor (ArrowMonad a) where
+    fmap f (ArrowMonad m) = ArrowMonad $ m >>> arr f
+
 instance ArrowApply a => Monad (ArrowMonad a) where
     return x = ArrowMonad (arr (\_ -> x))
     ArrowMonad m >>= f = ArrowMonad $
         m >>> arr (\x -> let ArrowMonad h = f x in (h, ())) >>> app
 
+instance (ArrowApply a, ArrowPlus a) => MonadPlus (ArrowMonad a) where
+   mzero = ArrowMonad zeroArrow
+   ArrowMonad x `mplus` ArrowMonad y = ArrowMonad (x <+> y)
+
 -- | Any instance of 'ArrowApply' can be made into an instance of
 --   'ArrowChoice' by defining 'left' = 'leftApp'.