{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Rescue.Class (MonadRescue (..)) where
import Data.WorldPeace
import Control.Exception
import qualified Control.Monad.Catch as Catch
import Control.Monad.Cont
import Control.Monad.Raise
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import qualified Control.Monad.RWS.Lazy as Lazy
import qualified Control.Monad.RWS.Strict as Strict
import qualified Control.Monad.State.Lazy as Lazy
import qualified Control.Monad.State.Strict as Strict
import qualified Control.Monad.Writer.Lazy as Lazy
import qualified Control.Monad.Writer.Strict as Strict
class MonadRaise m => MonadRescue m where
attempt :: m a -> m (Either (ErrorCase m) a)
instance MonadRescue Maybe where
attempt :: Maybe a -> Maybe (Either (ErrorCase Maybe) a)
attempt Maybe a
Nothing = Either (OpenUnion '[()]) a -> Maybe (Either (OpenUnion '[()]) a)
forall a. a -> Maybe a
Just (Either (OpenUnion '[()]) a -> Maybe (Either (OpenUnion '[()]) a))
-> (OpenUnion '[()] -> Either (OpenUnion '[()]) a)
-> OpenUnion '[()]
-> Maybe (Either (OpenUnion '[()]) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion '[()] -> Either (OpenUnion '[()]) a
forall a b. a -> Either a b
Left (OpenUnion '[()] -> Maybe (Either (OpenUnion '[()]) a))
-> OpenUnion '[()] -> Maybe (Either (OpenUnion '[()]) a)
forall a b. (a -> b) -> a -> b
$ () -> OpenUnion '[()]
forall a (as :: [*]). IsMember a as => a -> OpenUnion as
openUnionLift ()
attempt (Just a
x) = Either (OpenUnion '[()]) a -> Maybe (Either (OpenUnion '[()]) a)
forall a. a -> Maybe a
Just (Either (OpenUnion '[()]) a -> Maybe (Either (OpenUnion '[()]) a))
-> Either (OpenUnion '[()]) a -> Maybe (Either (OpenUnion '[()]) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (OpenUnion '[()]) a
forall a b. b -> Either a b
Right a
x
instance MonadRescue [] where
attempt :: [a] -> [Either (ErrorCase []) a]
attempt [] = [OpenUnion '[()] -> Either (OpenUnion '[()]) a
forall a b. a -> Either a b
Left (OpenUnion '[()] -> Either (OpenUnion '[()]) a)
-> OpenUnion '[()] -> Either (OpenUnion '[()]) a
forall a b. (a -> b) -> a -> b
$ () -> OpenUnion '[()]
forall err errs. Subset err errs => err -> errs
include ()]
attempt [a]
xs = a -> Either (OpenUnion '[()]) a
forall a b. b -> Either a b
Right (a -> Either (OpenUnion '[()]) a)
-> [a] -> [Either (OpenUnion '[()]) a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs
instance MonadRescue (Either (OpenUnion errs)) where
attempt :: Either (OpenUnion errs) a
-> Either
(OpenUnion errs) (Either (ErrorCase (Either (OpenUnion errs))) a)
attempt Either (OpenUnion errs) a
action = Either (OpenUnion errs) a
-> Either (OpenUnion errs) (Either (OpenUnion errs) a)
forall a b. b -> Either a b
Right Either (OpenUnion errs) a
action
instance MonadRescue IO where
attempt :: IO a -> IO (Either (ErrorCase IO) a)
attempt IO a
action =
IO a -> IO (Either IOException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Catch.try IO a
action IO (Either IOException a)
-> (Either IOException a
-> IO (Either (OpenUnion '[IOException]) a))
-> IO (Either (OpenUnion '[IOException]) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (IOException
err :: IOException) -> Either (OpenUnion '[IOException]) a
-> IO (Either (OpenUnion '[IOException]) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion '[IOException]) a
-> IO (Either (OpenUnion '[IOException]) a))
-> (OpenUnion '[IOException]
-> Either (OpenUnion '[IOException]) a)
-> OpenUnion '[IOException]
-> IO (Either (OpenUnion '[IOException]) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion '[IOException] -> Either (OpenUnion '[IOException]) a
forall a b. a -> Either a b
Left (OpenUnion '[IOException]
-> IO (Either (OpenUnion '[IOException]) a))
-> OpenUnion '[IOException]
-> IO (Either (OpenUnion '[IOException]) a)
forall a b. (a -> b) -> a -> b
$ IOException -> OpenUnion '[IOException]
forall err errs. Subset err errs => err -> errs
include IOException
err
Right a
val -> Either (OpenUnion '[IOException]) a
-> IO (Either (OpenUnion '[IOException]) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion '[IOException]) a
-> IO (Either (OpenUnion '[IOException]) a))
-> Either (OpenUnion '[IOException]) a
-> IO (Either (OpenUnion '[IOException]) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (OpenUnion '[IOException]) a
forall a b. b -> Either a b
Right a
val
instance
( MonadRescue m
, () `IsMember` Errors m
, Errors m `Contains` Errors m
)
=> MonadRescue (MaybeT m) where
attempt :: MaybeT m a -> MaybeT m (Either (ErrorCase (MaybeT m)) a)
attempt (MaybeT m (Maybe a)
action) =
m (Maybe (Either (OpenUnion (Errors m)) a))
-> MaybeT m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (Either (OpenUnion (Errors m)) a))
-> MaybeT m (Either (OpenUnion (Errors m)) a))
-> m (Maybe (Either (OpenUnion (Errors m)) a))
-> MaybeT m (Either (OpenUnion (Errors m)) a)
forall a b. (a -> b) -> a -> b
$
m (Maybe a) -> m (Either (OpenUnion (Errors m)) (Maybe a))
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m (Maybe a)
action m (Either (OpenUnion (Errors m)) (Maybe a))
-> (Either (OpenUnion (Errors m)) (Maybe a)
-> m (Maybe (Either (OpenUnion (Errors m)) a)))
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left OpenUnion (Errors m)
errs -> Maybe (Either (OpenUnion (Errors m)) a)
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either (OpenUnion (Errors m)) a)
-> m (Maybe (Either (OpenUnion (Errors m)) a)))
-> (OpenUnion (Errors m)
-> Maybe (Either (OpenUnion (Errors m)) a))
-> OpenUnion (Errors m)
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (OpenUnion (Errors m)) a
-> Maybe (Either (OpenUnion (Errors m)) a)
forall a. a -> Maybe a
Just (Either (OpenUnion (Errors m)) a
-> Maybe (Either (OpenUnion (Errors m)) a))
-> (OpenUnion (Errors m) -> Either (OpenUnion (Errors m)) a)
-> OpenUnion (Errors m)
-> Maybe (Either (OpenUnion (Errors m)) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion (Errors m) -> Either (OpenUnion (Errors m)) a
forall a b. a -> Either a b
Left (OpenUnion (Errors m)
-> m (Maybe (Either (OpenUnion (Errors m)) a)))
-> OpenUnion (Errors m)
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall a b. (a -> b) -> a -> b
$ OpenUnion (Errors m) -> OpenUnion (Errors m)
forall err errs. Subset err errs => err -> errs
include OpenUnion (Errors m)
errs
Right Maybe a
Nothing -> Maybe (Either (OpenUnion (Errors m)) a)
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either (OpenUnion (Errors m)) a)
-> m (Maybe (Either (OpenUnion (Errors m)) a)))
-> (OpenUnion (Errors m)
-> Maybe (Either (OpenUnion (Errors m)) a))
-> OpenUnion (Errors m)
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (OpenUnion (Errors m)) a
-> Maybe (Either (OpenUnion (Errors m)) a)
forall a. a -> Maybe a
Just (Either (OpenUnion (Errors m)) a
-> Maybe (Either (OpenUnion (Errors m)) a))
-> (OpenUnion (Errors m) -> Either (OpenUnion (Errors m)) a)
-> OpenUnion (Errors m)
-> Maybe (Either (OpenUnion (Errors m)) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion (Errors m) -> Either (OpenUnion (Errors m)) a
forall a b. a -> Either a b
Left (OpenUnion (Errors m)
-> m (Maybe (Either (OpenUnion (Errors m)) a)))
-> OpenUnion (Errors m)
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall a b. (a -> b) -> a -> b
$ () -> OpenUnion (Errors m)
forall err errs. Subset err errs => err -> errs
include ()
Right (Just a
val) -> Maybe (Either (OpenUnion (Errors m)) a)
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either (OpenUnion (Errors m)) a)
-> m (Maybe (Either (OpenUnion (Errors m)) a)))
-> (Either (OpenUnion (Errors m)) a
-> Maybe (Either (OpenUnion (Errors m)) a))
-> Either (OpenUnion (Errors m)) a
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (OpenUnion (Errors m)) a
-> Maybe (Either (OpenUnion (Errors m)) a)
forall a. a -> Maybe a
Just (Either (OpenUnion (Errors m)) a
-> m (Maybe (Either (OpenUnion (Errors m)) a)))
-> Either (OpenUnion (Errors m)) a
-> m (Maybe (Either (OpenUnion (Errors m)) a))
forall a b. (a -> b) -> a -> b
$ a -> Either (OpenUnion (Errors m)) a
forall a b. b -> Either a b
Right a
val
instance MonadRescue m => MonadRescue (IdentityT m) where
attempt :: IdentityT m a -> IdentityT m (Either (ErrorCase (IdentityT m)) a)
attempt (IdentityT m a
action) = m (Either (OpenUnion (Errors m)) a)
-> IdentityT m (Either (OpenUnion (Errors m)) a)
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m (Either (OpenUnion (Errors m)) a)
-> IdentityT m (Either (OpenUnion (Errors m)) a))
-> m (Either (OpenUnion (Errors m)) a)
-> IdentityT m (Either (OpenUnion (Errors m)) a)
forall a b. (a -> b) -> a -> b
$ m a -> m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m a
action
instance
( MonadRescue m
, Contains (Errors m) errs
)
=> MonadRescue (ExceptT (OpenUnion errs) m) where
attempt :: ExceptT (OpenUnion errs) m a
-> ExceptT
(OpenUnion errs)
m
(Either (ErrorCase (ExceptT (OpenUnion errs) m)) a)
attempt (ExceptT m (Either (OpenUnion errs) a)
action) =
m (Either (OpenUnion errs) a)
-> ExceptT (OpenUnion errs) m (Either (OpenUnion errs) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (OpenUnion errs) a)
-> ExceptT (OpenUnion errs) m (Either (OpenUnion errs) a))
-> m (Either (OpenUnion errs) a)
-> ExceptT (OpenUnion errs) m (Either (OpenUnion errs) a)
forall a b. (a -> b) -> a -> b
$
m (Either (OpenUnion errs) a)
-> m (Either
(Union Identity (Errors m)) (Either (OpenUnion errs) a))
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt m (Either (OpenUnion errs) a)
action m (Either (Union Identity (Errors m)) (Either (OpenUnion errs) a))
-> (Either (Union Identity (Errors m)) (Either (OpenUnion errs) a)
-> m (Either (OpenUnion errs) a))
-> m (Either (OpenUnion errs) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Union Identity (Errors m)
err -> Either (OpenUnion errs) a -> m (Either (OpenUnion errs) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion errs) a -> m (Either (OpenUnion errs) a))
-> (OpenUnion errs -> Either (OpenUnion errs) a)
-> OpenUnion errs
-> m (Either (OpenUnion errs) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenUnion errs -> Either (OpenUnion errs) a
forall a b. a -> Either a b
Left (OpenUnion errs -> m (Either (OpenUnion errs) a))
-> OpenUnion errs -> m (Either (OpenUnion errs) a)
forall a b. (a -> b) -> a -> b
$ Union Identity (Errors m) -> OpenUnion errs
forall err errs. Subset err errs => err -> errs
include Union Identity (Errors m)
err
Right Either (OpenUnion errs) a
errOrVal -> Either (OpenUnion errs) a -> m (Either (OpenUnion errs) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either (OpenUnion errs) a
errOrVal
instance MonadRescue m => MonadRescue (ReaderT cfg m) where
attempt :: ReaderT cfg m a
-> ReaderT cfg m (Either (ErrorCase (ReaderT cfg m)) a)
attempt = (m a -> m (Either (OpenUnion (Errors m)) a))
-> ReaderT cfg m a
-> ReaderT cfg m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m a -> m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt
instance (Monoid w, MonadRescue m) => MonadRescue (Lazy.WriterT w m) where
attempt :: WriterT w m a -> WriterT w m (Either (ErrorCase (WriterT w m)) a)
attempt = (m (a, w) -> m (Either (OpenUnion (Errors m)) a, w))
-> WriterT w m a -> WriterT w m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT m (a, w) -> m (Either (OpenUnion (Errors m)) a, w)
forall (m :: * -> *) (errs :: [*]) a w.
(MonadRescue m, RaisesOnly m errs) =>
m (a, w) -> m (Either (OpenUnion errs) a, w)
runner2
instance (Monoid w, MonadRescue m) => MonadRescue (Strict.WriterT w m) where
attempt :: WriterT w m a -> WriterT w m (Either (ErrorCase (WriterT w m)) a)
attempt = (m (a, w) -> m (Either (OpenUnion (Errors m)) a, w))
-> WriterT w m a -> WriterT w m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT m (a, w) -> m (Either (OpenUnion (Errors m)) a, w)
forall (m :: * -> *) (errs :: [*]) a w.
(MonadRescue m, RaisesOnly m errs) =>
m (a, w) -> m (Either (OpenUnion errs) a, w)
runner2
instance MonadRescue m => MonadRescue (Lazy.StateT s m) where
attempt :: StateT s m a -> StateT s m (Either (ErrorCase (StateT s m)) a)
attempt = (m (a, s) -> m (Either (OpenUnion (Errors m)) a, s))
-> StateT s m a -> StateT s m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Lazy.mapStateT m (a, s) -> m (Either (OpenUnion (Errors m)) a, s)
forall (m :: * -> *) (errs :: [*]) a w.
(MonadRescue m, RaisesOnly m errs) =>
m (a, w) -> m (Either (OpenUnion errs) a, w)
runner2
instance MonadRescue m => MonadRescue (Strict.StateT s m) where
attempt :: StateT s m a -> StateT s m (Either (ErrorCase (StateT s m)) a)
attempt = (m (a, s) -> m (Either (OpenUnion (Errors m)) a, s))
-> StateT s m a -> StateT s m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT m (a, s) -> m (Either (OpenUnion (Errors m)) a, s)
forall (m :: * -> *) (errs :: [*]) a w.
(MonadRescue m, RaisesOnly m errs) =>
m (a, w) -> m (Either (OpenUnion errs) a, w)
runner2
instance (Monoid w, MonadRescue m) => MonadRescue (Lazy.RWST r w s m) where
attempt :: RWST r w s m a
-> RWST r w s m (Either (ErrorCase (RWST r w s m)) a)
attempt = (m (a, s, w) -> m (Either (OpenUnion (Errors m)) a, s, w))
-> RWST r w s m a -> RWST r w s m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Lazy.mapRWST m (a, s, w) -> m (Either (OpenUnion (Errors m)) a, s, w)
forall (m :: * -> *) (errs :: [*]) a b c.
(MonadRescue m, RaisesOnly m errs) =>
m (a, b, c) -> m (Either (OpenUnion errs) a, b, c)
runner3
instance (Monoid w, MonadRescue m) => MonadRescue (Strict.RWST r w s m) where
attempt :: RWST r w s m a
-> RWST r w s m (Either (ErrorCase (RWST r w s m)) a)
attempt = (m (a, s, w) -> m (Either (OpenUnion (Errors m)) a, s, w))
-> RWST r w s m a -> RWST r w s m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST m (a, s, w) -> m (Either (OpenUnion (Errors m)) a, s, w)
forall (m :: * -> *) (errs :: [*]) a b c.
(MonadRescue m, RaisesOnly m errs) =>
m (a, b, c) -> m (Either (OpenUnion errs) a, b, c)
runner3
instance MonadRescue m => MonadRescue (ContT r m) where
attempt :: ContT r m a -> ContT r m (Either (ErrorCase (ContT r m)) a)
attempt = ((Either (OpenUnion (Errors m)) a -> m r) -> a -> m r)
-> ContT r m a -> ContT r m (Either (OpenUnion (Errors m)) a)
forall k b (m :: k -> *) (r :: k) a.
((b -> m r) -> a -> m r) -> ContT r m a -> ContT r m b
withContT (((Either (OpenUnion (Errors m)) a -> m r) -> a -> m r)
-> ContT r m a -> ContT r m (Either (OpenUnion (Errors m)) a))
-> ((Either (OpenUnion (Errors m)) a -> m r) -> a -> m r)
-> ContT r m a
-> ContT r m (Either (OpenUnion (Errors m)) a)
forall a b. (a -> b) -> a -> b
$ \Either (OpenUnion (Errors m)) a -> m r
b_mr a
current -> Either (OpenUnion (Errors m)) a -> m r
b_mr (Either (OpenUnion (Errors m)) a -> m r)
-> m (Either (OpenUnion (Errors m)) a) -> m r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a -> m (Either (OpenUnion (Errors m)) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
current)
runner2
:: ( MonadRescue m
, RaisesOnly m errs
)
=> m (a, w)
-> m (Either (OpenUnion errs) a, w)
runner2 :: m (a, w) -> m (Either (OpenUnion errs) a, w)
runner2 m (a, w)
inner = do
(a
a, w
w) <- m (a, w)
inner
Either (OpenUnion errs) a
errOrVal <- m a -> m (Either (ErrorCase m) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
(Either (OpenUnion errs) a, w) -> m (Either (OpenUnion errs) a, w)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion errs) a
errOrVal, w
w)
runner3
:: ( MonadRescue m
, RaisesOnly m errs
)
=> m (a, b, c)
-> m (Either (OpenUnion errs) a, b, c)
runner3 :: m (a, b, c) -> m (Either (OpenUnion errs) a, b, c)
runner3 m (a, b, c)
inner = do
(a
a, b
s, c
w) <- m (a, b, c)
inner
Either (OpenUnion errs) a
errOrVal <- m a -> m (Either (ErrorCase m) a)
forall (m :: * -> *) a.
MonadRescue m =>
m a -> m (Either (ErrorCase m) a)
attempt (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
(Either (OpenUnion errs) a, b, c)
-> m (Either (OpenUnion errs) a, b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (OpenUnion errs) a
errOrVal, b
s, c
w)