{- |
Synchronous exceptions immediately abort a series of computations.
We provide monads for describing this behaviour.
In contrast to ErrorT from @mtl@ or @transformers@ package
we do not pose restrictions on the exception type.

How to tell, that a function can possibly throw more than one (kind of) exception?

If you would use the exception type @(Either ParserException IOError)@
then this is different from @(Either IOError ParserException)@.
Thus we recommned using type classes for exceptions.
Then you can use one type containing all exceptions in an application,
but the type signature still tells which exceptions are actually possible.
Examples:

> parser :: ParserException e => ExceptionalT e ParserMonad a
>
> getLine :: IOException e => ExceptionalT e IO String
>
> fileParser :: (ParserException e, IOException e) => ExceptionalT e IO String

You can remove single exceptions from the set,
but with Haskell 98 you need instances for all the other constraints
in the exception constraint set.
There is a more advanced approach,
that allows removing exceptions constraints
without a quadratic growth of instances.
It uses some non-Haskell-98 type hackery,
see the @exception@ package by Joseph Iborra.
Fortunately, you use this package in every case
and let the user decide
whether he wants Haskell 98 or non-standard way of handling exceptions.

See also: <https://wiki.haskell.org/Exception>.
-}
module Control.Monad.Exception.Synchronous (
   Exceptional(..),
   fromMaybe,    toMaybe,
   fromEither,   toEither,
   fromExitCode, toExitCode,
   getExceptionNull,
   switch,
   force,
   mapException,
   mapExceptional,
   throw,
   assert,
   catch,
   resolve,
   merge,
   alternative,

   ExceptionalT(..),
   fromMaybeT,    toMaybeT,
   fromErrorT,    toErrorT,
   fromEitherT,   toEitherT,
   fromExitCodeT, toExitCodeT,
   liftT,
   switchT,
   forceT,
   mapExceptionT,
   mapExceptionalT,
   throwT,
   assertT,
   catchT,
   bracketT,
   resolveT,
   tryT,
   manyT,
   manyMonoidT,
   mergeT,
   alternativeT,
   ) where

import Control.Applicative (Applicative(pure, (<*>)))
import Control.Monad (Monad, return, liftM, liftM2, (>>=), (>>), (=<<),
          {- MonadPlus(mzero, mplus), -})
import Control.Monad.Fix (MonadFix, mfix, )
import Control.Monad.Trans.Class (MonadTrans, lift, )
import Control.Monad.Trans.Error (ErrorT(ErrorT, runErrorT))
import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT))
import Control.DeepSeq (NFData, rnf, )
import Data.Functor (Functor, fmap, )
import Data.Monoid(Monoid, mappend, mempty, Endo(Endo, appEndo), )
import Data.Function (flip, const, (.), ($), )
import Data.Either (Either(Left, Right), either, )
import Data.Maybe (Maybe(Just, Nothing), maybe, )
import Data.Bool (Bool, )
import Data.Eq (Eq, )

import System.Exit (ExitCode(ExitSuccess, ExitFailure), )

import Prelude (Show, Int, )


-- * Plain monad

{- |
Like 'Either', but explicitly intended for handling of exceptional results.
In contrast to 'Either' we do not support 'fail'.
Calling 'fail' in the 'Exceptional' monad is an error.
This way, we do not require that an exception can be derived from a 'String',
yet, we require no constraint on the exception type at all.
-}
data Exceptional e a =
     Success a
   | Exception e
   deriving (Int -> Exceptional e a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show a, Show e) => Int -> Exceptional e a -> ShowS
forall e a. (Show a, Show e) => [Exceptional e a] -> ShowS
forall e a. (Show a, Show e) => Exceptional e a -> String
showList :: [Exceptional e a] -> ShowS
$cshowList :: forall e a. (Show a, Show e) => [Exceptional e a] -> ShowS
show :: Exceptional e a -> String
$cshow :: forall e a. (Show a, Show e) => Exceptional e a -> String
showsPrec :: Int -> Exceptional e a -> ShowS
$cshowsPrec :: forall e a. (Show a, Show e) => Int -> Exceptional e a -> ShowS
Show, Exceptional e a -> Exceptional e a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a.
(Eq a, Eq e) =>
Exceptional e a -> Exceptional e a -> Bool
/= :: Exceptional e a -> Exceptional e a -> Bool
$c/= :: forall e a.
(Eq a, Eq e) =>
Exceptional e a -> Exceptional e a -> Bool
== :: Exceptional e a -> Exceptional e a -> Bool
$c== :: forall e a.
(Eq a, Eq e) =>
Exceptional e a -> Exceptional e a -> Bool
Eq)


fromMaybe :: e -> Maybe a -> Exceptional e a
fromMaybe :: forall e a. e -> Maybe a -> Exceptional e a
fromMaybe e
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. e -> Exceptional e a
Exception e
e) forall e a. a -> Exceptional e a
Success

fromEither :: Either e a -> Exceptional e a
fromEither :: forall e a. Either e a -> Exceptional e a
fromEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. e -> Exceptional e a
Exception forall e a. a -> Exceptional e a
Success

toMaybe :: Exceptional e a -> Maybe a
toMaybe :: forall e a. Exceptional e a -> Maybe a
toMaybe = forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
switch (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just

toEither :: Exceptional e a -> Either e a
toEither :: forall e a. Exceptional e a -> Either e a
toEither Exceptional e a
x =
   case Exceptional e a
x of
      Success a
a   -> forall a b. b -> Either a b
Right a
a
      Exception e
e -> forall a b. a -> Either a b
Left e
e


toExitCode :: Exceptional Int () -> ExitCode
toExitCode :: Exceptional Int () -> ExitCode
toExitCode Exceptional Int ()
e =
   case Exceptional Int ()
e of
      Success () -> ExitCode
ExitSuccess
      Exception Int
n -> Int -> ExitCode
ExitFailure Int
n

fromExitCode :: ExitCode -> Exceptional Int ()
fromExitCode :: ExitCode -> Exceptional Int ()
fromExitCode ExitCode
e =
   case ExitCode
e of
      ExitCode
ExitSuccess -> forall e a. a -> Exceptional e a
Success ()
      ExitFailure Int
n -> forall e a. e -> Exceptional e a
Exception Int
n


-- | useful in connection with 'Control.Monad.Exception.Asynchronous.continue'
getExceptionNull :: Exceptional e () -> Maybe e
getExceptionNull :: forall e. Exceptional e () -> Maybe e
getExceptionNull Exceptional e ()
x =
   case Exceptional e ()
x of
      Success ()
_   -> forall a. Maybe a
Nothing
      Exception e
e -> forall a. a -> Maybe a
Just e
e


{- |
Counterpart to 'either' for 'Either'.
-}
switch :: (e -> b) -> (a -> b) -> Exceptional e a -> b
switch :: forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
switch e -> b
f a -> b
g Exceptional e a
x =
   case Exceptional e a
x of
      Success a
a -> a -> b
g a
a
      Exception e
e -> e -> b
f e
e

{- |
If you are sure that the value is always a 'Success'
you can tell that the run-time system
thus making your program lazy.
However, try to avoid this function by using 'catch' and friends,
since this function is partial.
-}
force :: Exceptional e a -> Exceptional e a
force :: forall e a. Exceptional e a -> Exceptional e a
force ~(Success a
a) = forall e a. a -> Exceptional e a
Success a
a

mapException :: (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a
mapException :: forall e0 e1 a. (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a
mapException e0 -> e1
f Exceptional e0 a
x =
   case Exceptional e0 a
x of
      Success a
a   -> forall e a. a -> Exceptional e a
Success a
a
      Exception e0
e -> forall e a. e -> Exceptional e a
Exception (e0 -> e1
f e0
e)

mapExceptional :: (e0 -> e1) -> (a -> b) -> Exceptional e0 a -> Exceptional e1 b
mapExceptional :: forall e0 e1 a b.
(e0 -> e1) -> (a -> b) -> Exceptional e0 a -> Exceptional e1 b
mapExceptional e0 -> e1
f a -> b
g Exceptional e0 a
x =
   case Exceptional e0 a
x of
      Success a
a   -> forall e a. a -> Exceptional e a
Success (a -> b
g a
a)
      Exception e0
e -> forall e a. e -> Exceptional e a
Exception (e0 -> e1
f e0
e)

throw :: e -> Exceptional e a
throw :: forall e a. e -> Exceptional e a
throw = forall e a. e -> Exceptional e a
Exception

assert :: e -> Bool -> Exceptional e ()
assert :: forall e. e -> Bool -> Exceptional e ()
assert e
e Bool
b =
   if Bool
b then forall e a. a -> Exceptional e a
Success () else forall e a. e -> Exceptional e a
throw e
e

catch :: Exceptional e0 a -> (e0 -> Exceptional e1 a) -> Exceptional e1 a
catch :: forall e0 a e1.
Exceptional e0 a -> (e0 -> Exceptional e1 a) -> Exceptional e1 a
catch Exceptional e0 a
x e0 -> Exceptional e1 a
handler =
   case Exceptional e0 a
x of
      Success a
a   -> forall e a. a -> Exceptional e a
Success a
a
      Exception e0
e -> e0 -> Exceptional e1 a
handler e0
e

{-
bracket ::
   Exceptional e h ->
   (h -> Exceptional e ()) ->
   (h -> Exceptional e a) ->
   Exceptional e a
bracket open close action =
   open >>= \h ->
   case action h of
-}

resolve :: (e -> a) -> Exceptional e a -> a
resolve :: forall e a. (e -> a) -> Exceptional e a -> a
resolve e -> a
handler Exceptional e a
x =
   case Exceptional e a
x of
      Success a
a   -> a
a
      Exception e
e -> e -> a
handler e
e

-- like Applicative.<|>
infixl 3 `alternative`, `alternativeT`

alternative, _alternative ::
   Exceptional e a -> Exceptional e a -> Exceptional e a
alternative :: forall e a. Exceptional e a -> Exceptional e a -> Exceptional e a
alternative Exceptional e a
x Exceptional e a
y = forall e0 a e1.
Exceptional e0 a -> (e0 -> Exceptional e1 a) -> Exceptional e1 a
catch Exceptional e a
x (forall a b. a -> b -> a
const Exceptional e a
y)
_alternative :: forall e a. Exceptional e a -> Exceptional e a -> Exceptional e a
_alternative Exceptional e a
x Exceptional e a
y = forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
switch (forall a b. a -> b -> a
const Exceptional e a
y) forall e a. a -> Exceptional e a
Success Exceptional e a
x



-- like Applicative.<*>
infixl 4 `merge`, `mergeT`

{- | see 'mergeT' -}
merge, mergeLazy, _mergeStrict ::
   (Monoid e) =>
   Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b
merge :: forall e a b.
Monoid e =>
Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b
merge = forall e a b.
Monoid e =>
Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b
mergeLazy

mergeLazy :: forall e a b.
Monoid e =>
Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b
mergeLazy Exceptional e (a -> b)
ef Exceptional e a
ea =
   case Exceptional e (a -> b)
ef of
      Exception e
e0 ->
         forall e a. e -> Exceptional e a
Exception forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend e
e0 forall a b. (a -> b) -> a -> b
$
         case Exceptional e a
ea of
            Success a
_ -> forall a. Monoid a => a
mempty
            Exception e
e1 -> e
e1
      Success a -> b
f -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Exceptional e a
ea

_mergeStrict :: forall e a b.
Monoid e =>
Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b
_mergeStrict Exceptional e (a -> b)
ef Exceptional e a
ea =
   case (Exceptional e (a -> b)
ef,Exceptional e a
ea) of
      (Success a -> b
f, Success a
a) -> forall e a. a -> Exceptional e a
Success forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
      (Exception e
e, Success a
_) -> forall e a. e -> Exceptional e a
Exception e
e
      (Success a -> b
_, Exception e
e) -> forall e a. e -> Exceptional e a
Exception e
e
      (Exception e
e0, Exception e
e1) -> forall e a. e -> Exceptional e a
Exception forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend e
e0 e
e1


instance (NFData e, NFData a) => NFData (Exceptional e a) where
   rnf :: Exceptional e a -> ()
rnf = forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
switch forall a. NFData a => a -> ()
rnf forall a. NFData a => a -> ()
rnf

instance Functor (Exceptional e) where
   fmap :: forall a b. (a -> b) -> Exceptional e a -> Exceptional e b
fmap a -> b
f Exceptional e a
x =
      case Exceptional e a
x of
         Success a
a   -> forall e a. a -> Exceptional e a
Success (a -> b
f a
a)
         Exception e
e -> forall e a. e -> Exceptional e a
Exception e
e

instance Applicative (Exceptional e) where
   pure :: forall a. a -> Exceptional e a
pure = forall e a. a -> Exceptional e a
Success
   Exceptional e (a -> b)
f <*> :: forall a b.
Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b
<*> Exceptional e a
x =
      case Exceptional e (a -> b)
f of
         Exception e
e -> forall e a. e -> Exceptional e a
Exception e
e
         Success a -> b
g ->
            case Exceptional e a
x of
               Success a
a   -> forall e a. a -> Exceptional e a
Success (a -> b
g a
a)
               Exception e
e -> forall e a. e -> Exceptional e a
Exception e
e

instance Monad (Exceptional e) where
   return :: forall a. a -> Exceptional e a
return = forall e a. a -> Exceptional e a
Success
   Exceptional e a
x >>= :: forall a b.
Exceptional e a -> (a -> Exceptional e b) -> Exceptional e b
>>= a -> Exceptional e b
f =
      case Exceptional e a
x of
         Exception e
e -> forall e a. e -> Exceptional e a
Exception e
e
         Success a
y -> a -> Exceptional e b
f a
y

{- |
I think it is not a good idea to use this instance,
maybe we shoul remove it.
It expects that the constructor is 'Success'
and the result is undefined otherwise.
But if the constructor must always be 'Success',
why using 'Exceptional' then, at all?
-}
instance MonadFix (Exceptional e) where
    mfix :: forall a. (a -> Exceptional e a) -> Exceptional e a
mfix a -> Exceptional e a
f =
       let unSuccess :: Exceptional e a -> a
unSuccess ~(Success a
x) = a
x
           a :: Exceptional e a
a = a -> Exceptional e a
f (forall {e} {a}. Exceptional e a -> a
unSuccess Exceptional e a
a)
       in  Exceptional e a
a

{-
A MonadPlus instance would require another class, say DefaultException,
that provides a default exception used for @mzero@.
In Control.Monad.Error this is handled by the Error class.
Since String is a typical type used for exceptions -
shall there be a DefaultException String instance?
-}



-- * Monad transformer

-- | like ErrorT, but ExceptionalT is the better name in order to distinguish from real (programming) errors
newtype ExceptionalT e m a =
   ExceptionalT {forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT :: m (Exceptional e a)}


_assertMaybeT :: (Monad m) => e -> Maybe a -> ExceptionalT e m a
_assertMaybeT :: forall (m :: * -> *) e a.
Monad m =>
e -> Maybe a -> ExceptionalT e m a
_assertMaybeT e
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. Monad m => e -> ExceptionalT e m a
throwT e
e) forall (m :: * -> *) a. Monad m => a -> m a
return

fromMaybeT :: Monad m => e -> MaybeT m a -> ExceptionalT e m a
fromMaybeT :: forall (m :: * -> *) e a.
Monad m =>
e -> MaybeT m a -> ExceptionalT e m a
fromMaybeT e
e  =  forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall e a. e -> Maybe a -> Exceptional e a
fromMaybe e
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

toMaybeT :: Monad m => ExceptionalT e m a -> MaybeT m a
toMaybeT :: forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> MaybeT m a
toMaybeT  =  forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Exceptional e a -> Maybe a
toMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT

fromErrorT :: Monad m => ErrorT e m a -> ExceptionalT e m a
fromErrorT :: forall (m :: * -> *) e a.
Monad m =>
ErrorT e m a -> ExceptionalT e m a
fromErrorT  =  forall (m :: * -> *) e a.
Monad m =>
m (Either e a) -> ExceptionalT e m a
fromEitherT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT

toErrorT :: Monad m => ExceptionalT e m a -> ErrorT e m a
toErrorT :: forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> ErrorT e m a
toErrorT  =  forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> m (Either e a)
toEitherT

fromEitherT :: Monad m => m (Either e a) -> ExceptionalT e m a
fromEitherT :: forall (m :: * -> *) e a.
Monad m =>
m (Either e a) -> ExceptionalT e m a
fromEitherT  =  forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Either e a -> Exceptional e a
fromEither

toEitherT :: Monad m => ExceptionalT e m a -> m (Either e a)
toEitherT :: forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> m (Either e a)
toEitherT  =  forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Exceptional e a -> Either e a
toEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT

toExitCodeT ::
   (Functor m) =>
   ExceptionalT Int m () -> m ExitCode
toExitCodeT :: forall (m :: * -> *).
Functor m =>
ExceptionalT Int m () -> m ExitCode
toExitCodeT ExceptionalT Int m ()
act =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exceptional Int () -> ExitCode
toExitCode forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT ExceptionalT Int m ()
act

fromExitCodeT ::
   (Functor m) =>
   m ExitCode -> ExceptionalT Int m ()
fromExitCodeT :: forall (m :: * -> *).
Functor m =>
m ExitCode -> ExceptionalT Int m ()
fromExitCodeT m ExitCode
act =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExitCode -> Exceptional Int ()
fromExitCode m ExitCode
act


liftT :: (Monad m) => Exceptional e a -> ExceptionalT e m a
liftT :: forall (m :: * -> *) e a.
Monad m =>
Exceptional e a -> ExceptionalT e m a
liftT = forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return


switchT ::
   (Monad m) =>
   (e -> m b) -> (a -> m b) ->
   ExceptionalT e m a -> m b
switchT :: forall (m :: * -> *) e b a.
Monad m =>
(e -> m b) -> (a -> m b) -> ExceptionalT e m a -> m b
switchT e -> m b
e a -> m b
s ExceptionalT e m a
m =
   forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
switch e -> m b
e a -> m b
s forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT ExceptionalT e m a
m

{- |
see 'force'
-}
forceT :: Monad m => ExceptionalT e m a -> ExceptionalT e m a
forceT :: forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> ExceptionalT e m a
forceT =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. Exceptional e a -> Exceptional e a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT


mapExceptionT :: (Monad m) =>
   (e0 -> e1) ->
   ExceptionalT e0 m a ->
   ExceptionalT e1 m a
mapExceptionT :: forall (m :: * -> *) e0 e1 a.
Monad m =>
(e0 -> e1) -> ExceptionalT e0 m a -> ExceptionalT e1 m a
mapExceptionT e0 -> e1
f =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall e0 e1 a. (e0 -> e1) -> Exceptional e0 a -> Exceptional e1 a
mapException e0 -> e1
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT

mapExceptionalT ::
   (m (Exceptional e0 a) -> n (Exceptional e1 b)) ->
   ExceptionalT e0 m a -> ExceptionalT e1 n b
mapExceptionalT :: forall (m :: * -> *) e0 a (n :: * -> *) e1 b.
(m (Exceptional e0 a) -> n (Exceptional e1 b))
-> ExceptionalT e0 m a -> ExceptionalT e1 n b
mapExceptionalT m (Exceptional e0 a) -> n (Exceptional e1 b)
f =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Exceptional e0 a) -> n (Exceptional e1 b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT

throwT :: (Monad m) =>
   e -> ExceptionalT e m a
throwT :: forall (m :: * -> *) e a. Monad m => e -> ExceptionalT e m a
throwT = forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. e -> Exceptional e a
throw

assertT :: (Monad m) =>
   e -> Bool -> ExceptionalT e m ()
assertT :: forall (m :: * -> *) e. Monad m => e -> Bool -> ExceptionalT e m ()
assertT e
e = forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. e -> Bool -> Exceptional e ()
assert e
e

catchT :: (Monad m) =>
   ExceptionalT e0 m a ->
   (e0 -> ExceptionalT e1 m a) ->
   ExceptionalT e1 m a
catchT :: forall (m :: * -> *) e0 a e1.
Monad m =>
ExceptionalT e0 m a
-> (e0 -> ExceptionalT e1 m a) -> ExceptionalT e1 m a
catchT ExceptionalT e0 m a
action e0 -> ExceptionalT e1 m a
handler =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e b a.
Monad m =>
(e -> m b) -> (a -> m b) -> ExceptionalT e m a -> m b
switchT (forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e0 -> ExceptionalT e1 m a
handler) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. a -> Exceptional e a
Success) ExceptionalT e0 m a
action

{- |
If the enclosed monad has custom exception facilities,
they could skip the cleanup code.
Make sure, that this cannot happen by choosing an appropriate monad.
-}
bracketT :: (Monad m) =>
   ExceptionalT e m h ->
   (h -> ExceptionalT e m ()) ->
   (h -> ExceptionalT e m a) ->
   ExceptionalT e m a
bracketT :: forall (m :: * -> *) e h a.
Monad m =>
ExceptionalT e m h
-> (h -> ExceptionalT e m ())
-> (h -> ExceptionalT e m a)
-> ExceptionalT e m a
bracketT ExceptionalT e m h
open h -> ExceptionalT e m ()
close h -> ExceptionalT e m a
action =
   ExceptionalT e m h
open forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \h
h ->
      forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$
         do Exceptional e a
a <- forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT (h -> ExceptionalT e m a
action h
h)
            Exceptional e ()
c <- forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT (h -> ExceptionalT e m ()
close h
h)
            forall (m :: * -> *) a. Monad m => a -> m a
return (Exceptional e a
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
r -> Exceptional e ()
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
r)

resolveT :: (Monad m) =>
   (e -> m a) -> ExceptionalT e m a -> m a
resolveT :: forall (m :: * -> *) e a.
Monad m =>
(e -> m a) -> ExceptionalT e m a -> m a
resolveT e -> m a
handler ExceptionalT e m a
x =
   do Exceptional e a
r <- forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT ExceptionalT e m a
x
      forall e a. (e -> a) -> Exceptional e a -> a
resolve e -> m a
handler (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return Exceptional e a
r)

tryT :: (Monad m) =>
   ExceptionalT e m a -> m (Exceptional e a)
tryT :: forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> m (Exceptional e a)
tryT = forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT


{- |
Repeat an action until an exception occurs.
Initialize the result with @empty@ and add new elements using @cons@
(e.g. @[]@ and @(:)@).
The exception handler decides whether the terminating exception
is re-raised ('Just') or catched ('Nothing').
-}
manyT :: (Monad m) =>
   (e0 -> Maybe e1)        {- ^ exception handler -} ->
   (a -> b -> b)           {- ^ @cons@ function -} ->
   b                       {- ^ @empty@ -} ->
   ExceptionalT e0 m a     {- ^ atomic action to repeat -} ->
   ExceptionalT e1 m b
manyT :: forall (m :: * -> *) e0 e1 a b.
Monad m =>
(e0 -> Maybe e1)
-> (a -> b -> b) -> b -> ExceptionalT e0 m a -> ExceptionalT e1 m b
manyT e0 -> Maybe e1
handler a -> b -> b
cons b
empty ExceptionalT e0 m a
action =
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Endo a -> a -> a
appEndo b
empty) forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a e0 e1.
(Monad m, Monoid a) =>
(e0 -> Maybe e1) -> ExceptionalT e0 m a -> ExceptionalT e1 m a
manyMonoidT e0 -> Maybe e1
handler forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> b
cons) ExceptionalT e0 m a
action

manyMonoidT :: (Monad m, Monoid a) =>
   (e0 -> Maybe e1)        {- ^ exception handler -} ->
   ExceptionalT e0 m a     {- ^ atomic action to repeat -} ->
   ExceptionalT e1 m a
manyMonoidT :: forall (m :: * -> *) a e0 e1.
(Monad m, Monoid a) =>
(e0 -> Maybe e1) -> ExceptionalT e0 m a -> ExceptionalT e1 m a
manyMonoidT e0 -> Maybe e1
handler ExceptionalT e0 m a
action =
   let recourse :: ExceptionalT e1 m a
recourse =
          do Exceptional e0 a
r <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> m (Exceptional e a)
tryT ExceptionalT e0 m a
action
             case Exceptional e0 a
r of
                -- Exception e -> maybe (return empty) throwT (handler e)
                -- more lazy
                Exception e0
e -> forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. a -> Exceptional e a
Success forall a. Monoid a => a
mempty) forall e a. e -> Exceptional e a
throw (e0 -> Maybe e1
handler e0
e)
                Success a
x   -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Monoid a => a -> a -> a
mappend a
x) ExceptionalT e1 m a
recourse
   in  ExceptionalT e1 m a
recourse


{- |
This combines two actions similar to Applicative's @<*>@.
The result action fails if one of the input action fails,
but both actions are executed.
E.g. consider a compiler that emits all errors
that can be detected independently,
but eventually aborts if there is at least one error.

The exception type @e@ might be a list type,
or an @Endo@ type that implements a difflist.
-}
mergeT ::
   (Monoid e, Monad m) =>
   ExceptionalT e m (a -> b) ->
   ExceptionalT e m a ->
   ExceptionalT e m b
mergeT :: forall e (m :: * -> *) a b.
(Monoid e, Monad m) =>
ExceptionalT e m (a -> b)
-> ExceptionalT e m a -> ExceptionalT e m b
mergeT ExceptionalT e m (a -> b)
mf ExceptionalT e m a
ma =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall e a b.
Monoid e =>
Exceptional e (a -> b) -> Exceptional e a -> Exceptional e b
merge (forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT ExceptionalT e m (a -> b)
mf) (forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT ExceptionalT e m a
ma)

alternativeT, _alternativeT ::
   (Monad m) =>
   ExceptionalT e m a -> ExceptionalT e m a -> ExceptionalT e m a
alternativeT :: forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> ExceptionalT e m a -> ExceptionalT e m a
alternativeT ExceptionalT e m a
x ExceptionalT e m a
y = forall (m :: * -> *) e0 a e1.
Monad m =>
ExceptionalT e0 m a
-> (e0 -> ExceptionalT e1 m a) -> ExceptionalT e1 m a
catchT ExceptionalT e m a
x (forall a b. a -> b -> a
const ExceptionalT e m a
y)
_alternativeT :: forall (m :: * -> *) e a.
Monad m =>
ExceptionalT e m a -> ExceptionalT e m a -> ExceptionalT e m a
_alternativeT ExceptionalT e m a
x ExceptionalT e m a
y =
   forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e b a.
Monad m =>
(e -> m b) -> (a -> m b) -> ExceptionalT e m a -> m b
switchT (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT ExceptionalT e m a
y) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. a -> Exceptional e a
Success) ExceptionalT e m a
x


instance Functor m => Functor (ExceptionalT e m) where
   fmap :: forall a b. (a -> b) -> ExceptionalT e m a -> ExceptionalT e m b
fmap a -> b
f (ExceptionalT m (Exceptional e a)
x) =
      forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) m (Exceptional e a)
x)

instance Applicative m => Applicative (ExceptionalT e m) where
   pure :: forall a. a -> ExceptionalT e m a
pure = forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
   ExceptionalT m (Exceptional e (a -> b))
f <*> :: forall a b.
ExceptionalT e m (a -> b)
-> ExceptionalT e m a -> ExceptionalT e m b
<*> ExceptionalT m (Exceptional e a)
x =
      forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) m (Exceptional e (a -> b))
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Exceptional e a)
x)

instance Monad m => Monad (ExceptionalT e m) where
   return :: forall a. a -> ExceptionalT e m a
return = forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
   ExceptionalT e m a
x0 >>= :: forall a b.
ExceptionalT e m a
-> (a -> ExceptionalT e m b) -> ExceptionalT e m b
>>= a -> ExceptionalT e m b
f =
      forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$
         forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT ExceptionalT e m a
x0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Exceptional e a
x1 ->
         case Exceptional e a
x1 of
            Exception e
e -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall e a. e -> Exceptional e a
Exception e
e)
            Success a
x -> forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT forall a b. (a -> b) -> a -> b
$ a -> ExceptionalT e m b
f a
x

{- |
Same restrictions applies as for @instance MonadFix (Exceptional e a)@.
-}
instance (MonadFix m) => MonadFix (ExceptionalT e m) where
   mfix :: forall a. (a -> ExceptionalT e m a) -> ExceptionalT e m a
mfix a -> ExceptionalT e m a
f = forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \ ~(Success a
r) -> forall e (m :: * -> *) a. ExceptionalT e m a -> m (Exceptional e a)
runExceptionalT forall a b. (a -> b) -> a -> b
$ a -> ExceptionalT e m a
f a
r

instance MonadTrans (ExceptionalT e) where
   lift :: forall (m :: * -> *) a. Monad m => m a -> ExceptionalT e m a
lift m a
m = forall e (m :: * -> *) a. m (Exceptional e a) -> ExceptionalT e m a
ExceptionalT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall e a. a -> Exceptional e a
Success m a
m

{-
instance MonadIO m => MonadIO (ExceptionalT e m) where
   liftIO act = ExceptionalT $ liftIO $ liftM Success act
-}