{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE UndecidableInstances #-}
module Control.Monad.Validate.Class
( MonadValidate(..)
, exceptToValidate
, exceptToValidateWith
, WrappedMonadTrans(..)
) where
import qualified Control.Monad.Trans.RWS.CPS as CPS
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.CPS as CPS
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Data.Functor
import Data.Kind (Type)
class (Monad m, Semigroup e) => MonadValidate e m | m -> e where
refute :: e -> m a
dispute :: e -> m ()
dispute = m (Maybe Any) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe Any) -> m ()) -> (e -> m (Maybe Any)) -> e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Any -> m (Maybe Any)
forall e (m :: * -> *) a. MonadValidate e m => m a -> m (Maybe a)
tolerate (m Any -> m (Maybe Any)) -> (e -> m Any) -> e -> m (Maybe Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m Any
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
{-# INLINE dispute #-}
tolerate :: m a -> m (Maybe a)
exceptToValidate :: forall e m a. (MonadValidate e m) => ExceptT e m a -> m a
exceptToValidate :: ExceptT e m a -> m a
exceptToValidate = (e -> e) -> ExceptT e m a -> m a
forall e1 e2 (m :: * -> *) a.
MonadValidate e2 m =>
(e1 -> e2) -> ExceptT e1 m a -> m a
exceptToValidateWith e -> e
forall a. a -> a
id
{-# INLINE exceptToValidate #-}
exceptToValidateWith :: forall e1 e2 m a. (MonadValidate e2 m) => (e1 -> e2) -> ExceptT e1 m a -> m a
exceptToValidateWith :: (e1 -> e2) -> ExceptT e1 m a -> m a
exceptToValidateWith 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. MonadValidate e m => e -> m a
refute (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)
-> (ExceptT e1 m a -> m (Either e1 a)) -> ExceptT e1 m a -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ExceptT e1 m a -> m (Either e1 a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
{-# INLINE exceptToValidateWith #-}
newtype WrappedMonadTrans (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) (a :: Type)
= WrapMonadTrans { WrappedMonadTrans t m a -> t m a
unwrapMonadTrans :: t m a }
deriving (a -> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
(a -> b) -> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
(forall a b.
(a -> b) -> WrappedMonadTrans t m a -> WrappedMonadTrans t m b)
-> (forall a b.
a -> WrappedMonadTrans t m b -> WrappedMonadTrans t m a)
-> Functor (WrappedMonadTrans t m)
forall a b. a -> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
forall a b.
(a -> b) -> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
<$ :: a -> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
$c<$ :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
fmap :: (a -> b) -> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
$cfmap :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
Functor, Functor (WrappedMonadTrans t m)
a -> WrappedMonadTrans t m a
Functor (WrappedMonadTrans t m)
-> (forall a. a -> WrappedMonadTrans t m a)
-> (forall a b.
WrappedMonadTrans t m (a -> b)
-> WrappedMonadTrans t m a -> WrappedMonadTrans t m b)
-> (forall a b c.
(a -> b -> c)
-> WrappedMonadTrans t m a
-> WrappedMonadTrans t m b
-> WrappedMonadTrans t m c)
-> (forall a b.
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b)
-> (forall a b.
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m a)
-> Applicative (WrappedMonadTrans t m)
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
WrappedMonadTrans t m (a -> b)
-> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
(a -> b -> c)
-> WrappedMonadTrans t m a
-> WrappedMonadTrans t m b
-> WrappedMonadTrans t m c
forall a. a -> WrappedMonadTrans t m a
forall a b.
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
forall a b.
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
forall a b.
WrappedMonadTrans t m (a -> b)
-> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
forall a b c.
(a -> b -> c)
-> WrappedMonadTrans t m a
-> WrappedMonadTrans t m b
-> WrappedMonadTrans t m 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 (t :: (* -> *) -> * -> *) (m :: * -> *).
Applicative (t m) =>
Functor (WrappedMonadTrans t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
WrappedMonadTrans t m (a -> b)
-> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c)
-> WrappedMonadTrans t m a
-> WrappedMonadTrans t m b
-> WrappedMonadTrans t m c
<* :: WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
$c<* :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m a
*> :: WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
$c*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
liftA2 :: (a -> b -> c)
-> WrappedMonadTrans t m a
-> WrappedMonadTrans t m b
-> WrappedMonadTrans t m c
$cliftA2 :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c)
-> WrappedMonadTrans t m a
-> WrappedMonadTrans t m b
-> WrappedMonadTrans t m c
<*> :: WrappedMonadTrans t m (a -> b)
-> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
$c<*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
WrappedMonadTrans t m (a -> b)
-> WrappedMonadTrans t m a -> WrappedMonadTrans t m b
pure :: a -> WrappedMonadTrans t m a
$cpure :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> WrappedMonadTrans t m a
$cp1Applicative :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
Applicative (t m) =>
Functor (WrappedMonadTrans t m)
Applicative, Applicative (WrappedMonadTrans t m)
a -> WrappedMonadTrans t m a
Applicative (WrappedMonadTrans t m)
-> (forall a b.
WrappedMonadTrans t m a
-> (a -> WrappedMonadTrans t m b) -> WrappedMonadTrans t m b)
-> (forall a b.
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b)
-> (forall a. a -> WrappedMonadTrans t m a)
-> Monad (WrappedMonadTrans t m)
WrappedMonadTrans t m a
-> (a -> WrappedMonadTrans t m b) -> WrappedMonadTrans t m b
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
forall a. a -> WrappedMonadTrans t m a
forall a b.
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
forall a b.
WrappedMonadTrans t m a
-> (a -> WrappedMonadTrans t m b) -> WrappedMonadTrans t m 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
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
Monad (t m) =>
Applicative (WrappedMonadTrans t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
WrappedMonadTrans t m a
-> (a -> WrappedMonadTrans t m b) -> WrappedMonadTrans t m b
return :: a -> WrappedMonadTrans t m a
$creturn :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> WrappedMonadTrans t m a
>> :: WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
$c>> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
WrappedMonadTrans t m a
-> WrappedMonadTrans t m b -> WrappedMonadTrans t m b
>>= :: WrappedMonadTrans t m a
-> (a -> WrappedMonadTrans t m b) -> WrappedMonadTrans t m b
$c>>= :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
WrappedMonadTrans t m a
-> (a -> WrappedMonadTrans t m b) -> WrappedMonadTrans t m b
$cp1Monad :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
Monad (t m) =>
Applicative (WrappedMonadTrans t m)
Monad, m a -> WrappedMonadTrans t m a
(forall (m :: * -> *) a. Monad m => m a -> WrappedMonadTrans t m a)
-> MonadTrans (WrappedMonadTrans t)
forall (m :: * -> *) a. Monad m => m a -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> WrappedMonadTrans t m a
$clift :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> WrappedMonadTrans t m a
MonadTrans, MonadTrans (WrappedMonadTrans t)
m (StT (WrappedMonadTrans t) a) -> WrappedMonadTrans t m a
MonadTrans (WrappedMonadTrans t)
-> (forall (m :: * -> *) a.
Monad m =>
(Run (WrappedMonadTrans t) -> m a) -> WrappedMonadTrans t m a)
-> (forall (m :: * -> *) a.
Monad m =>
m (StT (WrappedMonadTrans t) a) -> WrappedMonadTrans t m a)
-> MonadTransControl (WrappedMonadTrans t)
(Run (WrappedMonadTrans t) -> m a) -> WrappedMonadTrans t m a
forall (m :: * -> *) a.
Monad m =>
m (StT (WrappedMonadTrans t) a) -> WrappedMonadTrans t m a
forall (m :: * -> *) a.
Monad m =>
(Run (WrappedMonadTrans t) -> m a) -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
MonadTrans (WrappedMonadTrans t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (WrappedMonadTrans t) a) -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (WrappedMonadTrans t) -> m a) -> WrappedMonadTrans t m a
restoreT :: m (StT (WrappedMonadTrans t) a) -> WrappedMonadTrans t m a
$crestoreT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (WrappedMonadTrans t) a) -> WrappedMonadTrans t m a
liftWith :: (Run (WrappedMonadTrans t) -> m a) -> WrappedMonadTrans t m a
$cliftWith :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (WrappedMonadTrans t) -> m a) -> WrappedMonadTrans t m a
$cp1MonadTransControl :: forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
MonadTrans (WrappedMonadTrans t)
MonadTransControl)
instance (MonadTransControl t, Monad (t m), MonadValidate e m)
=> MonadValidate e (WrappedMonadTrans t m) where
refute :: e -> WrappedMonadTrans t m a
refute = m a -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WrappedMonadTrans t m a)
-> (e -> m a) -> e -> WrappedMonadTrans t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
dispute :: e -> WrappedMonadTrans t m ()
dispute = m () -> WrappedMonadTrans t m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WrappedMonadTrans t m ())
-> (e -> m ()) -> e -> WrappedMonadTrans t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
tolerate :: WrappedMonadTrans t m a -> WrappedMonadTrans t m (Maybe a)
tolerate WrappedMonadTrans t m a
m = (Run (WrappedMonadTrans t) -> m (Maybe (StT t a)))
-> WrappedMonadTrans t m (Maybe (StT t a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run (WrappedMonadTrans t)
run -> m (StT t a) -> m (Maybe (StT t a))
forall e (m :: * -> *) a. MonadValidate e m => m a -> m (Maybe a)
tolerate (WrappedMonadTrans t m a -> m (StT (WrappedMonadTrans t) a)
Run (WrappedMonadTrans t)
run WrappedMonadTrans t m a
m)) WrappedMonadTrans t m (Maybe (StT t a))
-> (Maybe (StT t a) -> WrappedMonadTrans t m (Maybe a))
-> WrappedMonadTrans t m (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
WrappedMonadTrans t m (Maybe a)
-> (StT t a -> WrappedMonadTrans t m (Maybe a))
-> Maybe (StT t a)
-> WrappedMonadTrans t m (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> WrappedMonadTrans t m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a)
-> WrappedMonadTrans t m a -> WrappedMonadTrans t m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (WrappedMonadTrans t m a -> WrappedMonadTrans t m (Maybe a))
-> (StT t a -> WrappedMonadTrans t m a)
-> StT t a
-> WrappedMonadTrans t m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (StT t a) -> WrappedMonadTrans t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT t a) -> WrappedMonadTrans t m a)
-> (StT t a -> m (StT t a)) -> StT t a -> WrappedMonadTrans t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StT t a -> m (StT t a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
{-# INLINE refute #-}
{-# INLINE dispute #-}
{-# INLINE tolerate #-}
deriving via (WrappedMonadTrans IdentityT m) instance (MonadValidate e m) => MonadValidate e (IdentityT m)
deriving via (WrappedMonadTrans (ExceptT a) m) instance (MonadValidate e m) => MonadValidate e (ExceptT a m)
deriving via (WrappedMonadTrans MaybeT m) instance (MonadValidate e m) => MonadValidate e (MaybeT m)
deriving via (WrappedMonadTrans (ReaderT r) m) instance (MonadValidate e m) => MonadValidate e (ReaderT r m)
deriving via (WrappedMonadTrans (Lazy.RWST r w s) m) instance (MonadValidate e m, Monoid w) => MonadValidate e (Lazy.RWST r w s m)
deriving via (WrappedMonadTrans (Strict.RWST r w s) m) instance (MonadValidate e m, Monoid w) => MonadValidate e (Strict.RWST r w s m)
deriving via (WrappedMonadTrans (Lazy.StateT s) m) instance (MonadValidate e m) => MonadValidate e (Lazy.StateT s m)
deriving via (WrappedMonadTrans (Strict.StateT s) m) instance (MonadValidate e m) => MonadValidate e (Strict.StateT s m)
deriving via (WrappedMonadTrans (Lazy.WriterT w) m) instance (MonadValidate e m, Monoid w) => MonadValidate e (Lazy.WriterT w m)
deriving via (WrappedMonadTrans (Strict.WriterT w) m) instance (MonadValidate e m, Monoid w) => MonadValidate e (Strict.WriterT w m)
instance (MonadValidate e m, Monoid w) => MonadValidate e (CPS.WriterT w m) where
refute :: e -> WriterT w m a
refute = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> (e -> m a) -> e -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
dispute :: e -> WriterT w m ()
dispute = m () -> WriterT w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> (e -> m ()) -> e -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
tolerate :: WriterT w m a -> WriterT w m (Maybe a)
tolerate WriterT w m a
m = m (Maybe a, w) -> WriterT w m (Maybe a)
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
CPS.writerT (m (Maybe a, w) -> WriterT w m (Maybe a))
-> m (Maybe a, w) -> WriterT w m (Maybe a)
forall a b. (a -> b) -> a -> b
$ m (a, w) -> m (Maybe (a, w))
forall e (m :: * -> *) a. MonadValidate e m => m a -> m (Maybe a)
tolerate (WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
CPS.runWriterT WriterT w m a
m) m (Maybe (a, w))
-> (Maybe (a, w) -> (Maybe a, w)) -> m (Maybe a, w)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Maybe a, w)
-> ((a, w) -> (Maybe a, w)) -> Maybe (a, w) -> (Maybe a, w)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a
forall a. Maybe a
Nothing, w
forall a. Monoid a => a
mempty) (\(a
v, w
w) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
v, w
w))
{-# INLINE refute #-}
{-# INLINE dispute #-}
{-# INLINE tolerate #-}
instance (MonadValidate e m, Monoid w) => MonadValidate e (CPS.RWST r w s m) where
refute :: e -> RWST r w s m a
refute = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> RWST r w s m a) -> (e -> m a) -> e -> RWST r w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadValidate e m => e -> m a
refute
dispute :: e -> RWST r w s m ()
dispute = m () -> RWST r w s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ()) -> (e -> m ()) -> e -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m ()
forall e (m :: * -> *). MonadValidate e m => e -> m ()
dispute
tolerate :: RWST r w s m a -> RWST r w s m (Maybe a)
tolerate RWST r w s m a
m = (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall (m :: * -> *) w r s a.
(Functor m, Monoid w) =>
(r -> s -> m (a, s, w)) -> RWST r w s m a
CPS.rwsT ((r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a))
-> (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \r
r s
s1 -> m (a, s, w) -> m (Maybe (a, s, w))
forall e (m :: * -> *) a. MonadValidate e m => m a -> m (Maybe a)
tolerate (RWST r w s m a -> r -> s -> m (a, s, w)
forall w r s (m :: * -> *) a.
Monoid w =>
RWST r w s m a -> r -> s -> m (a, s, w)
CPS.runRWST RWST r w s m a
m r
r s
s1) m (Maybe (a, s, w))
-> (Maybe (a, s, w) -> (Maybe a, s, w)) -> m (Maybe a, s, w)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
(Maybe a, s, w)
-> ((a, s, w) -> (Maybe a, s, w))
-> Maybe (a, s, w)
-> (Maybe a, s, w)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a
forall a. Maybe a
Nothing, s
s1, w
forall a. Monoid a => a
mempty) (\(a
v, s
s2, w
w) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
v, s
s2, w
w))
{-# INLINE refute #-}
{-# INLINE dispute #-}
{-# INLINE tolerate #-}