1 files changed, 38 insertions, 19 deletions

diff --git a/libraries/base/Text/ParserCombinators/ReadP.hs b/libraries/base/Text/ParserCombinators/ReadP.hs
index a0e6e22062..e42e882bff 100644
--- a/libraries/base/Text/ParserCombinators/ReadP.hs
+++ b/libraries/base/Text/ParserCombinators/ReadP.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE MagicHash #-}
+{-# LANGUAGE DeriveFunctor #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -60,18 +61,18 @@ module Text.ParserCombinators.ReadP
   chainl1,
   chainr1,
   manyTill,
-  
+
   -- * Running a parser
   ReadS,
   readP_to_S,
   readS_to_P,
-  
+
   -- * Properties
   -- $properties
   )
  where
 
-import Control.Monad( MonadPlus(..), sequence, liftM2 )
+import Control.Monad ( Alternative(empty, (<|>)), MonadPlus(..), sequence, liftM2 )
 
 import {-# SOURCE #-} GHC.Unicode ( isSpace  )
 import GHC.List ( replicate, null )
@@ -99,9 +100,14 @@ data P a
   | Fail
   | Result a (P a)
   | Final [(a,String)] -- invariant: list is non-empty!
+  deriving Functor
 
 -- Monad, MonadPlus
 
+instance Applicative P where
+  pure  = return
+  (<*>) = liftA2 id
+
 instance Monad P where
   return x = Result x Fail
 
@@ -113,34 +119,39 @@ instance Monad P where
 
   fail _ = Fail
 
-instance MonadPlus P where
-  mzero = Fail
+
+instance Alternative P where
+  empty = Fail
 
   -- most common case: two gets are combined
-  Get f1     `mplus` Get f2     = Get (\c -> f1 c `mplus` f2 c)
-  
+  Get f1     <|> Get f2     = Get (\c -> f1 c `mplus` f2 c)
+
   -- results are delivered as soon as possible
-  Result x p `mplus` q          = Result x (p `mplus` q)
-  p          `mplus` Result x q = Result x (p `mplus` q)
+  Result x p <|> q          = Result x (p `mplus` q)
+  p          <|> Result x q = Result x (p `mplus` q)
 
   -- fail disappears
-  Fail       `mplus` p          = p
-  p          `mplus` Fail       = p
+  Fail       <|> p          = p
+  p          <|> Fail       = p
 
   -- two finals are combined
   -- final + look becomes one look and one final (=optimization)
   -- final + sthg else becomes one look and one final
-  Final r    `mplus` Final t    = Final (r ++ t)
-  Final r    `mplus` Look f     = Look (\s -> Final (r ++ run (f s) s))
-  Final r    `mplus` p          = Look (\s -> Final (r ++ run p s))
-  Look f     `mplus` Final r    = Look (\s -> Final (run (f s) s ++ r))
-  p          `mplus` Final r    = Look (\s -> Final (run p s ++ r))
+  Final r    <|> Final t    = Final (r ++ t)
+  Final r    <|> Look f     = Look (\s -> Final (r ++ run (f s) s))
+  Final r    <|> p          = Look (\s -> Final (r ++ run p s))
+  Look f     <|> Final r    = Look (\s -> Final (run (f s) s ++ r))
+  p          <|> Final r    = Look (\s -> Final (run p s ++ r))
 
   -- two looks are combined (=optimization)
   -- look + sthg else floats upwards
-  Look f     `mplus` Look g     = Look (\s -> f s `mplus` g s)
-  Look f     `mplus` p          = Look (\s -> f s `mplus` p)
-  p          `mplus` Look f     = Look (\s -> p `mplus` f s)
+  Look f     <|> Look g     = Look (\s -> f s <|> g s)
+  Look f     <|> p          = Look (\s -> f s <|> p)
+  p          <|> Look f     = Look (\s -> p <|> f s)
+
+instance MonadPlus P where
+  mzero = empty
+  mplus = (<|>)
 
 -- ---------------------------------------------------------------------------
 -- The ReadP type
@@ -152,11 +163,19 @@ newtype ReadP a = R (forall b . (a -> P b) -> P b)
 instance Functor ReadP where
   fmap h (R f) = R (\k -> f (k . h))
 
+instance Applicative ReadP where
+    pure = return
+    (<*>) = liftA2 id
+
 instance Monad ReadP where
   return x  = R (\k -> k x)
   fail _    = R (\_ -> Fail)
   R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
 
+instance Alternative ReadP where
+    empty = mzero
+    (<|>) = mplus
+
 instance MonadPlus ReadP where
   mzero = pfail
   mplus = (+++)