Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- newtype ValidationT e m a = ValidationT {
- unValidationT :: ExceptT e (StateT e m) a
- runValidationT :: (Monoid e, Monad m) => ValidationT e m a -> m (e, Maybe a)
- runValidationTEither :: (Monoid e, Eq e, Monad m) => ValidationT e m a -> m (Either e a)
- handleValidationT :: (Monoid e, Monad m, Eq e) => (e -> m a) -> ValidationT e m a -> m a
- vError :: Monad m => e -> ValidationT e m a
- vWarning :: (Monad m, Monoid e) => e -> ValidationT e m ()
- vErrorL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m x
- vWarningL :: (Monad m, Monoid e) => ASetter' e a -> a -> ValidationT e m ()
- vZoom :: (Monad m, Monoid a, Monoid b) => (a -> b) -> ValidationT a m x -> ValidationT b m x
- vZoomL :: (Monad m, Monoid a, Monoid b) => ASetter' b a -> ValidationT a m x -> ValidationT b m x
- vPromote :: (Monad m, Monoid a, Eq a) => ValidationT a m x -> ValidationT a m x
- mmSingleton :: (Eq v, Monoid v, Ord k) => k -> v -> MonoidMap k v
- setMempty :: Monoid s => ASetter' s a -> a -> s
- neConcat :: Foldable f => (a -> a -> a) -> f a -> Maybe a
- textErrors :: [Text] -> Maybe Text
- _MonoidMap :: forall k v k v. Iso (MonoidMap k v) (MonoidMap k v) (Map k v) (Map k v)
- newtype MonoidMap k v = MonoidMap (Map k v)
Documentation
newtype ValidationT e m a Source #
ValidationT | |
|
Instances
runValidationT :: (Monoid e, Monad m) => ValidationT e m a -> m (e, Maybe a) Source #
Returns mempty
instead of error if no warnings have occurred.
Returns Nothing
as the second element of tuple if computation was
interrupted by vError
.
Returns all concatenated errors and warnings and the result if no errors have occurred (warnings could have occurred).
>>>
:{
runValidationT $ do vWarning ["warning1"] vError ["error"] vWarning ["warning2"] return 8 :} (["error","warning1"],Nothing)
>>>
:{
runValidationT $ do vWarning ["warning1"] vWarning ["warning2"] return 8 :} (["warning1","warning2"],Just 8)
runValidationTEither :: (Monoid e, Eq e, Monad m) => ValidationT e m a -> m (Either e a) Source #
Like runValidationT
but doesn't return the result
if any warning has occurred.
>>>
:{
runValidationTEither $ do vWarning ["warning1"] vError ["error"] vWarning ["warning2"] return 8 :} Left ["error","warning1"]
>>>
:{
runValidationTEither $ do vWarning ["warning1"] vWarning ["warning2"] return 8 :} Left ["warning1","warning2"]
handleValidationT :: (Monoid e, Monad m, Eq e) => (e -> m a) -> ValidationT e m a -> m a Source #
Like runValidationTEither
, but takes an error handler instead of
returning errors and warnings.
>>>
:{
handleValidationT (\_ -> return 11) $ do vWarning ["warning1"] vError ["error"] vWarning ["warning2"] return 8 :} 11
>>>
:{
handleValidationT (\_ -> return 11) $ do vWarning ["warning1"] vWarning ["warning2"] return 8 :} 11
vError :: Monad m => e -> ValidationT e m a Source #
Stops further execution and appends the given error.
vWarning :: (Monad m, Monoid e) => e -> ValidationT e m () Source #
Does not stop further execution and appends the given warning.
vZoom :: (Monad m, Monoid a, Monoid b) => (a -> b) -> ValidationT a m x -> ValidationT b m x Source #
Allows you apply a transformation to the "e" in "ValidationT e m x".
>>>
:{
runValidationT . vZoom (Data.Map.singleton "password errors") $ do vWarning ["warning1"] vError ["error"] vWarning ["warning2"] return 8 :} (fromList [("password errors",["error","warning1"])],Nothing)
>>>
:{
runValidationT . vZoom (Data.Map.singleton "password errors") $ do vWarning ["warning1"] vWarning ["warning2"] return 8 :} (fromList [("password errors",["warning1","warning2"])],Just 8)
vZoomL :: (Monad m, Monoid a, Monoid b) => ASetter' b a -> ValidationT a m x -> ValidationT b m x Source #
Like vZoom
but takes a setter instead of a function.
vPromote :: (Monad m, Monoid a, Eq a) => ValidationT a m x -> ValidationT a m x Source #
Turn any warnings the have occurred into errors.
textErrors :: [Text] -> Maybe Text Source #
Returns the strings, concatanated with ", "
if the list is not empty.
Returns Nothing if the list is empty
>>>
textErrors ["foo", "bar"]
Just "foo, bar"
>>>
textErrors ["foo"]
Just "foo"
>>>
textErrors []
Nothing
newtype MonoidMap k v Source #
Map with Monoid
instance which mappend
its values
This can be used as the e
in `ValidationT e m a` to provide different
sets of errors and warnings for different keys.
>>>
:{
mconcat [ MonoidMap $ M.fromList [(1, "foo"), (2, "hello, "), (3, "oh no")] , MonoidMap $ M.fromList [(1, "bar"), (2, "world")] ] :} MonoidMap (fromList [(1,"foobar"),(2,"hello, world"),(3,"oh no")])