{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Validate.Internal where
import Control.Monad.IO.Class
import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Reader.Class
import Control.Monad.State.Strict
import Control.Monad.Trans.Control
import Control.Monad.Writer.Class
import Data.Functor
import Data.Functor.Identity
import Data.Tuple (swap)
import GHC.Stack (HasCallStack)
import Control.Monad.Validate.Class
newtype ValidateT e m a = ValidateT
{ ValidateT e m a
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
getValidateT :: forall s. StateT (MonoMaybe s e) (ExceptT e m) a }
deriving instance (Functor m) => Functor (ValidateT e m)
validateT
:: forall e m a. (Functor m)
=> (forall s. MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT :: (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a))
f = (forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT ((MonoMaybe s e -> ExceptT e m (a, MonoMaybe s e))
-> StateT (MonoMaybe s e) (ExceptT e m) a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (m (Either e (a, MonoMaybe s e)) -> ExceptT e m (a, MonoMaybe s e)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e (a, MonoMaybe s e)) -> ExceptT e m (a, MonoMaybe s e))
-> (MonoMaybe s e -> m (Either e (a, MonoMaybe s e)))
-> MonoMaybe s e
-> ExceptT e m (a, MonoMaybe s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either e (MonoMaybe s e, a) -> Either e (a, MonoMaybe s e))
-> m (Either e (MonoMaybe s e, a))
-> m (Either e (a, MonoMaybe s e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((MonoMaybe s e, a) -> (a, MonoMaybe s e))
-> Either e (MonoMaybe s e, a) -> Either e (a, MonoMaybe s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MonoMaybe s e, a) -> (a, MonoMaybe s e)
forall a b. (a, b) -> (b, a)
swap) (m (Either e (MonoMaybe s e, a))
-> m (Either e (a, MonoMaybe s e)))
-> (MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> MonoMaybe s e
-> m (Either e (a, MonoMaybe s e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoMaybe s e -> m (Either e (MonoMaybe s e, a))
forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a))
f)))
{-# INLINE validateT #-}
unValidateT
:: forall s e m a. (Functor m)
=> MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT :: MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s e
e (ValidateT forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m) = ExceptT e m (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((a, MonoMaybe s e) -> (MonoMaybe s e, a)
forall a b. (a, b) -> (b, a)
swap ((a, MonoMaybe s e) -> (MonoMaybe s e, a))
-> ExceptT e m (a, MonoMaybe s e) -> ExceptT e m (MonoMaybe s e, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT (MonoMaybe s e) (ExceptT e m) a
-> MonoMaybe s e -> ExceptT e m (a, MonoMaybe s e)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT (MonoMaybe s e) (ExceptT e m) a
forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m MonoMaybe s e
e)
{-# INLINE unValidateT #-}
instance (Monad m) => Applicative (ValidateT e m) where
pure :: a -> ValidateT e m a
pure a
v = (forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT (a -> StateT (MonoMaybe s e) (ExceptT e m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v)
{-# INLINE pure #-}
ValidateT e m (a -> b)
m1 <*> :: ValidateT e m (a -> b) -> ValidateT e m a -> ValidateT e m b
<*> ValidateT e m a
m2 = (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, b)))
-> ValidateT e m b
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, b)))
-> ValidateT e m b)
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, b)))
-> ValidateT e m b
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e0 ->
MonoMaybe s e
-> ValidateT e m (a -> b) -> m (Either e (MonoMaybe s e, a -> b))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s e
e0 ValidateT e m (a -> b)
m1 m (Either e (MonoMaybe s e, a -> b))
-> (Either e (MonoMaybe s e, a -> b)
-> m (Either e (MonoMaybe s e, b)))
-> m (Either e (MonoMaybe s e, b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left e
e1 -> MonoMaybe 'SJust e
-> ValidateT e m a -> m (Either e (MonoMaybe 'SJust e, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT (e -> MonoMaybe 'SJust e
forall (s :: MonoMaybeS) a. a -> MonoMaybe s a
MJust @'SJust e
e1) ValidateT e m a
m2 m (Either e (MonoMaybe 'SJust e, a))
-> (Either e (MonoMaybe 'SJust e, a)
-> Either e (MonoMaybe s e, b))
-> m (Either e (MonoMaybe s e, b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Left e
e2 -> e -> Either e (MonoMaybe s e, b)
forall a b. a -> Either a b
Left e
e2
Right (MJust e
e2, a
_) -> e -> Either e (MonoMaybe s e, b)
forall a b. a -> Either a b
Left e
e2
Right (MonoMaybe s e
e1, a -> b
v1) -> MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s e
e1 ValidateT e m a
m2 m (Either e (MonoMaybe s e, a))
-> (Either e (MonoMaybe s e, a) -> Either e (MonoMaybe s e, b))
-> m (Either e (MonoMaybe s e, b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Left e
e2 -> e -> Either e (MonoMaybe s e, b)
forall a b. a -> Either a b
Left e
e2
Right (MonoMaybe s e
e2, a
v2) -> (MonoMaybe s e, b) -> Either e (MonoMaybe s e, b)
forall a b. b -> Either a b
Right (MonoMaybe s e
e2, a -> b
v1 a
v2)
{-# INLINABLE (<*>) #-}
instance (Monad m) => Monad (ValidateT e m) where
ValidateT forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m >>= :: ValidateT e m a -> (a -> ValidateT e m b) -> ValidateT e m b
>>= a -> ValidateT e m b
f = (forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) b)
-> ValidateT e m b
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT (StateT (MonoMaybe s e) (ExceptT e m) a
forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m StateT (MonoMaybe s e) (ExceptT e m) a
-> (a -> StateT (MonoMaybe s e) (ExceptT e m) b)
-> StateT (MonoMaybe s e) (ExceptT e m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> ValidateT e m b
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) b
forall e (m :: * -> *) a.
ValidateT e m a
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
getValidateT (a -> ValidateT e m b
f a
x))
{-# INLINE (>>=) #-}
instance MonadTrans (ValidateT e) where
lift :: m a -> ValidateT e m a
lift m a
m = (forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT (ExceptT e m a -> StateT (MonoMaybe s e) (ExceptT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT e m a -> StateT (MonoMaybe s e) (ExceptT e m) a)
-> ExceptT e m a -> StateT (MonoMaybe s e) (ExceptT e m) a
forall a b. (a -> b) -> a -> b
$ m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m)
{-# INLINE lift #-}
instance (MonadIO m) => MonadIO (ValidateT e m) where
liftIO :: IO a -> ValidateT e m a
liftIO = m a -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ValidateT e m a)
-> (IO a -> m a) -> IO a -> ValidateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# INLINE liftIO #-}
instance (MonadBase b m) => MonadBase b (ValidateT e m) where
liftBase :: b α -> ValidateT e m α
liftBase = m α -> ValidateT e m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> ValidateT e m α) -> (b α -> m α) -> b α -> ValidateT e m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
{-# INLINE liftBase #-}
data ValidateTState e a = forall s. ValidateTState
{ ()
getValidateTState :: Either e (MonoMaybe s e, a) }
deriving instance (Show e, Show a) => Show (ValidateTState e a)
deriving instance Functor (ValidateTState e)
instance MonadTransControl (ValidateT e) where
type StT (ValidateT e) a = ValidateTState e a
liftWith :: (Run (ValidateT e) -> m a) -> ValidateT e m a
liftWith Run (ValidateT e) -> m a
f = (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a)
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e ->
(MonoMaybe s e, a) -> Either e (MonoMaybe s e, a)
forall a b. b -> Either a b
Right ((MonoMaybe s e, a) -> Either e (MonoMaybe s e, a))
-> (a -> (MonoMaybe s e, a)) -> a -> Either e (MonoMaybe s e, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MonoMaybe s e
e,) (a -> Either e (MonoMaybe s e, a))
-> m a -> m (Either e (MonoMaybe s e, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Run (ValidateT e) -> m a
f ((Either e (MonoMaybe s e, b) -> ValidateTState e b)
-> n (Either e (MonoMaybe s e, b)) -> n (ValidateTState e b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either e (MonoMaybe s e, b) -> ValidateTState e b
forall e a (s :: MonoMaybeS).
Either e (MonoMaybe s e, a) -> ValidateTState e a
ValidateTState (n (Either e (MonoMaybe s e, b)) -> n (ValidateTState e b))
-> (ValidateT e n b -> n (Either e (MonoMaybe s e, b)))
-> ValidateT e n b
-> n (ValidateTState e b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoMaybe s e -> ValidateT e n b -> n (Either e (MonoMaybe s e, b))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s e
e)
{-# INLINABLE liftWith #-}
restoreT :: (HasCallStack, Monad m) => m (StT (ValidateT e) a) -> ValidateT e m a
restoreT :: m (StT (ValidateT e) a) -> ValidateT e m a
restoreT m (StT (ValidateT e) a)
m = (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a)
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e1 -> do
ValidateTState Either e (MonoMaybe s e, a)
r <- m (StT (ValidateT e) a)
m (ValidateTState e a)
m
case MonoMaybe s e
e1 of
MonoMaybe s e
MNothing -> case Either e (MonoMaybe s e, a)
r of
Left e
e2 -> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a)))
-> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall a b. (a -> b) -> a -> b
$ e -> Either e (MonoMaybe s e, a)
forall a b. a -> Either a b
Left e
e2
Right (MJust e
e2, a
v) -> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a)))
-> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall a b. (a -> b) -> a -> b
$ (MonoMaybe s e, a) -> Either e (MonoMaybe s e, a)
forall a b. b -> Either a b
Right (e -> MonoMaybe s e
forall (s :: MonoMaybeS) a. a -> MonoMaybe s a
MJust e
e2, a
v)
Right (MonoMaybe s e
MNothing, a
v) -> Either e (MonoMaybe 'SMaybe e, a)
-> m (Either e (MonoMaybe 'SMaybe e, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e (MonoMaybe 'SMaybe e, a)
-> m (Either e (MonoMaybe 'SMaybe e, a)))
-> Either e (MonoMaybe 'SMaybe e, a)
-> m (Either e (MonoMaybe 'SMaybe e, a))
forall a b. (a -> b) -> a -> b
$ (MonoMaybe 'SMaybe e, a) -> Either e (MonoMaybe 'SMaybe e, a)
forall a b. b -> Either a b
Right (MonoMaybe 'SMaybe e
forall a. MonoMaybe 'SMaybe a
MNothing, a
v)
MJust e
_ -> case Either e (MonoMaybe s e, a)
r of
Left e
e2 -> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a)))
-> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall a b. (a -> b) -> a -> b
$ e -> Either e (MonoMaybe s e, a)
forall a b. a -> Either a b
Left e
e2
Right (MJust e
e2, a
v) -> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a)))
-> Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall a b. (a -> b) -> a -> b
$ (MonoMaybe s e, a) -> Either e (MonoMaybe s e, a)
forall a b. b -> Either a b
Right (e -> MonoMaybe s e
forall (s :: MonoMaybeS) a. a -> MonoMaybe s a
MJust e
e2, a
v)
Right (MonoMaybe s e
MNothing, a
_) -> String -> m (Either e (MonoMaybe s e, a))
forall a. HasCallStack => String -> a
error
(String -> m (Either e (MonoMaybe s e, a)))
-> String -> m (Either e (MonoMaybe s e, a))
forall a b. (a -> b) -> a -> b
$ String
"Control.Monad.Validate.ValidateT#restoreT: panic!\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" An attempt was made to restore from a state captured before any validation\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" errors occurred into a context with validation errors. This is probably the\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" result of an incorrect use of MonadBaseControl (as validation errors should\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" strictly increase). Ensure that all state is restored immediately upon\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" returning from the base monad (or is not restored at all).\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" If you believe your use of MonadBaseControl is not in error, and this is a bug\n"
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" in ValidateT, please submit a bug report."
{-# INLINABLE restoreT #-}
instance (MonadBaseControl b m) => MonadBaseControl b (ValidateT e m) where
type StM (ValidateT e m) a = ComposeSt (ValidateT e) m a
liftBaseWith :: (RunInBase (ValidateT e m) b -> b a) -> ValidateT e m a
liftBaseWith = (RunInBase (ValidateT e m) b -> b a) -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: StM (ValidateT e m) a -> ValidateT e m a
restoreM = StM (ValidateT e m) a -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}
liftCatch
:: (Functor m)
=> (forall b. m b -> (e -> m b) -> m b)
-> ValidateT d m a -> (e -> ValidateT d m a) -> ValidateT d m a
liftCatch :: (forall b. m b -> (e -> m b) -> m b)
-> ValidateT d m a -> (e -> ValidateT d m a) -> ValidateT d m a
liftCatch forall b. m b -> (e -> m b) -> m b
catchE ValidateT d m a
m e -> ValidateT d m a
f = (forall (s :: MonoMaybeS).
MonoMaybe s d -> m (Either d (MonoMaybe s d, a)))
-> ValidateT d m a
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s d -> m (Either d (MonoMaybe s d, a)))
-> ValidateT d m a)
-> (forall (s :: MonoMaybeS).
MonoMaybe s d -> m (Either d (MonoMaybe s d, a)))
-> ValidateT d m a
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s d
e ->
m (Either d (MonoMaybe s d, a))
-> (e -> m (Either d (MonoMaybe s d, a)))
-> m (Either d (MonoMaybe s d, a))
forall b. m b -> (e -> m b) -> m b
catchE (MonoMaybe s d -> ValidateT d m a -> m (Either d (MonoMaybe s d, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s d
e ValidateT d m a
m) (MonoMaybe s d -> ValidateT d m a -> m (Either d (MonoMaybe s d, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s d
e (ValidateT d m a -> m (Either d (MonoMaybe s d, a)))
-> (e -> ValidateT d m a) -> e -> m (Either d (MonoMaybe s d, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ValidateT d m a
f)
{-# INLINE liftCatch #-}
instance (MonadError e m) => MonadError e (ValidateT a m) where
throwError :: e -> ValidateT a m a
throwError = m a -> ValidateT a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ValidateT a m a) -> (e -> m a) -> e -> ValidateT a m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: ValidateT a m a -> (e -> ValidateT a m a) -> ValidateT a m a
catchError = (forall b. m b -> (e -> m b) -> m b)
-> ValidateT a m a -> (e -> ValidateT a m a) -> ValidateT a m a
forall (m :: * -> *) e d a.
Functor m =>
(forall b. m b -> (e -> m b) -> m b)
-> ValidateT d m a -> (e -> ValidateT d m a) -> ValidateT d m a
liftCatch forall b. m b -> (e -> m b) -> m b
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
{-# INLINE throwError #-}
{-# INLINE catchError #-}
instance (MonadReader r m) => MonadReader r (ValidateT e m) where
ask :: ValidateT e m r
ask = m r -> ValidateT e m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> ValidateT e m a -> ValidateT e m a
local r -> r
f (ValidateT forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m) = (forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT ((r -> r)
-> StateT (MonoMaybe s e) (ExceptT e m) a
-> StateT (MonoMaybe s e) (ExceptT e m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f StateT (MonoMaybe s e) (ExceptT e m) a
forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m)
reader :: (r -> a) -> ValidateT e m a
reader = m a -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ValidateT e m a)
-> ((r -> a) -> m a) -> (r -> a) -> ValidateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader
{-# INLINE ask #-}
{-# INLINE local #-}
{-# INLINE reader #-}
instance (MonadState s m) => MonadState s (ValidateT e m) where
get :: ValidateT e m s
get = m s -> ValidateT e m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> ValidateT e m ()
put = m () -> ValidateT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ValidateT e m ()) -> (s -> m ()) -> s -> ValidateT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
state :: (s -> (a, s)) -> ValidateT e m a
state = m a -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ValidateT e m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> ValidateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
{-# INLINE get #-}
{-# INLINE put #-}
{-# INLINE state #-}
instance (MonadWriter w m) => MonadWriter w (ValidateT e m) where
writer :: (a, w) -> ValidateT e m a
writer = m a -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ValidateT e m a)
-> ((a, w) -> m a) -> (a, w) -> ValidateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
tell :: w -> ValidateT e m ()
tell = m () -> ValidateT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ValidateT e m ()) -> (w -> m ()) -> w -> ValidateT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: ValidateT e m a -> ValidateT e m (a, w)
listen (ValidateT forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m) = (forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) (a, w))
-> ValidateT e m (a, w)
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT (StateT (MonoMaybe s e) (ExceptT e m) a
-> StateT (MonoMaybe s e) (ExceptT e m) (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen StateT (MonoMaybe s e) (ExceptT e m) a
forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
m)
pass :: ValidateT e m (a, w -> w) -> ValidateT e m a
pass (ValidateT forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) (a, w -> w)
m) = (forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT (StateT (MonoMaybe s e) (ExceptT e m) (a, w -> w)
-> StateT (MonoMaybe s e) (ExceptT e m) a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass StateT (MonoMaybe s e) (ExceptT e m) (a, w -> w)
forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) (a, w -> w)
m)
{-# INLINE writer #-}
{-# INLINE tell #-}
{-# INLINE listen #-}
{-# INLINE pass #-}
instance (MonadThrow m) => MonadThrow (ValidateT e m) where
throwM :: e -> ValidateT e m a
throwM = m a -> ValidateT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ValidateT e m a) -> (e -> m a) -> e -> ValidateT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
{-# INLINE throwM #-}
instance (MonadCatch m) => MonadCatch (ValidateT e m) where
catch :: ValidateT e m a -> (e -> ValidateT e m a) -> ValidateT e m a
catch = (forall b. m b -> (e -> m b) -> m b)
-> ValidateT e m a -> (e -> ValidateT e m a) -> ValidateT e m a
forall (m :: * -> *) e d a.
Functor m =>
(forall b. m b -> (e -> m b) -> m b)
-> ValidateT d m a -> (e -> ValidateT d m a) -> ValidateT d m a
liftCatch forall b. m b -> (e -> m b) -> m b
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch
{-# INLINE catch #-}
liftMask
:: (Functor m)
=> (forall c. ((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. ValidateT e m a -> ValidateT e m a) -> ValidateT e m b) -> ValidateT e m b
liftMask :: (forall c. ((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. ValidateT e m a -> ValidateT e m a)
-> ValidateT e m b)
-> ValidateT e m b
liftMask forall c. ((forall a. m a -> m a) -> m c) -> m c
maskE (forall a. ValidateT e m a -> ValidateT e m a) -> ValidateT e m b
f = (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, b)))
-> ValidateT e m b
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, b)))
-> ValidateT e m b)
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, b)))
-> ValidateT e m b
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e1 ->
((forall a. m a -> m a) -> m (Either e (MonoMaybe s e, b)))
-> m (Either e (MonoMaybe s e, b))
forall c. ((forall a. m a -> m a) -> m c) -> m c
maskE (((forall a. m a -> m a) -> m (Either e (MonoMaybe s e, b)))
-> m (Either e (MonoMaybe s e, b)))
-> ((forall a. m a -> m a) -> m (Either e (MonoMaybe s e, b)))
-> m (Either e (MonoMaybe s e, b))
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask ->
MonoMaybe s e -> ValidateT e m b -> m (Either e (MonoMaybe s e, b))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s e
e1 (ValidateT e m b -> m (Either e (MonoMaybe s e, b)))
-> ValidateT e m b -> m (Either e (MonoMaybe s e, b))
forall a b. (a -> b) -> a -> b
$ (forall a. ValidateT e m a -> ValidateT e m a) -> ValidateT e m b
f ((forall a. ValidateT e m a -> ValidateT e m a) -> ValidateT e m b)
-> (forall a. ValidateT e m a -> ValidateT e m a)
-> ValidateT e m b
forall a b. (a -> b) -> a -> b
$ \ValidateT e m a
m ->
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a)
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e2 ->
m (Either e (MonoMaybe s e, a)) -> m (Either e (MonoMaybe s e, a))
forall a. m a -> m a
unmask (m (Either e (MonoMaybe s e, a))
-> m (Either e (MonoMaybe s e, a)))
-> m (Either e (MonoMaybe s e, a))
-> m (Either e (MonoMaybe s e, a))
forall a b. (a -> b) -> a -> b
$ MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s e
e2 ValidateT e m a
m
{-# INLINE liftMask #-}
instance (MonadMask m) => MonadMask (ValidateT e m) where
mask :: ((forall a. ValidateT e m a -> ValidateT e m a) -> ValidateT e m b)
-> ValidateT e m b
mask = (forall c. ((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. ValidateT e m a -> ValidateT e m a)
-> ValidateT e m b)
-> ValidateT e m b
forall (m :: * -> *) e b.
Functor m =>
(forall c. ((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. ValidateT e m a -> ValidateT e m a)
-> ValidateT e m b)
-> ValidateT e m b
liftMask forall c. ((forall a. m a -> m a) -> m c) -> m c
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask
uninterruptibleMask :: ((forall a. ValidateT e m a -> ValidateT e m a) -> ValidateT e m b)
-> ValidateT e m b
uninterruptibleMask = (forall c. ((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. ValidateT e m a -> ValidateT e m a)
-> ValidateT e m b)
-> ValidateT e m b
forall (m :: * -> *) e b.
Functor m =>
(forall c. ((forall a. m a -> m a) -> m c) -> m c)
-> ((forall a. ValidateT e m a -> ValidateT e m a)
-> ValidateT e m b)
-> ValidateT e m b
liftMask forall c. ((forall a. m a -> m a) -> m c) -> m c
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask
generalBracket :: ValidateT e m a
-> (a -> ExitCase b -> ValidateT e m c)
-> (a -> ValidateT e m b)
-> ValidateT e m (b, c)
generalBracket ValidateT e m a
m a -> ExitCase b -> ValidateT e m c
f a -> ValidateT e m b
g = (forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) (b, c))
-> ValidateT e m (b, c)
forall e (m :: * -> *) a.
(forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a)
-> ValidateT e m a
ValidateT ((forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) (b, c))
-> ValidateT e m (b, c))
-> (forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) (b, c))
-> ValidateT e m (b, c)
forall a b. (a -> b) -> a -> b
$ StateT (MonoMaybe s e) (ExceptT e m) a
-> (a -> ExitCase b -> StateT (MonoMaybe s e) (ExceptT e m) c)
-> (a -> StateT (MonoMaybe s e) (ExceptT e m) b)
-> StateT (MonoMaybe s e) (ExceptT e m) (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
(ValidateT e m a
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
forall e (m :: * -> *) a.
ValidateT e m a
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
getValidateT ValidateT e m a
m)
(\a
a ExitCase b
b -> ValidateT e m c
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) c
forall e (m :: * -> *) a.
ValidateT e m a
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
getValidateT (ValidateT e m c
-> forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) c)
-> ValidateT e m c
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) c
forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> ValidateT e m c
f a
a ExitCase b
b)
(\a
a -> ValidateT e m b
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) b
forall e (m :: * -> *) a.
ValidateT e m a
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) a
getValidateT (ValidateT e m b
-> forall (s :: MonoMaybeS).
StateT (MonoMaybe s e) (ExceptT e m) b)
-> ValidateT e m b
-> forall (s :: MonoMaybeS). StateT (MonoMaybe s e) (ExceptT e m) b
forall a b. (a -> b) -> a -> b
$ a -> ValidateT e m b
g a
a)
{-# INLINE mask #-}
{-# INLINE uninterruptibleMask #-}
{-# INLINE generalBracket #-}
instance (Monad m, Semigroup e) => MonadValidate e (ValidateT e m) where
refute :: e -> ValidateT e m a
refute e
e2 = (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a)
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e1 ->
let !e3 :: e
e3 = ((s ~ 'SMaybe) => e) -> (e -> e) -> MonoMaybe s e -> e
forall (s :: MonoMaybeS) b a.
((s ~ 'SMaybe) => b) -> (a -> b) -> MonoMaybe s a -> b
monoMaybe e
(s ~ 'SMaybe) => e
e2 (e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e2) MonoMaybe s e
e1 in Either e (MonoMaybe s e, a) -> m (Either e (MonoMaybe s e, a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e -> Either e (MonoMaybe s e, a)
forall a b. a -> Either a b
Left e
e3)
dispute :: e -> ValidateT e m ()
dispute e
e2 = (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, ())))
-> ValidateT e m ()
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, ())))
-> ValidateT e m ())
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, ())))
-> ValidateT e m ()
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e1 ->
let !e3 :: e
e3 = ((s ~ 'SMaybe) => e) -> (e -> e) -> MonoMaybe s e -> e
forall (s :: MonoMaybeS) b a.
((s ~ 'SMaybe) => b) -> (a -> b) -> MonoMaybe s a -> b
monoMaybe e
(s ~ 'SMaybe) => e
e2 (e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e2) MonoMaybe s e
e1 in Either e (MonoMaybe s e, ()) -> m (Either e (MonoMaybe s e, ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((MonoMaybe s e, ()) -> Either e (MonoMaybe s e, ())
forall a b. b -> Either a b
Right (e -> MonoMaybe s e
forall (s :: MonoMaybeS) a. a -> MonoMaybe s a
MJust e
e3, ()))
tolerate :: ValidateT e m a -> ValidateT e m (Maybe a)
tolerate ValidateT e m a
m = (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, Maybe a)))
-> ValidateT e m (Maybe a)
forall e (m :: * -> *) a.
Functor m =>
(forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, a)))
-> ValidateT e m a
validateT ((forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, Maybe a)))
-> ValidateT e m (Maybe a))
-> (forall (s :: MonoMaybeS).
MonoMaybe s e -> m (Either e (MonoMaybe s e, Maybe a)))
-> ValidateT e m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \MonoMaybe s e
e1 ->
(MonoMaybe s e, Maybe a) -> Either e (MonoMaybe s e, Maybe a)
forall a b. b -> Either a b
Right ((MonoMaybe s e, Maybe a) -> Either e (MonoMaybe s e, Maybe a))
-> (Either e (MonoMaybe s e, a) -> (MonoMaybe s e, Maybe a))
-> Either e (MonoMaybe s e, a)
-> Either e (MonoMaybe s e, Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e -> (MonoMaybe s e, Maybe a))
-> ((MonoMaybe s e, a) -> (MonoMaybe s e, Maybe a))
-> Either e (MonoMaybe s e, a)
-> (MonoMaybe s e, Maybe a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e
e2 -> (e -> MonoMaybe s e
forall (s :: MonoMaybeS) a. a -> MonoMaybe s a
MJust e
e2, Maybe a
forall a. Maybe a
Nothing)) ((a -> Maybe a) -> (MonoMaybe s e, a) -> (MonoMaybe s e, Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just) (Either e (MonoMaybe s e, a) -> Either e (MonoMaybe s e, Maybe a))
-> m (Either e (MonoMaybe s e, a))
-> m (Either e (MonoMaybe s e, Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe s e
e1 ValidateT e m a
m
{-# INLINABLE refute #-}
{-# INLINABLE dispute #-}
{-# INLINABLE tolerate #-}
runValidateT :: forall e m a. (Functor m) => ValidateT e m a -> m (Either e a)
runValidateT :: ValidateT e m a -> m (Either e a)
runValidateT ValidateT e m a
m = MonoMaybe 'SMaybe e
-> ValidateT e m a -> m (Either e (MonoMaybe 'SMaybe e, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe 'SMaybe e
forall a. MonoMaybe 'SMaybe a
MNothing ValidateT e m a
m m (Either e (MonoMaybe 'SMaybe e, a))
-> (Either e (MonoMaybe 'SMaybe e, a) -> Either e a)
-> m (Either e a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Left e
e -> e -> Either e a
forall a b. a -> Either a b
Left e
e
Right (MJust e
e, a
_) -> e -> Either e a
forall a b. a -> Either a b
Left e
e
Right (MonoMaybe 'SMaybe e
MNothing, a
v) -> a -> Either e a
forall a b. b -> Either a b
Right a
v
execValidateT :: forall e m a. (Monoid e, Functor m) => ValidateT e m a -> m e
execValidateT :: ValidateT e m a -> m e
execValidateT = (Either e a -> e) -> m (Either e a) -> m e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> e) -> (a -> e) -> Either e a -> e
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> e
forall a. a -> a
id a -> e
forall a. Monoid a => a
mempty) (m (Either e a) -> m e)
-> (ValidateT e m a -> m (Either e a)) -> ValidateT e m a -> m e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidateT e m a -> m (Either e a)
forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
runValidateT
embedValidateT :: forall e m a. (MonadValidate e m) => ValidateT e m a -> m a
embedValidateT :: ValidateT e m a -> m a
embedValidateT ValidateT e m a
m = MonoMaybe 'SMaybe e
-> ValidateT e m a -> m (Either e (MonoMaybe 'SMaybe e, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe 'SMaybe e
forall a. MonoMaybe 'SMaybe a
MNothing ValidateT e m a
m m (Either e (MonoMaybe 'SMaybe e, a))
-> (Either e (MonoMaybe 'SMaybe e, a) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left e
e -> e -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute e
e
Right (MJust e
e, a
v) -> e -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute e
e m () -> a -> m a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
v
Right (MonoMaybe 'SMaybe e
MNothing, a
v) -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
mapErrors
:: forall e1 e2 m a. (Monad m, Semigroup e2)
=> (e1 -> e2) -> ValidateT e1 m a -> ValidateT e2 m a
mapErrors :: (e1 -> e2) -> ValidateT e1 m a -> ValidateT e2 m a
mapErrors e1 -> e2
f ValidateT e1 m a
m = m (Either e1 (MonoMaybe 'SMaybe e1, a))
-> ValidateT e2 m (Either e1 (MonoMaybe 'SMaybe e1, a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (MonoMaybe 'SMaybe e1
-> ValidateT e1 m a -> m (Either e1 (MonoMaybe 'SMaybe e1, a))
forall (s :: MonoMaybeS) e (m :: * -> *) a.
Functor m =>
MonoMaybe s e -> ValidateT e m a -> m (Either e (MonoMaybe s e, a))
unValidateT MonoMaybe 'SMaybe e1
forall a. MonoMaybe 'SMaybe a
MNothing ValidateT e1 m a
m) ValidateT e2 m (Either e1 (MonoMaybe 'SMaybe e1, a))
-> (Either e1 (MonoMaybe 'SMaybe e1, a) -> ValidateT e2 m a)
-> ValidateT e2 m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left e1
e -> e2 -> ValidateT e2 m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute (e1 -> e2
f e1
e)
Right (MJust e1
e, a
v) -> e2 -> ValidateT e2 m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute (e1 -> e2
f e1
e) ValidateT e2 m () -> a -> ValidateT e2 m a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
v
Right (MonoMaybe 'SMaybe e1
MNothing, a
v) -> a -> ValidateT e2 m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
validateToError :: forall e m a. (MonadError e m) => ValidateT e m a -> m a
validateToError :: ValidateT e m a -> m a
validateToError = (e -> e) -> ValidateT e m a -> m a
forall e1 e2 (m :: * -> *) a.
MonadError e2 m =>
(e1 -> e2) -> ValidateT e1 m a -> m a
validateToErrorWith e -> e
forall a. a -> a
id
{-# INLINE validateToError #-}
validateToErrorWith :: forall e1 e2 m a. (MonadError e2 m) => (e1 -> e2) -> ValidateT e1 m a -> m a
validateToErrorWith :: (e1 -> e2) -> ValidateT e1 m a -> m a
validateToErrorWith e1 -> e2
f = (e1 -> m a) -> (a -> m a) -> Either e1 a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e2 -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (e2 -> m a) -> (e1 -> e2) -> e1 -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e1 a -> m a)
-> (ValidateT e1 m a -> m (Either e1 a)) -> ValidateT e1 m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ValidateT e1 m a -> m (Either e1 a)
forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
runValidateT
{-# INLINE validateToErrorWith #-}
type Validate e = ValidateT e Identity
runValidate :: forall e a. Validate e a -> Either e a
runValidate :: Validate e a -> Either e a
runValidate = Identity (Either e a) -> Either e a
forall a. Identity a -> a
runIdentity (Identity (Either e a) -> Either e a)
-> (Validate e a -> Identity (Either e a))
-> Validate e a
-> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validate e a -> Identity (Either e a)
forall e (m :: * -> *) a.
Functor m =>
ValidateT e m a -> m (Either e a)
runValidateT
{-# INLINE runValidate #-}
execValidate :: forall e a. (Monoid e) => Validate e a -> e
execValidate :: Validate e a -> e
execValidate = Identity e -> e
forall a. Identity a -> a
runIdentity (Identity e -> e)
-> (Validate e a -> Identity e) -> Validate e a -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validate e a -> Identity e
forall e (m :: * -> *) a.
(Monoid e, Functor m) =>
ValidateT e m a -> m e
execValidateT
{-# INLINE execValidate #-}
data MonoMaybe s a where
MNothing :: MonoMaybe 'SMaybe a
MJust :: forall s a. !a -> MonoMaybe s a
deriving instance (Show a) => Show (MonoMaybe s a)
deriving instance (Eq a) => Eq (MonoMaybe s a)
deriving instance (Ord a) => Ord (MonoMaybe s a)
deriving instance Functor (MonoMaybe s)
data MonoMaybeS = SMaybe | SJust
monoMaybe :: (s ~ 'SMaybe => b) -> (a -> b) -> MonoMaybe s a -> b
monoMaybe :: ((s ~ 'SMaybe) => b) -> (a -> b) -> MonoMaybe s a -> b
monoMaybe (s ~ 'SMaybe) => b
v a -> b
f = \case
MonoMaybe s a
MNothing -> b
(s ~ 'SMaybe) => b
v
MJust a
x -> a -> b
f a
x
{-# INLINE monoMaybe #-}