{-# 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,
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 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))