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

3 files changed, 16 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