From b62605e53c167719b3bf8842eba628061cf22dd1 Mon Sep 17 00:00:00 2001
From: Herbert Valerio Riedel <hvr@gnu.org>
Date: Tue, 3 Nov 2015 16:12:18 -0600
Subject: Add `MonadPlus IO` and `Alternative IO` instances

This requires adding a new primitive `mplusIO` to `GHC.IO`

Update transformers submodule to accomodate extant orphan instances.

Reviewed By: austin, bgamari

Differential Revision: https://phabricator.haskell.org/D1148

GHC Trac Issues: #10755
---
 libraries/base/GHC/Base.hs    |  8 +++++++-
 libraries/base/GHC/IO.hs      | 10 ++++++++--
 libraries/base/GHC/IO.hs-boot |  2 +-
 3 files changed, 16 insertions(+), 4 deletions(-)

(limited to 'libraries/base/GHC')

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
-- 
cgit v1.2.1