@@ -16,6 +16,7 @@ module Control.Monad.Validation
1616 , vWarningL
1717 , vZoom
1818 , vZoomL
19+ , vPromote
1920 , mmSingleton
2021 , setMempty
2122 , neConcat
@@ -37,11 +38,14 @@ import Data.Foldable as F
3738import Data.Functor
3839import Data.List as L
3940import Data.Map.Strict as M
40−import Data.Monoid
4141import Data.Text as T
4242import Data.Vector as V
4343import Test.QuickCheck
4444
45+#if MIN_VERSION_mtl(2,3,0)
46+import Control.Monad
47+import Control.Monad.Fix
48+#endif
4549
4650-- | Collects all thrown warnings in 'StateT' and errors
4751-- in 'ExceptT' into a single value using 'Monoid'.
@@ -85,7 +89,7 @@ instance (Ord k, Semigroup v) => Semigroup (MonoidMap k v) where
8589
8690instance (Ord k, Monoid v) => Monoid (MonoidMap k v) where
8791 mempty = MonoidMap M.empty
88− mappend = mmAppend
92+ mappend = (<>)
8993
9094instance (ToJSON k, ToJSON v) => ToJSON (MonoidMap k v) where
9195 toJSON (MonoidMap m) = toJSON $ L.map toObj $ M.toList m
@@ -143,12 +147,12 @@ neConcat f a
143147textErrors :: [Text] -> Maybe Text
144148textErrors = neConcat (\a b -> a <> ", " <> b)
145149
146−-- | Returns 'mempty' instead of error if no warnings have occured.
150+-- | Returns 'mempty' instead of error if no warnings have occurred.
147151-- Returns 'Nothing' as the second element of tuple if computation was
148152-- interrupted by 'vError'.
149153--
150154-- Returns all concatenated errors and warnings and the result if no
151−-- errors have occured (warnings could have occured).
155+-- errors have occurred (warnings could have occurred).
152156--
153157-- >>> :{
154158-- runValidationT $ do
@@ -174,7 +178,7 @@ runValidationT (ValidationT m) = do
174178 Right a -> (warnings, Just a)
175179
176180-- | Like 'runValidationT' but doesn't return the result
177−-- if any warning has occured.
181+-- if any warning has occurred.
178182--
179183-- >>> :{
180184-- runValidationTEither $ do
@@ -285,3 +289,12 @@ vZoomL
285289 -> ValidationT a m x
286290 -> ValidationT b m x
287291vZoomL l = vZoom (setMempty l)
292+
293+-- | Turn any warnings the have occurred into errors.
294+vPromote
295+ :: (Monad m, Monoid a, Eq a)
296+ => ValidationT a m x
297+ -> ValidationT a m x
298+vPromote m = do
299+ err <- lift $ runValidationTEither m
300+ either vError return err