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 <[email protected]> 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'. _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
