module Control.Monad.Ology.Data.Exn where

import Control.Monad.Ology.General
import Control.Monad.Ology.Specific.Result
import Import

-- | Exceptions that can be thrown and caught in this monad.
type Exn :: (Type -> Type) -> Type -> Type
data Exn m e = MkExn
    { forall (m :: Type -> Type) e. Exn m e -> forall a. e -> m a
exnThrow :: forall a. e -> m a
    , forall (m :: Type -> Type) e.
Exn m e -> forall a. m a -> (e -> m a) -> m a
exnCatch :: forall a. m a -> (e -> m a) -> m a
    }

instance Invariant (Exn m) where
    invmap :: forall a b. (a -> b) -> (b -> a) -> Exn m a -> Exn m b
invmap a -> b
f b -> a
g (MkExn forall a. a -> m a
t forall a. m a -> (a -> m a) -> m a
c) = forall (m :: Type -> Type) e.
(forall a. e -> m a)
-> (forall a. m a -> (e -> m a) -> m a) -> Exn m e
MkExn (forall a. a -> m a
t forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> a
g) (\m a
ma b -> m a
ema -> forall a. m a -> (a -> m a) -> m a
c m a
ma forall a b. (a -> b) -> a -> b
$ b -> m a
ema forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
f)

instance Summable (Exn m) where
    rVoid :: Exn m Void
rVoid = MkExn {exnThrow :: forall a. Void -> m a
exnThrow = forall a. Void -> a
absurd, exnCatch :: forall a. m a -> (Void -> m a) -> m a
exnCatch = \m a
m Void -> m a
_ -> m a
m}
    Exn m a
exn1 <+++> :: forall a b. Exn m a -> Exn m b -> Exn m (Either a b)
<+++> Exn m b
exn2 =
        MkExn
            { exnThrow :: forall a. Either a b -> m a
exnThrow = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: Type -> Type) e. Exn m e -> forall a. e -> m a
exnThrow Exn m a
exn1) (forall (m :: Type -> Type) e. Exn m e -> forall a. e -> m a
exnThrow Exn m b
exn2)
            , exnCatch :: forall a. m a -> (Either a b -> m a) -> m a
exnCatch = \m a
m Either a b -> m a
k -> forall (m :: Type -> Type) e.
Exn m e -> forall a. m a -> (e -> m a) -> m a
exnCatch Exn m a
exn1 (forall (m :: Type -> Type) e.
Exn m e -> forall a. m a -> (e -> m a) -> m a
exnCatch Exn m b
exn2 m a
m (Either a b -> m a
k forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. b -> Either a b
Right)) (Either a b -> m a
k forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left)
            }

exnTry :: Monad m => Exn m e -> m a -> m (Result e a)
exnTry :: forall (m :: Type -> Type) e a.
Monad m =>
Exn m e -> m a -> m (Result e a)
exnTry Exn m e
exn m a
ma = forall (m :: Type -> Type) e.
Exn m e -> forall a. m a -> (e -> m a) -> m a
exnCatch Exn m e
exn (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e a. a -> Result e a
SuccessResult m a
ma) forall a b. (a -> b) -> a -> b
$ \e
e -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e a. e -> Result e a
FailureResult e
e

exnHandle :: Exn m e -> (e -> m a) -> m a -> m a
exnHandle :: forall (m :: Type -> Type) e a. Exn m e -> (e -> m a) -> m a -> m a
exnHandle Exn m e
exn e -> m a
handler m a
ma = forall (m :: Type -> Type) e.
Exn m e -> forall a. m a -> (e -> m a) -> m a
exnCatch Exn m e
exn m a
ma e -> m a
handler

exnOnException ::
       forall e m a. Monad m
    => Exn m e
    -> m a
    -> m ()
    -> m a
exnOnException :: forall e (m :: Type -> Type) a.
Monad m =>
Exn m e -> m a -> m () -> m a
exnOnException Exn m e
exn m a
ma m ()
handler = forall (m :: Type -> Type) e.
Exn m e -> forall a. m a -> (e -> m a) -> m a
exnCatch Exn m e
exn m a
ma forall a b. (a -> b) -> a -> b
$ \e
e -> m ()
handler forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> forall (m :: Type -> Type) e. Exn m e -> forall a. e -> m a
exnThrow Exn m e
exn e
e

exnBracket ::
       forall e m a b. MonadTunnelIO m
    => Exn m e
    -> m a
    -> (a -> m ())
    -> (a -> m b)
    -> m b
exnBracket :: forall e (m :: Type -> Type) a b.
MonadTunnelIO m =>
Exn m e -> m a -> (a -> m ()) -> (a -> m b) -> m b
exnBracket Exn m e
exn m a
before a -> m ()
after a -> m b
thing =
    forall (m :: Type -> Type) b.
MonadTunnelIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
        a
a <- m a
before
        b
r <- forall e (m :: Type -> Type) a.
Monad m =>
Exn m e -> m a -> m () -> m a
exnOnException Exn m e
exn (forall a. m a -> m a
restore (a -> m b
thing a
a)) (a -> m ()
after a
a)
        ()
_ <- a -> m ()
after a
a
        forall (m :: Type -> Type) a. Monad m => a -> m a
return b
r

exnFinally ::
       forall e m a. MonadTunnelIO m
    => Exn m e
    -> m a
    -> m ()
    -> m a
exnFinally :: forall e (m :: Type -> Type) a.
MonadTunnelIO m =>
Exn m e -> m a -> m () -> m a
exnFinally Exn m e
exn m a
ma m ()
handler = forall e (m :: Type -> Type) a b.
MonadTunnelIO m =>
Exn m e -> m a -> (a -> m ()) -> (a -> m b) -> m b
exnBracket Exn m e
exn (forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) (forall a b. a -> b -> a
const m ()
handler) (forall a b. a -> b -> a
const m a
ma)

exnBracket_ ::
       forall e m. MonadTunnelIO m
    => Exn m e
    -> m ()
    -> m ()
    -> m --> m
exnBracket_ :: forall e (m :: Type -> Type).
MonadTunnelIO m =>
Exn m e -> m () -> m () -> m --> m
exnBracket_ Exn m e
exn m ()
before m ()
after m a
thing = forall e (m :: Type -> Type) a b.
MonadTunnelIO m =>
Exn m e -> m a -> (a -> m ()) -> (a -> m b) -> m b
exnBracket Exn m e
exn m ()
before (forall a b. a -> b -> a
const m ()
after) (forall a b. a -> b -> a
const m a
thing)

mapExn :: (e2 -> e1) -> (e1 -> Maybe e2) -> Exn m e1 -> Exn m e2
mapExn :: forall e2 e1 (m :: Type -> Type).
(e2 -> e1) -> (e1 -> Maybe e2) -> Exn m e1 -> Exn m e2
mapExn e2 -> e1
f e1 -> Maybe e2
g Exn m e1
exn =
    MkExn
        { exnThrow :: forall a. e2 -> m a
exnThrow = forall (m :: Type -> Type) e. Exn m e -> forall a. e -> m a
exnThrow Exn m e1
exn forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e2 -> e1
f
        , exnCatch :: forall a. m a -> (e2 -> m a) -> m a
exnCatch =
              \m a
ma e2 -> m a
handler ->
                  forall (m :: Type -> Type) e.
Exn m e -> forall a. m a -> (e -> m a) -> m a
exnCatch Exn m e1
exn m a
ma forall a b. (a -> b) -> a -> b
$ \e1
e ->
                      case e1 -> Maybe e2
g e1
e of
                          Maybe e2
Nothing -> forall (m :: Type -> Type) e. Exn m e -> forall a. e -> m a
exnThrow Exn m e1
exn e1
e
                          Just e2
e' -> e2 -> m a
handler e2
e'
        }

liftExn ::
       forall t m. (MonadTransTunnel t, Monad m)
    => Exn m --> Exn (t m)
liftExn :: forall (t :: TransKind) (m :: Type -> Type).
(MonadTransTunnel t, Monad m) =>
Exn m --> Exn (t m)
liftExn (MkExn forall a. a -> m a
t forall a. m a -> (a -> m a) -> m a
c :: Exn m e) = let
    t' :: forall a. e -> t m a
    t' :: forall a. a -> t m a
t' a
e = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. a -> m a
t a
e
    c' :: forall a. t m a -> (e -> t m a) -> t m a
    c' :: forall a. t m a -> (a -> t m a) -> t m a
c' t m a
tma a -> t m a
handler = forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransTunnel t, Monad m) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t r))
-> t m r
tunnel forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
unlift -> forall a. m a -> (a -> m a) -> m a
c (forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
unlift t m a
tma) forall a b. (a -> b) -> a -> b
$ \a
e -> forall (m1 :: Type -> Type) a.
Monad m1 =>
t m1 a -> m1 (Tunnel t a)
unlift forall a b. (a -> b) -> a -> b
$ a -> t m a
handler a
e
    in forall (m :: Type -> Type) e.
(forall a. e -> m a)
-> (forall a. m a -> (e -> m a) -> m a) -> Exn m e
MkExn forall a. a -> t m a
t' forall a. t m a -> (a -> t m a) -> t m a
c'

allExn ::
       forall m. MonadException m
    => Exn m (Exc m)
allExn :: forall (m :: Type -> Type). MonadException m => Exn m (Exc m)
allExn = forall (m :: Type -> Type) e.
(forall a. e -> m a)
-> (forall a. m a -> (e -> m a) -> m a) -> Exn m e
MkExn forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc

someExn ::
       forall e m. MonadCatch e m
    => Exn m e
someExn :: forall e (m :: Type -> Type). MonadCatch e m => Exn m e
someExn = forall (m :: Type -> Type) e.
(forall a. e -> m a)
-> (forall a. m a -> (e -> m a) -> m a) -> Exn m e
MkExn forall e (m :: Type -> Type) a. MonadThrow e m => e -> m a
throw forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch