summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libraries/base/GHC/Base.hs8
-rw-r--r--libraries/base/GHC/IO.hs10
-rw-r--r--libraries/base/GHC/IO.hs-boot2
-rw-r--r--libraries/base/changelog.md3
m---------libraries/transformers0
5 files changed, 19 insertions, 4 deletions
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index 619acac7e0..189e480359 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -111,7 +111,7 @@ import GHC.CString
import GHC.Magic
import GHC.Prim
import GHC.Err
-import {-# SOURCE #-} GHC.IO (failIO)
+import {-# SOURCE #-} GHC.IO (failIO,mplusIO)
import GHC.Tuple () -- Note [Depend on GHC.Tuple]
import GHC.Integer () -- Note [Depend on GHC.Integer]
@@ -1079,6 +1079,12 @@ instance Monad IO where
(>>=) = bindIO
fail s = failIO s
+instance Alternative IO where
+ empty = failIO "mzero"
+ (<|>) = mplusIO
+
+instance MonadPlus IO
+
returnIO :: a -> IO a
returnIO x = IO $ \ s -> (# s, x #)
diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs
index 9fa0aff929..1e8c74e5c1 100644
--- a/libraries/base/GHC/IO.hs
+++ b/libraries/base/GHC/IO.hs
@@ -23,7 +23,7 @@
-----------------------------------------------------------------------------
module GHC.IO (
- IO(..), unIO, failIO, liftIO,
+ IO(..), unIO, failIO, liftIO, mplusIO,
unsafePerformIO, unsafeInterleaveIO,
unsafeDupablePerformIO, unsafeDupableInterleaveIO,
noDuplicate,
@@ -45,7 +45,7 @@ import GHC.ST
import GHC.Exception
import GHC.Show
-import {-# SOURCE #-} GHC.IO.Exception ( userError )
+import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
-- ---------------------------------------------------------------------------
-- The IO Monad
@@ -292,6 +292,12 @@ catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
catchAny (IO io) handler = IO $ catch# io handler'
where handler' (SomeException e) = unIO (handler e)
+
+mplusIO :: IO a -> IO a -> IO a
+mplusIO m n = m `catchIOError` \ _ -> n
+ where catchIOError :: IO a -> (IOError -> IO a) -> IO a
+ catchIOError = catchException
+
-- | A variant of 'throw' that can only be used within the 'IO' monad.
--
-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
diff --git a/libraries/base/GHC/IO.hs-boot b/libraries/base/GHC/IO.hs-boot
index fb0dd963b3..88b09aafb0 100644
--- a/libraries/base/GHC/IO.hs-boot
+++ b/libraries/base/GHC/IO.hs-boot
@@ -6,4 +6,4 @@ module GHC.IO where
import GHC.Types
failIO :: [Char] -> IO a
-
+mplusIO :: IO a -> IO a -> IO a
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index fe65399855..7fb4d785b9 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -85,6 +85,9 @@
* The `MINIMAL` definition of `ArrowChoice` is now `left OR (+++)`.
+ * Add `MonadPlus IO` and `Alternative IO` instances
+ (previously orphans in `transformers`) (#10755)
+
## 4.8.2.0 *Oct 2015*
* Bundled with GHC 7.10.3
diff --git a/libraries/transformers b/libraries/transformers
-Subproject 0c7207e9702afb5344cc33892eb6da9126a85cf
+Subproject 5ccb747e67d579e3f212fd3526469c35282e532