diff options
-rw-r--r-- | libraries/base/GHC/Base.hs | 8 | ||||
-rw-r--r-- | libraries/base/GHC/IO.hs | 10 | ||||
-rw-r--r-- | libraries/base/GHC/IO.hs-boot | 2 | ||||
-rw-r--r-- | libraries/base/changelog.md | 3 | ||||
m--------- | libraries/transformers | 0 |
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 |