monad-validate 1.1.0.0 → 1.2.0.0
raw patch · 7 files changed
+179/−31 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- CHANGELOG.md +6/−0
- monad-validate.cabal +6/−6
- package.yaml +3/−3
- src/Control/Monad/Validate.hs +9/−3
- src/Control/Monad/Validate/Class.hs +88/−13
- src/Control/Monad/Validate/Internal.hs +38/−6
- test/Control/Monad/ValidateSpec.hs +29/−0
CHANGELOG.md view
@@ -1,3 +1,9 @@+# 1.2.0.0 [2019-08-09]++- Added the `exceptToValidate`, `exceptToValidateWith`, `validateToError`, and `validateToErrorWith` functions for converting between different error-raising monads.+- Removed the `DefaultSignatures`-based default methods for `MonadValidate` in favor of a `WrappedMonadTrans` newtype available from `Control.Monad.Validate.Class` that can be used to derive instances using `DerivingVia`.+- Added a default implementation of `dispute` in terms of `refute` and `tolerate` and added their equivalence as a law for `MonadValidate`.+ # 1.1.0.0 [2019-08-05] - Added the `tolerate` method to `MonadValidate`, which allows relaxing validation errors from fatal to nonfatal.
monad-validate.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 79775fef96c91f15bf687d1020e2db81124f7fb2e493f1bf2e780efe2d7b04b5+-- hash: 01f2db430333f42507cd5119f27ea00db52a0c775cf89d589a0dcc045024bf90 name: monad-validate-version: 1.1.0.0+version: 1.2.0.0 synopsis: A monad transformer for data validation. description: Provides the 'ValidateT' monad transformer, designed for writing data validations that provide high-quality error reporting without much effort. 'ValidateT' automatically exploits the data@@ -43,10 +43,10 @@ Paths_monad_validate hs-source-dirs: src- default-extensions: ApplicativeDo BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable EmptyCase ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies+ default-extensions: ApplicativeDo BangPatterns ConstraintKinds DataKinds DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingVia EmptyCase ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends:- base >=4.11 && <5+ base >=4.12 && <5 , exceptions >=0.9 && <1 , monad-control >=1 && <2 , mtl@@ -62,12 +62,12 @@ Paths_monad_validate hs-source-dirs: test- default-extensions: ApplicativeDo BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable EmptyCase ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies+ default-extensions: ApplicativeDo BangPatterns ConstraintKinds DataKinds DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DerivingVia EmptyCase ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -rtsopts -threaded -with-rtsopts=-N build-depends: aeson , aeson-qq- , base >=4.11 && <5+ , base >=4.12 && <5 , exceptions >=0.9 && <1 , hspec , monad-control >=1 && <2
package.yaml view
@@ -1,5 +1,5 @@ name: monad-validate-version: 1.1.0.0+version: 1.2.0.0 category: Control copyright: 2019 Hasura license: ISC@@ -33,12 +33,12 @@ - BangPatterns - ConstraintKinds - DataKinds-- DefaultSignatures - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveLift - DeriveTraversable+- DerivingVia - EmptyCase - ExistentialQuantification - FlexibleContexts@@ -61,7 +61,7 @@ - TypeFamilies dependencies:-- base >= 4.11 && < 5+- base >= 4.12 && < 5 - exceptions >= 0.9 && < 1 - monad-control >= 1 && < 2 - mtl
src/Control/Monad/Validate.hs view
@@ -3,17 +3,23 @@ -- that you may find other uses for them, too. For an overview of this library’s functionality, see -- the documentation for 'ValidateT'. module Control.Monad.Validate (- -- * The ValidateT monad transformer+ -- * The @ValidateT@ monad transformer ValidateT , runValidateT , execValidateT , embedValidateT , mapErrors - -- * The MonadValidate class+ -- * The @MonadValidate@ class , MonadValidate(..) - -- * The Validate monad+ -- * Converting between monads+ , exceptToValidate+ , exceptToValidateWith+ , validateToError+ , validateToErrorWith++ -- * The @Validate@ monad , Validate , runValidate , execValidate
src/Control/Monad/Validate/Class.hs view
@@ -3,6 +3,11 @@ module Control.Monad.Validate.Class ( MonadValidate(..)+ , exceptToValidate+ , exceptToValidateWith++ -- * Deriving @MonadValidate@ instances with @DerivingVia@+ , WrappedMonadTrans(..) ) where import qualified Control.Monad.Trans.RWS.CPS as CPS@@ -14,6 +19,7 @@ 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@@ -33,6 +39,12 @@ 2. Unlike 'Control.Monad.Writer.Class.tell', raising an error using 'dispute' still causes the computation to globally fail, it just doesn’t affect local execution. +Instances must obey the following law:++@+'dispute' ≡ 'void' '.' 'tolerate' '.' 'refute'+@+ For a more thorough explanation, with examples, see the documentation for 'Control.Monad.Validate.ValidateT'. -} class (Monad m, Semigroup e) => MonadValidate e m | m -> e where@@ -52,7 +64,13 @@ -- >>> 'Control.Monad.Validate.runValidate' ('dispute' ["boom"] '>>' 'dispute' ["bang"]) -- 'Left' ["boom", "bang"] -- @+ --+ -- If not explicitly implemented, the default implementation is @'void' '.' 'tolerate' '.'+ -- 'refute'@ (which must behave equivalently by law), but it is sometimes possible to provide a+ -- more efficient implementation. dispute :: e -> m ()+ dispute = void . tolerate . refute+ {-# INLINE dispute #-} -- | @'tolerate' m@ behaves like @m@, except that any fatal errors raised by 'refute' are altered -- to non-fatal errors that return 'Nothing'. This allows @m@’s result to be used for further@@ -66,33 +84,90 @@ -- @since 1.1.0.0 tolerate :: m a -> m (Maybe a) - default refute :: (MonadTrans t, MonadValidate e m', m ~ t m') => e -> m a+{-| Runs an 'ExceptT' computation, and if it raised an error, re-raises it using 'refute'. This+effectively converts a computation that uses 'ExceptT' (or 'Control.Monad.Except.MonadError') into+one that uses 'MonadValidate'.++@+>>> 'Control.Monad.Validate.runValidate' '$' 'exceptToValidate' ('pure' 42)+'Right' 42+>>> 'Control.Monad.Validate.runValidate' '$' 'exceptToValidate' ('Control.Monad.Except.throwError' ["boom"])+'Left' "boom"+@++@since 1.2.0.0 -}+exceptToValidate :: forall e m a. (MonadValidate e m) => ExceptT e m a -> m a+exceptToValidate = exceptToValidateWith id+{-# INLINE exceptToValidate #-}++{-| Like 'exceptToValidate', but additionally accepts a function, which is applied to the error+raised by 'ExceptT' before passing it to 'refute'. This can be useful if the original error type is+not a 'Semigroup'.++@+>>> 'Control.Monad.Validate.runValidate' '$' 'exceptToValidateWith' (:[]) ('pure' 42)+'Right' 42+>>> 'Control.Monad.Validate.runValidate' '$' 'exceptToValidateWith' (:[]) ('Control.Monad.Except.throwError' "boom")+'Left' ["boom"]+@++@since 1.2.0.0 -}+exceptToValidateWith :: forall e1 e2 m a. (MonadValidate e2 m) => (e1 -> e2) -> ExceptT e1 m a -> m a+exceptToValidateWith f = either (refute . f) pure <=< runExceptT+{-# INLINE exceptToValidateWith #-}++{-| If you have a monad transformer that implements the 'MonadTransControl' class, this newtype+wrapper can be used to automatically derive instances of 'MonadValidate' using the @DerivingVia@+GHC extension.++Example:++@+{\-\# LANGUAGE DerivingVia \#-\}++newtype CustomT c m a = CustomT { runCustomT :: ... }+ deriving ('MonadValidate' e) via ('WrappedMonadTrans' (CustomT c) m)+@++@since 1.2.0.0 -}+newtype WrappedMonadTrans (t :: (* -> *) -> * -> *) (m :: * -> *) (a :: *)+ = WrapMonadTrans { unwrapMonadTrans :: t m a }+ deriving (Functor, Applicative, Monad, MonadTrans, MonadTransControl)++instance (MonadTransControl t, Monad (t m), MonadValidate e m)+ => MonadValidate e (WrappedMonadTrans t m) where refute = lift . refute- default dispute :: (MonadTrans t, MonadValidate e m', m ~ t m') => e -> m () dispute = lift . dispute- default tolerate :: (MonadTransControl t, MonadValidate e m', m ~ t m') => m a -> m (Maybe a) tolerate m = liftWith (\run -> tolerate (run m)) >>= maybe (pure Nothing) (fmap Just . restoreT . pure) {-# INLINE refute #-} {-# INLINE dispute #-} {-# INLINE tolerate #-} -instance (MonadValidate e m) => MonadValidate e (ExceptT a m)-instance (MonadValidate e m) => MonadValidate e (IdentityT m)-instance (MonadValidate e m) => MonadValidate e (MaybeT m)-instance (MonadValidate e m) => MonadValidate e (ReaderT r m)-instance (MonadValidate e m, Monoid w) => MonadValidate e (Lazy.RWST r w s m)-instance (MonadValidate e m, Monoid w) => MonadValidate e (Strict.RWST r w s m)-instance (MonadValidate e m) => MonadValidate e (Lazy.StateT s m)-instance (MonadValidate e m) => MonadValidate e (Strict.StateT s m)-instance (MonadValidate e m, Monoid w) => MonadValidate e (Lazy.WriterT w m)-instance (MonadValidate e m, Monoid w) => MonadValidate e (Strict.WriterT w m)+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 = lift . refute+ dispute = lift . dispute tolerate m = CPS.writerT $ tolerate (CPS.runWriterT m) <&> maybe (Nothing, mempty) (\(v, w) -> (Just v, w))+ {-# INLINE refute #-}+ {-# INLINE dispute #-} {-# INLINE tolerate #-} instance (MonadValidate e m, Monoid w) => MonadValidate e (CPS.RWST r w s m) where+ refute = lift . refute+ dispute = lift . dispute tolerate m = CPS.rwsT $ \r s1 -> tolerate (CPS.runRWST m r s1) <&> maybe (Nothing, s1, mempty) (\(v, s2, w) -> (Just v, s2, w))+ {-# INLINE refute #-}+ {-# INLINE dispute #-} {-# INLINE tolerate #-}
src/Control/Monad/Validate/Internal.hs view
@@ -258,10 +258,10 @@ Fortunately, the solution is quite simple: use a different data structure. If order doesn’t matter, use a @Set@ or @HashSet@. If it does, but either LIFO consumption of the data is okay or you are-okay with paying to reverse the data once after collecting the errors, @'Data.Semigroup.Dual' [a]@-to accumulate elements in an efficient manner. If neither is true, use a data structure like @Seq@-that provides an efficient implementation of a functional queue. You can always convert back to a-plain list at the end once you’re done, if you have to. -}+okay with paying to reverse the data once after collecting the errors, use @'Data.Semigroup.Dual'+[a]@ to accumulate elements in an efficient manner. If neither is true, use a data structure like+@Seq@ that provides an efficient implementation of a functional queue. You can always convert back+to a plain list at the end once you’re done, if you have to. -} newtype ValidateT e m a = ValidateT { getValidateT :: forall s. StateT (MonoMaybe s e) (ExceptT e m) a } -- Sadly, GeneralizedNewtypeDeriving can’t help us here due to the inner forall, but we can at least@@ -495,12 +495,44 @@ -- -- @since 1.1.0.0 mapErrors- :: forall e e' m a. (Monad m, Semigroup e')- => (e -> e') -> ValidateT e m a -> ValidateT e' m a+ :: forall e1 e2 m a. (Monad m, Semigroup e2)+ => (e1 -> e2) -> ValidateT e1 m a -> ValidateT e2 m a mapErrors f m = lift (unValidateT MNothing m) >>= \case Left e -> refute (f e) Right (MJust e, v) -> dispute (f e) $> v Right (MNothing, v) -> pure v++{-| Runs a 'ValidateT' computation, and if it raised any errors, re-raises them using 'throwError'.+This effectively converts a computation that uses 'ValidateT' (or 'MonadValidate') into one that+uses 'MonadError'.++@+>>> 'runExcept' '$' 'validateToError' ('pure' 42)+'Right' 42+>>> 'runExcept' '$' 'validateToError' ('refute' ["boom"] *> 'refute' ["bang"])+'Left' ["boom", "bang"]+@++@since 1.2.0.0 -}+validateToError :: forall e m a. (MonadError e m) => ValidateT e m a -> m a+validateToError = validateToErrorWith id+{-# INLINE validateToError #-}++{-| Like 'validateToError', but additionally accepts a function, which is applied to the errors+raised by 'ValidateT' before passing them to 'throwError'. This can be useful to concatenate+multiple errors into one.++@+>>> 'runExcept' '$' 'validateToErrorWith' 'mconcat' ('pure' 42)+'Right' 42+>>> 'runExcept' '$' 'validateToErrorWith' 'mconcat' ('refute' ["boom"] *> 'refute' ["bang"])+'Left' "boombang"+@++@since 1.2.0.0 -}+validateToErrorWith :: forall e1 e2 m a. (MonadError e2 m) => (e1 -> e2) -> ValidateT e1 m a -> m a+validateToErrorWith f = either (throwError . f) pure <=< runValidateT+{-# INLINE validateToErrorWith #-} -- | 'ValidateT' specialized to the 'Identity' base monad. See 'ValidateT' for usage information. type Validate e = ValidateT e Identity
test/Control/Monad/ValidateSpec.hs view
@@ -11,6 +11,7 @@ import Control.Monad import Control.Monad.Reader+import Control.Monad.Except import Data.Aeson (Object, Value(..)) import Data.Aeson.QQ (aesonQQ) import Data.Foldable@@ -178,6 +179,34 @@ embedValidateT $ mapErrors (map Left) foo embedValidateT $ mapErrors (map Right) bar runValidate baz `shouldBe` Left [Left 42, Right False]++ describe "exceptToValidate" $+ it "converts an ExceptT computation to ValidateT" $ do+ runValidate (exceptToValidate (pure 42))+ `shouldBe` (Right 42 :: Either [Text] Integer)+ runValidate (exceptToValidate (throwError ["boom"]))+ `shouldBe` (Left ["boom"] :: Either [Text] Integer)++ describe "exceptToValidateWith" $+ it "converts an ExceptT computation to ValidateT by applying a function to any errors" $ do+ runValidate (exceptToValidateWith (:[]) (pure 42))+ `shouldBe` (Right 42 :: Either [Text] Integer)+ runValidate (exceptToValidateWith (:[]) (throwError "boom"))+ `shouldBe` (Left ["boom"] :: Either [Text] Integer)++ describe "validateToError" $+ it "converts an ValidateT computation to ExceptT" $ do+ runExcept (validateToError (pure 42))+ `shouldBe` (Right 42 :: Either [Text] Integer)+ runExcept (validateToError (refute ["boom"] *> refute ["bang"]))+ `shouldBe` (Left ["boom", "bang"] :: Either [Text] Integer)++ describe "validateToErrorWith" $+ it "converts an ValidateT computation to ExceptT by applying a function to any errors" $ do+ runExcept (validateToErrorWith mconcat (pure 42))+ `shouldBe` (Right 42 :: Either Text Integer)+ runExcept (validateToErrorWith mconcat (refute ["boom"] *> refute ["bang"]))+ `shouldBe` (Left "boombang" :: Either Text Integer) it "collects validation information from all sub-branches of <*>" $ do let tables =