{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Oops
(
catchFM,
catchM,
throwFM,
throwM,
snatchFM,
snatchM,
runOops,
runOops0,
runOops1,
suspendM,
catchAsLeftM,
catchAsNothingM,
catchAndExitFailureM,
throwLeftM,
throwNothingM,
throwNothingAsM,
throwPureLeftM,
throwPureNothingM,
throwPureNothingAsM,
leftM,
nothingM,
recoverM,
recoverOrVoidM,
onExceptionThrowM,
onExceptionM,
DV.CouldBeF (..),
DV.CouldBe (..),
DV.CouldBeAnyOfF,
DV.CouldBeAnyOf,
DV.Variant,
DV.VariantF(..),
) 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.Function ((&))
import Data.Functor.Identity (Identity (..))
import Data.Variant (Catch, CatchF(..), CouldBe, CouldBeF(..), Variant, VariantF, preposterous)
import Data.Void (Void, absurd)
import qualified Control.Monad.Catch as CMC
import qualified Data.Variant as DV
import qualified System.Exit as IO
catchFM :: 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
catchFM :: 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
catchFM f x -> ExceptT (VariantF f e') m a
recover ExceptT (VariantF f e) m a
xs = 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) ExceptT (VariantF f e) m a
xs
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)
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
recover 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)
catchM :: 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
catchM :: 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
catchM x -> ExceptT (Variant e') m a
recover ExceptT (Variant e) m a
xs
= 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
catchFM (x -> ExceptT (Variant e') m a
recover forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity) ExceptT (Variant e) m a
xs
snatchFM
:: 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
snatchFM :: 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
snatchFM f x -> ExceptT (VariantF f e) m a
recover ExceptT (VariantF f e) m a
xs = 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) ExceptT (VariantF f e) m a
xs
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)
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
recover 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)
snatchM :: 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
snatchM :: 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
snatchM x -> ExceptT (Variant e) m a
recover ExceptT (Variant e) m a
xs = 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
snatchFM (x -> ExceptT (Variant e) m a
recover forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity) ExceptT (Variant e) m a
xs
throwFM :: forall x e f m a. ()
=> MonadError (VariantF f e) m
=> e `CouldBe` x
=> f x
-> m a
throwFM :: forall x (e :: [*]) (f :: * -> *) (m :: * -> *) a.
(MonadError (VariantF f e) m, CouldBe e x) =>
f x -> m a
throwFM = 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
throwF
throwM :: forall x e m a. ()
=> MonadError (Variant e) m
=> e `CouldBe` x
=> x
-> m a
throwM :: forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
x -> m a
throwM = forall x (e :: [*]) (f :: * -> *) (m :: * -> *) a.
(MonadError (VariantF f e) m, CouldBe e x) =>
f x -> m a
throwFM 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
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
runOops0 :: forall m a. Monad m => ExceptT (Variant '[]) m a -> ExceptT Void m a
runOops0 :: forall (m :: * -> *) a.
Monad m =>
ExceptT (Variant '[]) m a -> ExceptT Void m a
runOops0 = 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 a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *). VariantF f '[] -> Void
preposterous)))
runOops1 :: forall x m a. Monad m => ExceptT (Variant '[x]) m a -> ExceptT x m a
runOops1 :: forall x (m :: * -> *) a.
Monad m =>
ExceptT (Variant '[x]) m a -> ExceptT x m a
runOops1 = 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))
suspendM :: forall x m a n b. ()
=> (m (Either x a) -> n (Either x b))
-> ExceptT x m a
-> ExceptT x n b
suspendM :: forall x (m :: * -> *) a (n :: * -> *) b.
(m (Either x a) -> n (Either x b))
-> ExceptT x m a -> ExceptT x n b
suspendM 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
catchAsLeftM :: forall x e m a. ()
=> Monad m
=> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m (Either x a)
catchAsLeftM :: forall x (e :: [*]) (m :: * -> *) a.
Monad m =>
ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m (Either x a)
catchAsLeftM = 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
catchM @x (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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right
catchAsNothingM :: forall x e m a. ()
=> Monad m
=> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m (Maybe a)
catchAsNothingM :: forall x (e :: [*]) (m :: * -> *) a.
Monad m =>
ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m (Maybe a)
catchAsNothingM = 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
catchM @x (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)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just
catchAndExitFailureM :: forall x e m a. ()
=> MonadIO m
=> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m a
catchAndExitFailureM :: forall x (e :: [*]) (m :: * -> *) a.
MonadIO m =>
ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m a
catchAndExitFailureM = 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
catchM @x (forall a b. a -> b -> a
const (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO a
IO.exitFailure))
throwLeftM :: forall x e m a. ()
=> MonadError (Variant e) m
=> CouldBeF e x
=> Monad m
=> Either x a
-> m a
throwLeftM :: forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBeF e x, Monad m) =>
Either x a -> m a
throwLeftM = 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
throwM forall (f :: * -> *) a. Applicative f => a -> f a
pure
throwNothingM :: ()
=> MonadError (Variant e) m
=> CouldBeF e ()
=> Monad m
=> Maybe a
-> m a
throwNothingM :: forall (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBeF e (), Monad m) =>
Maybe a -> m a
throwNothingM = forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> Maybe a -> m a
throwNothingAsM ()
throwNothingAsM :: forall e es m a. ()
=> MonadError (Variant es) m
=> CouldBe es e
=> e
-> Maybe a
-> m a
throwNothingAsM :: forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> Maybe a -> m a
throwNothingAsM 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
throwM e
e) forall (f :: * -> *) a. Applicative f => a -> f a
pure
throwPureLeftM :: forall x e m a. ()
=> MonadError (Variant e) m
=> CouldBeF e x
=> m (Either x a)
-> m a
throwPureLeftM :: forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBeF e x) =>
m (Either x a) -> m a
throwPureLeftM 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, CouldBeF e x, Monad m) =>
Either x a -> m a
throwLeftM
throwPureNothingM :: ()
=> MonadError (Variant e) m
=> CouldBeF e ()
=> Monad m
=> m (Maybe a)
-> m a
throwPureNothingM :: forall (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBeF e (), Monad m) =>
m (Maybe a) -> m a
throwPureNothingM m (Maybe a)
f = m (Maybe a)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBeF e (), Monad m) =>
Maybe a -> m a
throwNothingM
throwPureNothingAsM :: forall e es m a. ()
=> MonadError (Variant es) m
=> CouldBe es e
=> e
-> m (Maybe a)
-> m a
throwPureNothingAsM :: forall e (es :: [*]) (m :: * -> *) a.
(MonadError (Variant es) m, CouldBe es e) =>
e -> m (Maybe a) -> m a
throwPureNothingAsM 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
throwNothingAsM e
e
leftM :: forall x m a. ()
=> Monad m
=> (x -> m a)
-> m (Either x a)
-> m a
leftM :: forall x (m :: * -> *) a.
Monad m =>
(x -> m a) -> m (Either x a) -> m a
leftM 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
nothingM :: forall m a. ()
=> Monad m
=> m a
-> m (Maybe a)
-> m a
nothingM :: forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
nothingM 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
recoverM :: forall x e m a. ()
=> Monad m
=> (x -> a)
-> ExceptT (Variant (x : e)) m a
-> ExceptT (Variant e) m a
recoverM :: forall x (e :: [*]) (m :: * -> *) a.
Monad m =>
(x -> a)
-> ExceptT (Variant (x : e)) m a -> ExceptT (Variant e) m a
recoverM x -> a
g ExceptT (Variant (x : e)) m a
f = ExceptT (Variant (x : e)) m a
f forall a b. a -> (a -> b) -> b
& 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
catchM (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
g)
recoverOrVoidM :: forall x e m. ()
=> Monad m
=> ExceptT (Variant (x : e)) m Void
-> ExceptT (Variant e) m x
recoverOrVoidM :: forall x (e :: [*]) (m :: * -> *).
Monad m =>
ExceptT (Variant (x : e)) m Void -> ExceptT (Variant e) m x
recoverOrVoidM ExceptT (Variant (x : e)) m Void
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Void -> a
absurd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right ExceptT (Variant (x : e)) m Void
f forall a b. a -> (a -> b) -> b
& 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
catchM @x (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))
onExceptionThrowM :: forall x e m a. ()
=> CMC.MonadCatch m
=> CMC.Exception x
=> MonadError (Variant e) m
=> CouldBeF e x
=> m a
-> m a
onExceptionThrowM :: forall x (e :: [*]) (m :: * -> *) a.
(MonadCatch m, Exception x, MonadError (Variant e) m,
CouldBeF e x) =>
m a -> m a
onExceptionThrowM = forall x (m :: * -> *) a.
(MonadCatch m, Exception x) =>
(x -> m a) -> m a -> m a
onExceptionM @x forall x (e :: [*]) (m :: * -> *) a.
(MonadError (Variant e) m, CouldBe e x) =>
x -> m a
throwM
onExceptionM :: forall x m a. ()
=> CMC.MonadCatch m
=> CMC.Exception x
=> (x -> m a)
-> m a
-> m a
onExceptionM :: forall x (m :: * -> *) a.
(MonadCatch m, Exception x) =>
(x -> m a) -> m a -> m a
onExceptionM 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