{-# LANGUAGE ExistentialQuantification #-}

{- |
Module      :  Control.Exception.Peel
Copyright   :  © Anders Kaseorg, 2010
License     :  BSD-style

Maintainer  :  Anders Kaseorg <andersk@mit.edu>
Stability   :  experimental
Portability :  non-portable (extended exceptions)

This is a wrapped version of Control.Exception with types generalized
from 'IO' to all monads in 'MonadPeelIO'.
-}

module Control.Exception.Peel (
  module Control.Exception.Extensible,
  throwIO, ioError,
  catch, catches, Handler(..), catchJust,
  handle, handleJust,
  try, tryJust,
  evaluate,
  bracket, bracket_, bracketOnError,
  finally, onException,
  ) where

import Prelude hiding (catch, ioError)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.IO.Peel
import Control.Exception.Extensible hiding (
  throwIO, ioError,
  catch, catches, Handler(..), catchJust,
  handle, handleJust,
  try, tryJust,
  evaluate,
  bracket, bracket_, bracketOnError,
  finally, onException,
  )
import qualified Control.Exception.Extensible as E

-- |Generalized version of 'E.throwIO'.
throwIO :: (MonadIO m, Exception e) => e -> m a
throwIO :: forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
E.throwIO

-- |Generalized version of 'E.ioError'.
ioError :: MonadIO m => IOError -> m a
ioError :: forall (m :: * -> *) a. MonadIO m => IOError -> m a
ioError = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IOError -> IO a
E.ioError

-- |Generalized version of 'E.catch'.
catch :: (MonadPeelIO m, Exception e) =>
         m a -- ^ The computation to run
         -> (e -> m a) -- ^ Handler to invoke if an exception is raised
         -> m a
catch :: forall (m :: * -> *) e a.
(MonadPeelIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch m a
a e -> m a
handler = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (m a -> IO (m a)
k m a
a) (\e
e -> m a -> IO (m a)
k forall a b. (a -> b) -> a -> b
$ e -> m a
handler e
e)

-- |Generalized version of 'E.catchJust'.
catchJust :: (MonadPeelIO m, Exception e) =>
             (e -> Maybe b) -- ^ Predicate to select exceptions
             -> m a -- ^ Computation to run
             -> (b -> m a) -- ^ Handler
             -> m a
catchJust :: forall (m :: * -> *) e b a.
(MonadPeelIO m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust e -> Maybe b
p m a
a b -> m a
handler = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
E.catchJust e -> Maybe b
p (m a -> IO (m a)
k m a
a) (\b
e -> m a -> IO (m a)
k (b -> m a
handler b
e))

-- |Generalized version of 'E.catches'.
catches :: MonadPeelIO m => m a -> [Handler m a] -> m a
catches :: forall (m :: * -> *) a.
MonadPeelIO m =>
m a -> [Handler m a] -> m a
catches m a
a [Handler m a]
handlers = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> [Handler a] -> IO a
E.catches (m a -> IO (m a)
k m a
a) [forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler forall a b. (a -> b) -> a -> b
$ \e
e -> m a -> IO (m a)
k forall a b. (a -> b) -> a -> b
$ e -> m a
handler e
e |
                                   Handler e -> m a
handler <- [Handler m a]
handlers]

-- |Generalized version of 'E.Handler'.
data Handler m a = forall e. Exception e => Handler (e -> m a)

-- |Generalized version of 'E.handle'.
handle :: (MonadPeelIO m, Exception e) => (e -> m a) -> m a -> m a
handle :: forall (m :: * -> *) e a.
(MonadPeelIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle e -> m a
handler m a
a = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle (\e
e -> m a -> IO (m a)
k (e -> m a
handler e
e)) (m a -> IO (m a)
k m a
a)

-- |Generalized version of 'E.handleJust'.
handleJust :: (MonadPeelIO m, Exception e) =>
             (e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust :: forall (m :: * -> *) e b a.
(MonadPeelIO m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust e -> Maybe b
p b -> m a
handler m a
a = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
E.handleJust e -> Maybe b
p (\b
e -> m a -> IO (m a)
k (b -> m a
handler b
e)) (m a -> IO (m a)
k m a
a)

sequenceEither :: Monad m => Either e (m a) -> m (Either e a)
sequenceEither :: forall (m :: * -> *) e a.
Monad m =>
Either e (m a) -> m (Either e a)
sequenceEither (Left e
e) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left e
e
sequenceEither (Right m a
m) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a b. b -> Either a b
Right m a
m

-- |Generalized version of 'E.try'.
try :: (MonadPeelIO m, Exception e) => m a -> m (Either e a)
try :: forall (m :: * -> *) e a.
(MonadPeelIO m, Exception e) =>
m a -> m (Either e a)
try = forall (m :: * -> *) a b.
MonadPeelIO m =>
(IO (m a) -> IO (m b)) -> m a -> m b
liftIOOp_ (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (m :: * -> *) e a.
Monad m =>
Either e (m a) -> m (Either e a)
sequenceEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
E.try)

-- |Generalized version of 'E.tryJust'.
tryJust :: (MonadPeelIO m, Exception e) =>
           (e -> Maybe b) -> m a -> m (Either b a)
tryJust :: forall (m :: * -> *) e b a.
(MonadPeelIO m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust e -> Maybe b
p = forall (m :: * -> *) a b.
MonadPeelIO m =>
(IO (m a) -> IO (m b)) -> m a -> m b
liftIOOp_ (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (m :: * -> *) e a.
Monad m =>
Either e (m a) -> m (Either e a)
sequenceEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
E.tryJust e -> Maybe b
p)

-- |Generalized version of 'E.evaluate'.
evaluate :: MonadIO m => a -> m a
evaluate :: forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
E.evaluate

-- |Generalized version of 'E.bracket'.  Note, any monadic side
-- effects in @m@ of the \"release\" computation will be discarded; it
-- is run only for its side effects in @IO@.
bracket :: MonadPeelIO m =>
           m a -- ^ computation to run first (\"acquire resource\")
           -> (a -> m b) -- ^ computation to run last (\"release resource\")
           -> (a -> m c) -- ^ computation to run in-between
           -> m c
bracket :: forall (m :: * -> *) a b c.
MonadPeelIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m a
before a -> m b
after a -> m c
thing = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m b -> IO (m b)
k' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m c -> IO (m c)
k'' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (m a -> IO (m a)
k m a
before) (\m a
x -> m b -> IO (m b)
k' forall a b. (a -> b) -> a -> b
$ m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
after) (\m a
x -> m c -> IO (m c)
k'' forall a b. (a -> b) -> a -> b
$ m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m c
thing)

-- |Generalized version of 'E.bracket_'.  Note, any monadic side
-- effects in @m@ of /both/ the \"acquire\" and \"release\"
-- computations will be discarded.  To keep the monadic side effects
-- of the \"acquire\" computation, use 'bracket' with constant
-- functions instead.
bracket_ :: MonadPeelIO m => m a -> m b -> m c -> m c
bracket_ :: forall (m :: * -> *) a b c.
MonadPeelIO m =>
m a -> m b -> m c -> m c
bracket_ m a
before m b
after m c
thing = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m b -> IO (m b)
k' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m c -> IO (m c)
k'' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> IO b -> IO c -> IO c
E.bracket_ (m a -> IO (m a)
k m a
before) (m b -> IO (m b)
k' m b
after) (m c -> IO (m c)
k'' m c
thing)

-- |Generalized version of 'E.bracketOnError'.
bracketOnError :: MonadPeelIO m =>
                  m a -- ^ computation to run first (\"acquire resource\")
                  -> (a -> m b) -- ^ computation to run last (\"release resource\")
                  -> (a -> m c) -- ^ computation to run in-between
                  -> m c
bracketOnError :: forall (m :: * -> *) a b c.
MonadPeelIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError m a
before a -> m b
after a -> m c
thing = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m b -> IO (m b)
k' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m c -> IO (m c)
k'' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (m a -> IO (m a)
k m a
before) (\m a
x -> m b -> IO (m b)
k' forall a b. (a -> b) -> a -> b
$ m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
after) (\m a
x -> m c -> IO (m c)
k'' forall a b. (a -> b) -> a -> b
$ m a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m c
thing)

-- |Generalized version of 'E.finally'.  Note, any monadic side
-- effects in @m@ of the \"afterward\" computation will be discarded.
finally :: MonadPeelIO m =>
           m a -- ^ computation to run first
           -> m b -- ^ computation to run afterward (even if an exception was raised)
           -> m a
finally :: forall (m :: * -> *) a b. MonadPeelIO m => m a -> m b -> m a
finally m a
a m b
sequel = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m b -> IO (m b)
k' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IO a -> IO b -> IO a
E.finally (m a -> IO (m a)
k m a
a) (m b -> IO (m b)
k' m b
sequel)

-- |Generalized version of 'E.onException'.
onException :: MonadPeelIO m => m a -> m b -> m a
onException :: forall (m :: * -> *) a b. MonadPeelIO m => m a -> m b -> m a
onException m a
m m b
what = do
  m a -> IO (m a)
k <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  m b -> IO (m b)
k' <- forall (m :: * -> *) a. MonadPeelIO m => m (m a -> IO (m a))
peelIO
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IO a -> IO b -> IO a
E.onException (m a -> IO (m a)
k m a
m) (m b -> IO (m b)
k' m b
what)