{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Oops
(
catchF,
catch,
throwF,
throw,
snatchF,
snatch,
CouldBeF,
CouldBe,
CouldBeAnyOfF,
CouldBeAnyOf,
Variant,
VariantF,
runOops,
runOopsInExceptT,
runOopsInEither,
suspend,
catchOrMap,
catchAsLeft,
catchAsNothing,
catchAndExitFailure,
recover,
recoverOrVoid,
onLeft,
onNothing,
onLeftThrow,
onNothingThrow,
hoistEither,
hoistMaybe,
onExceptionThrow,
onException,
) where
import Control.Monad.Error.Class (MonadError (..))
import Control.Monad.Except (ExceptT(ExceptT))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Except (mapExceptT, runExceptT)
import Data.Bifunctor (first)
import Data.Functor.Identity (Identity (..))
import Data.Variant (Catch, CatchF, CouldBe, CouldBeAnyOf, CouldBeAnyOfF, CouldBeF, Variant, VariantF)
import Data.Void (Void, absurd)
import qualified Control.Monad.Catch as CMC
import qualified Data.Variant as DV
import qualified System.Exit as IO
catchF :: forall x e e' f m a. ()
=> Monad m
=> CatchF x e e'
=> (f x -> ExceptT (VariantF f e') m a)
-> ExceptT (VariantF f e ) m a
-> ExceptT (VariantF f e') m a
catchF :: forall {k} (x :: k) (e :: [k]) (e' :: [k]) (f :: k -> *)
(m :: * -> *) a.
(Monad m, CatchF x e e') =>
(f x -> ExceptT (VariantF f e') m a)
-> ExceptT (VariantF f e) m a -> ExceptT (VariantF f e') m a
catchF f x -> ExceptT (VariantF f e') m a
h = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (VariantF f e) a -> m (Either (VariantF f e') a)
go)
where
go :: Either (VariantF f e) a -> m (Either (VariantF f e') a)
go = \case
Right a
success -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right a
success)
Left VariantF f e
failure -> case forall {k} (x :: k) (xs :: [k]) (ys :: [k]) (f :: k -> *).
CatchF x xs ys =>
VariantF f xs -> Either (VariantF f ys) (f x)
DV.catchF @x VariantF f e
failure of
Right f x
hit -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (f x -> ExceptT (VariantF f e') m a
h f x
hit)
Left VariantF f e'
miss -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left VariantF f e'
miss)
catch :: forall x e e' m a. ()
=> Monad m
=> Catch x e e'
=> (x -> ExceptT (Variant e') m a)
-> ExceptT (Variant e ) m a
-> ExceptT (Variant e') m a
catch :: forall x (e :: [*]) (e' :: [*]) (m :: * -> *) a.
(Monad m, Catch x e e') =>
(x -> ExceptT (Variant e') m a)
-> ExceptT (Variant e) m a -> ExceptT (Variant e') m a
catch x -> ExceptT (Variant e') m a
h = forall {k} (x :: k) (e :: [k]) (e' :: [k]) (f :: k -> *)
(m :: * -> *) a.
(Monad m, CatchF x e e') =>
(f x -> ExceptT (VariantF f e') m a)
-> ExceptT (VariantF f e) m a -> ExceptT (VariantF f e') m a
catchF (x -> ExceptT (Variant e') m a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity)
snatchF
:: forall x e f m a. ()
=> Monad m
=> e `CouldBe` x
=> (f x -> ExceptT (VariantF f e) m a)
-> ExceptT (VariantF f e) m a
-> ExceptT (VariantF f e) m a
snatchF :: forall x (e :: [*]) (f :: * -> *) (m :: * -> *) a.
(Monad m, CouldBe e x) =>
(f x -> ExceptT (VariantF f e) m a)
-> ExceptT (VariantF f e) m a -> ExceptT (VariantF f e) m a
snatchF f x -> ExceptT (VariantF f e) m a
h = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (VariantF f e) a -> m (Either (VariantF f e) a)
go)
where
go :: Either (VariantF f e) a -> m (Either (VariantF f e) a)
go = \case
Right a
success -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right a
success)
Left VariantF f e
failure -> case forall k (xs :: [k]) (x :: k) (f :: k -> *).
CouldBeF xs x =>
VariantF f xs -> Either (VariantF f xs) (f x)
DV.snatchF @_ @_ @x VariantF f e
failure of
Right f x
hit -> forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (f x -> ExceptT (VariantF f e) m a
h f x
hit)
Left VariantF f e
miss -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left VariantF f e
miss)
snatch :: forall x e m a. ()
=> Monad m
=> e `CouldBe` x
=> (x -> ExceptT (Variant e) m a)
-> ExceptT (Variant e) m a
-> ExceptT (Variant e) m a
snatch :: forall x (e :: [*]) (m :: * -> *) a.
(Monad m, CouldBe e x) =>
(x -> ExceptT (Variant e) m a)
-> ExceptT (Variant e) m a -> ExceptT (Variant e) m a
snatch x -> ExceptT (Variant e) m a
h = forall x (e :: [*]) (f :: * -> *) (m :: * -> *) a.
(Monad m, CouldBe e x) =>
(f x -> ExceptT (VariantF f e) m a)
-> ExceptT (VariantF f e) m a -> ExceptT (VariantF f e) m a
snatchF (x -> ExceptT (Variant e) m a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity)
throwF :: forall x e f m a. ()
=> MonadError (VariantF f e) m
=> e `CouldBe` x
=> f x
-> m a
throwF :: forall x (e :: [*]) (f :: * -> *) (m :: * -> *) a.
(MonadError (VariantF f e) m, CouldBe e x) =>
f x -> m a
throwF = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (xs :: [k]) (x :: k) (f :: k -> *).
CouldBeF xs x =>
f x -> VariantF f xs
DV.throwF
throw :: forall x e m a. ()
=> MonadError (Variant e) m
=> e `CouldBe` x
=> x
-> m a
throw :: forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
x -> m a
throw = forall x (e :: [*]) (f :: * -> *) (m :: * -> *) a.
(MonadError (VariantF f e) m, CouldBe e x) =>
f x -> m a
throwF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity
runOops :: ()
=> Monad m
=> ExceptT (Variant '[]) m a
-> m a
runOops :: forall (m :: * -> *) a. Monad m => ExceptT (Variant '[]) m a -> m a
runOops ExceptT (Variant '[]) m a
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *). VariantF f '[] -> Void
DV.preposterous) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT (Variant '[]) m a
f
runOopsInExceptT :: forall x m a. Monad m => ExceptT (Variant '[x]) m a -> ExceptT x m a
runOopsInExceptT :: forall x (m :: * -> *) a.
Monad m =>
ExceptT (Variant '[x]) m a -> ExceptT x m a
runOopsInExceptT = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall (xs :: [*]) o. Eithers xs o => Variant xs -> o
DV.toEithers))
runOopsInEither :: forall x m a. Monad m => ExceptT (Variant '[x]) m a -> m (Either x a)
runOopsInEither :: forall x (m :: * -> *) a.
Monad m =>
ExceptT (Variant '[x]) m a -> m (Either x a)
runOopsInEither = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall (xs :: [*]) o. Eithers xs o => Variant xs -> o
DV.toEithers))
suspend :: forall x m a n b. ()
=> (m (Either x a) -> n (Either x b))
-> ExceptT x m a
-> ExceptT x n b
suspend :: forall x (m :: * -> *) a (n :: * -> *) b.
(m (Either x a) -> n (Either x b))
-> ExceptT x m a -> ExceptT x n b
suspend m (Either x a) -> n (Either x b)
f = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either x a) -> n (Either x b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
catchOrMap :: forall x a e' m b. Monad m
=> (b -> a)
-> (x -> ExceptT (Variant e') m a)
-> ExceptT (Variant (x : e')) m b
-> ExceptT (Variant e') m a
catchOrMap :: forall x a (e' :: [*]) (m :: * -> *) b.
Monad m =>
(b -> a)
-> (x -> ExceptT (Variant e') m a)
-> ExceptT (Variant (x : e')) m b
-> ExceptT (Variant e') m a
catchOrMap b -> a
g x -> ExceptT (Variant e') m a
h = forall x (e :: [*]) (e' :: [*]) (m :: * -> *) a.
(Monad m, Catch x e e') =>
(x -> ExceptT (Variant e') m a)
-> ExceptT (Variant e) m a -> ExceptT (Variant e') m a
catch x -> ExceptT (Variant e') m a
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
g
catchAsLeft :: forall x e m a. ()
=> Monad m
=> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m (Either x a)
catchAsLeft :: forall x (e :: [*]) (m :: * -> *) a.
Monad m =>
ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m (Either x a)
catchAsLeft = forall x a (e' :: [*]) (m :: * -> *) b.
Monad m =>
(b -> a)
-> (x -> ExceptT (Variant e') m a)
-> ExceptT (Variant (x : e')) m b
-> ExceptT (Variant e') m a
catchOrMap forall a b. b -> Either a b
Right (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
catchAsNothing :: forall x e m a. ()
=> Monad m
=> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m (Maybe a)
catchAsNothing :: forall x (e :: [*]) (m :: * -> *) a.
Monad m =>
ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m (Maybe a)
catchAsNothing = forall x a (e' :: [*]) (m :: * -> *) b.
Monad m =>
(b -> a)
-> (x -> ExceptT (Variant e') m a)
-> ExceptT (Variant (x : e')) m b
-> ExceptT (Variant e') m a
catchOrMap forall a. a -> Maybe a
Just (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
catchAndExitFailure :: forall x e m a. ()
=> MonadIO m
=> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m a
catchAndExitFailure :: forall x (e :: [*]) (m :: * -> *) a.
MonadIO m =>
ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m a
catchAndExitFailure = forall x (e :: [*]) (e' :: [*]) (m :: * -> *) a.
(Monad m, Catch x e e') =>
(x -> ExceptT (Variant e') m a)
-> ExceptT (Variant e) m a -> ExceptT (Variant e') m a
catch @x (forall a b. a -> b -> a
const (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO a
IO.exitFailure))
hoistEither :: forall x e m a. ()
=> MonadError (Variant e) m
=> e `CouldBe` x
=> Monad m
=> Either x a
-> m a
hoistEither :: forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x, Monad m) =>
Either x a -> m a
hoistEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
x -> m a
throw forall (f :: * -> *) a. Applicative f => a -> f a
pure
hoistMaybe :: forall e es m a. ()
=> MonadError (Variant es) m
=> CouldBe es e
=> e
-> Maybe a
-> m a
hoistMaybe :: forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> Maybe a -> m a
hoistMaybe e
e = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
x -> m a
throw e
e) forall (f :: * -> *) a. Applicative f => a -> f a
pure
onLeftThrow :: forall x e m a. ()
=> MonadError (Variant e) m
=> e `CouldBe` x
=> m (Either x a)
-> m a
onLeftThrow :: forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
m (Either x a) -> m a
onLeftThrow m (Either x a)
f = m (Either x a)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x, Monad m) =>
Either x a -> m a
hoistEither
onNothingThrow :: forall e es m a. ()
=> MonadError (Variant es) m
=> CouldBe es e
=> e
-> m (Maybe a)
-> m a
onNothingThrow :: forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> m (Maybe a) -> m a
onNothingThrow e
e m (Maybe a)
f = m (Maybe a)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> Maybe a -> m a
hoistMaybe e
e
onLeft :: forall x m a. ()
=> Monad m
=> (x -> m a)
-> m (Either x a)
-> m a
onLeft :: forall x (m :: * -> *) a.
Monad m =>
(x -> m a) -> m (Either x a) -> m a
onLeft x -> m a
g m (Either x a)
f = m (Either x a)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either x -> m a
g forall (f :: * -> *) a. Applicative f => a -> f a
pure
onNothing :: forall m a. ()
=> Monad m
=> m a
-> m (Maybe a)
-> m a
onNothing :: forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
onNothing m a
g m (Maybe a)
f = m (Maybe a)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
g forall (f :: * -> *) a. Applicative f => a -> f a
pure
recover :: forall x e m a. ()
=> Monad m
=> (x -> a)
-> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m a
recover :: forall x (e :: [*]) (m :: * -> *) a.
Monad m =>
(x -> a)
-> ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m a
recover x -> a
f = forall x (e :: [*]) (e' :: [*]) (m :: * -> *) a.
(Monad m, Catch x e e') =>
(x -> ExceptT (Variant e') m a)
-> ExceptT (Variant e) m a -> ExceptT (Variant e') m a
catch (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
f)
recoverOrVoid :: forall x e m. ()
=> Monad m
=> ExceptT (Variant (x : e)) m Void
-> ExceptT (Variant e) m x
recoverOrVoid :: forall x (e :: [*]) (m :: * -> *).
Monad m =>
ExceptT (Variant (x : e)) m Void -> ExceptT (Variant e) m x
recoverOrVoid = forall x a (e' :: [*]) (m :: * -> *) b.
Monad m =>
(b -> a)
-> (x -> ExceptT (Variant e') m a)
-> ExceptT (Variant (x : e')) m b
-> ExceptT (Variant e') m a
catchOrMap @x forall a. Void -> a
absurd forall (f :: * -> *) a. Applicative f => a -> f a
pure
onExceptionThrow :: forall x e m a. ()
=> CMC.MonadCatch m
=> CMC.Exception x
=> MonadError (Variant e) m
=> e `CouldBe` x
=> m a
-> m a
onExceptionThrow :: forall x (e :: [*]) (m :: * -> *) a.
(MonadCatch m, Exception x, MonadError (Variant e) m,
CouldBe e x) =>
m a -> m a
onExceptionThrow = forall x (m :: * -> *) a.
(MonadCatch m, Exception x) =>
(x -> m a) -> m a -> m a
onException @x forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
x -> m a
throw
onException :: forall x m a. ()
=> CMC.MonadCatch m
=> CMC.Exception x
=> (x -> m a)
-> m a
-> m a
onException :: forall x (m :: * -> *) a.
(MonadCatch m, Exception x) =>
(x -> m a) -> m a -> m a
onException x -> m a
h m a
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either x -> m a
h forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
CMC.try m a
f