{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, DeriveTraversable, DerivingVia #-}
-----------------------------------------------------------------------------
-- |
-- Module     : Control.Selective.Trans.Except
-- Copyright  : (c) Andrey Mokhov 2018-2023
-- License    : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability  : experimental
--
-- This is a library for /selective applicative functors/, or just
-- /selective functors/ for short, an abstraction between applicative functors
-- and monads, introduced in this paper:
-- https://www.staff.ncl.ac.uk/andrey.mokhov/selective-functors.pdf.
--
-- This module defines a newtype around 'ExceptT' from @transformers@ with less
-- restrictive 'Applicative', 'Selective', and 'Alternative' implementations.
-- It supplies an @instance 'Selective' f => 'Selective' ('ExceptT' e f)@, which
-- makes 'ExceptT' a bona-fide 'Selective' transformer.
--
-- The API follows the API from the @transformers@ package, so it can be used as
-- a drop-in replacement. The documentation can be found in the
-- [@transformers@](https://hackage.haskell.org/package/transformers/docs/Control-Monad-Trans-Except.html) package.
-----------------------------------------------------------------------------
module Control.Selective.Trans.Except where

import Control.Applicative (Alternative)
import Control.Monad (MonadPlus)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Zip (MonadZip)
import Data.Functor.Classes
import Data.Functor.Contravariant (Contravariant)
import Data.Functor.Identity
#if MIN_VERSION_base(4,13,0)
-- MonadFail is imported already
#else
import Control.Monad.Fail
#endif

import qualified Control.Monad.Trans.Except as T

import Control.Selective
import Control.Monad.Signatures

-- | A newtype wrapper around 'T.ExceptT' from @transformers@ that provides less
-- restrictive 'Applicative', 'Selective' and 'Alternative' instances.
newtype ExceptT e f a = ExceptT { forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap :: T.ExceptT e f a }
  deriving
    ( forall a b. a -> ExceptT e f b -> ExceptT e f a
forall a b. (a -> b) -> ExceptT e f a -> ExceptT e f b
forall e (f :: * -> *) a b.
Functor f =>
a -> ExceptT e f b -> ExceptT e f a
forall e (f :: * -> *) a b.
Functor f =>
(a -> b) -> ExceptT e f a -> ExceptT e f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ExceptT e f b -> ExceptT e f a
$c<$ :: forall e (f :: * -> *) a b.
Functor f =>
a -> ExceptT e f b -> ExceptT e f a
fmap :: forall a b. (a -> b) -> ExceptT e f a -> ExceptT e f b
$cfmap :: forall e (f :: * -> *) a b.
Functor f =>
(a -> b) -> ExceptT e f a -> ExceptT e f b
Functor, forall a. Eq a => a -> ExceptT e f a -> Bool
forall a. Num a => ExceptT e f a -> a
forall a. Ord a => ExceptT e f a -> a
forall m. Monoid m => ExceptT e f m -> m
forall a. ExceptT e f a -> Bool
forall a. ExceptT e f a -> Int
forall a. ExceptT e f a -> [a]
forall a. (a -> a -> a) -> ExceptT e f a -> a
forall m a. Monoid m => (a -> m) -> ExceptT e f a -> m
forall b a. (b -> a -> b) -> b -> ExceptT e f a -> b
forall a b. (a -> b -> b) -> b -> ExceptT e f a -> b
forall e (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> ExceptT e f a -> Bool
forall e (f :: * -> *) a. (Foldable f, Num a) => ExceptT e f a -> a
forall e (f :: * -> *) a. (Foldable f, Ord a) => ExceptT e f a -> a
forall e (f :: * -> *) m.
(Foldable f, Monoid m) =>
ExceptT e f m -> m
forall e (f :: * -> *) a. Foldable f => ExceptT e f a -> Bool
forall e (f :: * -> *) a. Foldable f => ExceptT e f a -> Int
forall e (f :: * -> *) a. Foldable f => ExceptT e f a -> [a]
forall e (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ExceptT e f a -> a
forall e (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ExceptT e f a -> m
forall e (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ExceptT e f a -> b
forall e (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ExceptT e f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ExceptT e f a -> a
$cproduct :: forall e (f :: * -> *) a. (Foldable f, Num a) => ExceptT e f a -> a
sum :: forall a. Num a => ExceptT e f a -> a
$csum :: forall e (f :: * -> *) a. (Foldable f, Num a) => ExceptT e f a -> a
minimum :: forall a. Ord a => ExceptT e f a -> a
$cminimum :: forall e (f :: * -> *) a. (Foldable f, Ord a) => ExceptT e f a -> a
maximum :: forall a. Ord a => ExceptT e f a -> a
$cmaximum :: forall e (f :: * -> *) a. (Foldable f, Ord a) => ExceptT e f a -> a
elem :: forall a. Eq a => a -> ExceptT e f a -> Bool
$celem :: forall e (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> ExceptT e f a -> Bool
length :: forall a. ExceptT e f a -> Int
$clength :: forall e (f :: * -> *) a. Foldable f => ExceptT e f a -> Int
null :: forall a. ExceptT e f a -> Bool
$cnull :: forall e (f :: * -> *) a. Foldable f => ExceptT e f a -> Bool
toList :: forall a. ExceptT e f a -> [a]
$ctoList :: forall e (f :: * -> *) a. Foldable f => ExceptT e f a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ExceptT e f a -> a
$cfoldl1 :: forall e (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ExceptT e f a -> a
foldr1 :: forall a. (a -> a -> a) -> ExceptT e f a -> a
$cfoldr1 :: forall e (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> ExceptT e f a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ExceptT e f a -> b
$cfoldl' :: forall e (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ExceptT e f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ExceptT e f a -> b
$cfoldl :: forall e (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> ExceptT e f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ExceptT e f a -> b
$cfoldr' :: forall e (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ExceptT e f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ExceptT e f a -> b
$cfoldr :: forall e (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> ExceptT e f a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ExceptT e f a -> m
$cfoldMap' :: forall e (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ExceptT e f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ExceptT e f a -> m
$cfoldMap :: forall e (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> ExceptT e f a -> m
fold :: forall m. Monoid m => ExceptT e f m -> m
$cfold :: forall e (f :: * -> *) m.
(Foldable f, Monoid m) =>
ExceptT e f m -> m
Foldable, forall {e} {f :: * -> *}. Traversable f => Functor (ExceptT e f)
forall {e} {f :: * -> *}. Traversable f => Foldable (ExceptT e f)
forall e (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
ExceptT e f (m a) -> m (ExceptT e f a)
forall e (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
ExceptT e f (f a) -> f (ExceptT e f a)
forall e (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> ExceptT e f a -> m (ExceptT e f b)
forall e (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> ExceptT e f a -> f (ExceptT e f b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExceptT e f a -> f (ExceptT e f b)
sequence :: forall (m :: * -> *) a.
Monad m =>
ExceptT e f (m a) -> m (ExceptT e f a)
$csequence :: forall e (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
ExceptT e f (m a) -> m (ExceptT e f a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ExceptT e f a -> m (ExceptT e f b)
$cmapM :: forall e (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> ExceptT e f a -> m (ExceptT e f b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ExceptT e f (f a) -> f (ExceptT e f a)
$csequenceA :: forall e (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
ExceptT e f (f a) -> f (ExceptT e f a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ExceptT e f a -> f (ExceptT e f b)
$ctraverse :: forall e (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> ExceptT e f a -> f (ExceptT e f b)
Traversable, forall a. a -> ExceptT e f a
forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f b
forall a b. ExceptT e f a -> (a -> ExceptT e f b) -> ExceptT e f b
forall {e} {f :: * -> *}.
(Selective f, Monad f) =>
Applicative (ExceptT e f)
forall e (f :: * -> *) a.
(Selective f, Monad f) =>
a -> ExceptT e f a
forall e (f :: * -> *) a b.
(Selective f, Monad f) =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f b
forall e (f :: * -> *) a b.
(Selective f, Monad f) =>
ExceptT e f a -> (a -> ExceptT e f b) -> ExceptT e f b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ExceptT e f a
$creturn :: forall e (f :: * -> *) a.
(Selective f, Monad f) =>
a -> ExceptT e f a
>> :: forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f b
$c>> :: forall e (f :: * -> *) a b.
(Selective f, Monad f) =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f b
>>= :: forall a b. ExceptT e f a -> (a -> ExceptT e f b) -> ExceptT e f b
$c>>= :: forall e (f :: * -> *) a b.
(Selective f, Monad f) =>
ExceptT e f a -> (a -> ExceptT e f b) -> ExceptT e f b
Monad, forall b a. b -> ExceptT e f b -> ExceptT e f a
forall a' a. (a' -> a) -> ExceptT e f a -> ExceptT e f a'
forall e (f :: * -> *) b a.
Contravariant f =>
b -> ExceptT e f b -> ExceptT e f a
forall e (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> ExceptT e f a -> ExceptT e f a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: forall b a. b -> ExceptT e f b -> ExceptT e f a
$c>$ :: forall e (f :: * -> *) b a.
Contravariant f =>
b -> ExceptT e f b -> ExceptT e f a
contramap :: forall a' a. (a' -> a) -> ExceptT e f a -> ExceptT e f a'
$ccontramap :: forall e (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> ExceptT e f a -> ExceptT e f a'
Contravariant, ExceptT e f a -> ExceptT e f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e (f :: * -> *) a.
(Eq1 f, Eq e, Eq a) =>
ExceptT e f a -> ExceptT e f a -> Bool
/= :: ExceptT e f a -> ExceptT e f a -> Bool
$c/= :: forall e (f :: * -> *) a.
(Eq1 f, Eq e, Eq a) =>
ExceptT e f a -> ExceptT e f a -> Bool
== :: ExceptT e f a -> ExceptT e f a -> Bool
$c== :: forall e (f :: * -> *) a.
(Eq1 f, Eq e, Eq a) =>
ExceptT e f a -> ExceptT e f a -> Bool
Eq, ExceptT e f a -> ExceptT e f a -> Bool
ExceptT e f a -> ExceptT e f a -> Ordering
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {e} {f :: * -> *} {a}.
(Ord1 f, Ord e, Ord a) =>
Eq (ExceptT e f a)
forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> Bool
forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> Ordering
forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
min :: ExceptT e f a -> ExceptT e f a -> ExceptT e f a
$cmin :: forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
max :: ExceptT e f a -> ExceptT e f a -> ExceptT e f a
$cmax :: forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
>= :: ExceptT e f a -> ExceptT e f a -> Bool
$c>= :: forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> Bool
> :: ExceptT e f a -> ExceptT e f a -> Bool
$c> :: forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> Bool
<= :: ExceptT e f a -> ExceptT e f a -> Bool
$c<= :: forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> Bool
< :: ExceptT e f a -> ExceptT e f a -> Bool
$c< :: forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> Bool
compare :: ExceptT e f a -> ExceptT e f a -> Ordering
$ccompare :: forall e (f :: * -> *) a.
(Ord1 f, Ord e, Ord a) =>
ExceptT e f a -> ExceptT e f a -> Ordering
Ord, ReadPrec [ExceptT e f a]
ReadPrec (ExceptT e f a)
ReadS [ExceptT e f a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
ReadPrec [ExceptT e f a]
forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
ReadPrec (ExceptT e f a)
forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
Int -> ReadS (ExceptT e f a)
forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
ReadS [ExceptT e f a]
readListPrec :: ReadPrec [ExceptT e f a]
$creadListPrec :: forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
ReadPrec [ExceptT e f a]
readPrec :: ReadPrec (ExceptT e f a)
$creadPrec :: forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
ReadPrec (ExceptT e f a)
readList :: ReadS [ExceptT e f a]
$creadList :: forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
ReadS [ExceptT e f a]
readsPrec :: Int -> ReadS (ExceptT e f a)
$creadsPrec :: forall e (f :: * -> *) a.
(Read1 f, Read e, Read a) =>
Int -> ReadS (ExceptT e f a)
Read, Int -> ExceptT e f a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e (f :: * -> *) a.
(Show1 f, Show e, Show a) =>
Int -> ExceptT e f a -> ShowS
forall e (f :: * -> *) a.
(Show1 f, Show e, Show a) =>
[ExceptT e f a] -> ShowS
forall e (f :: * -> *) a.
(Show1 f, Show e, Show a) =>
ExceptT e f a -> String
showList :: [ExceptT e f a] -> ShowS
$cshowList :: forall e (f :: * -> *) a.
(Show1 f, Show e, Show a) =>
[ExceptT e f a] -> ShowS
show :: ExceptT e f a -> String
$cshow :: forall e (f :: * -> *) a.
(Show1 f, Show e, Show a) =>
ExceptT e f a -> String
showsPrec :: Int -> ExceptT e f a -> ShowS
$cshowsPrec :: forall e (f :: * -> *) a.
(Show1 f, Show e, Show a) =>
Int -> ExceptT e f a -> ShowS
Show
    , forall a. (a -> ExceptT e f a) -> ExceptT e f a
forall {e} {f :: * -> *}.
(Selective f, MonadFix f) =>
Monad (ExceptT e f)
forall e (f :: * -> *) a.
(Selective f, MonadFix f) =>
(a -> ExceptT e f a) -> ExceptT e f a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> ExceptT e f a) -> ExceptT e f a
$cmfix :: forall e (f :: * -> *) a.
(Selective f, MonadFix f) =>
(a -> ExceptT e f a) -> ExceptT e f a
MonadFix, forall a. String -> ExceptT e f a
forall {e} {f :: * -> *}.
(Selective f, MonadFail f) =>
Monad (ExceptT e f)
forall e (f :: * -> *) a.
(Selective f, MonadFail f) =>
String -> ExceptT e f a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> ExceptT e f a
$cfail :: forall e (f :: * -> *) a.
(Selective f, MonadFail f) =>
String -> ExceptT e f a
MonadFail, forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f (a, b)
forall a b. ExceptT e f (a, b) -> (ExceptT e f a, ExceptT e f b)
forall a b c.
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
forall {e} {f :: * -> *}.
(Selective f, MonadZip f) =>
Monad (ExceptT e f)
forall e (f :: * -> *) a b.
(Selective f, MonadZip f) =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f (a, b)
forall e (f :: * -> *) a b.
(Selective f, MonadZip f) =>
ExceptT e f (a, b) -> (ExceptT e f a, ExceptT e f b)
forall e (f :: * -> *) a b c.
(Selective f, MonadZip f) =>
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
forall (m :: * -> *).
Monad m
-> (forall a b. m a -> m b -> m (a, b))
-> (forall a b c. (a -> b -> c) -> m a -> m b -> m c)
-> (forall a b. m (a, b) -> (m a, m b))
-> MonadZip m
munzip :: forall a b. ExceptT e f (a, b) -> (ExceptT e f a, ExceptT e f b)
$cmunzip :: forall e (f :: * -> *) a b.
(Selective f, MonadZip f) =>
ExceptT e f (a, b) -> (ExceptT e f a, ExceptT e f b)
mzipWith :: forall a b c.
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
$cmzipWith :: forall e (f :: * -> *) a b c.
(Selective f, MonadZip f) =>
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
mzip :: forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f (a, b)
$cmzip :: forall e (f :: * -> *) a b.
(Selective f, MonadZip f) =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f (a, b)
MonadZip, forall a. IO a -> ExceptT e f a
forall {e} {f :: * -> *}.
(Selective f, MonadIO f) =>
Monad (ExceptT e f)
forall e (f :: * -> *) a.
(Selective f, MonadIO f) =>
IO a -> ExceptT e f a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> ExceptT e f a
$cliftIO :: forall e (f :: * -> *) a.
(Selective f, MonadIO f) =>
IO a -> ExceptT e f a
MonadIO, forall a. ExceptT e f a
forall a. ExceptT e f a -> ExceptT e f a -> ExceptT e f a
forall {e} {f :: * -> *}.
(Selective f, Monoid e, Monad f) =>
Monad (ExceptT e f)
forall {e} {f :: * -> *}.
(Selective f, Monoid e, Monad f) =>
Alternative (ExceptT e f)
forall e (f :: * -> *) a.
(Selective f, Monoid e, Monad f) =>
ExceptT e f a
forall e (f :: * -> *) a.
(Selective f, Monoid e, Monad f) =>
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. ExceptT e f a -> ExceptT e f a -> ExceptT e f a
$cmplus :: forall e (f :: * -> *) a.
(Selective f, Monoid e, Monad f) =>
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
mzero :: forall a. ExceptT e f a
$cmzero :: forall e (f :: * -> *) a.
(Selective f, Monoid e, Monad f) =>
ExceptT e f a
MonadPlus, forall a b.
(a -> b -> Bool) -> ExceptT e f a -> ExceptT e f b -> Bool
forall e (f :: * -> *) a b.
(Eq e, Eq1 f) =>
(a -> b -> Bool) -> ExceptT e f a -> ExceptT e f b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: forall a b.
(a -> b -> Bool) -> ExceptT e f a -> ExceptT e f b -> Bool
$cliftEq :: forall e (f :: * -> *) a b.
(Eq e, Eq1 f) =>
(a -> b -> Bool) -> ExceptT e f a -> ExceptT e f b -> Bool
Eq1, forall a b.
(a -> b -> Ordering) -> ExceptT e f a -> ExceptT e f b -> Ordering
forall {e} {f :: * -> *}. (Ord e, Ord1 f) => Eq1 (ExceptT e f)
forall e (f :: * -> *) a b.
(Ord e, Ord1 f) =>
(a -> b -> Ordering) -> ExceptT e f a -> ExceptT e f b -> Ordering
forall (f :: * -> *).
Eq1 f
-> (forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
liftCompare :: forall a b.
(a -> b -> Ordering) -> ExceptT e f a -> ExceptT e f b -> Ordering
$cliftCompare :: forall e (f :: * -> *) a b.
(Ord e, Ord1 f) =>
(a -> b -> Ordering) -> ExceptT e f a -> ExceptT e f b -> Ordering
Ord1, forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptT e f a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptT e f a)
forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptT e f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptT e f a]
forall e (f :: * -> *) a.
(Read e, Read1 f) =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptT e f a]
forall e (f :: * -> *) a.
(Read e, Read1 f) =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptT e f a)
forall e (f :: * -> *) a.
(Read e, Read1 f) =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptT e f a)
forall e (f :: * -> *) a.
(Read e, Read1 f) =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptT e f a]
forall (f :: * -> *).
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a])
-> Read1 f
liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptT e f a]
$cliftReadListPrec :: forall e (f :: * -> *) a.
(Read e, Read1 f) =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [ExceptT e f a]
liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptT e f a)
$cliftReadPrec :: forall e (f :: * -> *) a.
(Read e, Read1 f) =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (ExceptT e f a)
liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptT e f a]
$cliftReadList :: forall e (f :: * -> *) a.
(Read e, Read1 f) =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [ExceptT e f a]
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptT e f a)
$cliftReadsPrec :: forall e (f :: * -> *) a.
(Read e, Read1 f) =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (ExceptT e f a)
Read1, forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptT e f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [ExceptT e f a] -> ShowS
forall e (f :: * -> *) a.
(Show e, Show1 f) =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptT e f a -> ShowS
forall e (f :: * -> *) a.
(Show e, Show1 f) =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [ExceptT e f a] -> ShowS
forall (f :: * -> *).
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [ExceptT e f a] -> ShowS
$cliftShowList :: forall e (f :: * -> *) a.
(Show e, Show1 f) =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [ExceptT e f a] -> ShowS
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptT e f a -> ShowS
$cliftShowsPrec :: forall e (f :: * -> *) a.
(Show e, Show1 f) =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> ExceptT e f a -> ShowS
Show1 )
  deriving (forall a. a -> ExceptT e f a
forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f a
forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f b
forall a b. ExceptT e f (a -> b) -> ExceptT e f a -> ExceptT e f b
forall a b c.
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {f :: * -> *} {e}. Selective f => Functor (ExceptT e f)
forall (f :: * -> *) e a. Selective f => a -> ExceptT e f a
forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f a
forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f b
forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f (a -> b) -> ExceptT e f a -> ExceptT e f b
forall (f :: * -> *) e a b c.
Selective f =>
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
<* :: forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f a
$c<* :: forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f a
*> :: forall a b. ExceptT e f a -> ExceptT e f b -> ExceptT e f b
$c*> :: forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f a -> ExceptT e f b -> ExceptT e f b
liftA2 :: forall a b c.
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
$cliftA2 :: forall (f :: * -> *) e a b c.
Selective f =>
(a -> b -> c) -> ExceptT e f a -> ExceptT e f b -> ExceptT e f c
<*> :: forall a b. ExceptT e f (a -> b) -> ExceptT e f a -> ExceptT e f b
$c<*> :: forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f (a -> b) -> ExceptT e f a -> ExceptT e f b
pure :: forall a. a -> ExceptT e f a
$cpure :: forall (f :: * -> *) e a. Selective f => a -> ExceptT e f a
Applicative, forall a b.
ExceptT e f (Either a b) -> ExceptT e f (a -> b) -> ExceptT e f b
forall (f :: * -> *).
Applicative f
-> (forall a b. f (Either a b) -> f (a -> b) -> f b) -> Selective f
forall (f :: * -> *) e. Selective f => Applicative (ExceptT e f)
forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f (Either a b) -> ExceptT e f (a -> b) -> ExceptT e f b
select :: forall a b.
ExceptT e f (Either a b) -> ExceptT e f (a -> b) -> ExceptT e f b
$cselect :: forall (f :: * -> *) e a b.
Selective f =>
ExceptT e f (Either a b) -> ExceptT e f (a -> b) -> ExceptT e f b
Selective, forall a. ExceptT e f a
forall a. ExceptT e f a -> ExceptT e f [a]
forall a. ExceptT e f a -> ExceptT e f a -> ExceptT e f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {f :: * -> *} {e}.
(Selective f, Monoid e) =>
Applicative (ExceptT e f)
forall (f :: * -> *) e a. (Selective f, Monoid e) => ExceptT e f a
forall (f :: * -> *) e a.
(Selective f, Monoid e) =>
ExceptT e f a -> ExceptT e f [a]
forall (f :: * -> *) e a.
(Selective f, Monoid e) =>
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
many :: forall a. ExceptT e f a -> ExceptT e f [a]
$cmany :: forall (f :: * -> *) e a.
(Selective f, Monoid e) =>
ExceptT e f a -> ExceptT e f [a]
some :: forall a. ExceptT e f a -> ExceptT e f [a]
$csome :: forall (f :: * -> *) e a.
(Selective f, Monoid e) =>
ExceptT e f a -> ExceptT e f [a]
<|> :: forall a. ExceptT e f a -> ExceptT e f a -> ExceptT e f a
$c<|> :: forall (f :: * -> *) e a.
(Selective f, Monoid e) =>
ExceptT e f a -> ExceptT e f a -> ExceptT e f a
empty :: forall a. ExceptT e f a
$cempty :: forall (f :: * -> *) e a. (Selective f, Monoid e) => ExceptT e f a
Alternative) via (ComposeEither f e)

{- Why don't we provide a `MonadTrans (ExceptT e)` instance?

   Recall the definition of the MonadTrans type class:

     class (forall m. Monad m => Monad (t m)) => MonadTrans t where
         lift :: Monad m => m a -> t m a

   If we instantiate `t` to `ExceptT e` in the constraint, we get

     forall m. Monad m => Monad (ExceptT e m)

   but the `Applicative (ExceptT e m)` instance comes with the `Selective m`
   constraint, and since Selective is not a superclass of Monad, we're stuck.
   In other words, `ExceptT` is really not a universal monad transformer: it
   works only for monads `m` that also happen to have a `Selective m` instance.

   I can see three possible solutions but none of them has a chance of working
   in practice:

     * Change the constraint in the definition of MonadTrans to

         forall m. (Selective m, Monad m) => Monad (ExceptT e m)

     * Make Selective a superclass of Monad
     * Revert the "Applicative is a superclass of Monad" proposal (lol!)

   And so we just don't provide `MonadTrans (ExceptT e)` instance.

   We could provide a SelectiveTrans instance instead, where

     class (forall f. Selective f => Selective (t f)) => SelectiveTrans t where
         lift :: Selective f => f a -> t f a

   Sounds fun!
-}

-- | Inject an 'T.ExceptT' value into the newtype wrapper.
wrap :: T.ExceptT e m a -> ExceptT e m a
wrap :: forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
wrap = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT

type Except e = ExceptT e Identity

except :: Monad m => Either e a -> ExceptT e m a
except :: forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
T.except

runExcept :: Except e a -> Either e a
runExcept :: forall e a. Except e a -> Either e a
runExcept = forall e a. Except e a -> Either e a
T.runExcept forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap

mapExcept :: (Either e a -> Either e' b) -> Except e a -> Except e' b
mapExcept :: forall e a e' b.
(Either e a -> Either e' b) -> Except e a -> Except e' b
mapExcept Either e a -> Either e' b
f = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a e' b.
(Either e a -> Either e' b) -> Except e a -> Except e' b
T.mapExcept Either e a -> Either e' b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap

withExcept :: (e -> e') -> Except e a -> Except e' a
withExcept :: forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept e -> e'
f = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e e' a. (e -> e') -> Except e a -> Except e' a
T.withExcept e -> e'
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap

runExceptT :: ExceptT e m a -> m (Either e a)
runExceptT :: forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
T.runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap

mapExceptT :: (m (Either e a) -> n (Either e' b)) -> ExceptT e m a -> ExceptT e' n b
mapExceptT :: forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT m (Either e a) -> n (Either e' b)
f = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT 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
T.mapExceptT m (Either e a) -> n (Either e' b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap

withExceptT :: Functor m => (e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT :: forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT e -> e'
f = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
T.withExceptT e -> e'
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap

throwE :: Monad m => e -> ExceptT e m a
throwE :: forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
T.throwE

catchE :: Monad m => ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE :: forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
catchE ExceptT e m a
action e -> ExceptT e' m a
continuation = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
T.catchE (forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap ExceptT e m a
action) (forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ExceptT e' m a
continuation)

liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b
liftCallCC :: forall (m :: * -> *) e a b.
CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b
liftCallCC CallCC m (Either e a) (Either e b)
callCC (a -> ExceptT e m b) -> ExceptT e m a
caller = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a b.
CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b
T.liftCallCC CallCC m (Either e a) (Either e b)
callCC (forall e (f :: * -> *) a. ExceptT e f a -> ExceptT e f a
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ExceptT e m b) -> ExceptT e m a
caller forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
.))

liftListen :: Monad m => Listen w m (Either e a) -> Listen w (ExceptT e m) a
liftListen :: forall (m :: * -> *) w e a.
Monad m =>
Listen w m (Either e a) -> Listen w (ExceptT e m) a
liftListen Listen w m (Either e a)
listen (ExceptT ExceptT e m a
action) = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w e a.
Monad m =>
Listen w m (Either e a) -> Listen w (ExceptT e m) a
T.liftListen Listen w m (Either e a)
listen ExceptT e m a
action

liftPass :: Monad m => Pass w m (Either e a) -> Pass w (ExceptT e m) a
liftPass :: forall (m :: * -> *) w e a.
Monad m =>
Pass w m (Either e a) -> Pass w (ExceptT e m) a
liftPass Pass w m (Either e a)
pass (ExceptT ExceptT e m (a, w -> w)
action) = forall e (m :: * -> *) a. ExceptT e m a -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w e a.
Monad m =>
Pass w m (Either e a) -> Pass w (ExceptT e m) a
T.liftPass Pass w m (Either e a)
pass ExceptT e m (a, w -> w)
action