{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverlappingInstances #-}
module Control.Monad.Exception.Base where

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.Base
import Control.Monad.Exception.Catch
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0)
import qualified Control.Monad.Fail as Fail
#endif
import Control.Monad.Loc
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
import Control.Monad.IO.Class
import Control.Failure
import Control.Monad.Fix
import Data.Typeable
import Data.Functor.Identity

type CallTrace = [String]

-- | A Monad Transformer for explicitly typed checked exceptions.
newtype EMT l m a = EMT {EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT :: m (Either (CallTrace, CheckedException l) a)}

-- | Run a computation explicitly handling exceptions
tryEMT :: Monad m => EMT AnyException m a -> m (Either SomeException a)
tryEMT :: EMT AnyException m a -> m (Either SomeException a)
tryEMT (EMT m (Either (CallTrace, CheckedException AnyException) a)
m) = ((CallTrace, CheckedException AnyException) -> SomeException)
-> Either (CallTrace, CheckedException AnyException) a
-> Either SomeException a
forall a b r. (a -> b) -> Either a r -> Either b r
mapLeft (CheckedException AnyException -> SomeException
forall l. CheckedException l -> SomeException
checkedException(CheckedException AnyException -> SomeException)
-> ((CallTrace, CheckedException AnyException)
    -> CheckedException AnyException)
-> (CallTrace, CheckedException AnyException)
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CallTrace, CheckedException AnyException)
-> CheckedException AnyException
forall a b. (a, b) -> b
snd) (Either (CallTrace, CheckedException AnyException) a
 -> Either SomeException a)
-> m (Either (CallTrace, CheckedException AnyException) a)
-> m (Either SomeException a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m (Either (CallTrace, CheckedException AnyException) a)
m

tryEMTWithLoc :: Monad m => EMT AnyException m a -> m (Either (CallTrace, SomeException) a)
tryEMTWithLoc :: EMT AnyException m a -> m (Either (CallTrace, SomeException) a)
tryEMTWithLoc = (Either (CallTrace, CheckedException AnyException) a
 -> Either (CallTrace, SomeException) a)
-> m (Either (CallTrace, CheckedException AnyException) a)
-> m (Either (CallTrace, SomeException) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((CallTrace, CheckedException AnyException)
 -> (CallTrace, SomeException))
-> Either (CallTrace, CheckedException AnyException) a
-> Either (CallTrace, SomeException) a
forall a b r. (a -> b) -> Either a r -> Either b r
mapLeft ((CheckedException AnyException -> SomeException)
-> (CallTrace, CheckedException AnyException)
-> (CallTrace, SomeException)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second CheckedException AnyException -> SomeException
forall l. CheckedException l -> SomeException
checkedException)) (m (Either (CallTrace, CheckedException AnyException) a)
 -> m (Either (CallTrace, SomeException) a))
-> (EMT AnyException m a
    -> m (Either (CallTrace, CheckedException AnyException) a))
-> EMT AnyException m a
-> m (Either (CallTrace, SomeException) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EMT AnyException m a
-> m (Either (CallTrace, CheckedException AnyException) a)
forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT

runEMTGen :: forall l m a . Monad m => EMT l m a -> m a
runEMTGen :: EMT l m a -> m a
runEMTGen (EMT m (Either (CallTrace, CheckedException l) a)
m) = m (Either (CallTrace, CheckedException l) a)
m m (Either (CallTrace, CheckedException l) a)
-> (Either (CallTrace, CheckedException l) a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either (CallTrace, CheckedException l) a
x ->
                     case Either (CallTrace, CheckedException l) a
x of
                       Right a
x -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
                       Left (CallTrace
loc,CheckedException l
e) -> [Char] -> m a
forall a. HasCallStack => [Char] -> a
error (CallTrace -> SomeException -> [Char]
forall e. Exception e => CallTrace -> e -> [Char]
showExceptionWithTrace CallTrace
loc (CheckedException l -> SomeException
forall l. CheckedException l -> SomeException
checkedException CheckedException l
e))

data AnyException
data NoExceptions
data ParanoidMode

instance Exception e => Throws e AnyException

-- | Run a safe computation
runEMT :: Monad m => EMT NoExceptions m a -> m a
runEMT :: EMT NoExceptions m a -> m a
runEMT = EMT NoExceptions m a -> m a
forall l (m :: * -> *) a. Monad m => EMT l m a -> m a
runEMTGen

-- | Run a safe computation checking even unchecked ('UncaughtException') exceptions
runEMTParanoid :: Monad m => EMT ParanoidMode m a -> m a
runEMTParanoid :: EMT ParanoidMode m a -> m a
runEMTParanoid = EMT ParanoidMode m a -> m a
forall l (m :: * -> *) a. Monad m => EMT l m a -> m a
runEMTGen

instance Monad m => Functor (EMT l m) where
  fmap :: (a -> b) -> EMT l m a -> EMT l m b
fmap a -> b
f EMT l m a
emt = m (Either (CallTrace, CheckedException l) b) -> EMT l m b
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) b) -> EMT l m b)
-> m (Either (CallTrace, CheckedException l) b) -> EMT l m b
forall a b. (a -> b) -> a -> b
$ do
                 Either (CallTrace, CheckedException l) a
v <- EMT l m a -> m (Either (CallTrace, CheckedException l) a)
forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT EMT l m a
emt
                 case Either (CallTrace, CheckedException l) a
v of
                   Left  (CallTrace, CheckedException l)
e -> Either (CallTrace, CheckedException l) b
-> m (Either (CallTrace, CheckedException l) b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((CallTrace, CheckedException l)
-> Either (CallTrace, CheckedException l) b
forall a b. a -> Either a b
Left (CallTrace, CheckedException l)
e)
                   Right a
x -> Either (CallTrace, CheckedException l) b
-> m (Either (CallTrace, CheckedException l) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either (CallTrace, CheckedException l) b
forall a b. b -> Either a b
Right (a -> b
f a
x))

instance Monad m => Monad (EMT l m) where
  return :: a -> EMT l m a
return = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> (a -> m (Either (CallTrace, CheckedException l) a))
-> a
-> EMT l m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (CallTrace, CheckedException l) a
 -> m (Either (CallTrace, CheckedException l) a))
-> (a -> Either (CallTrace, CheckedException l) a)
-> a
-> m (Either (CallTrace, CheckedException l) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (CallTrace, CheckedException l) a
forall a b. b -> Either a b
Right

  EMT l m a
emt >>= :: EMT l m a -> (a -> EMT l m b) -> EMT l m b
>>= a -> EMT l m b
f = m (Either (CallTrace, CheckedException l) b) -> EMT l m b
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) b) -> EMT l m b)
-> m (Either (CallTrace, CheckedException l) b) -> EMT l m b
forall a b. (a -> b) -> a -> b
$ do
                Either (CallTrace, CheckedException l) a
v <- EMT l m a -> m (Either (CallTrace, CheckedException l) a)
forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT EMT l m a
emt
                case Either (CallTrace, CheckedException l) a
v of
                  Left (CallTrace, CheckedException l)
e  -> Either (CallTrace, CheckedException l) b
-> m (Either (CallTrace, CheckedException l) b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((CallTrace, CheckedException l)
-> Either (CallTrace, CheckedException l) b
forall a b. a -> Either a b
Left (CallTrace, CheckedException l)
e)
                  Right a
x -> EMT l m b -> m (Either (CallTrace, CheckedException l) b)
forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT (a -> EMT l m b
f a
x)

#if !MIN_VERSION_base(4,13,0)
#if MIN_VERSION_base(4,9,0)
  fail = Fail.fail
#else
  fail s = EMT $ return $ Left ([], CheckedException $ toException $ FailException s)
#endif
#endif

instance Monad m => Applicative (EMT l m) where
  pure :: a -> EMT l m a
pure  = a -> EMT l m a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: EMT l m (a -> b) -> EMT l m a -> EMT l m b
(<*>) = EMT l m (a -> b) -> EMT l m a -> EMT l m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

#if MIN_VERSION_base(4,9,0)
#if MIN_VERSION_base(4,13,0)
instance Monad m => MonadFail (EMT l m) where
#else
instance Monad m => Fail.MonadFail (EMT l m) where
#endif
  fail :: [Char] -> EMT l m a
fail [Char]
s = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall a b. (a -> b) -> a -> b
$ Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (CallTrace, CheckedException l) a
 -> m (Either (CallTrace, CheckedException l) a))
-> Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall a b. (a -> b) -> a -> b
$ (CallTrace, CheckedException l)
-> Either (CallTrace, CheckedException l) a
forall a b. a -> Either a b
Left ([], SomeException -> CheckedException l
forall l. SomeException -> CheckedException l
CheckedException (SomeException -> CheckedException l)
-> SomeException -> CheckedException l
forall a b. (a -> b) -> a -> b
$ FailException -> SomeException
forall e. Exception e => e -> SomeException
toException (FailException -> SomeException) -> FailException -> SomeException
forall a b. (a -> b) -> a -> b
$ [Char] -> FailException
FailException [Char]
s)
#endif

instance (Exception e, Throws e l, Monad m) => Failure e (EMT l m) where
  failure :: e -> EMT l m v
failure = e -> EMT l m v
forall e l (m :: * -> *) a.
(Exception e, Throws e l, Monad m) =>
e -> EMT l m a
throw

#if !MIN_VERSION_failure(0,2,0)
instance (Exception e, Throws e l, Failure e m, Monad m) => WrapFailure e (EMT l m) where
  wrapFailure mkE m
      = EMT $ do
          v <- unEMT m
          case v of
            Right _ -> return v
            Left (loc, CheckedException (SomeException e))
                    -> return $ Left (loc, CheckedException $ toException $ mkE e)
#endif

instance MonadTrans (EMT l) where
  lift :: m a -> EMT l m a
lift = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> (m a -> m (Either (CallTrace, CheckedException l) a))
-> m a
-> EMT l m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either (CallTrace, CheckedException l) a)
-> m a -> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Either (CallTrace, CheckedException l) a
forall a b. b -> Either a b
Right


instance MonadBase b m => MonadBase b (EMT l m) where
    liftBase :: b α -> EMT l m α
liftBase = b α -> EMT l m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault

instance MonadBaseControl b m => MonadBaseControl b (EMT l m) where
#if MIN_VERSION_monad_control(1,0,0)
     type StM (EMT l m) a = ComposeSt (EMT l) m a
     liftBaseWith :: (RunInBase (EMT l m) b -> b a) -> EMT l m a
liftBaseWith = (RunInBase (EMT l m) b -> b a) -> EMT l m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
     restoreM :: StM (EMT l m) a -> EMT l m a
restoreM     = StM (EMT l m) a -> EMT l m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
#else
     newtype StM (EMT l m) a = StmEMT {unStmEMT :: ComposeSt (EMT l) m a}
     liftBaseWith = defaultLiftBaseWith StmEMT
     restoreM     = defaultRestoreM   unStmEMT
#endif

-- newtype EMT l m a = EMT {unEMT :: m (Either (CallTrace, CheckedException l) a)}

instance MonadTransControl (EMT l) where
#if MIN_VERSION_monad_control(1,0,0)
     type StT (EMT l) a = Either (CallTrace, CheckedException l) a
     liftWith :: (Run (EMT l) -> m a) -> EMT l m a
liftWith Run (EMT l) -> m a
f = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall a b. (a -> b) -> a -> b
$ (a -> Either (CallTrace, CheckedException l) a)
-> m a -> m (Either (CallTrace, CheckedException l) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either (CallTrace, CheckedException l) a
forall (m :: * -> *) a. Monad m => a -> m a
return (m a -> m (Either (CallTrace, CheckedException l) a))
-> m a -> m (Either (CallTrace, CheckedException l) a)
forall a b. (a -> b) -> a -> b
$ Run (EMT l) -> m a
f (Run (EMT l) -> m a) -> Run (EMT l) -> m a
forall a b. (a -> b) -> a -> b
$ forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
Run (EMT l)
unEMT
     restoreT :: m (StT (EMT l) a) -> EMT l m a
restoreT   = m (StT (EMT l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT
#else
     newtype StT (EMT l) a = StEMT {unStEMT :: Either (CallTrace, CheckedException l) a}
     liftWith f = EMT $ liftM return $ f $ liftM StEMT . unEMT
     restoreT   = EMT . liftM unStEMT
#endif

instance Monad m => MonadLoc (EMT l m) where
    withLoc :: [Char] -> EMT l m a -> EMT l m a
withLoc [Char]
loc (EMT m (Either (CallTrace, CheckedException l) a)
emt) = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall a b. (a -> b) -> a -> b
$ do
                     Either (CallTrace, CheckedException l) a
current <- [Char]
-> m (Either (CallTrace, CheckedException l) a)
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. MonadLoc m => [Char] -> m a -> m a
withLoc [Char]
loc m (Either (CallTrace, CheckedException l) a)
emt
                     case Either (CallTrace, CheckedException l) a
current of
                       (Left (CallTrace
tr, CheckedException l
a)) -> Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((CallTrace, CheckedException l)
-> Either (CallTrace, CheckedException l) a
forall a b. a -> Either a b
Left ([Char]
loc[Char] -> CallTrace -> CallTrace
forall a. a -> [a] -> [a]
:CallTrace
tr, CheckedException l
a))
                       Either (CallTrace, CheckedException l) a
_              -> Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either (CallTrace, CheckedException l) a
current

instance MonadFix m => MonadFix (EMT l m) where
  mfix :: (a -> EMT l m a) -> EMT l m a
mfix a -> EMT l m a
f = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall a b. (a -> b) -> a -> b
$ (Either (CallTrace, CheckedException l) a
 -> m (Either (CallTrace, CheckedException l) a))
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((Either (CallTrace, CheckedException l) a
  -> m (Either (CallTrace, CheckedException l) a))
 -> m (Either (CallTrace, CheckedException l) a))
-> (Either (CallTrace, CheckedException l) a
    -> m (Either (CallTrace, CheckedException l) a))
-> m (Either (CallTrace, CheckedException l) a)
forall a b. (a -> b) -> a -> b
$ \Either (CallTrace, CheckedException l) a
a -> EMT l m a -> m (Either (CallTrace, CheckedException l) a)
forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT (EMT l m a -> m (Either (CallTrace, CheckedException l) a))
-> EMT l m a -> m (Either (CallTrace, CheckedException l) a)
forall a b. (a -> b) -> a -> b
$ a -> EMT l m a
f (a -> EMT l m a) -> a -> EMT l m a
forall a b. (a -> b) -> a -> b
$ case Either (CallTrace, CheckedException l) a
a of
                                             Right a
r -> a
r
                                             Either (CallTrace, CheckedException l) a
_       -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"empty fix argument"

-- | The throw primitive
throw :: (Exception e, Throws e l, Monad m) => e -> EMT l m a
throw :: e -> EMT l m a
throw = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> (e -> m (Either (CallTrace, CheckedException l) a))
-> e
-> EMT l m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (CallTrace, CheckedException l) a
 -> m (Either (CallTrace, CheckedException l) a))
-> (e -> Either (CallTrace, CheckedException l) a)
-> e
-> m (Either (CallTrace, CheckedException l) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\CheckedException l
e -> (CallTrace, CheckedException l)
-> Either (CallTrace, CheckedException l) a
forall a b. a -> Either a b
Left ([],CheckedException l
e)) (CheckedException l -> Either (CallTrace, CheckedException l) a)
-> (e -> CheckedException l)
-> e
-> Either (CallTrace, CheckedException l) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> CheckedException l
forall l. SomeException -> CheckedException l
CheckedException (SomeException -> CheckedException l)
-> (e -> SomeException) -> e -> CheckedException l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toException

-- | Rethrow an exception keeping the call trace
rethrow :: (Throws e l, Monad m) => CallTrace -> e -> EMT l m a
rethrow :: CallTrace -> e -> EMT l m a
rethrow CallTrace
callt = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT (m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> (e -> m (Either (CallTrace, CheckedException l) a))
-> e
-> EMT l m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (CallTrace, CheckedException l) a
 -> m (Either (CallTrace, CheckedException l) a))
-> (e -> Either (CallTrace, CheckedException l) a)
-> e
-> m (Either (CallTrace, CheckedException l) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\CheckedException l
e -> (CallTrace, CheckedException l)
-> Either (CallTrace, CheckedException l) a
forall a b. a -> Either a b
Left (CallTrace
callt,CheckedException l
e)) (CheckedException l -> Either (CallTrace, CheckedException l) a)
-> (e -> CheckedException l)
-> e
-> Either (CallTrace, CheckedException l) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> CheckedException l
forall l. SomeException -> CheckedException l
CheckedException (SomeException -> CheckedException l)
-> (e -> SomeException) -> e -> CheckedException l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
toException

showExceptionWithTrace :: Exception e => [String] -> e -> String
showExceptionWithTrace :: CallTrace -> e -> [Char]
showExceptionWithTrace [] e
e = e -> [Char]
forall a. Show a => a -> [Char]
show e
e
showExceptionWithTrace CallTrace
trace e
e = CallTrace -> [Char]
unlines ( e -> [Char]
forall a. Show a => a -> [Char]
show e
e
                                         [Char] -> CallTrace -> CallTrace
forall a. a -> [a] -> [a]
: [ [Char]
" in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
loc | [Char]
loc <- CallTrace -> CallTrace
forall a. [a] -> [a]
reverse CallTrace
trace])

-- | UncaughtException models unchecked exceptions
--
--   In order to declare an unchecked exception @E@,
--   all that is needed is to make @e@ an instance of 'UncaughtException'
--
--  > instance UncaughtException E
--
--   Note that declaring an exception E as unchecked does not automatically
--   turn its children unchecked too. This is a shortcoming of the current encoding.

class Exception e => UncaughtException e
instance UncaughtException e => Throws e NoExceptions
instance UncaughtException SomeException

-- ---------------
-- The EM Monad
-- ---------------

-- | A monad of explicitly typed, checked exceptions
type EM l = EMT l Identity

-- | Run a computation explicitly handling exceptions
tryEM :: EM AnyException a -> Either SomeException a
tryEM :: EM AnyException a -> Either SomeException a
tryEM = Identity (Either SomeException a) -> Either SomeException a
forall a. Identity a -> a
runIdentity (Identity (Either SomeException a) -> Either SomeException a)
-> (EM AnyException a -> Identity (Either SomeException a))
-> EM AnyException a
-> Either SomeException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EM AnyException a -> Identity (Either SomeException a)
forall (m :: * -> *) a.
Monad m =>
EMT AnyException m a -> m (Either SomeException a)
tryEMT

tryEMWithLoc :: EM AnyException a -> Either (CallTrace, SomeException) a
tryEMWithLoc :: EM AnyException a -> Either (CallTrace, SomeException) a
tryEMWithLoc = Identity (Either (CallTrace, SomeException) a)
-> Either (CallTrace, SomeException) a
forall a. Identity a -> a
runIdentity (Identity (Either (CallTrace, SomeException) a)
 -> Either (CallTrace, SomeException) a)
-> (EM AnyException a
    -> Identity (Either (CallTrace, SomeException) a))
-> EM AnyException a
-> Either (CallTrace, SomeException) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EM AnyException a -> Identity (Either (CallTrace, SomeException) a)
forall (m :: * -> *) a.
Monad m =>
EMT AnyException m a -> m (Either (CallTrace, SomeException) a)
tryEMTWithLoc

-- | Run a safe computation
runEM :: EM NoExceptions a -> a
runEM :: EM NoExceptions a -> a
runEM = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (EM NoExceptions a -> Identity a) -> EM NoExceptions a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EM NoExceptions a -> Identity a
forall (m :: * -> *) a. Monad m => EMT NoExceptions m a -> m a
runEMT

-- | Run a computation checking even unchecked (@UncaughtExceptions@) exceptions
runEMParanoid :: EM ParanoidMode a -> a
runEMParanoid :: EM ParanoidMode a -> a
runEMParanoid = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (EM ParanoidMode a -> Identity a) -> EM ParanoidMode a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EM ParanoidMode a -> Identity a
forall (m :: * -> *) a. Monad m => EMT ParanoidMode m a -> m a
runEMTParanoid

instance (Throws MonadZeroException l) => MonadPlus (EM l) where
  mzero :: EM l a
mzero = MonadZeroException -> EM l a
forall e l (m :: * -> *) a.
(Exception e, Throws e l, Monad m) =>
e -> EMT l m a
throw MonadZeroException
MonadZeroException
  mplus :: EM l a -> EM l a -> EM l a
mplus = EM l a -> EM l a -> EM l a
forall (m :: * -> *) l a.
Monad m =>
EMT l m a -> EMT l m a -> EMT l m a
mplusDefault

instance (Throws MonadZeroException l) => Alternative (EM l) where
  <|> :: EM l a -> EM l a -> EM l a
(<|>) = EM l a -> EM l a -> EM l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  empty :: EM l a
empty = EM l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
-- -----------
-- Exceptions
-- -----------

-- | @FailException@ is thrown by Monad 'fail'
data FailException = FailException String deriving (Int -> FailException -> [Char] -> [Char]
[FailException] -> [Char] -> [Char]
FailException -> [Char]
(Int -> FailException -> [Char] -> [Char])
-> (FailException -> [Char])
-> ([FailException] -> [Char] -> [Char])
-> Show FailException
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [FailException] -> [Char] -> [Char]
$cshowList :: [FailException] -> [Char] -> [Char]
show :: FailException -> [Char]
$cshow :: FailException -> [Char]
showsPrec :: Int -> FailException -> [Char] -> [Char]
$cshowsPrec :: Int -> FailException -> [Char] -> [Char]
Show, Typeable)
instance Exception FailException

-- | @MonadZeroException@ is thrown by MonadPlus 'mzero'
data MonadZeroException = MonadZeroException deriving (Int -> MonadZeroException -> [Char] -> [Char]
[MonadZeroException] -> [Char] -> [Char]
MonadZeroException -> [Char]
(Int -> MonadZeroException -> [Char] -> [Char])
-> (MonadZeroException -> [Char])
-> ([MonadZeroException] -> [Char] -> [Char])
-> Show MonadZeroException
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [MonadZeroException] -> [Char] -> [Char]
$cshowList :: [MonadZeroException] -> [Char] -> [Char]
show :: MonadZeroException -> [Char]
$cshow :: MonadZeroException -> [Char]
showsPrec :: Int -> MonadZeroException -> [Char] -> [Char]
$cshowsPrec :: Int -> MonadZeroException -> [Char] -> [Char]
Show, Typeable)
instance Exception MonadZeroException

-- | This function may be used as a value for 'mplus' in 'MonadPlus'
mplusDefault :: Monad m => EMT l m a -> EMT l m a -> EMT l m a
mplusDefault :: EMT l m a -> EMT l m a -> EMT l m a
mplusDefault EMT l m a
emt1 EMT l m a
emt2 = m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall l (m :: * -> *) a.
m (Either (CallTrace, CheckedException l) a) -> EMT l m a
EMT(m (Either (CallTrace, CheckedException l) a) -> EMT l m a)
-> m (Either (CallTrace, CheckedException l) a) -> EMT l m a
forall a b. (a -> b) -> a -> b
$ do
                     Either (CallTrace, CheckedException l) a
v1 <- EMT l m a -> m (Either (CallTrace, CheckedException l) a)
forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT EMT l m a
emt1
                     case Either (CallTrace, CheckedException l) a
v1 of
                       Left (CallTrace
_,CheckedException SomeException
e) | Just MonadZeroException
MonadZeroException <- SomeException -> Maybe MonadZeroException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> EMT l m a -> m (Either (CallTrace, CheckedException l) a)
forall l (m :: * -> *) a.
EMT l m a -> m (Either (CallTrace, CheckedException l) a)
unEMT EMT l m a
emt2
                       Either (CallTrace, CheckedException l) a
_  -> Either (CallTrace, CheckedException l) a
-> m (Either (CallTrace, CheckedException l) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either (CallTrace, CheckedException l) a
v1
-- other

mapLeft :: (a -> b) -> Either a r -> Either b r
mapLeft :: (a -> b) -> Either a r -> Either b r
mapLeft a -> b
f (Left a
x)  = b -> Either b r
forall a b. a -> Either a b
Left (a -> b
f a
x)
mapLeft a -> b
_ (Right r
x) = r -> Either b r
forall a b. b -> Either a b
Right r
x


instance MonadIO m => MonadIO (EMT l m) where
  liftIO :: IO a -> EMT l m a
liftIO = m a -> EMT l m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> EMT l m a) -> (IO a -> m a) -> IO a -> EMT l m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO