| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Control.Monad.Validation
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 #
Constructors
| ValidationT | |
Fields
| |
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")])