validation 1 → 1.3.3

raw patch · 11 files changed

Files

• LICENCE +4/−3
• Setup.hs +0/−2
• changelog +135/−1
• src/Data/Validation.hs +8/−370
• src/Data/Validation/Validation.hs +620/−0
• src/Data/Validation/ValidationMonad.hs +609/−0
• src/Data/Validation/Validator.hs +2061/−0
• test/doctest_tests.hs +23/−0
• test/hedgehog_tests.hs +570/−21
• test/hunit_tests.hs +0/−131
• validation.cabal +73/−37

@@ -1,6 +1,7 @@-Copyright 2010-2013 Tony Morris, Nick Partridge-Copyright 2014,2015 NICTA Limited-Copyright 2016,2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.+Copyright (C) 2010-2013 Tony Morris, Nick Partridge+Copyright (C) 2014,2015 NICTA Limited+Copyright (c) 2016-2019 Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230+Copyright (c) 2019-2026 Tony Morris  All rights reserved. 

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,3 +1,138 @@+1.3.3++* Add unmatch, constructing a prism from a review and any validator. It is+  an inverse of match: unmatch p (match p) is p, and match (unmatch r v)+  is v+* Add (<--), an operator for unmatch (infixr 2, binding more loosely than+  (.), (-->), <$> and <!>)+* Depend on either-n+* Add Injection1 and Injection2 instances (from either-n) for Validation,+  where _I1 is the Failure constructor and _I2 is the Success constructor+* Add Injection1 and Injection2 instances for ValidationMonad, the+  Validation inside Identity++1.3.2++* Change the Extend instances for all four validators to keep failures,+  like Validation: for each input, extended fails where the validator+  fails, rather than always succeeding. The constraint on the monadic+  validators is relaxed to Functor+* Generalise the ReviewValidation instance for ValidationMonad to+  ValidationMonadT over any Applicative+* Relax constraints: Choice for ValidatorProfunctor no longer requires+  Semigroup, Sieve for ValidatorMonadProfunctorT requires only Functor,+  and the MonadFail instances no longer require a redundant Monad++1.3.1++* Change the Alt instance for Validator to be like Either: the first+  Success wins, otherwise the second Failure is returned. The Semigroup+  constraint is removed+* Remove the Plus and Alternative instances for Validator+* Add (-->), constructing any validator from a prism and a function on+  its focus, so that validators can be written one case per constructor+  (infixl 6, binding tighter than <!>)+* Add match, constructing any validator from a prism, and its+  specialisations matchValidator, matchValidatorProfunctor,+  matchValidatorMonad and matchValidatorMonadProfunctor+* Add the missing cross-type optics instances between Validator and+  ValidatorMonadProfunctorT, and between ValidatorProfunctor and+  ValidatorMonadT+* Generalise the ReviewValidator and ReviewValidatorProfunctor instances+  for ValidatorMonadT and ValidatorMonadProfunctorT from Identity to any+  Applicative+* Add hedgehog property tests for match and its specialisations+* Raise dependency lower bounds to the oldest versions that build on+  GHC 9.6 (base >= 4.18, lens >= 5.2.1, semigroupoids >= 6.0.0.1, ...),+  and check them in CI with lower-bounds.project+* Remove GHC 9.0.1 from CI, and build with GHC 9.6.7, 9.8.4 and 9.10.3+* Add bin/lint.sh, running hlint and fourmolu, and check it in CI++1.3.0++* Replace ormolu with fourmolu+* Remove CPP, raise lens lower bound to >= 4.20+* Move Data.Validation to Data.Validation.Validation, re-export from+  Data.Validation+* Add ValidationMonadT monad transformer with short-circuiting+  Applicative, Bind, Monad, MonadError, MonadTrans, and related instances+* Add Eq1, Eq2, Ord1, Ord2, Show1, Show2 instances for Validation+* Add Generic1, Plus, Alternative, Bifoldable1, Bitraversable1, Assoc,+  Extend instances for Validation+* Add four validator newtypes with different parameter orders:+  - Validator x err a (Bifunctor, accumulating Applicative)+  - ValidatorProfunctor err x a (Profunctor, accumulating Applicative)+  - ValidatorMonadT x err f a (Monad, MonadTrans, BindTrans)+  - ValidatorMonadProfunctorT err f x a (Profunctor, Monad, Category, Arrow)+* Add cross-type optics instances between all four validator newtypes+* Add classy optics (Get/Has/Review/As) for all new types+* Add Wrapped/Rewrapped instances for all new types+* Add validationMonad isomorphism between Validation and ValidationMonad+* Remove Validator profunctor transformer (replaced by above newtypes)+* Remove ReifiedIso', ReifiedPrism' profunctor wrappers+* Remove examples/ subdirectory+* Drop support for GHC < 9.6+* Add 728 doctests across all modules+* Remove unused profunctors and tagged dependencies from test suite++1.2.2++* Implement Either instances for ReviewFailure, AsFailure, ReviewSuccess,+  and AsSuccess+* Add hedgehog property tests for Either optic instances++1.2.1++* Updates to documentation.++1.2.0++* Add Validator e p x a profunctor transformer newtype with instances+  for Functor, Apply, Applicative, Alt, Selective, Profunctor, Strong,+  Choice, Semigroupoid, Category, Arrow, ArrowChoice, ArrowApply, and+  Wrapped/Rewrapped+* Add classy optics for Validator (GetValidator, HasValidator,+  ReviewValidator, AsValidator)+* Add profunctor newtypes Iso'' and Prism'' for wrapping monomorphic+  optics as two-parameter profunctors+* Add unitValidator, taggedValidator, and swapValidator isomorphisms+* Add nonEmptyList example validators using Iso'' and Prism''+* Add tagged package dependency+* Expand hedgehog property tests from 4 to 35 covering semigroup,+  monoid, functor, applicative, apply, alt, bifunctor, foldValidation,+  iso/prism roundtrips, swap, and all Validator instances+* Replace HUnit tests with doctest suite (187 examples)+* Add tests: True to cabal.project+* Update examples for current API (remove Validate class, use either iso)+* Hide Prelude.either to avoid ambiguity with Data.Validation.either++1.1.5++* Update version bounds++1.1.4++* Remove nix build+* Add `Selective` instance++1.1.3++* Fix CI for older GHC++1.1.2++* Drop support for GHC-7.8.*, GHC-7.6.*, GHC-7.4.*, and GHC-7.2.*+* Adjust lower bounds of most dependencies to be inline with the lowest supported GHC version of 7.10.3++1.1.1++* Add `Data.Bifunctor.Swap.Swap` instance from `swap`+* Support `lens ^>= 5`++1.1++* Generalise types of `validate` and `ensure` functions to use `Maybe` instead of `Bool`+ 1  * Rename `AccValidation` to `Validation`@@ -94,4 +229,3 @@ 0.3.4  Loosen the type of the Isos for polymorphic update.-

@@ -1,373 +1,11 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TypeFamilies #-}--#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE DeriveGeneric #-}-#endif+{-# OPTIONS_GHC -Wall #-} --- | A data type similar to @Data.Either@ that accumulates failures.-module Data.Validation-(-  -- * Data type-  Validation(..)-  -- * Constructing validations-, validate-, validationNel-, fromEither-, liftError-  -- * Functions on validations-, validation-, toEither-, orElse-, valueOr-, ensure-, codiagonal-, validationed-, bindValidation-  -- * Prisms-  -- | These prisms are useful for writing code which is polymorphic in its-  -- choice of Either or Validation. This choice can then be made later by a-  -- user, depending on their needs.-  ---  -- An example of this style of usage can be found-  -- <https://github.com/qfpl/validation/blob/master/examples/src/PolymorphicEmail.hs here>-, _Failure-, _Success-  -- * Isomorphisms-, Validate(..)-, revalidate+module Data.Validation (+  module Data.Validation.Validation,+  module Data.Validation.ValidationMonad,+  module Data.Validation.Validator, ) where -import Control.Applicative(Applicative((<*>), pure), (<$>))-import Control.DeepSeq (NFData (rnf))-import Control.Lens (over, under)-import Control.Lens.Getter((^.))-import Control.Lens.Iso(Swapped(..), Iso, iso, from)-import Control.Lens.Prism(Prism, prism)-import Control.Lens.Review(( # ))-import Data.Bifoldable(Bifoldable(bifoldr))-import Data.Bifunctor(Bifunctor(bimap))-import Data.Bitraversable(Bitraversable(bitraverse))-import Data.Bool (Bool)-import Data.Data(Data)-import Data.Either(Either(Left, Right), either)-import Data.Eq(Eq)-import Data.Foldable(Foldable(foldr))-import Data.Function((.), ($), id)-import Data.Functor(Functor(fmap))-import Data.Functor.Alt(Alt((<!>)))-import Data.Functor.Apply(Apply((<.>)))-import Data.List.NonEmpty (NonEmpty)-import Data.Monoid(Monoid(mappend, mempty))-import Data.Ord(Ord)-import Data.Semigroup(Semigroup((<>)))-import Data.Traversable(Traversable(traverse))-import Data.Typeable(Typeable)-#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif-import Prelude(Show)----- | An @Validation@ is either a value of the type @err@ or @a@, similar to 'Either'. However,--- the 'Applicative' instance for @Validation@ /accumulates/ errors using a 'Semigroup' on @err@.--- In contrast, the @Applicative@ for @Either@ returns only the first error.------ A consequence of this is that @Validation@ has no 'Data.Functor.Bind.Bind' or 'Control.Monad.Monad' instance. This is because--- such an instance would violate the law that a Monad's 'Control.Monad.ap' must equal the--- @Applicative@'s 'Control.Applicative.<*>'------ An example of typical usage can be found <https://github.com/qfpl/validation/blob/master/examples/src/Email.hs here>.----data Validation err a =-  Failure err-  | Success a-  deriving (-    Eq, Ord, Show, Data, Typeable-#if __GLASGOW_HASKELL__ >= 702-    , Generic-#endif-  )--instance Functor (Validation err) where-  fmap _ (Failure e) =-    Failure e-  fmap f (Success a) =-    Success (f a)-  {-# INLINE fmap #-}--instance Semigroup err => Apply (Validation err) where-  Failure e1 <.> b = Failure $ case b of-    Failure e2 -> e1 <> e2-    Success _ -> e1-  Success _  <.> Failure e2 =-    Failure e2-  Success f  <.> Success a  =-    Success (f a)-  {-# INLINE (<.>) #-}--instance Semigroup err => Applicative (Validation err) where-  pure =-    Success-  (<*>) =-    (<.>)--instance Alt (Validation err) where-  Failure _ <!> x =-    x-  Success a <!> _ =-    Success a-  {-# INLINE (<!>) #-}--instance Foldable (Validation err) where-  foldr f x (Success a) =-    f a x-  foldr _ x (Failure _) =-    x-  {-# INLINE foldr #-}--instance Traversable (Validation err) where-  traverse f (Success a) =-    Success <$> f a-  traverse _ (Failure e) =-    pure (Failure e)-  {-# INLINE traverse #-}--instance Bifunctor Validation where-  bimap f _ (Failure e) =-    Failure (f e)-  bimap _ g (Success a) =-    Success (g a)-  {-# INLINE bimap #-}---instance Bifoldable Validation where-  bifoldr _ g x (Success a) =-    g a x-  bifoldr f _ x (Failure e) =-    f e x-  {-# INLINE bifoldr #-}--instance Bitraversable Validation where-  bitraverse _ g (Success a) =-    Success <$> g a-  bitraverse f _ (Failure e) =-    Failure <$> f e-  {-# INLINE bitraverse #-}--appValidation ::-  (err -> err -> err)-  -> Validation err a-  -> Validation err a-  -> Validation err a-appValidation m (Failure e1) (Failure e2) =-  Failure (e1 `m` e2)-appValidation _ (Failure _) (Success a2) =-  Success a2-appValidation _ (Success a1) (Failure _) =-  Success a1-appValidation _ (Success a1) (Success _) =-  Success a1-{-# INLINE appValidation #-}--instance Semigroup e => Semigroup (Validation e a) where-  (<>) =-    appValidation (<>)-  {-# INLINE (<>) #-}--instance Monoid e => Monoid (Validation e a) where-  mappend =-    appValidation mappend-  {-# INLINE mappend #-}-  mempty =-    Failure mempty-  {-# INLINE mempty #-}--instance Swapped Validation where-  swapped =-    iso-      (\v -> case v of-        Failure e -> Success e-        Success a -> Failure a)-      (\v -> case v of-        Failure a -> Success a-        Success e -> Failure e)-  {-# INLINE swapped #-}--instance (NFData e, NFData a) => NFData (Validation e a) where-  rnf v =-    case v of-      Failure e -> rnf e-      Success a -> rnf a---- | 'validate's the @a@ with the given predicate, returning @e@ if the predicate does not hold.------ This can be thought of as having the less general type:------ @--- validate :: e -> (a -> Bool) -> a -> Validation e a--- @-validate :: Validate v => e -> (a -> Bool) -> a -> v e a-validate e p a =-  if p a then _Success # a else _Failure # e---- | 'validationNel' is 'liftError' specialised to 'NonEmpty' lists, since--- they are a common semigroup to use.-validationNel :: Either e a -> Validation (NonEmpty e) a-validationNel = liftError pure---- | Converts from 'Either' to 'Validation'.-fromEither :: Either e a -> Validation e a-fromEither = liftError id---- | 'liftError' is useful for converting an 'Either' to an 'Validation'--- when the @Left@ of the 'Either' needs to be lifted into a 'Semigroup'.-liftError :: (b -> e) -> Either b a -> Validation e a-liftError f = either (Failure . f) Success---- | 'validation' is the catamorphism for @Validation@.-validation :: (e -> c) -> (a -> c) -> Validation e a -> c-validation ec ac v = case v of-  Failure e -> ec e-  Success a -> ac a---- | Converts from 'Validation' to 'Either'.-toEither :: Validation e a -> Either e a-toEither = validation Left Right---- | @v 'orElse' a@ returns @a@ when @v@ is Failure, and the @a@ in @Success a@.------ This can be thought of as having the less general type:------ @--- orElse :: Validation e a -> a -> a--- @-orElse :: Validate v => v e a -> a -> a-orElse v a = case v ^. _Validation of-  Failure _ -> a-  Success x -> x---- | Return the @a@ or run the given function over the @e@.------ This can be thought of as having the less general type:------ @--- valueOr :: (e -> a) -> Validation e a -> a--- @-valueOr :: Validate v => (e -> a) -> v e a -> a-valueOr ea v = case v ^. _Validation of-  Failure e -> ea e-  Success a -> a---- | 'codiagonal' gets the value out of either side.-codiagonal :: Validation a a -> a-codiagonal = valueOr id---- | 'ensure' leaves the validation unchanged when the predicate holds, or--- fails with @e@ otherwise.------ This can be thought of as having the less general type:------ @--- ensure :: e -> (a -> Bool) -> Validation e a -> Validation e a--- @-ensure :: Validate v => e -> (a -> Bool) -> v e a -> v e a-ensure e p =-  over _Validation $ \v -> case v of-    Failure x -> Failure x-    Success a -> validate e p a---- | Run a function on anything with a Validate instance (usually Either)--- as if it were a function on Validation------ This can be thought of as having the type------ @(Either e a -> Either e' a') -> Validation e a -> Validation e' a'@-validationed :: Validate v => (v e a -> v e' a') -> Validation e a -> Validation e' a'-validationed f = under _Validation f---- | @bindValidation@ binds through an Validation, which is useful for--- composing Validations sequentially. Note that despite having a bind--- function of the correct type, Validation is not a monad.--- The reason is, this bind does not accumulate errors, so it does not--- agree with the Applicative instance.------ There is nothing wrong with using this function, it just does not make a--- valid @Monad@ instance.-bindValidation :: Validation e a -> (a -> Validation e b) -> Validation e b-bindValidation v f = case v of-  Failure e -> Failure e-  Success a -> f a---- | The @Validate@ class carries around witnesses that the type @f@ is isomorphic--- to Validation, and hence isomorphic to Either.-class Validate f where-  _Validation ::-    Iso (f e a) (f g b) (Validation e a) (Validation g b)--  _Either ::-    Iso (f e a) (f g b) (Either e a) (Either g b)-  _Either =-    iso-      (\x -> case x ^. _Validation of-        Failure e -> Left e-        Success a -> Right a)-      (\x -> _Validation # case x of-        Left e -> Failure e-        Right a -> Success a)-  {-# INLINE _Either #-}--instance Validate Validation where-  _Validation =-    id-  {-# INLINE _Validation #-}-  _Either =-    iso-      (\x -> case x of-        Failure e -> Left e-        Success a -> Right a)-      (\x -> case x of-        Left e -> Failure e-        Right a -> Success a)-  {-# INLINE _Either #-}--instance Validate Either where-  _Validation =-    iso-      fromEither-      toEither-  {-# INLINE _Validation #-}-  _Either =-    id-  {-# INLINE _Either #-}---- | This prism generalises 'Control.Lens.Prism._Left'. It targets the failure case of either 'Either' or 'Validation'.-_Failure ::-  Validate f =>-  Prism (f e1 a) (f e2 a) e1 e2-_Failure =-  prism-    (\x -> _Either # Left x)-    (\x -> case x ^. _Either of-             Left e -> Right e-             Right a -> Left (_Either # Right a))-{-# INLINE _Failure #-}---- | This prism generalises 'Control.Lens.Prism._Right'. It targets the success case of either 'Either' or 'Validation'.-_Success ::-  Validate f =>-  Prism (f e a) (f e b) a b-_Success =-  prism-    (\x -> _Either # Right x)-    (\x -> case x ^. _Either of-             Left e -> Left (_Either # Left e)-             Right a -> Right a)-{-# INLINE _Success #-}---- | 'revalidate' converts between any two instances of 'Validate'.-revalidate :: (Validate f, Validate g) => Iso (f e1 s) (f e2 t) (g e1 s) (g e2 t)-revalidate = _Validation . from _Validation-+import Data.Validation.Validation+import Data.Validation.ValidationMonad+import Data.Validation.Validator

@@ -0,0 +1,620 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-}++-- | A data type similar to @Data.Either@ that accumulates failures.+module Data.Validation.Validation (+  -- * Data type+  Validation (..),++  -- * Catamorphism+  foldValidation,++  -- * Optics++  -- ** Classy lenses+  GetValidation (..),+  HasValidation (..),++  -- ** Classy prisms+  ReviewValidation (..),+  AsValidation (..),++  -- ** Prisms+  __Failure,+  __Success,++  -- ** Isomorphisms+  Data.Validation.Validation.either,+  codiagonal,+) where++import Control.Applicative (Alternative (empty, (<|>)))+import Control.Category (Category (..))+import Control.DeepSeq (NFData (rnf))+import Control.Lens (Getter, Lens', Prism, Prism', Review, from, prism, unto)+import Control.Lens.Iso (Iso, iso)+import Control.Selective (Selective (..))+import Data.Bifoldable (Bifoldable (bifoldr))+import Data.Bifoldable1 (Bifoldable1 (bifoldMap1))+import Data.Bifunctor (Bifunctor (bimap))+import Data.Bifunctor.Assoc (Assoc (assoc, unassoc))+import Data.Bifunctor.Swap (Swap (..))+import Data.Bitraversable (Bitraversable (bitraverse))+import Data.Bool (bool)+import Data.Data (Data)+import qualified Data.Either as Either+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Classes (Eq1 (liftEq), Eq2 (liftEq2), Ord1 (liftCompare), Ord2 (liftCompare2), Show1 (liftShowsPrec), Show2 (liftShowsPrec2), showsUnaryWith)+import Data.Functor.Extend (Extend (extended))+import Data.Functor.Plus (Plus (zero))+import Data.Lens.Injection (Injection1 (_I1), Injection2 (_I2))+import Data.Semigroup.Traversable.Class (Bitraversable1 (bitraverse1))+import Data.Typeable (Typeable)+import GHC.Generics (Generic, Generic1)+import Prelude hiding (either, id, (.))++{- $setup+>>> import Prelude hiding (either, id, (.))+>>> import Control.Lens((^?), (#), review, view, from, set)+>>> import Data.Functor.Alt(Alt((<!>)))+>>> import Data.Functor.Apply(Apply((<.>)))+>>> import Control.DeepSeq(rnf)+>>> import Control.Category(id, (.))+>>> import Control.Selective(Selective(select))+>>> import Data.Bifunctor(Bifunctor(bimap))+>>> import Data.Bifoldable(Bifoldable(bifoldr))+>>> import Data.Bitraversable(Bitraversable(bitraverse))+>>> import Data.Bifunctor.Swap(Swap(swap))+>>> import Data.Lens.Injection(Injection1(_I1), Injection2(_I2))+>>> :set -XNoMonomorphismRestriction -w+-}++{- | A @Validation@ is either a value of the type @err@ or @a@, similar to 'Either'. However,+the 'Applicative' instance for @Validation@ /accumulates/ errors using a 'Semigroup' on @err@.+In contrast, the @Applicative@ for @Either@ returns only the first error.++A consequence of this is that @Validation@ has no 'Data.Functor.Bind.Bind' or 'Control.Monad.Monad' instance. This is because+such an instance would violate the law that a Monad's 'Control.Monad.ap' must equal the+@Applicative@'s 'Control.Applicative.<*>'++See the <https://github.com/system-f/validation README> for usage examples.+-}+data Validation err a+  = Failure err+  | Success a+  deriving (Data, Eq, Generic, Generic1, Ord, Show, Typeable)++instance Eq2 Validation where+  liftEq2 f _ (Failure a) (Failure b) = f a b+  liftEq2 _ g (Success a) (Success b) = g a b+  liftEq2 _ _ _ _ = False+  {-# INLINE liftEq2 #-}++instance (Eq err) => Eq1 (Validation err) where+  liftEq = liftEq2 (==)+  {-# INLINE liftEq #-}++instance Ord2 Validation where+  liftCompare2 f _ (Failure a) (Failure b) = f a b+  liftCompare2 _ _ (Failure _) (Success _) = LT+  liftCompare2 _ _ (Success _) (Failure _) = GT+  liftCompare2 _ g (Success a) (Success b) = g a b+  {-# INLINE liftCompare2 #-}++instance (Ord err) => Ord1 (Validation err) where+  liftCompare = liftCompare2 compare+  {-# INLINE liftCompare #-}++instance Show2 Validation where+  liftShowsPrec2 sp1 _ _ _ d (Failure a) = showsUnaryWith sp1 "Failure" d a+  liftShowsPrec2 _ _ sp2 _ d (Success a) = showsUnaryWith sp2 "Success" d a+  {-# INLINE liftShowsPrec2 #-}++instance (Show err) => Show1 (Validation err) where+  liftShowsPrec = liftShowsPrec2 showsPrec showList+  {-# INLINE liftShowsPrec #-}++{- |+>>> fmap (+1) (Success 2 :: Validation String Int)+Success 3++>>> fmap (+1) (Failure "err" :: Validation String Int)+Failure "err"+-}+instance Functor (Validation err) where+  fmap _ (Failure e) =+    Failure e+  fmap f (Success a) =+    Success (f a)+  {-# INLINE fmap #-}++{- | Accumulates errors on the left using 'Semigroup'.++>>> import Data.Functor.Apply(Apply((<.>)))+>>> Success (+1) <.> Success 2 :: Validation [String] Int+Success 3++>>> Failure ["e1"] <.> Success 2 :: Validation [String] Int+Failure ["e1"]++>>> Success (+1) <.> Failure ["e2"] :: Validation [String] Int+Failure ["e2"]++>>> Failure ["e1"] <.> Failure ["e2"] :: Validation [String] Int+Failure ["e1","e2"]+-}+instance (Semigroup err) => Apply (Validation err) where+  Failure e1 <.> b = Failure $ case b of+    Failure e2 -> e1 <> e2+    Success _ -> e1+  Success _ <.> Failure e2 =+    Failure e2+  Success f <.> Success a =+    Success (f a)+  {-# INLINE (<.>) #-}++{- | Delegates to the 'Apply' instance, accumulating errors with '<>'.++>>> pure (+1) <*> pure 2 :: Validation [String] Int+Success 3++>>> Failure ["e1"] <*> Failure ["e2"] :: Validation [String] Int+Failure ["e1","e2"]+-}+instance (Semigroup err) => Applicative (Validation err) where+  pure =+    Success+  {-# INLINE pure #-}+  (<*>) =+    (<.>)+  {-# INLINE (<*>) #-}++{- | Tries the left, then the right, accumulating errors on two failures.++>>> import Data.Functor.Alt(Alt((<!>)))+>>> Success 1 <!> Success 2 :: Validation [String] Int+Success 1++>>> Failure ["e1"] <!> Success 2 :: Validation [String] Int+Success 2++>>> Success 1 <!> Failure ["e2"] :: Validation [String] Int+Success 1++>>> Failure ["e1"] <!> Failure ["e2"] :: Validation [String] Int+Failure ["e1","e2"]+-}+instance (Semigroup err) => Alt (Validation err) where+  Failure e1 <!> Failure e2 =+    Failure (e1 <> e2)+  Failure _ <!> Success a =+    Success a+  Success a <!> _ =+    Success a+  {-# INLINE (<!>) #-}++instance (Monoid err) => Plus (Validation err) where+  zero = Failure mempty+  {-# INLINE zero #-}++instance (Monoid err) => Alternative (Validation err) where+  empty = zero+  {-# INLINE empty #-}+  (<|>) = (<!>)+  {-# INLINE (<|>) #-}++{- | Skips the second effect on 'Failure'.++>>> import Control.Selective(Selective(select))+>>> select (Success (Right 1)) (Success (+1)) :: Validation [String] Int+Success 1++>>> select (Success (Left 1)) (Success (+1)) :: Validation [String] Int+Success 2++>>> select (Failure ["e1"]) (Success (+1)) :: Validation [String] Int+Failure ["e1"]++>>> select (Failure ["e1"]) (Failure ["e2"]) :: Validation [String] Int+Failure ["e1"]+-}+instance (Semigroup err) => Selective (Validation err) where+  select (Failure e) _ = Failure e+  select (Success x) f = Either.either (\a -> ($ a) <$> f) Success x+  {-# INLINE select #-}++{- |+>>> foldr (:) [] (Success 1 :: Validation String Int)+[1]++>>> foldr (:) [] (Failure "err" :: Validation String Int)+[]+-}+instance Foldable (Validation err) where+  foldr f x (Success a) =+    f a x+  foldr _ x (Failure _) =+    x+  {-# INLINE foldr #-}++{- |+>>> traverse (\x -> [x, x+1]) (Success 1 :: Validation String Int)+[Success 1,Success 2]++>>> traverse (\x -> [x, x+1]) (Failure "err" :: Validation String Int)+[Failure "err"]+-}+instance Traversable (Validation err) where+  traverse f (Success a) =+    Success <$> f a+  traverse _ (Failure e) =+    pure (Failure e)+  {-# INLINE traverse #-}++{- |+>>> import Data.Bifunctor(Bifunctor(bimap))+>>> bimap show (+1) (Failure 1 :: Validation Int Int)+Failure "1"++>>> bimap show (+1) (Success 1 :: Validation Int Int)+Success 2+-}+instance Bifunctor Validation where+  bimap f _ (Failure e) =+    Failure (f e)+  bimap _ g (Success a) =+    Success (g a)+  {-# INLINE bimap #-}++{- |+>>> import Data.Bifoldable(Bifoldable(bifoldr))+>>> bifoldr (\e r -> show e ++ r) (\a r -> show a ++ r) "" (Failure 1 :: Validation Int Int)+"1"++>>> bifoldr (\e r -> show e ++ r) (\a r -> show a ++ r) "" (Success 2 :: Validation Int Int)+"2"+-}+instance Bifoldable Validation where+  bifoldr _ g x (Success a) =+    g a x+  bifoldr f _ x (Failure e) =+    f e x+  {-# INLINE bifoldr #-}++instance Bifoldable1 Validation where+  bifoldMap1 f _ (Failure e) = f e+  bifoldMap1 _ g (Success a) = g a+  {-# INLINE bifoldMap1 #-}++{- |+>>> import Data.Bitraversable(Bitraversable(bitraverse))+>>> bitraverse (\e -> [e, e+1]) (\a -> [a, a*2]) (Failure 1 :: Validation Int Int)+[Failure 1,Failure 2]++>>> bitraverse (\e -> [e, e+1]) (\a -> [a, a*2]) (Success 3 :: Validation Int Int)+[Success 3,Success 6]+-}+instance Bitraversable Validation where+  bitraverse _ g (Success a) =+    Success <$> g a+  bitraverse f _ (Failure e) =+    Failure <$> f e+  {-# INLINE bitraverse #-}++instance Bitraversable1 Validation where+  bitraverse1 f _ (Failure e) = Failure <$> f e+  bitraverse1 _ g (Success a) = Success <$> g a+  {-# INLINE bitraverse1 #-}++{- | First 'Success' wins; two 'Failure's are combined with '<>'.++>>> Failure ["e1"] <> Failure ["e2"] :: Validation [String] Int+Failure ["e1","e2"]++>>> Failure ["e1"] <> Success 2 :: Validation [String] Int+Success 2++>>> Success 1 <> Failure ["e2"] :: Validation [String] Int+Success 1++>>> Success 1 <> Success 2 :: Validation [String] Int+Success 1+-}+instance (Semigroup e) => Semigroup (Validation e a) where+  Failure e1 <> Failure e2 = Failure (e1 <> e2)+  Failure _ <> Success a = Success a+  Success a <> _ = Success a+  {-# INLINE (<>) #-}++{- |+>>> mempty :: Validation [String] Int+Failure []+-}+instance (Monoid e) => Monoid (Validation e a) where+  mempty =+    Failure mempty+  {-# INLINE mempty #-}++{- |+>>> import Data.Bifunctor.Swap(Swap(swap))+>>> swap (Failure "err" :: Validation String Int)+Success "err"++>>> swap (Success 1 :: Validation String Int)+Failure 1+-}+instance Swap Validation where+  swap v =+    case v of+      Failure e -> Success e+      Success a -> Failure a+  {-# INLINE swap #-}++instance Assoc Validation where+  assoc (Failure (Failure a)) = Failure a+  assoc (Failure (Success b)) = Success (Failure b)+  assoc (Success c) = Success (Success c)+  {-# INLINE assoc #-}+  unassoc (Failure a) = Failure (Failure a)+  unassoc (Success (Failure b)) = Failure (Success b)+  unassoc (Success (Success c)) = Success c+  {-# INLINE unassoc #-}++{- |+>>> import Control.DeepSeq(rnf)+>>> rnf (Success 1 :: Validation String Int)+()++>>> rnf (Failure "err" :: Validation String Int)+()+-}+instance (NFData e, NFData a) => NFData (Validation e a) where+  rnf v =+    case v of+      Failure e -> rnf e+      Success a -> rnf a+  {-# INLINE rnf #-}++instance Extend (Validation err) where+  extended _ (Failure e) = Failure e+  extended f w@(Success _) = Success (f w)+  {-# INLINE extended #-}++{- | Catamorphism for 'Validation'.++>>> foldValidation show show (Failure 1 :: Validation Int Int)+"1"++>>> foldValidation show show (Success 2 :: Validation Int Int)+"2"+-}+foldValidation :: (a -> x) -> (b -> x) -> Validation a b -> x+foldValidation f _ (Failure a) = f a+foldValidation _ s (Success b) = s b+{-# INLINE foldValidation #-}++{- | Polymorphic 'Prism' targeting the 'Failure' constructor.++>>> import Control.Lens((^?), review)+>>> review __Failure "err" :: Validation String Int+Failure "err"++>>> (Failure "err" :: Validation String Int) ^? __Failure+Just "err"++>>> (Success 1 :: Validation String Int) ^? __Failure+Nothing+-}+__Failure :: Prism (Validation a b) (Validation a' b) a a'+__Failure =+  prism+    Failure+    ( \case+        Failure a -> Right a+        Success b -> Left (Success b)+    )+{-# INLINE __Failure #-}++{- | Polymorphic 'Prism' targeting the 'Success' constructor.++>>> import Control.Lens((^?), review)+>>> review __Success 1 :: Validation String Int+Success 1++>>> (Success 1 :: Validation String Int) ^? __Success+Just 1++>>> (Failure "err" :: Validation String Int) ^? __Success+Nothing+-}+__Success :: Prism (Validation a b) (Validation a b') b b'+__Success =+  prism+    Success+    ( \case+        Failure a -> Left (Failure a)+        Success b -> Right b+    )+{-# INLINE __Success #-}++{- | The first constructor, 'Failure'. The same as '__Failure'.++>>> import Control.Lens((^?), (#), over)+>>> (Failure "err" :: Validation String Int) ^? _I1+Just "err"++>>> (Success 1 :: Validation String Int) ^? _I1+Nothing++>>> _I1 # "err" :: Validation String Int+Failure "err"++>>> over _I1 length (Failure "err" :: Validation String Int)+Failure 3+-}+instance Injection1 (Validation a b) (Validation a' b) a a' where+  _I1 = __Failure+  {-# INLINE _I1 #-}++{- | The second constructor, 'Success'. The same as '__Success'.++>>> import Control.Lens((^?), (#), over)+>>> (Success 1 :: Validation String Int) ^? _I2+Just 1++>>> (Failure "err" :: Validation String Int) ^? _I2+Nothing++>>> _I2 # 1 :: Validation String Int+Success 1++>>> over _I2 show (Success 1 :: Validation String Int)+Success "1"+-}+instance Injection2 (Validation a b) (Validation a b') b b' where+  _I2 = __Success+  {-# INLINE _I2 #-}++{- | Isomorphism between 'Validation' and 'Either'.++>>> import Control.Lens(view)+>>> view either (Failure "err" :: Validation String Int)+Left "err"++>>> view either (Success 1 :: Validation String Int)+Right 1+-}+either :: Iso (Validation a b) (Validation a' b') (Either a b) (Either a' b')+either =+  iso+    (foldValidation Left Right)+    (Either.either Failure Success)+{-# INLINE either #-}++{- | Isomorphism between @Validation a a@ and @(Bool, a)@, where 'False' corresponds to 'Failure'.++>>> import Control.Lens(view)+>>> view codiagonal (Failure "x" :: Validation String String)+(False,"x")++>>> view codiagonal (Success "x" :: Validation String String)+(True,"x")+-}+codiagonal :: Iso (Validation a a) (Validation a' a') (Bool, a) (Bool, a')+codiagonal =+  iso+    (foldValidation (False,) (True,))+    (\(p, a) -> bool (Failure a) (Success a) p)+{-# INLINE codiagonal #-}++-- | Class for types that have a 'Getter' to a 'Validation'.+class GetValidation s err a | s -> err a where+  getValidation :: Getter s (Validation err a)++instance GetValidation (Validation err a) err a where+  getValidation = id+  {-# INLINE getValidation #-}++{- |+>>> import Control.Lens(view)+>>> view getValidation (Left "err" :: Either String Int)+Failure "err"++>>> view getValidation (Right 1 :: Either String Int)+Success 1+-}+instance GetValidation (Either err a) err a where+  getValidation = from Data.Validation.Validation.either+  {-# INLINE getValidation #-}++-- | Class for types that have a 'Lens'' to a 'Validation' (as generated by @makeClassy@).+class (GetValidation s err a) => HasValidation s err a | s -> err a where+  validation :: Lens' s (Validation err a)++instance HasValidation (Validation err a) err a where+  validation = id+  {-# INLINE validation #-}++{- |+>>> import Control.Lens(view, set)+>>> view validation (Left "err" :: Either String Int)+Failure "err"++>>> set validation (Success 2 :: Validation String Int) (Left "err" :: Either String Int)+Right 2+-}+instance HasValidation (Either err a) err a where+  validation = from Data.Validation.Validation.either+  {-# INLINE validation #-}++-- | Class for types that have a 'Review' to a 'Validation'.+class ReviewValidation s err a | s -> err a where+  reviewValidation :: Review s (Validation err a)+  reviewFailure :: Review s err+  reviewFailure = reviewValidation . reviewFailure+  {-# INLINE reviewFailure #-}+  reviewSuccess :: Review s a+  reviewSuccess = reviewValidation . reviewSuccess+  {-# INLINE reviewSuccess #-}++instance ReviewValidation (Validation err a) err a where+  reviewValidation = id+  {-# INLINE reviewValidation #-}+  reviewFailure = unto Failure+  {-# INLINE reviewFailure #-}+  reviewSuccess = unto Success+  {-# INLINE reviewSuccess #-}++{- |+>>> import Control.Lens((#))+>>> reviewValidation # (Failure "err" :: Validation String Int) :: Either String Int+Left "err"++>>> reviewValidation # (Success 1 :: Validation String Int) :: Either String Int+Right 1+-}+instance ReviewValidation (Either err a) err a where+  reviewValidation = from Data.Validation.Validation.either+  {-# INLINE reviewValidation #-}++-- | Class for types that have a 'Prism'' to a 'Validation' (as generated by @makeClassyPrisms@).+class (ReviewValidation s err a) => AsValidation s err a | s -> err a where+  _Validation :: Prism' s (Validation err a)+  _Failure :: Prism' s err+  _Failure = _Validation . _Failure+  {-# INLINE _Failure #-}+  _Success :: Prism' s a+  _Success = _Validation . _Success+  {-# INLINE _Success #-}++instance AsValidation (Validation err a) err a where+  _Validation = id+  {-# INLINE _Validation #-}+  _Failure = __Failure+  {-# INLINE _Failure #-}+  _Success = __Success+  {-# INLINE _Success #-}++{- |+>>> import Control.Lens((^?), (#))+>>> _Validation # (Failure "err" :: Validation String Int) :: Either String Int+Left "err"++>>> (Left "err" :: Either String Int) ^? _Validation+Just (Failure "err")++>>> (Right 1 :: Either String Int) ^? _Validation+Just (Success 1)+-}+instance AsValidation (Either err a) err a where+  _Validation = from Data.Validation.Validation.either+  {-# INLINE _Validation #-}

@@ -0,0 +1,609 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++{- | A monad transformer wrapping @m (Validation err a)@ with short-circuiting+'Applicative' and 'Monad' instances, unlike 'Validation' which accumulates errors.+-}+module Data.Validation.ValidationMonad (+  ValidationMonadT (..),+  ValidationMonad,+  liftValidationMonadT,++  -- * Isomorphisms+  validationMonad,++  -- * Optics++  -- ** Classy lenses+  GetValidationMonadT (..),+  HasValidationMonadT (..),++  -- ** Classy prisms+  ReviewValidationMonadT (..),+  AsValidationMonadT (..),+) where++import Control.Applicative (Alternative (empty, (<|>)))+import Control.DeepSeq (NFData (rnf))+import Control.Lens (Getter, Lens', Prism', Review, Rewrapped, Wrapped (_Wrapped', type Unwrapped), from, unto)+import Control.Lens.Iso (Iso, Iso', iso)+import Control.Monad (MonadPlus, ap)+import Control.Monad.Cont.Class (MonadCont (callCC))+import Control.Monad.Error.Class (MonadError (catchError, throwError))+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.RWS.Class (MonadRWS)+import Control.Monad.Reader.Class (MonadReader (ask, local, reader))+import Control.Monad.State.Class (MonadState (get, put, state))+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.Writer.Class (MonadWriter (listen, pass, tell, writer))+import Control.Selective (Selective (select), selectM)+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Bind (Bind ((>>-)))+import Data.Functor.Bind.Trans (BindTrans (liftB))+import Data.Functor.Classes (Eq1 (liftEq), Ord1 (liftCompare), Show1 (liftShowList, liftShowsPrec))+import Data.Functor.Extend (Extend (extended))+import Data.Functor.Identity (Identity (..))+import Data.Functor.Plus (Plus (zero))+import Data.Lens.Injection (Injection1 (_I1), Injection2 (_I2))+import Data.Validation.Validation (AsValidation (..), GetValidation (..), HasValidation (..), ReviewValidation (..), Validation (..), foldValidation)+import qualified Data.Validation.Validation as Validation+import GHC.Generics (Generic)++{- $setup+>>> import Data.Functor.Identity(Identity(..))+>>> import Data.Validation.Validation(Validation(..))+>>> import Data.Validation.ValidationMonad+>>> import Control.Lens(view, _Wrapped', review, (#), (^?), from)+>>> import Data.Functor.Alt(Alt((<!>)))+>>> import Data.Functor.Apply(Apply((<.>)))+>>> import Data.Functor.Extend(Extend(extended))+>>> import Data.Functor.Classes(Eq1(liftEq), Ord1(liftCompare))+>>> import Control.Monad.Error.Class(MonadError(throwError, catchError))+>>> import Control.Monad.Trans.Class(MonadTrans(lift))+>>> import Control.DeepSeq(rnf)+>>> import Data.Functor.Plus(Plus(zero))+>>> :set -XNoMonomorphismRestriction -w+-}++{- | A monad transformer wrapping @m (Validation err a)@.++>>> ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Success 1))++>>> ValidationMonadT (Identity (Failure "err")) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Failure "err"))+-}+newtype ValidationMonadT err m a = ValidationMonadT (m (Validation err a))+  deriving (Generic)++-- | Type alias for @ValidationMonadT err Identity a@.+type ValidationMonad err a = ValidationMonadT err Identity a++{- |+>>> ValidationMonadT (Identity (Success 1)) == (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+True++>>> ValidationMonadT (Identity (Success 1)) == (ValidationMonadT (Identity (Failure "err")) :: ValidationMonadT String Identity Int)+False+-}+deriving instance (Eq (m (Validation err a))) => Eq (ValidationMonadT err m a)++{- |+>>> compare (ValidationMonadT (Identity (Failure "a"))) (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+LT+-}+deriving instance (Ord (m (Validation err a))) => Ord (ValidationMonadT err m a)++{- |+>>> show (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+"ValidationMonadT (Identity (Success 1))"+-}+deriving instance (Show (m (Validation err a))) => Show (ValidationMonadT err m a)++{- |+>>> import Control.Lens(view, _Wrapped')+>>> view _Wrapped' (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+Identity (Success 1)+-}+instance Wrapped (ValidationMonadT err m a) where+  type Unwrapped (ValidationMonadT err m a) = m (Validation err a)+  _Wrapped' = iso (\(ValidationMonadT m) -> m) ValidationMonadT+  {-# INLINE _Wrapped' #-}++instance Rewrapped (ValidationMonadT err m a) (ValidationMonadT err' m' b)++{- |+>>> liftEq (==) (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int) (ValidationMonadT (Identity (Success 1)))+True++>>> liftEq (==) (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int) (ValidationMonadT (Identity (Success 2)))+False+-}+instance (Eq1 m, Eq err) => Eq1 (ValidationMonadT err m) where+  liftEq f (ValidationMonadT ma) (ValidationMonadT mb) = liftEq (liftEq f) ma mb+  {-# INLINE liftEq #-}++{- |+>>> liftCompare compare (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int) (ValidationMonadT (Identity (Success 2)))+LT+-}+instance (Ord1 m, Ord err) => Ord1 (ValidationMonadT err m) where+  liftCompare f (ValidationMonadT ma) (ValidationMonadT mb) = liftCompare (liftCompare f) ma mb+  {-# INLINE liftCompare #-}++instance (Show1 m, Show err) => Show1 (ValidationMonadT err m) where+  liftShowsPrec sp sl d (ValidationMonadT m) =+    showParen (d > 10) $+      showString "ValidationMonadT " . liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl) 11 m+  {-# INLINE liftShowsPrec #-}++{- | Lift a value from the base functor into 'ValidationMonadT'.++>>> liftValidationMonadT (Identity 1) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Success 1))+-}+liftValidationMonadT :: (Functor m) => m a -> ValidationMonadT err m a+liftValidationMonadT = ValidationMonadT . fmap Success+{-# INLINE liftValidationMonadT #-}++{- |+>>> fmap (+1) (ValidationMonadT (Identity (Success 2)) :: ValidationMonadT String Identity Int)+ValidationMonadT (Identity (Success 3))++>>> fmap (+1) (ValidationMonadT (Identity (Failure "err")) :: ValidationMonadT String Identity Int)+ValidationMonadT (Identity (Failure "err"))+-}+instance (Functor m) => Functor (ValidationMonadT err m) where+  fmap f (ValidationMonadT m) = ValidationMonadT (fmap (fmap f) m)+  {-# INLINE fmap #-}++{- | Short-circuiting: stops at the first 'Failure'.++>>> (ValidationMonadT (Identity (Success (+1))) :: ValidationMonadT String Identity (Int -> Int)) <.> ValidationMonadT (Identity (Success 2))+ValidationMonadT (Identity (Success 3))++>>> (ValidationMonadT (Identity (Failure "e1")) :: ValidationMonadT String Identity (Int -> Int)) <.> ValidationMonadT (Identity (Success 2))+ValidationMonadT (Identity (Failure "e1"))+-}+instance (Monad m) => Apply (ValidationMonadT err m) where+  (<.>) = ap+  {-# INLINE (<.>) #-}++{- | Short-circuiting: unlike 'Validation', does /not/ accumulate errors.++>>> pure 1 :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Success 1))++>>> (ValidationMonadT (Identity (Failure "e1")) :: ValidationMonadT String Identity (Int -> Int)) <*> (ValidationMonadT (Identity (Failure "e2")) :: ValidationMonadT String Identity Int)+ValidationMonadT (Identity (Failure "e1"))+-}+instance (Monad m) => Applicative (ValidationMonadT err m) where+  pure = ValidationMonadT . pure . Success+  {-# INLINE pure #-}+  ValidationMonadT mf <*> ValidationMonadT ma = ValidationMonadT $ do+    vf <- mf+    case vf of+      Failure e -> pure (Failure e)+      Success f -> fmap (fmap f) ma+  {-# INLINE (<*>) #-}++instance (Monad m) => Bind (ValidationMonadT err m) where+  (>>-) = (>>=)+  {-# INLINE (>>-) #-}++{- | Short-circuiting on the first 'Failure'.++>>> ValidationMonadT (Identity (Success 2)) >>= (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Success 3))++>>> (ValidationMonadT (Identity (Failure "err")) :: ValidationMonadT String Identity Int) >>= (\x -> ValidationMonadT (Identity (Success (x + 1))))+ValidationMonadT (Identity (Failure "err"))+-}+instance (Monad m) => Monad (ValidationMonadT err m) where+  ValidationMonadT m >>= k = ValidationMonadT $ do+    va <- m+    case va of+      Failure e -> pure (Failure e)+      Success a -> let ValidationMonadT n = k a in n+  {-# INLINE (>>=) #-}++instance (MonadFail m) => MonadFail (ValidationMonadT err m) where+  fail = liftValidationMonadT . fail+  {-# INLINE fail #-}++{- | First 'Success' wins; two 'Failure's accumulate errors.++>>> (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT [String] Identity Int) <!> ValidationMonadT (Identity (Success 2))+ValidationMonadT (Identity (Success 1))++>>> (ValidationMonadT (Identity (Failure ["e1"])) :: ValidationMonadT [String] Identity Int) <!> ValidationMonadT (Identity (Success 2))+ValidationMonadT (Identity (Success 2))++>>> (ValidationMonadT (Identity (Failure ["e1"])) :: ValidationMonadT [String] Identity Int) <!> ValidationMonadT (Identity (Failure ["e2"]))+ValidationMonadT (Identity (Failure ["e1","e2"]))+-}+instance (Monad m, Semigroup err) => Alt (ValidationMonadT err m) where+  ValidationMonadT ma <!> ValidationMonadT mb = ValidationMonadT $ do+    va <- ma+    case va of+      Success a -> pure (Success a)+      Failure e1 -> fmap (foldValidation (Failure . (e1 <>)) Success) mb+  {-# INLINE (<!>) #-}++{- |+>>> zero :: ValidationMonadT [String] Identity Int+ValidationMonadT (Identity (Failure []))+-}+instance (Monad m, Monoid err) => Plus (ValidationMonadT err m) where+  zero = ValidationMonadT (pure (Failure mempty))+  {-# INLINE zero #-}++instance (Monad m, Monoid err) => Alternative (ValidationMonadT err m) where+  empty = zero+  {-# INLINE empty #-}+  (<|>) = (<!>)+  {-# INLINE (<|>) #-}++instance (Monad m, Monoid err) => MonadPlus (ValidationMonadT err m)++instance (Monad m) => Selective (ValidationMonadT err m) where+  select = selectM+  {-# INLINE select #-}++{- |+>>> foldr (:) [] (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+[1]++>>> foldr (:) [] (ValidationMonadT (Identity (Failure "err")) :: ValidationMonadT String Identity Int)+[]+-}+instance (Foldable m) => Foldable (ValidationMonadT err m) where+  foldr f z (ValidationMonadT m) = foldr (flip (foldr f)) z m+  {-# INLINE foldr #-}++{- |+>>> traverse (\x -> [x, x+1]) (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+[ValidationMonadT (Identity (Success 1)),ValidationMonadT (Identity (Success 2))]++>>> traverse (\x -> [x, x+1]) (ValidationMonadT (Identity (Failure "err")) :: ValidationMonadT String Identity Int)+[ValidationMonadT (Identity (Failure "err"))]+-}+instance (Traversable m) => Traversable (ValidationMonadT err m) where+  traverse f (ValidationMonadT m) = ValidationMonadT <$> traverse (traverse f) m+  {-# INLINE traverse #-}++{- |+>>> extended (\_ -> 42) (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Success 42))++>>> extended (\_ -> 42) (ValidationMonadT (Identity (Failure "err")) :: ValidationMonadT String Identity Int) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Failure "err"))+-}+instance (Functor m) => Extend (ValidationMonadT err m) where+  extended f w@(ValidationMonadT m) = ValidationMonadT (fmap (foldValidation Failure (const (Success (f w)))) m)+  {-# INLINE extended #-}++{- |+>>> (ValidationMonadT (Identity (Failure ["e1"])) :: ValidationMonadT [String] Identity Int) <> ValidationMonadT (Identity (Failure ["e2"]))+ValidationMonadT (Identity (Failure ["e1","e2"]))++>>> (ValidationMonadT (Identity (Failure ["e1"])) :: ValidationMonadT [String] Identity Int) <> ValidationMonadT (Identity (Success 2))+ValidationMonadT (Identity (Success 2))+-}+instance (Applicative m, Semigroup e) => Semigroup (ValidationMonadT e m a) where+  ValidationMonadT ma <> ValidationMonadT mb = ValidationMonadT (liftA2 (<>) ma mb)+  {-# INLINE (<>) #-}++{- |+>>> mempty :: ValidationMonadT [String] Identity Int+ValidationMonadT (Identity (Failure []))+-}+instance (Applicative m, Monoid e) => Monoid (ValidationMonadT e m a) where+  mempty = ValidationMonadT (pure mempty)+  {-# INLINE mempty #-}++{- |+>>> rnf (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+()+-}+instance (NFData (m (Validation err a))) => NFData (ValidationMonadT err m a) where+  rnf (ValidationMonadT m) = rnf m+  {-# INLINE rnf #-}++{- |+>>> lift (Identity 1) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Success 1))+-}+instance MonadTrans (ValidationMonadT err) where+  lift = liftValidationMonadT+  {-# INLINE lift #-}++instance BindTrans (ValidationMonadT err) where+  liftB = liftValidationMonadT+  {-# INLINE liftB #-}++{- |+>>> throwError "err" :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Failure "err"))++>>> catchError (throwError "err" :: ValidationMonadT String Identity Int) (\e -> pure (length e))+ValidationMonadT (Identity (Success 3))+-}+instance (Monad m) => MonadError err (ValidationMonadT err m) where+  throwError = ValidationMonadT . pure . Failure+  {-# INLINE throwError #-}+  catchError (ValidationMonadT m) h = ValidationMonadT $ do+    va <- m+    case va of+      Failure e -> let ValidationMonadT n = h e in n+      Success a -> pure (Success a)+  {-# INLINE catchError #-}++instance (MonadIO m) => MonadIO (ValidationMonadT err m) where+  liftIO = liftValidationMonadT . liftIO+  {-# INLINE liftIO #-}++instance (MonadReader r m) => MonadReader r (ValidationMonadT err m) where+  ask = liftValidationMonadT ask+  {-# INLINE ask #-}+  local f (ValidationMonadT m) = ValidationMonadT (local f m)+  {-# INLINE local #-}+  reader = liftValidationMonadT . reader+  {-# INLINE reader #-}++instance (MonadWriter w m) => MonadWriter w (ValidationMonadT err m) where+  writer = liftValidationMonadT . writer+  {-# INLINE writer #-}+  tell = liftValidationMonadT . tell+  {-# INLINE tell #-}+  listen (ValidationMonadT m) = ValidationMonadT $ do+    (va, w) <- listen m+    pure (fmap (,w) va)+  {-# INLINE listen #-}+  pass (ValidationMonadT m) = ValidationMonadT $ pass $ do+    va <- m+    pure $ case va of+      Failure e -> (Failure e, id)+      Success (a, f) -> (Success a, f)+  {-# INLINE pass #-}++instance (MonadState s m) => MonadState s (ValidationMonadT err m) where+  get = liftValidationMonadT get+  {-# INLINE get #-}+  put = liftValidationMonadT . put+  {-# INLINE put #-}+  state = liftValidationMonadT . state+  {-# INLINE state #-}++instance (MonadCont m) => MonadCont (ValidationMonadT err m) where+  callCC f = ValidationMonadT $ callCC $ \c ->+    let ValidationMonadT m = f (ValidationMonadT . c . Success) in m+  {-# INLINE callCC #-}++instance (MonadRWS r w s m) => MonadRWS r w s (ValidationMonadT err m)++{- | Class for types that have a 'Getter' to a 'ValidationMonadT'.++>>> import Control.Lens(view)+>>> view getValidationMonadT (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+ValidationMonadT (Identity (Success 1))+-}+class GetValidationMonadT s err m a | s -> err m a where+  getValidationMonadT :: Getter s (ValidationMonadT err m a)++instance GetValidationMonadT (ValidationMonadT err m a) err m a where+  getValidationMonadT = id+  {-# INLINE getValidationMonadT #-}++{- | Class for types that have a 'Lens'' to a 'ValidationMonadT'.++>>> import Control.Lens(view)+>>> view validationMonadT (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+ValidationMonadT (Identity (Success 1))+-}+class (GetValidationMonadT s err m a) => HasValidationMonadT s err m a | s -> err m a where+  validationMonadT :: Lens' s (ValidationMonadT err m a)++instance HasValidationMonadT (ValidationMonadT err m a) err m a where+  validationMonadT = id+  {-# INLINE validationMonadT #-}++{- | Class for types that have a 'Review' to a 'ValidationMonadT'.++>>> import Control.Lens(review)+>>> review reviewValidationMonadT (ValidationMonadT (Identity (Success 1))) :: ValidationMonadT String Identity Int+ValidationMonadT (Identity (Success 1))+-}+class ReviewValidationMonadT s err m a | s -> err m a where+  reviewValidationMonadT :: Review s (ValidationMonadT err m a)++instance ReviewValidationMonadT (ValidationMonadT err m a) err m a where+  reviewValidationMonadT = id+  {-# INLINE reviewValidationMonadT #-}++-- | Class for types that have a 'Prism'' to a 'ValidationMonadT'.+class (ReviewValidationMonadT s err m a) => AsValidationMonadT s err m a | s -> err m a where+  _ValidationMonadT :: Prism' s (ValidationMonadT err m a)++instance AsValidationMonadT (ValidationMonadT err m a) err m a where+  _ValidationMonadT = id+  {-# INLINE _ValidationMonadT #-}++{- | Isomorphism between @Validation err a@ and @ValidationMonadT err Identity a@.++>>> import Control.Lens(view, from)+>>> view validationMonad (Success 1 :: Validation String Int)+ValidationMonadT (Identity (Success 1))++>>> view (from validationMonad) (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+Success 1+-}+validationMonad :: Iso (Validation err a) (Validation err' a') (ValidationMonad err a) (ValidationMonad err' a')+validationMonad = iso (ValidationMonadT . pure) (\(ValidationMonadT (Identity v)) -> v)+{-# INLINE validationMonad #-}++{- | The first constructor, 'Failure', of the 'Validation' inside 'Identity'.++>>> import Control.Lens((^?), (#))+>>> (ValidationMonadT (Identity (Failure "err")) :: ValidationMonad String Int) ^? _I1+Just "err"++>>> (ValidationMonadT (Identity (Success 1)) :: ValidationMonad String Int) ^? _I1+Nothing++>>> _I1 # "err" :: ValidationMonad String Int+ValidationMonadT (Identity (Failure "err"))+-}+instance Injection1 (ValidationMonad err a) (ValidationMonad err' a) err err' where+  _I1 = from validationMonad . _I1+  {-# INLINE _I1 #-}++{- | The second constructor, 'Success', of the 'Validation' inside 'Identity'.++>>> import Control.Lens((^?), (#))+>>> (ValidationMonadT (Identity (Success 1)) :: ValidationMonad String Int) ^? _I2+Just 1++>>> (ValidationMonadT (Identity (Failure "err")) :: ValidationMonad String Int) ^? _I2+Nothing++>>> _I2 # 1 :: ValidationMonad String Int+ValidationMonadT (Identity (Success 1))+-}+instance Injection2 (ValidationMonad err a) (ValidationMonad err a') a a' where+  _I2 = from validationMonad . _I2+  {-# INLINE _I2 #-}++-- Isomorphism between @Either err a@ and @ValidationMonad err a@.+eitherValidationMonad :: Iso' (Either err a) (ValidationMonad err a)+eitherValidationMonad = from Validation.either . validationMonad+{-# INLINE eitherValidationMonad #-}++{- |+>>> import Control.Lens(view)+>>> view getValidationMonadT (Success 1 :: Validation String Int)+ValidationMonadT (Identity (Success 1))+-}+instance GetValidationMonadT (Validation err a) err Identity a where+  getValidationMonadT = validationMonad+  {-# INLINE getValidationMonadT #-}++{- |+>>> import Control.Lens(view)+>>> view validationMonadT (Success 1 :: Validation String Int)+ValidationMonadT (Identity (Success 1))+-}+instance HasValidationMonadT (Validation err a) err Identity a where+  validationMonadT = validationMonad+  {-# INLINE validationMonadT #-}++{- |+>>> import Control.Lens(review)+>>> review reviewValidationMonadT (ValidationMonadT (Identity (Success 1))) :: Validation String Int+Success 1+-}+instance ReviewValidationMonadT (Validation err a) err Identity a where+  reviewValidationMonadT = validationMonad+  {-# INLINE reviewValidationMonadT #-}++{- |+>>> import Control.Lens((^?))+>>> (Success 1 :: Validation String Int) ^? _ValidationMonadT+Just (ValidationMonadT (Identity (Success 1)))+-}+instance AsValidationMonadT (Validation err a) err Identity a where+  _ValidationMonadT = validationMonad+  {-# INLINE _ValidationMonadT #-}++{- |+>>> import Control.Lens(view)+>>> view getValidation (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+Success 1+-}+instance GetValidation (ValidationMonad err a) err a where+  getValidation = from validationMonad+  {-# INLINE getValidation #-}++{- |+>>> import Control.Lens(view)+>>> view validation (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int)+Success 1+-}+instance HasValidation (ValidationMonad err a) err a where+  validation = from validationMonad+  {-# INLINE validation #-}++{- |+>>> import Control.Lens(review)+>>> review reviewValidation (Success 1 :: Validation String Int) :: ValidationMonadT String [] Int+ValidationMonadT [Success 1]+-}+instance (Applicative m) => ReviewValidation (ValidationMonadT err m a) err a where+  reviewValidation = unto (ValidationMonadT . pure)+  {-# INLINE reviewValidation #-}++{- |+>>> import Control.Lens((^?))+>>> (ValidationMonadT (Identity (Success 1)) :: ValidationMonadT String Identity Int) ^? _Validation+Just (Success 1)+-}+instance AsValidation (ValidationMonad err a) err a where+  _Validation = from validationMonad+  {-# INLINE _Validation #-}++{- |+>>> import Control.Lens(view)+>>> view getValidationMonadT (Left "err" :: Either String Int)+ValidationMonadT (Identity (Failure "err"))++>>> view getValidationMonadT (Right 1 :: Either String Int)+ValidationMonadT (Identity (Success 1))+-}+instance GetValidationMonadT (Either err a) err Identity a where+  getValidationMonadT = eitherValidationMonad+  {-# INLINE getValidationMonadT #-}++{- |+>>> import Control.Lens(view, set)+>>> view validationMonadT (Left "err" :: Either String Int)+ValidationMonadT (Identity (Failure "err"))++>>> set validationMonadT (ValidationMonadT (Identity (Success 2))) (Left "err" :: Either String Int)+Right 2+-}+instance HasValidationMonadT (Either err a) err Identity a where+  validationMonadT = eitherValidationMonad+  {-# INLINE validationMonadT #-}++{- |+>>> import Control.Lens(review)+>>> review reviewValidationMonadT (ValidationMonadT (Identity (Success 1))) :: Either String Int+Right 1++>>> review reviewValidationMonadT (ValidationMonadT (Identity (Failure "err"))) :: Either String Int+Left "err"+-}+instance ReviewValidationMonadT (Either err a) err Identity a where+  reviewValidationMonadT = eitherValidationMonad+  {-# INLINE reviewValidationMonadT #-}++{- |+>>> import Control.Lens((^?))+>>> (Left "err" :: Either String Int) ^? _ValidationMonadT+Just (ValidationMonadT (Identity (Failure "err")))++>>> (Right 1 :: Either String Int) ^? _ValidationMonadT+Just (ValidationMonadT (Identity (Success 1)))+-}+instance AsValidationMonadT (Either err a) err Identity a where+  _ValidationMonadT = eitherValidationMonad+  {-# INLINE _ValidationMonadT #-}

@@ -0,0 +1,2061 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++module Data.Validation.Validator (+  -- * Accumulating, Bifunctor parameter order+  Validator (..),++  -- * Accumulating, Profunctor parameter order+  ValidatorProfunctor (..),++  -- * Short-circuiting monad, MonadTrans parameter order+  ValidatorMonadT (..),+  ValidatorMonad,++  -- * Short-circuiting monad, Profunctor parameter order+  ValidatorMonadProfunctorT (..),+  ValidatorMonadProfunctor,++  -- * Optics — Validator++  -- ** Classy lenses+  GetValidator (..),+  HasValidator (..),++  -- ** Classy prisms+  ReviewValidator (..),+  AsValidator (..),++  -- * Optics — ValidatorProfunctor++  -- ** Classy lenses+  GetValidatorProfunctor (..),+  HasValidatorProfunctor (..),++  -- ** Classy prisms+  ReviewValidatorProfunctor (..),+  AsValidatorProfunctor (..),++  -- * Optics — ValidatorMonadT++  -- ** Classy lenses+  GetValidatorMonadT (..),+  HasValidatorMonadT (..),++  -- ** Classy prisms+  ReviewValidatorMonadT (..),+  AsValidatorMonadT (..),++  -- * Optics — ValidatorMonadProfunctorT++  -- ** Classy lenses+  GetValidatorMonadProfunctorT (..),+  HasValidatorMonadProfunctorT (..),++  -- ** Classy prisms+  ReviewValidatorMonadProfunctorT (..),+  AsValidatorMonadProfunctorT (..),++  -- * Constructing validators from prisms+  (-->),+  match,+  matchValidator,+  matchValidatorProfunctor,+  matchValidatorMonad,+  matchValidatorMonadProfunctor,++  -- * Constructing prisms from validators+  (<--),+  unmatch,+) where++import Control.Applicative (Alternative (empty, (<|>)))+import Control.Arrow (Arrow (arr, first), ArrowApply (app), ArrowChoice (left, right), ArrowPlus ((<+>)), ArrowZero (zeroArrow))+import Control.Category (Category (..))+import Control.Lens (APrism, AReview, Getter, Lens', Prism, Prism', Review, Rewrapped, Wrapped (_Wrapped', type Unwrapped), from, matching, prism, review, unto, view)+import Control.Lens.Iso (Iso', iso, mapping)+import Control.Monad (MonadPlus, ap, (>=>))+import Control.Monad.Cont.Class (MonadCont (callCC))+import Control.Monad.Error.Class (MonadError (catchError, throwError))+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.RWS.Class (MonadRWS)+import Control.Monad.Reader.Class (MonadReader (ask, local, reader))+import Control.Monad.State.Class (MonadState (get, put, state))+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.Writer.Class (MonadWriter (listen, pass, tell, writer))+import Control.Selective (Selective (..), selectM)+import Data.Bifunctor (Bifunctor (bimap))+import Data.Bifunctor.Swap (Swap (..))+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Bind (Bind ((>>-)))+import Data.Functor.Bind.Trans (BindTrans (liftB))+import Data.Functor.Extend (Extend (extended))+import Data.Functor.Identity (Identity (..))+import Data.Functor.Plus (Plus (zero))+import Data.Profunctor (Choice (left', right'), Profunctor (dimap, lmap, rmap), Strong (first', second'))+import Data.Profunctor.Sieve (Sieve (sieve))+import Data.Profunctor.Traversing (Traversing (traverse', wander))+import Data.Semigroupoid (Semigroupoid (o))+import Data.Validation.Validation (Validation (..))+import qualified Data.Validation.Validation as Validation+import Data.Validation.ValidationMonad (ValidationMonadT (..), liftValidationMonadT, validationMonad)+import GHC.Generics (Generic)+import Prelude hiding (id, (.))++{- $setup+>>> import Data.Validation.Validation(Validation(..))+>>> import Data.Validation.ValidationMonad(ValidationMonadT(..))+>>> import Data.Validation.Validator+>>> import Data.Functor.Identity(Identity(..))+>>> import Data.Functor.Alt(Alt((<!>)))+>>> import Data.Functor.Apply(Apply((<.>)))+>>> import Data.Functor.Bind(Bind((>>-)))+>>> import Data.Functor.Extend(Extend(extended))+>>> import Data.Functor.Plus(Plus(zero))+>>> import Data.Bifunctor(Bifunctor(bimap))+>>> import Data.Bifunctor.Swap(Swap(swap))+>>> import Data.Profunctor(Profunctor(dimap, lmap, rmap), Strong(first', second'), Choice(left', right'))+>>> import Data.Profunctor.Sieve(Sieve(sieve))+>>> import Data.Profunctor.Traversing(Traversing(traverse'))+>>> import Data.Semigroupoid(Semigroupoid(o))+>>> import Control.Category(id, (.))+>>> import Control.Arrow(Arrow(arr, first), ArrowApply(app), ArrowChoice(left, right), ArrowZero(zeroArrow), ArrowPlus((<+>)))+>>> import Control.Applicative(Alternative(empty))+>>> import Control.Selective(Selective(select))+>>> import Control.Monad.Error.Class(MonadError(throwError, catchError))+>>> import Control.Monad.Trans.Class(MonadTrans(lift))+>>> import Control.Lens(view, review, _Wrapped', (^?), _Just, _Left, _Right)+>>> import Prelude hiding (id, (.))+>>> :set -w+>>> let runV (Validator f) = f+>>> let runVM v x = let ValidatorMonadT f = v in let ValidationMonadT (Identity r) = f x in r+>>> let runVP (ValidatorProfunctor f) = f+>>> let vpOk x = ValidatorProfunctor (\_ -> Success x) :: ValidatorProfunctor [String] Int Int+>>> let vpErr e = ValidatorProfunctor (\_ -> Failure e) :: ValidatorProfunctor [String] Int Int+>>> let vpFromInput = ValidatorProfunctor (\x -> Success (x + 1)) :: ValidatorProfunctor [String] Int Int+>>> let runVMP v x = let ValidatorMonadProfunctorT f = v in let ValidationMonadT (Identity r) = f x in r+>>> let vmpOk a = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (a x)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let vmpSucc a = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Success a))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let vmpErr e = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Failure e))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let vmpFail = vmpErr ["fail"]+-}++-- ========================================+-- Validator (accumulating, Bifunctor order)+-- ========================================++{- | A validator that applies a function @x -> Validation err a@.+The 'Applicative' instance /accumulates/ errors using 'Semigroup', like 'Validation'.++Unlike 'Validation' and the other validators, the 'Alt' instance does /not/+accumulate errors: it behaves like 'Either', returning the first success, or+otherwise the second failure. As a consequence there are no 'Plus' or+'Alternative' instances, and '<>' (which accumulates) differs from '<!>'.++>>> let Validator f = Validator (\x -> if x > 0 then Success x else Failure ["not positive"]) :: Validator Int [String] Int+>>> f 5+Success 5++>>> f (-1)+Failure ["not positive"]+-}+newtype Validator x err a = Validator (x -> Validation err a)+  deriving (Generic)++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let v = Validator (\x -> Success (x + 1)) :: Validator Int [String] Int+>>> (view _Wrapped' v) 10+Success 11+-}+instance Wrapped (Validator x err a) where+  type Unwrapped (Validator x err a) = x -> Validation err a+  _Wrapped' = iso (\(Validator f) -> f) Validator+  {-# INLINE _Wrapped' #-}++instance Rewrapped (Validator x err a) (Validator x' err' b)++{- |+>>> let Validator f = fmap (+1) (Validator Success :: Validator Int [String] Int)+>>> f 10+Success 11++>>> let Validator f = fmap (+1) (Validator (\_ -> Failure ["err"]) :: Validator Int [String] Int)+>>> f 10+Failure ["err"]+-}+instance Functor (Validator x err) where+  fmap f (Validator g) = Validator (fmap (fmap f) g)+  {-# INLINE fmap #-}++{- | Accumulates errors using 'Semigroup'.++>>> import Data.Functor.Apply(Apply((<.>)))+>>> let Validator f = Validator (\_ -> Success (+1)) <.> (Validator Success :: Validator Int [String] Int)+>>> f 10+Success 11++>>> let Validator f = (Validator (\_ -> Failure ["e1"]) :: Validator Int [String] (Int -> Int)) <.> (Validator (\_ -> Failure ["e2"]) :: Validator Int [String] Int)+>>> f 0+Failure ["e1","e2"]+-}+instance (Semigroup err) => Apply (Validator x err) where+  Validator f <.> Validator g = Validator (\x -> f x <.> g x)+  {-# INLINE (<.>) #-}++{- | Accumulates errors using 'Semigroup'.++>>> let Validator f = pure 42 :: Validator Int [String] Int+>>> f 0+Success 42++>>> let Validator f = pure (+) <*> (Validator (\_ -> Failure ["e1"]) :: Validator Int [String] Int) <*> (Validator (\_ -> Failure ["e2"]) :: Validator Int [String] Int)+>>> f 0+Failure ["e1","e2"]+-}+instance (Semigroup err) => Applicative (Validator x err) where+  pure a = Validator (\_ -> Success a)+  {-# INLINE pure #-}+  Validator f <*> Validator g = Validator (\x -> f x <.> g x)+  {-# INLINE (<*>) #-}++{- | First success wins, like 'Either'; if both fail, the second failure is returned.+Errors are not accumulated, so no 'Semigroup' constraint is required.++This differs from the 'Alt' instances for 'Validation', 'ValidatorProfunctor',+'ValidatorMonadT' and 'ValidatorMonadProfunctorT', which all accumulate errors+when both sides fail. Converting a 'Validator' to one of those types (for+example with 'validatorProfunctor') therefore changes the meaning of '<!>'.+Use '<>' to accumulate errors from two 'Validator's.++>>> import Data.Functor.Alt(Alt((<!>)))+>>> let Validator f = (Validator (\_ -> Success 1) :: Validator Int [String] Int) <!> Validator (\_ -> Success 2)+>>> f 0+Success 1++>>> let Validator f = (Validator (\_ -> Success 1) :: Validator Int [String] Int) <!> Validator (\_ -> Failure ["e2"])+>>> f 0+Success 1++>>> let Validator f = (Validator (\_ -> Failure ["e1"]) :: Validator Int [String] Int) <!> Validator (\_ -> Success 2)+>>> f 0+Success 2++>>> let Validator f = (Validator (\_ -> Failure ["e1"]) :: Validator Int [String] Int) <!> Validator (\_ -> Failure ["e2"])+>>> f 0+Failure ["e2"]++>>> let Validator f = (Validator (\_ -> Failure 1) :: Validator Int Int Int) <!> Validator (\_ -> Failure 2)+>>> f 0+Failure 2+-}+instance Alt (Validator x err) where+  Validator f <!> Validator g =+    Validator+      ( \x -> case f x of+          Failure _ -> g x+          s@(Success _) -> s+      )+  {-# INLINE (<!>) #-}++{- |+>>> import Control.Selective(Selective(select))+>>> let Validator f = select (Validator (\_ -> Success (Right 1)) :: Validator Int [String] (Either Int Int)) (pure (+1))+>>> f 0+Success 1++>>> let Validator f = select (Validator (\_ -> Success (Left 1)) :: Validator Int [String] (Either Int Int)) (pure (+1))+>>> f 0+Success 2+-}+instance (Semigroup err) => Selective (Validator x err) where+  select (Validator f) (Validator g) = Validator (\x -> select (f x) (g x))+  {-# INLINE select #-}++{- |+>>> import Data.Bifunctor(Bifunctor(bimap))+>>> let Validator f = bimap (map (++ "!")) (+1) (Validator Success :: Validator Int [String] Int)+>>> f 10+Success 11++>>> let Validator f = bimap (map (++ "!")) (+1) (Validator (\_ -> Failure ["err"]) :: Validator Int [String] Int)+>>> f 0+Failure ["err!"]+-}+instance Bifunctor (Validator x) where+  bimap f g (Validator h) = Validator (bimap f g . h)+  {-# INLINE bimap #-}++{- |+>>> import Data.Bifunctor.Swap(Swap(swap))+>>> let Validator f = swap (Validator (\_ -> Failure "err") :: Validator Int String Int)+>>> f 0+Success "err"++>>> let Validator f = swap (Validator (\_ -> Success 1) :: Validator Int String Int)+>>> f 0+Failure 1+-}+instance Swap (Validator x) where+  swap (Validator f) = Validator (swap . f)+  {-# INLINE swap #-}++{- | Like 'Validation', a failure is kept: for each input, the result fails+where the validator fails, and otherwise succeeds with @f@ applied to the validator.++>>> import Data.Functor.Extend(Extend(extended))+>>> let Validator f = extended (\_ -> 42) (Validator (\_ -> Success 1) :: Validator Int [String] Int)+>>> f 0+Success 42++>>> let Validator f = extended (\_ -> 42) (Validator (\x -> if x > 0 then Success x else Failure ["not positive"]) :: Validator Int [String] Int)+>>> f 5+Success 42++>>> f (-1)+Failure ["not positive"]+-}+instance Extend (Validator x err) where+  extended f w@(Validator g) = Validator (\x -> f w <$ g x)+  {-# INLINE extended #-}++{- | First success wins; two failures accumulate. Unlike '<!>' for 'Validator',+this requires 'Semigroup' on @err@.++>>> let Validator f = (Validator (\_ -> Failure ["e1"]) :: Validator Int [String] Int) <> Validator (\_ -> Failure ["e2"])+>>> f 0+Failure ["e1","e2"]++>>> let Validator f = (Validator (\_ -> Success 1) :: Validator Int [String] Int) <> Validator (\_ -> Failure ["e2"])+>>> f 0+Success 1+-}+instance (Semigroup err) => Semigroup (Validator x err a) where+  Validator f <> Validator g = Validator (\x -> f x <> g x)+  {-# INLINE (<>) #-}++{- |+>>> let Validator f = mempty :: Validator Int [String] Int+>>> f 0+Failure []+-}+instance (Monoid err) => Monoid (Validator x err a) where+  mempty = Validator (const mempty)+  {-# INLINE mempty #-}++{- | Class for types that have a 'Getter' to a 'Validator'.++>>> import Control.Lens(view)+>>> let Validator f = view getValidator (Validator (\_ -> Success 1) :: Validator Int [String] Int)+>>> f 0+Success 1+-}+class GetValidator s x err a | s -> x err a where+  getValidator :: Getter s (Validator x err a)++instance GetValidator (Validator x err a) x err a where+  getValidator = id+  {-# INLINE getValidator #-}++{- | Class for types that have a 'Lens'' to a 'Validator'.++>>> import Control.Lens(view)+>>> let Validator f = view validator (Validator (\_ -> Success 1) :: Validator Int [String] Int)+>>> f 0+Success 1+-}+class (GetValidator s x err a) => HasValidator s x err a | s -> x err a where+  validator :: Lens' s (Validator x err a)++instance HasValidator (Validator x err a) x err a where+  validator = id+  {-# INLINE validator #-}++-- | Class for types that have a 'Review' to a 'Validator'.+class ReviewValidator s x err a | s -> x err a where+  reviewValidator :: Review s (Validator x err a)++instance ReviewValidator (Validator x err a) x err a where+  reviewValidator = id+  {-# INLINE reviewValidator #-}++-- | Class for types that have a 'Prism'' to a 'Validator'.+class (ReviewValidator s x err a) => AsValidator s x err a | s -> x err a where+  _Validator :: Prism' s (Validator x err a)++instance AsValidator (Validator x err a) x err a where+  _Validator = id+  {-# INLINE _Validator #-}++-- =============================================+-- ValidatorProfunctor (accumulating, Profunctor order)+-- =============================================++{- | A validator function @x -> Validation err a@ with @err@ as the+outermost parameter, enabling 'Profunctor' and related instances.++>>> runVP (ValidatorProfunctor (\x -> Success (x * 2))) 5+Success 10++>>> runVP (ValidatorProfunctor (\_ -> Failure ["bad"])) 5+Failure ["bad"]+-}+newtype ValidatorProfunctor err x a = ValidatorProfunctor (x -> Validation err a)+  deriving (Generic)++{- |+>>> view _Wrapped' vpFromInput $ 3+Success 4+-}+instance Wrapped (ValidatorProfunctor err x a) where+  type Unwrapped (ValidatorProfunctor err x a) = x -> Validation err a+  _Wrapped' = iso (\(ValidatorProfunctor f) -> f) ValidatorProfunctor+  {-# INLINE _Wrapped' #-}++instance Rewrapped (ValidatorProfunctor err x a) (ValidatorProfunctor err' x' b)++{- |+>>> runVP (fmap (+10) vpFromInput) 3+Success 14++>>> runVP (fmap (+10) (vpErr ["e"])) 3+Failure ["e"]+-}+instance Functor (ValidatorProfunctor err x) where+  fmap f (ValidatorProfunctor g) = ValidatorProfunctor (fmap (fmap f) g)+  {-# INLINE fmap #-}++{- | Accumulates errors from both sides.++>>> runVP (ValidatorProfunctor (\_ -> Success (+1)) <.> vpOk 2 :: ValidatorProfunctor [String] Int Int) 0+Success 3++>>> runVP (ValidatorProfunctor (\_ -> Failure ["e1"]) <.> ValidatorProfunctor (\_ -> Failure ["e2"]) :: ValidatorProfunctor [String] Int Int) 0+Failure ["e1","e2"]++>>> runVP (ValidatorProfunctor (\_ -> Failure ["e1"]) <.> vpOk 2 :: ValidatorProfunctor [String] Int Int) 0+Failure ["e1"]++>>> runVP (ValidatorProfunctor (\_ -> Success (+1)) <.> vpErr ["e2"] :: ValidatorProfunctor [String] Int Int) 0+Failure ["e2"]+-}+instance (Semigroup err) => Apply (ValidatorProfunctor err x) where+  ValidatorProfunctor f <.> ValidatorProfunctor g = ValidatorProfunctor (\x -> f x <.> g x)+  {-# INLINE (<.>) #-}++{- | 'pure' ignores the input, '<*>' accumulates errors.++>>> runVP (pure 42 :: ValidatorProfunctor [String] Int Int) 0+Success 42++>>> runVP (pure (+1) <*> pure 2 :: ValidatorProfunctor [String] Int Int) 0+Success 3++>>> runVP (ValidatorProfunctor (\_ -> Failure ["e1"]) <*> ValidatorProfunctor (\_ -> Failure ["e2"]) :: ValidatorProfunctor [String] Int Int) 0+Failure ["e1","e2"]+-}+instance (Semigroup err) => Applicative (ValidatorProfunctor err x) where+  pure a = ValidatorProfunctor (\_ -> Success a)+  {-# INLINE pure #-}+  ValidatorProfunctor f <*> ValidatorProfunctor g = ValidatorProfunctor (\x -> f x <.> g x)+  {-# INLINE (<*>) #-}++{- | First success wins; two failures accumulate.++>>> runVP (vpOk 1 <!> vpOk 2) 0+Success 1++>>> runVP (vpErr ["e1"] <!> vpOk 2) 0+Success 2++>>> runVP (vpOk 1 <!> vpErr ["e2"]) 0+Success 1++>>> runVP (vpErr ["e1"] <!> vpErr ["e2"]) 0+Failure ["e1","e2"]+-}+instance (Semigroup err) => Alt (ValidatorProfunctor err x) where+  ValidatorProfunctor f <!> ValidatorProfunctor g = ValidatorProfunctor (\x -> f x <!> g x)+  {-# INLINE (<!>) #-}++{- |+>>> runVP (zero :: ValidatorProfunctor [String] Int Int) 0+Failure []+-}+instance (Monoid err) => Plus (ValidatorProfunctor err x) where+  zero = ValidatorProfunctor (\_ -> Failure mempty)+  {-# INLINE zero #-}++{- |+>>> runVP (empty :: ValidatorProfunctor [String] Int Int) 0+Failure []++>>> runVP (vpErr ["e1"] <|> vpOk 2) 0+Success 2+-}+instance (Monoid err) => Alternative (ValidatorProfunctor err x) where+  empty = zero+  {-# INLINE empty #-}+  (<|>) = (<!>)+  {-# INLINE (<|>) #-}++{- |+>>> runVP (select (pure (Right 1)) (pure (+1)) :: ValidatorProfunctor [String] Int Int) 0+Success 1++>>> runVP (select (pure (Left 1)) (pure (+1)) :: ValidatorProfunctor [String] Int Int) 0+Success 2++>>> runVP (select (ValidatorProfunctor (\_ -> Failure ["e1"])) (pure (+1)) :: ValidatorProfunctor [String] Int Int) 0+Failure ["e1"]+-}+instance (Semigroup err) => Selective (ValidatorProfunctor err x) where+  select (ValidatorProfunctor f) (ValidatorProfunctor g) = ValidatorProfunctor (\x -> select (f x) (g x))+  {-# INLINE select #-}++{- | Contravariant in @x@, covariant in @a@.++>>> runVP (dimap (*2) (+10) vpFromInput) 3+Success 17++>>> runVP (lmap (*2) vpFromInput) 3+Success 7++>>> runVP (rmap (+10) vpFromInput) 3+Success 14+-}+instance Profunctor (ValidatorProfunctor err) where+  dimap f g (ValidatorProfunctor h) = ValidatorProfunctor (fmap g . h . f)+  {-# INLINE dimap #-}+  lmap f (ValidatorProfunctor h) = ValidatorProfunctor (h . f)+  {-# INLINE lmap #-}+  rmap g (ValidatorProfunctor h) = ValidatorProfunctor (fmap g . h)+  {-# INLINE rmap #-}++{- |+>>> runVP (first' vpFromInput) (3, "tag")+Success (4,"tag")++>>> runVP (second' vpFromInput) ("tag", 3)+Success ("tag",4)+-}+instance Strong (ValidatorProfunctor err) where+  first' (ValidatorProfunctor f) = ValidatorProfunctor (\(a, c) -> fmap (,c) (f a))+  {-# INLINE first' #-}+  second' (ValidatorProfunctor f) = ValidatorProfunctor (\(c, a) -> fmap (c,) (f a))+  {-# INLINE second' #-}++{- |+>>> runVP (left' vpFromInput) (Left 3)+Success (Left 4)++>>> runVP (left' vpFromInput) (Right "x" :: Either Int String)+Success (Right "x")++>>> runVP (right' vpFromInput) (Right 3)+Success (Right 4)++>>> runVP (right' vpFromInput) (Left "x" :: Either String Int)+Success (Left "x")+-}+instance Choice (ValidatorProfunctor err) where+  left' (ValidatorProfunctor f) = ValidatorProfunctor (either (fmap Left . f) (Success . Right))+  {-# INLINE left' #-}+  right' (ValidatorProfunctor f) = ValidatorProfunctor (either (Success . Left) (fmap Right . f))+  {-# INLINE right' #-}++{- |+>>> runVP (traverse' vpFromInput) [1, 2, 3]+Success [2,3,4]+-}+instance (Semigroup err) => Traversing (ValidatorProfunctor err) where+  traverse' (ValidatorProfunctor f) = ValidatorProfunctor (traverse f)+  {-# INLINE traverse' #-}+  wander t (ValidatorProfunctor f) = ValidatorProfunctor (t f)+  {-# INLINE wander #-}++{- |+>>> sieve vpFromInput 3+Success 4++>>> sieve (vpErr ["e"]) 0+Failure ["e"]+-}+instance Sieve (ValidatorProfunctor err) (Validation err) where+  sieve (ValidatorProfunctor f) = f+  {-# INLINE sieve #-}++{- | Like 'Validation', a failure is kept: for each input, the result fails+where the validator fails, and otherwise succeeds with @f@ applied to the validator.++>>> runVP (extended (\_ -> 42) vpFromInput) 0+Success 42++>>> runVP (extended (\_ -> 42) (vpErr ["e"])) 0+Failure ["e"]+-}+instance Extend (ValidatorProfunctor err x) where+  extended f w@(ValidatorProfunctor g) = ValidatorProfunctor (\x -> f w <$ g x)+  {-# INLINE extended #-}++{- |+>>> runVP (vpOk 1 <> vpOk 2) 0+Success 1++>>> runVP (vpErr ["e1"] <> vpErr ["e2"]) 0+Failure ["e1","e2"]++>>> runVP (vpErr ["e1"] <> vpOk 2) 0+Success 2+-}+instance (Semigroup err) => Semigroup (ValidatorProfunctor err x a) where+  ValidatorProfunctor f <> ValidatorProfunctor g = ValidatorProfunctor (\x -> f x <> g x)+  {-# INLINE (<>) #-}++{- |+>>> runVP (mempty :: ValidatorProfunctor [String] Int Int) 0+Failure []+-}+instance (Monoid err) => Monoid (ValidatorProfunctor err x a) where+  mempty = ValidatorProfunctor (const mempty)+  {-# INLINE mempty #-}++{- |+>>> runVP (view getValidatorProfunctor vpFromInput) 3+Success 4+-}+class GetValidatorProfunctor s err x a | s -> err x a where+  getValidatorProfunctor :: Getter s (ValidatorProfunctor err x a)++instance GetValidatorProfunctor (ValidatorProfunctor err x a) err x a where+  getValidatorProfunctor = id+  {-# INLINE getValidatorProfunctor #-}++{- |+>>> runVP (view validatorProfunctor vpFromInput) 3+Success 4+-}+class (GetValidatorProfunctor s err x a) => HasValidatorProfunctor s err x a | s -> err x a where+  validatorProfunctor :: Lens' s (ValidatorProfunctor err x a)++instance HasValidatorProfunctor (ValidatorProfunctor err x a) err x a where+  validatorProfunctor = id+  {-# INLINE validatorProfunctor #-}++{- |+>>> runVP (review reviewValidatorProfunctor vpFromInput) 3+Success 4+-}+class ReviewValidatorProfunctor s err x a | s -> err x a where+  reviewValidatorProfunctor :: Review s (ValidatorProfunctor err x a)++instance ReviewValidatorProfunctor (ValidatorProfunctor err x a) err x a where+  reviewValidatorProfunctor = id+  {-# INLINE reviewValidatorProfunctor #-}++{- |+>>> let v = review _ValidatorProfunctor vpFromInput :: ValidatorProfunctor [String] Int Int+>>> runVP v 3+Success 4+-}+class (ReviewValidatorProfunctor s err x a) => AsValidatorProfunctor s err x a | s -> err x a where+  _ValidatorProfunctor :: Prism' s (ValidatorProfunctor err x a)++instance AsValidatorProfunctor (ValidatorProfunctor err x a) err x a where+  _ValidatorProfunctor = id+  {-# INLINE _ValidatorProfunctor #-}++-- ==============================================+-- ValidatorMonadT (short-circuiting, MonadTrans order)+-- ==============================================++{- | A validator with short-circuiting 'Monad' and 'MonadTrans' instances.+The parameter order @x err f a@ enables 'MonadTrans' on @ValidatorMonadT x err@.++>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> let v = ValidatorMonadT (\x -> ValidationMonadT (Identity (if x > 0 then Success x else Failure ["non-positive"])))+>>> let ValidatorMonadT f = v in let ValidationMonadT (Identity r) = f 5 in r+Success 5++>>> let ValidatorMonadT f = v in let ValidationMonadT (Identity r) = f (-1) in r+Failure ["non-positive"]+-}+newtype ValidatorMonadT x err f a = ValidatorMonadT (x -> ValidationMonadT err f a)+  deriving (Generic)++-- | @ValidatorMonad x err a@ is @ValidatorMonadT x err Identity a@.+type ValidatorMonad x err a = ValidatorMonadT x err Identity a++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Control.Lens (view, _Wrapped')+>>> let v = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int String Identity Int+>>> view _Wrapped' v $ 0+ValidationMonadT (Identity (Success 1))+-}+instance Wrapped (ValidatorMonadT x err f a) where+  type Unwrapped (ValidatorMonadT x err f a) = x -> ValidationMonadT err f a+  _Wrapped' = iso (\(ValidatorMonadT f) -> f) ValidatorMonadT+  {-# INLINE _Wrapped' #-}++instance Rewrapped (ValidatorMonadT x err f a) (ValidatorMonadT x' err' f' b)++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> let v = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = fmap (+1) v in let ValidationMonadT (Identity r) = f 0 in r+Success 2+-}+instance (Functor f) => Functor (ValidatorMonadT x err f) where+  fmap f (ValidatorMonadT g) = ValidatorMonadT (fmap (fmap f) g)+  {-# INLINE fmap #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Data.Functor.Apply ((<.>))+>>> let f = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success (+1)))) :: ValidatorMonadT Int [String] Identity (Int -> Int)+>>> let a = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 2))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT g = f <.> a in let ValidationMonadT (Identity r) = g 0 in r+Success 3+-}+instance (Monad f) => Apply (ValidatorMonadT x err f) where+  (<.>) = ap+  {-# INLINE (<.>) #-}++{- | Short-circuits on first failure (unlike 'Validation' which accumulates).++>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> let e1 = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadT Int [String] Identity (Int -> Int)+>>> let e2 = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e2"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = e1 <*> e2 in let ValidationMonadT (Identity r) = f 0 in r+Failure ["e1"]+-}+instance (Monad f) => Applicative (ValidatorMonadT x err f) where+  pure a = ValidatorMonadT (\_ -> pure a)+  {-# INLINE pure #-}+  ValidatorMonadT f <*> ValidatorMonadT g = ValidatorMonadT (\x -> f x <*> g x)+  {-# INLINE (<*>) #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Data.Functor.Bind ((>>-))+>>> let v = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = v >>- \a -> ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success (a + 1)))) in let ValidationMonadT (Identity r) = f 0 in r+Success 2+-}+instance (Monad f) => Bind (ValidatorMonadT x err f) where+  (>>-) = (>>=)+  {-# INLINE (>>-) #-}++{- | Short-circuits on 'Failure'.++>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> let e1 = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let e2 = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e2"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = e1 >> e2 in let ValidationMonadT (Identity r) = f 0 in r+Failure ["e1"]+-}+instance (Monad f) => Monad (ValidatorMonadT x err f) where+  ValidatorMonadT f >>= k = ValidatorMonadT (\x -> f x >>= \a -> let ValidatorMonadT g = k a in g x)+  {-# INLINE (>>=) #-}++instance (MonadFail f) => MonadFail (ValidatorMonadT x err f) where+  fail = ValidatorMonadT . const . liftValidationMonadT . Prelude.fail+  {-# INLINE fail #-}++{- | First success wins; two failures accumulate.++>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Data.Functor.Alt ((<!>))+>>> let e1 = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let ok = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 2))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = e1 <!> ok in let ValidationMonadT (Identity r) = f 0 in r+Success 2+-}+instance (Monad f, Semigroup err) => Alt (ValidatorMonadT x err f) where+  ValidatorMonadT f <!> ValidatorMonadT g = ValidatorMonadT (\x -> f x <!> g x)+  {-# INLINE (<!>) #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Data.Functor.Alt ((<!>))+>>> import Data.Functor.Plus (zero)+>>> let ok = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = (zero :: ValidatorMonadT Int [String] Identity Int) <!> ok in let ValidationMonadT (Identity r) = f 0 in r+Success 1+-}+instance (Monad f, Monoid err) => Plus (ValidatorMonadT x err f) where+  zero = ValidatorMonadT (const zero)+  {-# INLINE zero #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> let ok = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = empty <|> ok in let ValidationMonadT (Identity r) = f 0 in r+Success 1+-}+instance (Monad f, Monoid err) => Alternative (ValidatorMonadT x err f) where+  empty = zero+  {-# INLINE empty #-}+  (<|>) = (<!>)+  {-# INLINE (<|>) #-}++instance (Monad f, Monoid err) => MonadPlus (ValidatorMonadT x err f)++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Control.Selective (select)+>>> let ok a = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success a)))+>>> let ValidatorMonadT f = select (ok (Left (1 :: Int))) (ok (+1)) :: ValidatorMonadT Int [String] Identity Int in let ValidationMonadT (Identity r) = f 0 in r+Success 2+-}+instance (Monad f) => Selective (ValidatorMonadT x err f) where+  select = selectM+  {-# INLINE select #-}++{- | Like 'Validation', a failure is kept: for each input, the result fails+where the validator fails, and otherwise succeeds with @f@ applied to the validator.+The effects of the validator are run.++>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Data.Functor.Extend (extended)+>>> let v = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = extended (\_ -> 42) v in let ValidationMonadT (Identity r) = f 0 in r+Success 42++>>> let e = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = extended (\_ -> 42) e in let ValidationMonadT (Identity r) = f 0 in r+Failure ["e"]+-}+instance (Functor f) => Extend (ValidatorMonadT x err f) where+  extended f w@(ValidatorMonadT g) = ValidatorMonadT (\x -> f w <$ g x)+  {-# INLINE extended #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> let e1 = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let e2 = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e2"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = e1 <> e2 in let ValidationMonadT (Identity r) = f 0 in r+Failure ["e1","e2"]+-}+instance (Applicative f, Semigroup err) => Semigroup (ValidatorMonadT x err f a) where+  ValidatorMonadT f <> ValidatorMonadT g = ValidatorMonadT (\x -> f x <> g x)+  {-# INLINE (<>) #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> let ValidatorMonadT f = mempty :: ValidatorMonadT Int [String] Identity Int in let ValidationMonadT (Identity r) = f 0 in r+Failure []+-}+instance (Applicative f, Monoid err) => Monoid (ValidatorMonadT x err f a) where+  mempty = ValidatorMonadT (const mempty)+  {-# INLINE mempty #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Control.Monad.Trans.Class (lift)+>>> let ValidatorMonadT f = lift (Identity 42) :: ValidatorMonadT Int [String] Identity Int in let ValidationMonadT (Identity r) = f 0 in r+Success 42+-}+instance MonadTrans (ValidatorMonadT x err) where+  lift = ValidatorMonadT . const . liftValidationMonadT+  {-# INLINE lift #-}++instance BindTrans (ValidatorMonadT x err) where+  liftB = ValidatorMonadT . const . liftValidationMonadT+  {-# INLINE liftB #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Control.Monad.Error.Class (throwError, catchError)+>>> let ValidatorMonadT f = throwError ["oops"] :: ValidatorMonadT Int [String] Identity Int in let ValidationMonadT (Identity r) = f 0 in r+Failure ["oops"]++>>> let e = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Failure ["e"]))) :: ValidatorMonadT Int [String] Identity Int+>>> let ValidatorMonadT f = catchError e (\_ -> ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 99)))) in let ValidationMonadT (Identity r) = f 0 in r+Success 99+-}+instance (Monad f) => MonadError err (ValidatorMonadT x err f) where+  throwError e = ValidatorMonadT (\_ -> throwError e)+  {-# INLINE throwError #-}+  catchError (ValidatorMonadT f) h = ValidatorMonadT (\x -> catchError (f x) (\e -> let ValidatorMonadT g = h e in g x))+  {-# INLINE catchError #-}++instance (MonadIO f) => MonadIO (ValidatorMonadT x err f) where+  liftIO = ValidatorMonadT . const . liftValidationMonadT . liftIO+  {-# INLINE liftIO #-}++instance (MonadReader r f) => MonadReader r (ValidatorMonadT x err f) where+  ask = ValidatorMonadT (\_ -> liftValidationMonadT ask)+  {-# INLINE ask #-}+  local f (ValidatorMonadT g) = ValidatorMonadT (local f . g)+  {-# INLINE local #-}+  reader = ValidatorMonadT . const . liftValidationMonadT . reader+  {-# INLINE reader #-}++instance (MonadWriter w f) => MonadWriter w (ValidatorMonadT x err f) where+  writer = ValidatorMonadT . const . liftValidationMonadT . writer+  {-# INLINE writer #-}+  tell = ValidatorMonadT . const . liftValidationMonadT . tell+  {-# INLINE tell #-}+  listen (ValidatorMonadT f) = ValidatorMonadT (listen . f)+  {-# INLINE listen #-}+  pass (ValidatorMonadT f) = ValidatorMonadT (pass . f)+  {-# INLINE pass #-}++instance (MonadState s f) => MonadState s (ValidatorMonadT x err f) where+  get = ValidatorMonadT (\_ -> liftValidationMonadT get)+  {-# INLINE get #-}+  put = ValidatorMonadT . const . liftValidationMonadT . put+  {-# INLINE put #-}+  state = ValidatorMonadT . const . liftValidationMonadT . state+  {-# INLINE state #-}++instance (MonadCont f) => MonadCont (ValidatorMonadT x err f) where+  callCC f = ValidatorMonadT (\x -> callCC (\c -> let ValidatorMonadT g = f (\a -> ValidatorMonadT (\_ -> c a)) in g x))+  {-# INLINE callCC #-}++instance (MonadRWS r w s f) => MonadRWS r w s (ValidatorMonadT x err f)++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Control.Lens (view)+>>> let v = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int String Identity Int+>>> let ValidatorMonadT f = view getValidatorMonadT v in let ValidationMonadT (Identity r) = f 0 in r+Success 1+-}+class GetValidatorMonadT s x err f a | s -> x err f a where+  getValidatorMonadT :: Getter s (ValidatorMonadT x err f a)++instance GetValidatorMonadT (ValidatorMonadT x err f a) x err f a where+  getValidatorMonadT = id+  {-# INLINE getValidatorMonadT #-}++{- |+>>> import Data.Functor.Identity (Identity(..))+>>> import Data.Validation.Validation (Validation(..))+>>> import Data.Validation.ValidationMonad (ValidationMonadT(..))+>>> import Control.Lens (view)+>>> let v = ValidatorMonadT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadT Int String Identity Int+>>> let ValidatorMonadT f = view validatorMonadT v in let ValidationMonadT (Identity r) = f 0 in r+Success 1+-}+class (GetValidatorMonadT s x err f a) => HasValidatorMonadT s x err f a | s -> x err f a where+  validatorMonadT :: Lens' s (ValidatorMonadT x err f a)++instance HasValidatorMonadT (ValidatorMonadT x err f a) x err f a where+  validatorMonadT = id+  {-# INLINE validatorMonadT #-}++class ReviewValidatorMonadT s x err f a | s -> x err f a where+  reviewValidatorMonadT :: Review s (ValidatorMonadT x err f a)++instance ReviewValidatorMonadT (ValidatorMonadT x err f a) x err f a where+  reviewValidatorMonadT = id+  {-# INLINE reviewValidatorMonadT #-}++class (ReviewValidatorMonadT s x err f a) => AsValidatorMonadT s x err f a | s -> x err f a where+  _ValidatorMonadT :: Prism' s (ValidatorMonadT x err f a)++instance AsValidatorMonadT (ValidatorMonadT x err f a) x err f a where+  _ValidatorMonadT = id+  {-# INLINE _ValidatorMonadT #-}++-- =====================================================+-- ValidatorMonadProfunctorT (short-circuiting, Profunctor order)+-- =====================================================++{- | A profunctor validator with short-circuiting monadic semantics.++@ValidatorMonadProfunctorT err f x a@ wraps @x -> ValidationMonadT err f a@.+The @Applicative@ and @Monad@ instances short-circuit on the first 'Failure'.+@Category@ composition sequences validators, short-circuiting on the first failure.++>>> import Control.Lens(view, _Wrapped')+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = (view _Wrapped' v) 3+>>> r+Success 4+-}+newtype ValidatorMonadProfunctorT err f x a = ValidatorMonadProfunctorT (x -> ValidationMonadT err f a)+  deriving (Generic)++-- | @ValidatorMonadProfunctor@ is @ValidatorMonadProfunctorT@ specialised to 'Identity'.+type ValidatorMonadProfunctor err x a = ValidatorMonadProfunctorT err Identity x a++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> view _Wrapped' v 3+ValidationMonadT (Identity (Success 4))+-}+instance Wrapped (ValidatorMonadProfunctorT err f x a) where+  type Unwrapped (ValidatorMonadProfunctorT err f x a) = x -> ValidationMonadT err f a+  _Wrapped' = iso (\(ValidatorMonadProfunctorT f) -> f) ValidatorMonadProfunctorT+  {-# INLINE _Wrapped' #-}++instance Rewrapped (ValidatorMonadProfunctorT err f x a) (ValidatorMonadProfunctorT err' f' x' b)++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = (view _Wrapped' (fmap (*10) v)) 3+>>> r+Success 40+-}+instance (Functor f) => Functor (ValidatorMonadProfunctorT err f x) where+  fmap f (ValidatorMonadProfunctorT g) = ValidatorMonadProfunctorT (fmap (fmap f) g)+  {-# INLINE fmap #-}++{- | Short-circuiting: stops at the first 'Failure'.++>>> import Control.Lens(view, _Wrapped')+>>> import Data.Functor.Apply(Apply((<.>)))+>>> let f = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (+ x)))) :: ValidatorMonadProfunctorT [String] Identity Int (Int -> Int)+>>> let g = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x * 2)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = (view _Wrapped' (f <.> g)) 3+>>> r+Success 9+-}+instance (Monad f) => Apply (ValidatorMonadProfunctorT err f x) where+  (<.>) = ap+  {-# INLINE (<.>) #-}++{- | Short-circuiting: unlike 'Validation', does /not/ accumulate errors.++>>> import Control.Lens(view, _Wrapped')+>>> let ValidationMonadT (Identity r) = view _Wrapped' (pure 42 :: ValidatorMonadProfunctorT [String] Identity Int Int) 0+>>> r+Success 42+-}+instance (Monad f) => Applicative (ValidatorMonadProfunctorT err f x) where+  pure a = ValidatorMonadProfunctorT (\_ -> pure a)+  {-# INLINE pure #-}+  ValidatorMonadProfunctorT f <*> ValidatorMonadProfunctorT g = ValidatorMonadProfunctorT (\x -> f x <*> g x)+  {-# INLINE (<*>) #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Data.Functor.Bind(Bind((>>-)))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (v >>- \a -> pure (a * 10)) 3+>>> r+Success 40+-}+instance (Monad f) => Bind (ValidatorMonadProfunctorT err f x) where+  (>>-) = (>>=)+  {-# INLINE (>>-) #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (v >>= \a -> pure (a * 10)) 3+>>> r+Success 40++>>> let f = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (f >>= \a -> pure (a * 10)) 3+>>> r+Failure ["e1"]+-}+instance (Monad f) => Monad (ValidatorMonadProfunctorT err f x) where+  ValidatorMonadProfunctorT f >>= k = ValidatorMonadProfunctorT (\x -> f x >>= \a -> let ValidatorMonadProfunctorT g = k a in g x)+  {-# INLINE (>>=) #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Data.Functor.Alt(Alt((<!>)))+>>> let v1 = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let v2 = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x * 2)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (v1 <!> v2) 3+>>> r+Success 6+-}+instance (Monad f, Semigroup err) => Alt (ValidatorMonadProfunctorT err f x) where+  ValidatorMonadProfunctorT f <!> ValidatorMonadProfunctorT g = ValidatorMonadProfunctorT (\x -> f x <!> g x)+  {-# INLINE (<!>) #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Data.Functor.Plus(Plus(zero))+>>> let ValidationMonadT (Identity r) = view _Wrapped' (zero :: ValidatorMonadProfunctorT [String] Identity Int Int) 3+>>> r+Failure []+-}+instance (Monad f, Monoid err) => Plus (ValidatorMonadProfunctorT err f x) where+  zero = ValidatorMonadProfunctorT (const zero)+  {-# INLINE zero #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let ValidationMonadT (Identity r) = view _Wrapped' (empty :: ValidatorMonadProfunctorT [String] Identity Int Int) 3+>>> r+Failure []+-}+instance (Monad f, Monoid err) => Alternative (ValidatorMonadProfunctorT err f x) where+  empty = zero+  {-# INLINE empty #-}+  (<|>) = (<!>)+  {-# INLINE (<|>) #-}++instance (Monad f, Monoid err) => MonadPlus (ValidatorMonadProfunctorT err f x)++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Control.Selective(Selective(select))+>>> let v = fmap Right (pure 1) :: ValidatorMonadProfunctorT [String] Identity Int (Either Int Int)+>>> let ValidationMonadT (Identity r) = view _Wrapped' (select v (pure (+1))) 3+>>> r+Success 1+-}+instance (Monad f) => Selective (ValidatorMonadProfunctorT err f x) where+  select = selectM+  {-# INLINE select #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Data.Profunctor(Profunctor(dimap, lmap, rmap))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (dimap (+10) (*2) v) 3+>>> r+Success 28++>>> let ValidationMonadT (Identity r) = view _Wrapped' (lmap (+10) v) 3+>>> r+Success 14++>>> let ValidationMonadT (Identity r) = view _Wrapped' (rmap (*2) v) 3+>>> r+Success 8+-}+instance (Functor f) => Profunctor (ValidatorMonadProfunctorT err f) where+  dimap f g (ValidatorMonadProfunctorT h) = ValidatorMonadProfunctorT (fmap g . h . f)+  {-# INLINE dimap #-}+  lmap f (ValidatorMonadProfunctorT h) = ValidatorMonadProfunctorT (h . f)+  {-# INLINE lmap #-}+  rmap g (ValidatorMonadProfunctorT h) = ValidatorMonadProfunctorT (fmap g . h)+  {-# INLINE rmap #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Data.Profunctor(Strong(first'))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (first' v) (3, "tag")+>>> r+Success (4,"tag")+-}+instance (Functor f) => Strong (ValidatorMonadProfunctorT err f) where+  first' (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (\(a, c) -> fmap (,c) (f a))+  {-# INLINE first' #-}+  second' (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (\(c, a) -> fmap (c,) (f a))+  {-# INLINE second' #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Data.Profunctor(Choice(left'))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (left' v) (Left 3 :: Either Int String)+>>> r+Success (Left 4)++>>> let ValidationMonadT (Identity r) = view _Wrapped' (left' v) (Right "x" :: Either Int String)+>>> r+Success (Right "x")+-}+instance (Monad f) => Choice (ValidatorMonadProfunctorT err f) where+  left' (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (either (fmap Left . f) (pure . Right))+  {-# INLINE left' #-}+  right' (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (either (pure . Left) (fmap Right . f))+  {-# INLINE right' #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (traverse' v) [1, 2, 3]+>>> r+Success [2,3,4]+-}+instance (Monad f) => Traversing (ValidatorMonadProfunctorT err f) where+  traverse' (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (traverse f)+  {-# INLINE traverse' #-}+  wander t (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (t f)+  {-# INLINE wander #-}++{- |+>>> import Data.Profunctor.Sieve(Sieve(sieve))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = sieve v 3+>>> r+Success 4+-}+instance (Functor f) => Sieve (ValidatorMonadProfunctorT err f) (ValidationMonadT err f) where+  sieve (ValidatorMonadProfunctorT f) = f+  {-# INLINE sieve #-}++{- | Kleisli-like composition, short-circuiting on failure.++>>> import Control.Lens(view, _Wrapped')+>>> import Data.Semigroupoid(Semigroupoid(o))+>>> let v1 = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let v2 = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x * 2)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (v2 `o` v1) 3+>>> r+Success 8+-}+instance (Monad f) => Semigroupoid (ValidatorMonadProfunctorT err f) where+  ValidatorMonadProfunctorT f `o` ValidatorMonadProfunctorT g = ValidatorMonadProfunctorT (g >=> f)+  {-# INLINE o #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Control.Category(id, (.))+>>> import Prelude hiding (id, (.))+>>> let v1 = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let v2 = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x * 2)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (v2 . v1) 3+>>> r+Success 8+-}+instance (Monad f) => Category (ValidatorMonadProfunctorT err f) where+  id = ValidatorMonadProfunctorT pure+  {-# INLINE id #-}+  ValidatorMonadProfunctorT f . ValidatorMonadProfunctorT g = ValidatorMonadProfunctorT (g >=> f)+  {-# INLINE (.) #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Control.Arrow(Arrow(arr))+>>> import Control.Category((.))+>>> import Prelude hiding ((.))+>>> let ValidationMonadT (Identity r) = view _Wrapped' (arr (+1) :: ValidatorMonadProfunctorT [String] Identity Int Int) 3+>>> r+Success 4+-}+instance (Monad f) => Arrow (ValidatorMonadProfunctorT err f) where+  arr f = ValidatorMonadProfunctorT (pure . f)+  {-# INLINE arr #-}+  first (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (\(a, c) -> fmap (,c) (f a))+  {-# INLINE first #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Control.Arrow(ArrowApply(app))+>>> import Control.Category((.))+>>> import Prelude hiding ((.))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (app :: ValidatorMonadProfunctorT [String] Identity (ValidatorMonadProfunctorT [String] Identity Int Int, Int) Int) (v, 3)+>>> r+Success 4+-}+instance (Monad f) => ArrowApply (ValidatorMonadProfunctorT err f) where+  app = ValidatorMonadProfunctorT (\(ValidatorMonadProfunctorT f, x) -> f x)+  {-# INLINE app #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Control.Arrow(ArrowChoice(left))+>>> import Control.Category((.))+>>> import Prelude hiding ((.))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (left v) (Left 3 :: Either Int String)+>>> r+Success (Left 4)+-}+instance (Monad f) => ArrowChoice (ValidatorMonadProfunctorT err f) where+  left (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (either (fmap Left . f) (pure . Right))+  {-# INLINE left #-}+  right (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (either (pure . Left) (fmap Right . f))+  {-# INLINE right #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Control.Arrow(ArrowZero(zeroArrow))+>>> import Control.Category((.))+>>> import Prelude hiding ((.))+>>> let ValidationMonadT (Identity r) = view _Wrapped' (zeroArrow :: ValidatorMonadProfunctorT [String] Identity Int Int) 3+>>> r+Failure []+-}+instance (Monad f, Monoid err) => ArrowZero (ValidatorMonadProfunctorT err f) where+  zeroArrow = ValidatorMonadProfunctorT (const zero)+  {-# INLINE zeroArrow #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Data.Functor.Alt(Alt((<!>)))+>>> import Control.Arrow(ArrowPlus((<+>)))+>>> import Control.Category((.))+>>> import Prelude hiding ((.))+>>> let v1 = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let v2 = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x * 2)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (v1 <+> v2) 3+>>> r+Success 6+-}+instance (Monad f, Monoid err) => ArrowPlus (ValidatorMonadProfunctorT err f) where+  ValidatorMonadProfunctorT f <+> ValidatorMonadProfunctorT g = ValidatorMonadProfunctorT (\x -> f x <!> g x)+  {-# INLINE (<+>) #-}++{- | Like 'Validation', a failure is kept: for each input, the result fails+where the validator fails, and otherwise succeeds with @f@ applied to the validator.+The effects of the validator are run.++>>> import Control.Lens(view, _Wrapped')+>>> import Data.Functor.Extend(Extend(extended))+>>> let v = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x + 1)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (extended (\_ -> 99) v) 3+>>> r+Success 99++>>> let e = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Failure ["e"]))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (extended (\_ -> 99) e) 3+>>> r+Failure ["e"]+-}+instance (Functor f) => Extend (ValidatorMonadProfunctorT err f x) where+  extended f w@(ValidatorMonadProfunctorT g) = ValidatorMonadProfunctorT (\x -> f w <$ g x)+  {-# INLINE extended #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let v1 = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Success 1))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let v2 = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Success 2))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (v1 <> v2) 0+>>> r+Success 1+-}+instance (Applicative f, Semigroup err) => Semigroup (ValidatorMonadProfunctorT err f x a) where+  ValidatorMonadProfunctorT f <> ValidatorMonadProfunctorT g = ValidatorMonadProfunctorT (\x -> f x <> g x)+  {-# INLINE (<>) #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> let ValidationMonadT (Identity r) = view _Wrapped' (mempty :: ValidatorMonadProfunctorT [String] Identity Int Int) 0+>>> r+Failure []+-}+instance (Applicative f, Monoid err) => Monoid (ValidatorMonadProfunctorT err f x a) where+  mempty = ValidatorMonadProfunctorT (const mempty)+  {-# INLINE mempty #-}++instance (MonadFail f) => MonadFail (ValidatorMonadProfunctorT err f x) where+  fail = ValidatorMonadProfunctorT . const . liftValidationMonadT . Prelude.fail+  {-# INLINE fail #-}++{- |+>>> import Control.Lens(view, _Wrapped')+>>> import Control.Monad.Error.Class(MonadError(throwError, catchError))+>>> let ValidationMonadT (Identity r) = view _Wrapped' (throwError ["oops"] :: ValidatorMonadProfunctorT [String] Identity Int Int) 3+>>> r+Failure ["oops"]++>>> let v = ValidatorMonadProfunctorT (\_ -> ValidationMonadT (Identity (Failure ["e1"]))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let h _ = ValidatorMonadProfunctorT (\x -> ValidationMonadT (Identity (Success (x * 2)))) :: ValidatorMonadProfunctorT [String] Identity Int Int+>>> let ValidationMonadT (Identity r) = view _Wrapped' (catchError v h) 3+>>> r+Success 6+-}+instance (Monad f) => MonadError err (ValidatorMonadProfunctorT err f x) where+  throwError e = ValidatorMonadProfunctorT (\_ -> throwError e)+  {-# INLINE throwError #-}+  catchError (ValidatorMonadProfunctorT f) h = ValidatorMonadProfunctorT (\x -> catchError (f x) (\e -> let ValidatorMonadProfunctorT g = h e in g x))+  {-# INLINE catchError #-}++instance (MonadIO f) => MonadIO (ValidatorMonadProfunctorT err f x) where+  liftIO = ValidatorMonadProfunctorT . const . liftValidationMonadT . liftIO+  {-# INLINE liftIO #-}++instance (MonadReader r f) => MonadReader r (ValidatorMonadProfunctorT err f x) where+  ask = ValidatorMonadProfunctorT (\_ -> liftValidationMonadT ask)+  {-# INLINE ask #-}+  local f (ValidatorMonadProfunctorT g) = ValidatorMonadProfunctorT (local f . g)+  {-# INLINE local #-}+  reader = ValidatorMonadProfunctorT . const . liftValidationMonadT . reader+  {-# INLINE reader #-}++instance (MonadWriter w f) => MonadWriter w (ValidatorMonadProfunctorT err f x) where+  writer = ValidatorMonadProfunctorT . const . liftValidationMonadT . writer+  {-# INLINE writer #-}+  tell = ValidatorMonadProfunctorT . const . liftValidationMonadT . tell+  {-# INLINE tell #-}+  listen (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (listen . f)+  {-# INLINE listen #-}+  pass (ValidatorMonadProfunctorT f) = ValidatorMonadProfunctorT (pass . f)+  {-# INLINE pass #-}++instance (MonadState s f) => MonadState s (ValidatorMonadProfunctorT err f x) where+  get = ValidatorMonadProfunctorT (\_ -> liftValidationMonadT get)+  {-# INLINE get #-}+  put = ValidatorMonadProfunctorT . const . liftValidationMonadT . put+  {-# INLINE put #-}+  state = ValidatorMonadProfunctorT . const . liftValidationMonadT . state+  {-# INLINE state #-}++instance (MonadCont f) => MonadCont (ValidatorMonadProfunctorT err f x) where+  callCC f = ValidatorMonadProfunctorT (\x -> callCC (\c -> let ValidatorMonadProfunctorT g = f (\a -> ValidatorMonadProfunctorT (\_ -> c a)) in g x))+  {-# INLINE callCC #-}++instance (MonadRWS r w s f) => MonadRWS r w s (ValidatorMonadProfunctorT err f x)++-- | Class for types that have a 'Getter' to a 'ValidatorMonadProfunctorT'.+class GetValidatorMonadProfunctorT s err f x a | s -> err f x a where+  getValidatorMonadProfunctorT :: Getter s (ValidatorMonadProfunctorT err f x a)++instance GetValidatorMonadProfunctorT (ValidatorMonadProfunctorT err f x a) err f x a where+  getValidatorMonadProfunctorT = id+  {-# INLINE getValidatorMonadProfunctorT #-}++-- | Class for types that have a 'Lens'' to a 'ValidatorMonadProfunctorT'.+class (GetValidatorMonadProfunctorT s err f x a) => HasValidatorMonadProfunctorT s err f x a | s -> err f x a where+  validatorMonadProfunctorT :: Lens' s (ValidatorMonadProfunctorT err f x a)++instance HasValidatorMonadProfunctorT (ValidatorMonadProfunctorT err f x a) err f x a where+  validatorMonadProfunctorT = id+  {-# INLINE validatorMonadProfunctorT #-}++-- | Class for types that have a 'Review' to a 'ValidatorMonadProfunctorT'.+class ReviewValidatorMonadProfunctorT s err f x a | s -> err f x a where+  reviewValidatorMonadProfunctorT :: Review s (ValidatorMonadProfunctorT err f x a)++instance ReviewValidatorMonadProfunctorT (ValidatorMonadProfunctorT err f x a) err f x a where+  reviewValidatorMonadProfunctorT = id+  {-# INLINE reviewValidatorMonadProfunctorT #-}++-- | Class for types that have a 'Prism'' to a 'ValidatorMonadProfunctorT'.+class (ReviewValidatorMonadProfunctorT s err f x a) => AsValidatorMonadProfunctorT s err f x a | s -> err f x a where+  _ValidatorMonadProfunctorT :: Prism' s (ValidatorMonadProfunctorT err f x a)++instance AsValidatorMonadProfunctorT (ValidatorMonadProfunctorT err f x a) err f x a where+  _ValidatorMonadProfunctorT = id+  {-# INLINE _ValidatorMonadProfunctorT #-}++-- =============================+-- Cross-type optics instances+-- =============================++-- Isomorphisms between the validator types, used by the cross-type instances.++validatorToProfunctor :: Iso' (Validator x err a) (ValidatorProfunctor err x a)+validatorToProfunctor = iso (\(Validator f) -> ValidatorProfunctor f) (\(ValidatorProfunctor f) -> Validator f)+{-# INLINE validatorToProfunctor #-}++monadToMonadProfunctor :: Iso' (ValidatorMonadT x err f a) (ValidatorMonadProfunctorT err f x a)+monadToMonadProfunctor = iso (\(ValidatorMonadT f) -> ValidatorMonadProfunctorT f) (\(ValidatorMonadProfunctorT f) -> ValidatorMonadT f)+{-# INLINE monadToMonadProfunctor #-}++validatorToMonad :: Iso' (Validator x err a) (ValidatorMonad x err a)+validatorToMonad = iso (\(Validator f) -> ValidatorMonadT (view validationMonad . f)) (\(ValidatorMonadT f) -> Validator (review validationMonad . f))+{-# INLINE validatorToMonad #-}++validatorToMonadProfunctor :: Iso' (Validator x err a) (ValidatorMonadProfunctor err x a)+validatorToMonadProfunctor = validatorToMonad . monadToMonadProfunctor+{-# INLINE validatorToMonadProfunctor #-}++profunctorToMonad :: Iso' (ValidatorProfunctor err x a) (ValidatorMonad x err a)+profunctorToMonad = from validatorToProfunctor . validatorToMonad+{-# INLINE profunctorToMonad #-}++profunctorToMonadProfunctor :: Iso' (ValidatorProfunctor err x a) (ValidatorMonadProfunctor err x a)+profunctorToMonadProfunctor = from validatorToProfunctor . validatorToMonadProfunctor+{-# INLINE profunctorToMonadProfunctor #-}++-- Cross-type optics: Validator <-> ValidatorProfunctor++instance GetValidator (ValidatorProfunctor err x a) x err a where+  getValidator = from validatorToProfunctor+  {-# INLINE getValidator #-}++instance HasValidator (ValidatorProfunctor err x a) x err a where+  validator = from validatorToProfunctor+  {-# INLINE validator #-}++instance ReviewValidator (ValidatorProfunctor err x a) x err a where+  reviewValidator = from validatorToProfunctor+  {-# INLINE reviewValidator #-}++instance AsValidator (ValidatorProfunctor err x a) x err a where+  _Validator = from validatorToProfunctor+  {-# INLINE _Validator #-}++instance GetValidatorProfunctor (Validator x err a) err x a where+  getValidatorProfunctor = validatorToProfunctor+  {-# INLINE getValidatorProfunctor #-}++instance HasValidatorProfunctor (Validator x err a) err x a where+  validatorProfunctor = validatorToProfunctor+  {-# INLINE validatorProfunctor #-}++instance ReviewValidatorProfunctor (Validator x err a) err x a where+  reviewValidatorProfunctor = validatorToProfunctor+  {-# INLINE reviewValidatorProfunctor #-}++instance AsValidatorProfunctor (Validator x err a) err x a where+  _ValidatorProfunctor = validatorToProfunctor+  {-# INLINE _ValidatorProfunctor #-}++-- Cross-type optics: ValidatorMonadT <-> ValidatorMonadProfunctorT++instance GetValidatorMonadT (ValidatorMonadProfunctorT err f x a) x err f a where+  getValidatorMonadT = from monadToMonadProfunctor+  {-# INLINE getValidatorMonadT #-}++instance HasValidatorMonadT (ValidatorMonadProfunctorT err f x a) x err f a where+  validatorMonadT = from monadToMonadProfunctor+  {-# INLINE validatorMonadT #-}++instance ReviewValidatorMonadT (ValidatorMonadProfunctorT err f x a) x err f a where+  reviewValidatorMonadT = from monadToMonadProfunctor+  {-# INLINE reviewValidatorMonadT #-}++instance AsValidatorMonadT (ValidatorMonadProfunctorT err f x a) x err f a where+  _ValidatorMonadT = from monadToMonadProfunctor+  {-# INLINE _ValidatorMonadT #-}++instance GetValidatorMonadProfunctorT (ValidatorMonadT x err f a) err f x a where+  getValidatorMonadProfunctorT = monadToMonadProfunctor+  {-# INLINE getValidatorMonadProfunctorT #-}++instance HasValidatorMonadProfunctorT (ValidatorMonadT x err f a) err f x a where+  validatorMonadProfunctorT = monadToMonadProfunctor+  {-# INLINE validatorMonadProfunctorT #-}++instance ReviewValidatorMonadProfunctorT (ValidatorMonadT x err f a) err f x a where+  reviewValidatorMonadProfunctorT = monadToMonadProfunctor+  {-# INLINE reviewValidatorMonadProfunctorT #-}++instance AsValidatorMonadProfunctorT (ValidatorMonadT x err f a) err f x a where+  _ValidatorMonadProfunctorT = monadToMonadProfunctor+  {-# INLINE _ValidatorMonadProfunctorT #-}++-- Cross-type optics: Validator <-> ValidatorMonadT (f ~ Identity)++instance GetValidator (ValidatorMonadT x err Identity a) x err a where+  getValidator = from validatorToMonad+  {-# INLINE getValidator #-}++instance HasValidator (ValidatorMonadT x err Identity a) x err a where+  validator = from validatorToMonad+  {-# INLINE validator #-}++instance (Applicative f) => ReviewValidator (ValidatorMonadT x err f a) x err a where+  reviewValidator = unto (\(Validator f) -> ValidatorMonadT (ValidationMonadT . pure . f))+  {-# INLINE reviewValidator #-}++instance AsValidator (ValidatorMonadT x err Identity a) x err a where+  _Validator = from validatorToMonad+  {-# INLINE _Validator #-}++instance GetValidatorMonadT (Validator x err a) x err Identity a where+  getValidatorMonadT = validatorToMonad+  {-# INLINE getValidatorMonadT #-}++instance HasValidatorMonadT (Validator x err a) x err Identity a where+  validatorMonadT = validatorToMonad+  {-# INLINE validatorMonadT #-}++instance ReviewValidatorMonadT (Validator x err a) x err Identity a where+  reviewValidatorMonadT = validatorToMonad+  {-# INLINE reviewValidatorMonadT #-}++instance AsValidatorMonadT (Validator x err a) x err Identity a where+  _ValidatorMonadT = validatorToMonad+  {-# INLINE _ValidatorMonadT #-}++-- Cross-type optics: ValidatorProfunctor <-> ValidatorMonadProfunctorT (f ~ Identity)++instance GetValidatorProfunctor (ValidatorMonadProfunctorT err Identity x a) err x a where+  getValidatorProfunctor = from profunctorToMonadProfunctor+  {-# INLINE getValidatorProfunctor #-}++instance HasValidatorProfunctor (ValidatorMonadProfunctorT err Identity x a) err x a where+  validatorProfunctor = from profunctorToMonadProfunctor+  {-# INLINE validatorProfunctor #-}++instance (Applicative f) => ReviewValidatorProfunctor (ValidatorMonadProfunctorT err f x a) err x a where+  reviewValidatorProfunctor = unto (\(ValidatorProfunctor f) -> ValidatorMonadProfunctorT (ValidationMonadT . pure . f))+  {-# INLINE reviewValidatorProfunctor #-}++instance AsValidatorProfunctor (ValidatorMonadProfunctorT err Identity x a) err x a where+  _ValidatorProfunctor = from profunctorToMonadProfunctor+  {-# INLINE _ValidatorProfunctor #-}++instance GetValidatorMonadProfunctorT (ValidatorProfunctor err x a) err Identity x a where+  getValidatorMonadProfunctorT = profunctorToMonadProfunctor+  {-# INLINE getValidatorMonadProfunctorT #-}++instance HasValidatorMonadProfunctorT (ValidatorProfunctor err x a) err Identity x a where+  validatorMonadProfunctorT = profunctorToMonadProfunctor+  {-# INLINE validatorMonadProfunctorT #-}++instance ReviewValidatorMonadProfunctorT (ValidatorProfunctor err x a) err Identity x a where+  reviewValidatorMonadProfunctorT = profunctorToMonadProfunctor+  {-# INLINE reviewValidatorMonadProfunctorT #-}++instance AsValidatorMonadProfunctorT (ValidatorProfunctor err x a) err Identity x a where+  _ValidatorMonadProfunctorT = profunctorToMonadProfunctor+  {-# INLINE _ValidatorMonadProfunctorT #-}++-- Cross-type optics: Validator <-> ValidatorMonadProfunctorT (f ~ Identity)++instance GetValidator (ValidatorMonadProfunctorT err Identity x a) x err a where+  getValidator = from validatorToMonadProfunctor+  {-# INLINE getValidator #-}++instance HasValidator (ValidatorMonadProfunctorT err Identity x a) x err a where+  validator = from validatorToMonadProfunctor+  {-# INLINE validator #-}++instance (Applicative f) => ReviewValidator (ValidatorMonadProfunctorT err f x a) x err a where+  reviewValidator = unto (\(Validator f) -> ValidatorMonadProfunctorT (ValidationMonadT . pure . f))+  {-# INLINE reviewValidator #-}++instance AsValidator (ValidatorMonadProfunctorT err Identity x a) x err a where+  _Validator = from validatorToMonadProfunctor+  {-# INLINE _Validator #-}++instance GetValidatorMonadProfunctorT (Validator x err a) err Identity x a where+  getValidatorMonadProfunctorT = validatorToMonadProfunctor+  {-# INLINE getValidatorMonadProfunctorT #-}++instance HasValidatorMonadProfunctorT (Validator x err a) err Identity x a where+  validatorMonadProfunctorT = validatorToMonadProfunctor+  {-# INLINE validatorMonadProfunctorT #-}++instance ReviewValidatorMonadProfunctorT (Validator x err a) err Identity x a where+  reviewValidatorMonadProfunctorT = validatorToMonadProfunctor+  {-# INLINE reviewValidatorMonadProfunctorT #-}++instance AsValidatorMonadProfunctorT (Validator x err a) err Identity x a where+  _ValidatorMonadProfunctorT = validatorToMonadProfunctor+  {-# INLINE _ValidatorMonadProfunctorT #-}++-- Cross-type optics: ValidatorProfunctor <-> ValidatorMonadT (f ~ Identity)++instance GetValidatorProfunctor (ValidatorMonadT x err Identity a) err x a where+  getValidatorProfunctor = from profunctorToMonad+  {-# INLINE getValidatorProfunctor #-}++instance HasValidatorProfunctor (ValidatorMonadT x err Identity a) err x a where+  validatorProfunctor = from profunctorToMonad+  {-# INLINE validatorProfunctor #-}++instance (Applicative f) => ReviewValidatorProfunctor (ValidatorMonadT x err f a) err x a where+  reviewValidatorProfunctor = unto (\(ValidatorProfunctor f) -> ValidatorMonadT (ValidationMonadT . pure . f))+  {-# INLINE reviewValidatorProfunctor #-}++instance AsValidatorProfunctor (ValidatorMonadT x err Identity a) err x a where+  _ValidatorProfunctor = from profunctorToMonad+  {-# INLINE _ValidatorProfunctor #-}++instance GetValidatorMonadT (ValidatorProfunctor err x a) x err Identity a where+  getValidatorMonadT = profunctorToMonad+  {-# INLINE getValidatorMonadT #-}++instance HasValidatorMonadT (ValidatorProfunctor err x a) x err Identity a where+  validatorMonadT = profunctorToMonad+  {-# INLINE validatorMonadT #-}++instance ReviewValidatorMonadT (ValidatorProfunctor err x a) x err Identity a where+  reviewValidatorMonadT = profunctorToMonad+  {-# INLINE reviewValidatorMonadT #-}++instance AsValidatorMonadT (ValidatorProfunctor err x a) x err Identity a where+  _ValidatorMonadT = profunctorToMonad+  {-# INLINE _ValidatorMonadT #-}++-- ==================================+-- Constructing validators from prisms+-- ==================================++{- | Construct a validator from a prism, mapping the focus with a function.+The validator succeeds with the function applied to the focus of the prism+when it matches, and otherwise fails with the input, retyped to @t@ (see+'Control.Lens.matching').++@p --> f@ is @f '<$>' 'match' p@, and @'match' p@ is @p --> 'id'@. As with+'match', the result can be any validator with a 'ReviewValidator' instance.++>>> runV (_Just --> (+ 1) :: Validator (Maybe Int) (Maybe Int) Int) (Just 1)+Success 2++>>> runV (_Just --> (+ 1) :: Validator (Maybe Int) (Maybe Int) Int) Nothing+Failure Nothing++'-->' is @infixl 6@. It binds more loosely than '.', so prisms compose+without parentheses, and more tightly than '<!>', so a validator can be+written as one case per constructor. The first case that matches wins, and+the input is returned as the failure if none match.++>>> let v = _Left --> length <!> _Right . _Just --> negate :: Validator (Either String (Maybe Int)) (Either String (Maybe Int)) Int+>>> runV v (Left "abc")+Success 3++>>> runV v (Right (Just 5))+Success (-5)++>>> runV v (Right Nothing)+Failure (Right Nothing)++The other validators are written the same way. Their '<!>' accumulates+errors, which requires the input type to be a 'Semigroup' (here 'Either').++>>> let v = _Left --> length <!> _Right . _Just --> negate :: ValidatorProfunctor (Either String (Maybe Int)) (Either String (Maybe Int)) Int+>>> runVP v (Right (Just 5))+Success (-5)++>>> runVP v (Right Nothing)+Failure (Right Nothing)++>>> let v = _Left --> length <!> _Right . _Just --> negate :: ValidatorMonad (Either String (Maybe Int)) (Either String (Maybe Int)) Int+>>> runVM v (Right (Just 5))+Success (-5)++>>> runVM v (Right Nothing)+Failure (Right Nothing)++>>> let v = _Left --> length <!> _Right . _Just --> negate :: ValidatorMonadProfunctor (Either String (Maybe Int)) (Either String (Maybe Int)) Int+>>> runVMP v (Right (Just 5))+Success (-5)++>>> runVMP v (Right Nothing)+Failure (Right Nothing)+-}+(-->) :: (ReviewValidator r s t a') => APrism s t a b -> (a -> a') -> r+(-->) p f = review reviewValidator (f <$> Validator (review Validation.either . matching p))+{-# INLINE (-->) #-}+{-# SPECIALIZE (-->) :: APrism s t a b -> (a -> a') -> Validator s t a' #-}+{-# SPECIALIZE (-->) :: APrism s t a b -> (a -> a') -> ValidatorProfunctor t s a' #-}+{-# SPECIALIZE (-->) :: APrism s t a b -> (a -> a') -> ValidatorMonad s t a' #-}+{-# SPECIALIZE (-->) :: APrism s t a b -> (a -> a') -> ValidatorMonadProfunctor t s a' #-}++infixl 6 -->++{- | Construct a validator from a prism. The validator succeeds with the+focus of the prism when it matches, and otherwise fails with the input,+retyped to @t@ (see 'Control.Lens.matching').++The result can be any validator with a 'ReviewValidator' instance, which+determines the validator type from the result type. @match p@ is+@p '-->' 'id'@.++>>> let Validator f = match _Just :: Validator (Maybe Int) (Maybe Int) Int+>>> f (Just 3)+Success 3++>>> f Nothing+Failure Nothing++A type-changing prism fails with the retyped input.++>>> let Validator f = match _Left :: Validator (Either Int String) (Either Bool String) Int+>>> f (Left 1)+Success 1++>>> f (Right "x")+Failure (Right "x")++Match each constructor with its own prism, and combine the validators with+'<!>'. The first prism that matches wins, and the input is returned as the+failure if none match. The result type annotation chooses the validator; the+specialisations 'matchValidator', 'matchValidatorProfunctor',+'matchValidatorMonad' and 'matchValidatorMonadProfunctor' avoid it.++>>> let v = match _Left <!> (show <$> match (_Right . _Just)) :: Validator (Either String (Maybe Int)) (Either String (Maybe Int)) String+>>> runV v (Left "abc")+Success "abc"++>>> runV v (Right (Just 5))+Success "5"++>>> runV v (Right Nothing)+Failure (Right Nothing)++'ValidatorProfunctor' and 'ValidatorMonadProfunctorT' take the error type first.++>>> let v = match _Left <!> (show <$> match (_Right . _Just)) :: ValidatorProfunctor (Either String (Maybe Int)) (Either String (Maybe Int)) String+>>> runVP v (Right (Just 5))+Success "5"++>>> runVP v (Right Nothing)+Failure (Right Nothing)++>>> let v = match _Left <!> (show <$> match (_Right . _Just)) :: ValidatorMonad (Either String (Maybe Int)) (Either String (Maybe Int)) String+>>> runVM v (Right (Just 5))+Success "5"++>>> runVM v (Right Nothing)+Failure (Right Nothing)++>>> let v = match _Left <!> (show <$> match (_Right . _Just)) :: ValidatorMonadProfunctor (Either String (Maybe Int)) (Either String (Maybe Int)) String+>>> runVMP v (Right (Just 5))+Success "5"++>>> runVMP v (Right Nothing)+Failure (Right Nothing)++The monadic validators work with any 'Applicative'.++>>> let ValidatorMonadT f = match _Just :: ValidatorMonadT (Maybe Int) (Maybe Int) [] Int+>>> let ValidationMonadT r = f (Just 3) in r+[Success 3]++>>> let ValidatorMonadProfunctorT f = match _Just :: ValidatorMonadProfunctorT (Maybe Int) Maybe (Maybe Int) Int+>>> let ValidationMonadT r = f Nothing in r+Just (Failure Nothing)+-}+match :: (ReviewValidator r s t a) => APrism s t a b -> r+match p = p --> id+{-# INLINE match #-}+{-# SPECIALIZE match :: APrism s t a b -> Validator s t a #-}+{-# SPECIALIZE match :: APrism s t a b -> ValidatorProfunctor t s a #-}+{-# SPECIALIZE match :: APrism s t a b -> ValidatorMonad s t a #-}+{-# SPECIALIZE match :: APrism s t a b -> ValidatorMonadProfunctor t s a #-}++{- | 'match' specialised to 'Validator', so no type annotation is needed.++Combine one prism per constructor with '<!>'. 'Validator' does not accumulate+errors, so the input type need not be a 'Semigroup'; if no prism matches, the+last failure is returned.++>>> let v = matchValidator _Left <!> (show <$> matchValidator (_Right . _Just))+>>> runV v (Left "abc")+Success "abc"++>>> runV v (Right (Just 5))+Success "5"++>>> runV v (Right (Nothing :: Maybe Int))+Failure (Right Nothing)++>>> runV (matchValidator _Just) (Nothing :: Maybe Int)+Failure Nothing+-}+matchValidator :: APrism s t a b -> Validator s t a+matchValidator = match+{-# INLINE matchValidator #-}++{- | 'match' specialised to 'ValidatorProfunctor', so no type annotation is needed.++The input type is also the error type, and '<!>' accumulates errors, so+combining with '<!>' requires the input type to be a 'Semigroup' (here+'Either').++>>> let v = matchValidatorProfunctor _Left <!> (show <$> matchValidatorProfunctor (_Right . _Just))+>>> runVP v (Left "abc")+Success "abc"++>>> runVP v (Right (Just 5))+Success "5"++>>> runVP v (Right (Nothing :: Maybe Int))+Failure (Right Nothing)++The input can be adapted with 'lmap'.++>>> runVP (lmap Just (matchValidatorProfunctor _Just)) (3 :: Int)+Success 3+-}+matchValidatorProfunctor :: APrism s t a b -> ValidatorProfunctor t s a+matchValidatorProfunctor = match+{-# INLINE matchValidatorProfunctor #-}++{- | 'match' specialised to 'ValidatorMonad', so no type annotation is needed.++Combining with '<!>' requires the input type to be a 'Semigroup' (here+'Either'). The 'Monad' instance short-circuits, so a match can decide the+next validator.++>>> let v = matchValidatorMonad _Left <!> (show <$> matchValidatorMonad (_Right . _Just))+>>> runVM v (Left "abc")+Success "abc"++>>> runVM v (Right (Just 5))+Success "5"++>>> runVM v (Right (Nothing :: Maybe Int))+Failure (Right Nothing)++>>> let w = matchValidatorMonad _Just >>= \n -> if n > (0 :: Int) then pure n else throwError (Just n)+>>> runVM w (Just 3)+Success 3++>>> runVM w (Just (-3))+Failure (Just (-3))++>>> runVM w Nothing+Failure Nothing+-}+matchValidatorMonad :: APrism s t a b -> ValidatorMonad s t a+matchValidatorMonad = match+{-# INLINE matchValidatorMonad #-}++{- | 'match' specialised to 'ValidatorMonadProfunctor', so no type annotation is needed.++Combining with '<!>' requires the input type to be a 'Semigroup' (here+'Either').++>>> let v = matchValidatorMonadProfunctor _Left <!> (show <$> matchValidatorMonadProfunctor (_Right . _Just))+>>> runVMP v (Left "abc")+Success "abc"++>>> runVMP v (Right (Just 5))+Success "5"++>>> runVMP v (Right (Nothing :: Maybe Int))+Failure (Right Nothing)+-}+matchValidatorMonadProfunctor :: APrism s t a b -> ValidatorMonadProfunctor t s a+matchValidatorMonadProfunctor = match+{-# INLINE matchValidatorMonadProfunctor #-}++-- ==================================+-- Constructing prisms from validators+-- ==================================++{- | Construct a prism from a review and a validator. The prism matches+when the validator succeeds, and otherwise returns the failure, retyped to+@t@ (see 'Control.Lens.matching'). It is built with the review.++'unmatch' is an inverse of 'match'. For a prism @p@, @'unmatch' p ('match' p)@+is @p@, and for a validator @v@, @'match' ('unmatch' r v)@ is @v@. The prism+is lawful when the validator succeeds with @b@ on @'review' r b@, and fails+with its input otherwise.++The result is a 'Prism', so it can be used directly with 'Control.Lens.^?',+'review' and other optics, and the review can be any 'AReview', including a+'Prism' or an 'Control.Lens.Iso'.++The validator can be any validator with a 'GetValidator' instance.++>>> import Control.Lens(Prism, matching, withPrism)+>>> let positive = Validator (\n -> if n > 0 then Success n else Failure n) :: Validator Int Int Int+>>> let p = unmatch id positive+>>> matching p 5+Right 5++>>> matching p (-5)+Left (-5)++>>> 5 ^? p+Just 5++>>> review p 7+7++A type-changing prism.++>>> let p = unmatch _Left (matchValidator _Left) :: Prism (Either Int String) (Either Bool String) Int Bool+>>> matching p (Left 1)+Right 1++>>> matching p (Right "x")+Left (Right "x")++>>> withPrism p (\build _ -> build True)+Left True++'match' recovers the validator.++>>> runV (matchValidator (unmatch _Just (matchValidator _Just))) (Just 3)+Success 3++>>> runV (matchValidator (unmatch _Just (matchValidator _Just))) (Nothing :: Maybe Int)+Failure Nothing++The other validators are written the same way.++>>> let p = unmatch _Right (matchValidatorProfunctor _Right) :: Prism (Either String Int) (Either String Int) Int Int+>>> matching p (Left "x")+Left (Left "x")++>>> let p = unmatch _Just (matchValidatorMonad _Just >>= \n -> if n > (0 :: Int) then pure n else throwError (Just n))+>>> matching p (Just 3)+Right 3++>>> matching p (Just (-3))+Left (Just (-3))++>>> let p = unmatch _Just (matchValidatorMonadProfunctor _Just)+>>> matching p (Nothing :: Maybe Int)+Left Nothing+-}+unmatch :: (GetValidator v s t a) => AReview t b -> v -> Prism s t a b+unmatch r v =+  prism (review r) (view (getValidator . _Wrapped' . mapping Validation.either) v)+{-# INLINE unmatch #-}+{-# SPECIALIZE unmatch :: AReview t b -> Validator s t a -> Prism s t a b #-}+{-# SPECIALIZE unmatch :: AReview t b -> ValidatorProfunctor t s a -> Prism s t a b #-}+{-# SPECIALIZE unmatch :: AReview t b -> ValidatorMonad s t a -> Prism s t a b #-}+{-# SPECIALIZE unmatch :: AReview t b -> ValidatorMonadProfunctor t s a -> Prism s t a b #-}++{- | An operator for 'unmatch'. @r '<--' v@ is @'unmatch' r v@.++'<--' is @infixr 2@. It binds more loosely than '.', '-->', '<$>' and+'<!>', so the review and the validator can each be written without+parentheses.++>>> import Control.Lens(Prism, matching)+>>> let p = _Right . _Just <-- length <$> matchValidator _Left <!> matchValidator (_Right . _Just) :: Prism (Either String (Maybe Int)) (Either String (Maybe Int)) Int Int+>>> matching p (Left "abc")+Right 3++>>> matching p (Right (Just 5))+Right 5++>>> matching p (Right Nothing)+Left (Right Nothing)++>>> review p 7+Right (Just 7)+-}+(<--) :: (GetValidator v s t a) => AReview t b -> v -> Prism s t a b+(<--) = unmatch+{-# INLINE (<--) #-}+{-# SPECIALIZE (<--) :: AReview t b -> Validator s t a -> Prism s t a b #-}+{-# SPECIALIZE (<--) :: AReview t b -> ValidatorProfunctor t s a -> Prism s t a b #-}+{-# SPECIALIZE (<--) :: AReview t b -> ValidatorMonad s t a -> Prism s t a b #-}+{-# SPECIALIZE (<--) :: AReview t b -> ValidatorMonadProfunctor t s a -> Prism s t a b #-}++infixr 2 <--

@@ -0,0 +1,23 @@+import Control.Monad (unless)+import System.Exit (ExitCode (..), exitFailure)+import System.Process (rawSystem)++main :: IO ()+main = do+  results <-+    mapM+      ( \f ->+          rawSystem+            "cabal"+            [ "exec"+            , "--"+            , "doctest"+            , "-isrc"+            , f+            ]+      )+      [ "src/Data/Validation/Validation.hs"+      , "src/Data/Validation/ValidationMonad.hs"+      , "src/Data/Validation/Validator.hs"+      ]+  unless (all (== ExitSuccess) results) exitFailure

@@ -1,49 +1,136 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}  import Control.Applicative (liftA3)+import Control.Lens (APrism', clonePrism, from, matching, review, (#), (^.), (^?), _Just, _Left, _Right) import Control.Monad (join, unless)-import Data.Semigroup ((<>))+import Data.Bifunctor (bimap)+import Data.Bifunctor.Swap (swap)+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Identity (Identity (..))+import Data.Lens.Injection (_I1, _I2)+import Data.Validation import Hedgehog import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range-import System.IO (BufferMode(..), hSetBuffering, stdout, stderr) import System.Exit (exitFailure)--import Data.Validation (Validation (Success, Failure))+import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)+import Prelude hiding (either, id, (.))+import qualified Prelude  main :: IO () main = do   hSetBuffering stdout LineBuffering   hSetBuffering stderr LineBuffering -  result <- checkParallel $ Group "Validation"-    [ ("prop_semigroup", prop_semigroup)-    , ("prop_monoid_assoc", prop_monoid_assoc)-    , ("prop_monoid_left_id", prop_monoid_left_id)-    , ("prop_monoid_right_id", prop_monoid_right_id)-    ]+  result <-+    checkParallel $+      Group+        "Validation"+        [ ("prop_semigroup_assoc", prop_semigroup_assoc)+        , ("prop_monoid_assoc", prop_monoid_assoc)+        , ("prop_monoid_left_id", prop_monoid_left_id)+        , ("prop_monoid_right_id", prop_monoid_right_id)+        , ("prop_functor_id", prop_functor_id)+        , ("prop_functor_compose", prop_functor_compose)+        , ("prop_applicative_id", prop_applicative_id)+        , ("prop_applicative_homomorphism", prop_applicative_homomorphism)+        , ("prop_apply_compose", prop_apply_compose)+        , ("prop_alt_assoc", prop_alt_assoc)+        , ("prop_alt_left_catch", prop_alt_left_catch)+        , ("prop_bifunctor_id", prop_bifunctor_id)+        , ("prop_bifunctor_compose", prop_bifunctor_compose)+        , ("prop_foldValidation_failure", prop_foldValidation_failure)+        , ("prop_foldValidation_success", prop_foldValidation_success)+        , ("prop_either_roundtrip", prop_either_roundtrip)+        , ("prop_either_roundtrip_inv", prop_either_roundtrip_inv)+        , ("prop_codiagonal_roundtrip", prop_codiagonal_roundtrip)+        , ("prop_failure_prism_review_preview", prop_failure_prism_review_preview)+        , ("prop_success_prism_review_preview", prop_success_prism_review_preview)+        , ("prop_failure_prism_miss", prop_failure_prism_miss)+        , ("prop_success_prism_miss", prop_success_prism_miss)+        , ("prop_poly_failure_prism", prop_poly_failure_prism)+        , ("prop_poly_success_prism", prop_poly_success_prism)+        , ("prop_injection1_review_preview", prop_prism_review_preview (_I1 :: APrism' (Validation [String] Int) [String]) genStrings)+        , ("prop_injection1_matching_review", prop_prism_matching_review _I1 testGen)+        , ("prop_injection2_review_preview", prop_prism_review_preview (_I2 :: APrism' (Validation [String] Int) Int) genInt)+        , ("prop_injection2_matching_review", prop_prism_matching_review _I2 testGen)+        , ("prop_validationMonad_injection1_review_preview", prop_prism_review_preview (_I1 :: APrism' (ValidationMonad [String] Int) [String]) genStrings)+        , ("prop_validationMonad_injection1_matching_review", prop_prism_matching_review _I1 testGenMonad)+        , ("prop_validationMonad_injection2_review_preview", prop_prism_review_preview (_I2 :: APrism' (ValidationMonad [String] Int) Int) genInt)+        , ("prop_validationMonad_injection2_matching_review", prop_prism_matching_review _I2 testGenMonad)+        , ("prop_validationMonad_injection1_validation", prop_validationMonad_injection1_validation)+        , ("prop_validationMonad_injection2_validation", prop_validationMonad_injection2_validation)+        , ("prop_swap_failure", prop_swap_failure)+        , ("prop_swap_success", prop_swap_success)+        , ("prop_swap_involution", prop_swap_involution)+        , ("prop_either_reviewFailure", prop_either_reviewFailure)+        , ("prop_either_asFailure_hit", prop_either_asFailure_hit)+        , ("prop_either_asFailure_miss", prop_either_asFailure_miss)+        , ("prop_either_reviewSuccess", prop_either_reviewSuccess)+        , ("prop_either_asSuccess_hit", prop_either_asSuccess_hit)+        , ("prop_either_asSuccess_miss", prop_either_asSuccess_miss)+        , ("prop_either_failure_roundtrip", prop_either_failure_roundtrip)+        , ("prop_either_success_roundtrip", prop_either_success_roundtrip)+        , ("prop_match_hit", prop_match_hit)+        , ("prop_match_miss", prop_match_miss)+        , ("prop_match_validatorProfunctor", prop_match_validatorProfunctor)+        , ("prop_match_validatorMonad", prop_match_validatorMonad)+        , ("prop_match_validatorMonadProfunctor", prop_match_validatorMonadProfunctor)+        , ("prop_match_alt", prop_match_alt)+        , ("prop_matchValidator_alt", prop_matchValidator_alt)+        , ("prop_matchValidatorProfunctor_alt", prop_matchValidatorProfunctor_alt)+        , ("prop_matchValidatorMonad_alt", prop_matchValidatorMonad_alt)+        , ("prop_matchValidatorMonadProfunctor_alt", prop_matchValidatorMonadProfunctor_alt)+        , ("prop_arrow_fmap_match", prop_arrow_fmap_match)+        , ("prop_arrow_id_match", prop_arrow_id_match)+        , ("prop_arrow_validator_alt", prop_arrow_validator_alt)+        , ("prop_arrow_validatorProfunctor_alt", prop_arrow_validatorProfunctor_alt)+        , ("prop_arrow_validatorMonad_alt", prop_arrow_validatorMonad_alt)+        , ("prop_arrow_validatorMonadProfunctor_alt", prop_arrow_validatorMonadProfunctor_alt)+        , ("prop_unmatch_match_matching", prop_unmatch_match_matching)+        , ("prop_unmatch_match_review", prop_unmatch_match_review)+        , ("prop_match_unmatch", prop_match_unmatch)+        , ("prop_unmatch_validatorProfunctor", prop_unmatch_validatorProfunctor)+        , ("prop_unmatch_validatorMonad", prop_unmatch_validatorMonad)+        , ("prop_unmatch_validatorMonadProfunctor", prop_unmatch_validatorMonadProfunctor)+        , ("prop_unmatch_arrow", prop_unmatch_arrow)+        , ("prop_unmatch_arrow_alt", prop_unmatch_arrow_alt)+        ] -  unless result $-    exitFailure+  unless result exitFailure +-- Generators+ genValidation :: Gen e -> Gen a -> Gen (Validation e a) genValidation e a = Gen.choice [fmap Failure e, fmap Success a] +genInt :: Gen Int+genInt = Gen.int (Range.linear (-100) 100)++genString :: Gen String+genString = Gen.string (Range.linear 0 50) Gen.unicode++genStrings :: Gen [String]+genStrings = Gen.list (Range.linear 1 10) genString+ testGen :: Gen (Validation [String] Int)-testGen =-  let range = Range.linear 1 50-      string = Gen.string range Gen.unicode-      strings = Gen.list range string-  in  genValidation strings Gen.enumBounded+testGen = genValidation genStrings genInt +testGenMonad :: Gen (ValidationMonad [String] Int)+testGenMonad = fmap (^. validationMonad) testGen++-- Semigroup / Monoid+ mkAssoc :: (Validation [String] Int -> Validation [String] Int -> Validation [String] Int) -> Property mkAssoc f =   let g = forAll testGen-      assoc = \x y z -> ((x `f` y) `f` z) === (x `f` (y `f` z))-  in  property $ join (liftA3 assoc g g g)+      assoc x y z = ((x `f` y) `f` z) === (x `f` (y `f` z))+   in property $ join (liftA3 assoc g g g) -prop_semigroup :: Property-prop_semigroup = mkAssoc (<>)+prop_semigroup_assoc :: Property+prop_semigroup_assoc = mkAssoc (<>)  prop_monoid_assoc :: Property prop_monoid_assoc = mkAssoc mappend@@ -60,3 +147,465 @@     x <- forAll testGen     (x `mappend` mempty) === x +-- Functor++prop_functor_id :: Property+prop_functor_id =+  property $ do+    x <- forAll testGen+    fmap Prelude.id x === x++prop_functor_compose :: Property+prop_functor_compose =+  property $ do+    x <- forAll testGen+    let f = (+ 1)+        g = (* 2)+    fmap (f Prelude.. g) x === fmap f (fmap g x)++-- Applicative / Apply++prop_applicative_id :: Property+prop_applicative_id =+  property $ do+    x <- forAll testGen+    (pure Prelude.id <*> x) === x++prop_applicative_homomorphism :: Property+prop_applicative_homomorphism =+  property $ do+    x <- forAll genInt+    let f = (+ 1)+    (pure f <*> pure x :: Validation [String] Int) === pure (f x)++prop_apply_compose :: Property+prop_apply_compose =+  property $ do+    w <- forAll testGen+    let u = Success (+ 1) :: Validation [String] (Int -> Int)+        v = Success (* 2) :: Validation [String] (Int -> Int)+    (fmap (Prelude..) u <.> v <.> w) === (u <.> (v <.> w))++-- Alt++prop_alt_assoc :: Property+prop_alt_assoc =+  property $ do+    x <- forAll testGen+    y <- forAll testGen+    z <- forAll testGen+    ((x <!> y) <!> z) === (x <!> (y <!> z))++prop_alt_left_catch :: Property+prop_alt_left_catch =+  property $ do+    x <- forAll genInt+    y <- forAll testGen+    (Success x <!> y) === (Success x :: Validation [String] Int)++-- Bifunctor++prop_bifunctor_id :: Property+prop_bifunctor_id =+  property $ do+    x <- forAll testGen+    bimap Prelude.id Prelude.id x === x++prop_bifunctor_compose :: Property+prop_bifunctor_compose =+  property $ do+    x <- forAll testGen+    let f = (++ ["x"])+        g = (+ 1)+        h = (++ ["y"])+        k = (* 2)+    bimap (f Prelude.. h) (g Prelude.. k) x === bimap f g (bimap h k x)++-- foldValidation++prop_foldValidation_failure :: Property+prop_foldValidation_failure =+  property $ do+    e <- forAll genStrings+    foldValidation length (const 0) (Failure e :: Validation [String] Int) === length e++prop_foldValidation_success :: Property+prop_foldValidation_success =+  property $ do+    a <- forAll genInt+    foldValidation (const 0) (+ 1) (Success a :: Validation [String] Int) === (a + 1)++-- Iso: either++prop_either_roundtrip :: Property+prop_either_roundtrip =+  property $ do+    x <- forAll testGen+    (x ^. either ^. from either) === x++prop_either_roundtrip_inv :: Property+prop_either_roundtrip_inv =+  property $ do+    x <- forAll testGen+    let e = x ^. either :: Prelude.Either [String] Int+    (e ^. from either) === x++-- Iso: codiagonal++prop_codiagonal_roundtrip :: Property+prop_codiagonal_roundtrip =+  property $ do+    x <- forAll (genValidation genInt genInt)+    (x ^. codiagonal ^. from codiagonal) === x++-- Prisms++prop_failure_prism_review_preview :: Property+prop_failure_prism_review_preview =+  property $ do+    e <- forAll genStrings+    let v = review _Failure e :: Validation [String] Int+    v ^? _Failure === Just e++prop_success_prism_review_preview :: Property+prop_success_prism_review_preview =+  property $ do+    a <- forAll genInt+    let v = review _Success a :: Validation [String] Int+    v ^? _Success === Just a++prop_failure_prism_miss :: Property+prop_failure_prism_miss =+  property $ do+    a <- forAll genInt+    (Success a :: Validation [String] Int) ^? _Failure === Nothing++prop_success_prism_miss :: Property+prop_success_prism_miss =+  property $ do+    e <- forAll genStrings+    (Failure e :: Validation [String] Int) ^? _Success === Nothing++-- Polymorphic prisms++prop_poly_failure_prism :: Property+prop_poly_failure_prism =+  property $ do+    e <- forAll genStrings+    let v = __Failure # e :: Validation [String] Int+    v ^? __Failure === Just e++prop_poly_success_prism :: Property+prop_poly_success_prism =+  property $ do+    a <- forAll genInt+    let v = __Success # a :: Validation [String] Int+    v ^? __Success === Just a++-- Injections++-- | Prism law: previewing a reviewed value gives that value back.+prop_prism_review_preview :: (Eq a, Show a) => APrism' s a -> Gen a -> Property+prop_prism_review_preview p ga =+  property $ do+    a <- forAll ga+    (clonePrism p # a) ^? clonePrism p === Just a++-- | Prism law: reviewing a matched value gives the original back, and a miss is unchanged.+prop_prism_matching_review :: (Eq s, Show s) => APrism' s a -> Gen s -> Property+prop_prism_matching_review p gs =+  property $ do+    s <- forAll gs+    Prelude.either Prelude.id (review (clonePrism p)) (matching p s) === s++prop_validationMonad_injection1_validation :: Property+prop_validationMonad_injection1_validation =+  property $ do+    v <- forAll testGen+    (v ^. validationMonad) ^? _I1 === v ^? _I1++prop_validationMonad_injection2_validation :: Property+prop_validationMonad_injection2_validation =+  property $ do+    v <- forAll testGen+    (v ^. validationMonad) ^? _I2 === v ^? _I2++-- Swap++prop_swap_failure :: Property+prop_swap_failure =+  property $ do+    e <- forAll genString+    let v = Failure e :: Validation String Int+    swap v === (Success e :: Validation Int String)++prop_swap_success :: Property+prop_swap_success =+  property $ do+    a <- forAll genInt+    let v = Success a :: Validation String Int+    swap v === (Failure a :: Validation Int String)++prop_swap_involution :: Property+prop_swap_involution =+  property $ do+    x <- forAll testGen+    (swap (swap x)) === x++-- Either instances: ReviewFailure, AsFailure, ReviewSuccess, AsSuccess++genEither :: Gen a -> Gen b -> Gen (Prelude.Either a b)+genEither ga gb = Gen.choice [fmap Left ga, fmap Right gb]++prop_either_reviewFailure :: Property+prop_either_reviewFailure =+  property $ do+    e <- forAll genStrings+    (reviewFailure # e :: Prelude.Either [String] Int) === Left e++prop_either_asFailure_hit :: Property+prop_either_asFailure_hit =+  property $ do+    e <- forAll genStrings+    (Left e :: Prelude.Either [String] Int) ^? _Failure === Just e++prop_either_asFailure_miss :: Property+prop_either_asFailure_miss =+  property $ do+    a <- forAll genInt+    (Right a :: Prelude.Either [String] Int) ^? _Failure === Nothing++prop_either_reviewSuccess :: Property+prop_either_reviewSuccess =+  property $ do+    a <- forAll genInt+    (reviewSuccess # a :: Prelude.Either [String] Int) === Right a++prop_either_asSuccess_hit :: Property+prop_either_asSuccess_hit =+  property $ do+    a <- forAll genInt+    (Right a :: Prelude.Either [String] Int) ^? _Success === Just a++prop_either_asSuccess_miss :: Property+prop_either_asSuccess_miss =+  property $ do+    e <- forAll genStrings+    (Left e :: Prelude.Either [String] Int) ^? _Success === Nothing++prop_either_failure_roundtrip :: Property+prop_either_failure_roundtrip =+  property $ do+    x <- forAll (genEither genStrings genInt)+    let reviewed = x ^? _Failure+    case x of+      Left e -> reviewed === Just e+      Right _ -> reviewed === Nothing++prop_either_success_roundtrip :: Property+prop_either_success_roundtrip =+  property $ do+    x <- forAll (genEither genStrings genInt)+    let reviewed = x ^? _Success+    case x of+      Right a -> reviewed === Just a+      Left _ -> reviewed === Nothing++-- match++matchRight :: Validator (Prelude.Either [String] Int) (Prelude.Either [String] Int) Int+matchRight = match _Right++runValidator :: Validator x err a -> x -> Validation err a+runValidator (Validator f) = f++prop_match_hit :: Property+prop_match_hit =+  property $ do+    a <- forAll genInt+    runValidator matchRight (Right a) === Success a++prop_match_miss :: Property+prop_match_miss =+  property $ do+    e <- forAll genStrings+    runValidator matchRight (Left e) === Failure (Left e)++prop_match_validatorProfunctor :: Property+prop_match_validatorProfunctor =+  property $ do+    x <- forAll (genEither genStrings genInt)+    let ValidatorProfunctor f = match _Right :: ValidatorProfunctor (Prelude.Either [String] Int) (Prelude.Either [String] Int) Int+    f x === runValidator matchRight x++prop_match_validatorMonad :: Property+prop_match_validatorMonad =+  property $ do+    x <- forAll (genEither genStrings genInt)+    let ValidatorMonadT f = match _Right :: ValidatorMonad (Prelude.Either [String] Int) (Prelude.Either [String] Int) Int+        ValidationMonadT (Identity r) = f x+    r === runValidator matchRight x++prop_match_validatorMonadProfunctor :: Property+prop_match_validatorMonadProfunctor =+  property $ do+    x <- forAll (genEither genStrings genInt)+    let ValidatorMonadProfunctorT f = match _Right :: ValidatorMonadProfunctor (Prelude.Either [String] Int) (Prelude.Either [String] Int) Int+        ValidationMonadT (Identity r) = f x+    r === runValidator matchRight x++-- match with (<!>): one prism per constructor, the first match wins++-- | The input used by the (<!>) properties: a Left, a Right Just, or a Right Nothing.+type Input = Prelude.Either String (Maybe Int)++genInput :: Gen Input+genInput = genEither genString (Gen.maybe genInt)++-- | The expected result: Left and Right Just match, Right Nothing matches neither prism.+expected :: Input -> Validation Input String+expected (Left s) = Success s+expected (Right (Just n)) = Success (show n)+expected i@(Right Nothing) = Failure i++prop_match_alt :: Property+prop_match_alt =+  property $ do+    i <- forAll genInput+    let v = match _Left <!> (show <$> match (_Right Prelude.. _Just)) :: Validator Input Input String+    runValidator v i === expected i++prop_matchValidator_alt :: Property+prop_matchValidator_alt =+  property $ do+    i <- forAll genInput+    let v = matchValidator _Left <!> (show <$> matchValidator (_Right Prelude.. _Just))+    runValidator v i === expected i++prop_matchValidatorProfunctor_alt :: Property+prop_matchValidatorProfunctor_alt =+  property $ do+    i <- forAll genInput+    let ValidatorProfunctor f = matchValidatorProfunctor _Left <!> (show <$> matchValidatorProfunctor (_Right Prelude.. _Just))+    f i === expected i++prop_matchValidatorMonad_alt :: Property+prop_matchValidatorMonad_alt =+  property $ do+    i <- forAll genInput+    let ValidatorMonadT f = matchValidatorMonad _Left <!> (show <$> matchValidatorMonad (_Right Prelude.. _Just))+        ValidationMonadT (Identity r) = f i+    r === expected i++prop_matchValidatorMonadProfunctor_alt :: Property+prop_matchValidatorMonadProfunctor_alt =+  property $ do+    i <- forAll genInput+    let ValidatorMonadProfunctorT f = matchValidatorMonadProfunctor _Left <!> (show <$> matchValidatorMonadProfunctor (_Right Prelude.. _Just))+        ValidationMonadT (Identity r) = f i+    r === expected i++-- (-->): match a prism and map its focus, one case per constructor++prop_arrow_fmap_match :: Property+prop_arrow_fmap_match =+  property $ do+    i <- forAll genInput+    let v = _Right Prelude.. _Just --> show :: Validator Input Input String+    runValidator v i === runValidator (show <$> matchValidator (_Right Prelude.. _Just)) i++prop_arrow_id_match :: Property+prop_arrow_id_match =+  property $ do+    i <- forAll genInput+    let v = _Left --> Prelude.id :: Validator Input Input String+    runValidator v i === runValidator (matchValidator _Left) i++prop_arrow_validator_alt :: Property+prop_arrow_validator_alt =+  property $ do+    i <- forAll genInput+    let v = _Left --> Prelude.id <!> _Right Prelude.. _Just --> show :: Validator Input Input String+    runValidator v i === expected i++prop_arrow_validatorProfunctor_alt :: Property+prop_arrow_validatorProfunctor_alt =+  property $ do+    i <- forAll genInput+    let ValidatorProfunctor f = _Left --> Prelude.id <!> _Right Prelude.. _Just --> show :: ValidatorProfunctor Input Input String+    f i === expected i++prop_arrow_validatorMonad_alt :: Property+prop_arrow_validatorMonad_alt =+  property $ do+    i <- forAll genInput+    let ValidatorMonadT f = _Left --> Prelude.id <!> _Right Prelude.. _Just --> show :: ValidatorMonad Input Input String+        ValidationMonadT (Identity r) = f i+    r === expected i++prop_arrow_validatorMonadProfunctor_alt :: Property+prop_arrow_validatorMonadProfunctor_alt =+  property $ do+    i <- forAll genInput+    let ValidatorMonadProfunctorT f = _Left --> Prelude.id <!> _Right Prelude.. _Just --> show :: ValidatorMonadProfunctor Input Input String+        ValidationMonadT (Identity r) = f i+    r === expected i++-- unmatch and (<--): construct a prism from a review and a validator++-- | A validator that succeeds on a positive number, and fails with its input otherwise.+positive :: Validator Int Int Int+positive = Validator (\n -> if n > 0 then Success n else Failure n)++-- | The expected match of positive.+expectedPositive :: Int -> Prelude.Either Int Int+expectedPositive n = if n > 0 then Right n else Left n++prop_unmatch_match_matching :: Property+prop_unmatch_match_matching =+  property $ do+    x <- forAll (genEither genStrings genInt)+    matching (unmatch _Right matchRight) x === matching _Right x++prop_unmatch_match_review :: Property+prop_unmatch_match_review =+  property $ do+    a <- forAll genInt+    review (unmatch _Right matchRight) a === (review _Right a :: Prelude.Either [String] Int)++prop_match_unmatch :: Property+prop_match_unmatch =+  property $ do+    n <- forAll genInt+    runValidator (matchValidator (unmatch Prelude.id positive)) n === runValidator positive n++prop_unmatch_validatorProfunctor :: Property+prop_unmatch_validatorProfunctor =+  property $ do+    n <- forAll genInt+    matching (unmatch Prelude.id (positive ^. validatorProfunctor)) n === expectedPositive n++prop_unmatch_validatorMonad :: Property+prop_unmatch_validatorMonad =+  property $ do+    n <- forAll genInt+    matching (unmatch Prelude.id (positive ^. validatorMonadT)) n === expectedPositive n++prop_unmatch_validatorMonadProfunctor :: Property+prop_unmatch_validatorMonadProfunctor =+  property $ do+    n <- forAll genInt+    matching (unmatch Prelude.id (positive ^. validatorMonadProfunctorT)) n === expectedPositive n++prop_unmatch_arrow :: Property+prop_unmatch_arrow =+  property $ do+    n <- forAll genInt+    matching (Prelude.id <-- positive) n === matching (unmatch Prelude.id positive) n++prop_unmatch_arrow_alt :: Property+prop_unmatch_arrow_alt =+  property $ do+    i <- forAll genInput+    let p = _Left <-- matchValidator _Left <!> show <$> matchValidator (_Right Prelude.. _Just)+    matching p i === expected i ^. either

@@ -1,131 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where--import Test.HUnit--import Prelude hiding (length)-import Control.Lens ((#))-import Control.Monad (when)-import Data.Foldable (length)-import Data.Proxy (Proxy (Proxy))-import Data.Validation (Validation (Success, Failure), Validate, _Failure, _Success, ensure,-                        orElse, validate, validation, validationNel)-import System.Exit (exitFailure)--seven :: Int-seven = 7--three :: Int-three = 3--testYY :: Test-testYY =-  let subject  = _Success # (+1) <*> _Success # seven :: Validation String Int-      expected = Success 8-  in  TestCase (assertEqual "Success <*> Success" subject expected)--testNY :: Test-testNY =-  let subject  = _Failure # ["f1"] <*> _Success # seven :: Validation [String] Int-      expected = Failure ["f1"]-  in  TestCase (assertEqual "Failure <*> Success" subject expected)--testYN :: Test-testYN =-  let subject  = _Success # (+1) <*> _Failure # ["f2"] :: Validation [String] Int-      expected = Failure ["f2"]-  in  TestCase (assertEqual "Success <*> Failure" subject expected)--testNN :: Test-testNN =-  let subject  = _Failure # ["f1"] <*> _Failure # ["f2"] :: Validation [String] Int-      expected = Failure ["f1","f2"]-  in  TestCase (assertEqual "Failure <*> Failure" subject expected)--testValidationNel :: Test-testValidationNel =-  let subject  = validation length (const 0) $ validationNel (Left ())-  in  TestCase (assertEqual "validationNel makes lists of length 1" subject 1)--testEnsureLeftFalse, testEnsureLeftTrue, testEnsureRightFalse, testEnsureRightTrue,-  testOrElseRight, testOrElseLeft-  :: forall v. (Validate v, Eq (v Int Int), Show (v Int Int)) => Proxy v -> Test--testEnsureLeftFalse _ =-  let subject :: v Int Int-      subject = ensure three (const False) (_Failure # seven)-  in  TestCase (assertEqual "ensure Left False" subject (_Failure # seven))--testEnsureLeftTrue _ =-  let subject :: v Int Int-      subject = ensure three (const True) (_Failure # seven)-  in  TestCase (assertEqual "ensure Left True" subject (_Failure # seven))--testEnsureRightFalse _ =-  let subject :: v Int Int-      subject = ensure three (const False) (_Success # seven)-  in  TestCase (assertEqual "ensure Right False" subject (_Failure # three))--testEnsureRightTrue _ =-  let subject :: v Int Int-      subject = ensure three (const True ) (_Success # seven)-  in  TestCase (assertEqual "ensure Right True" subject (_Success # seven))--testOrElseRight _ =-  let v :: v Int Int-      v = _Success # seven-      subject = v `orElse` three-  in  TestCase (assertEqual "orElseRight" subject seven)--testOrElseLeft _ =-  let v :: v Int Int-      v = _Failure # seven-      subject = v `orElse` three-  in  TestCase (assertEqual "orElseLeft" subject three)--testValidateTrue :: Test-testValidateTrue =-  let subject = validate three (const True) seven-      expected = Success seven-  in  TestCase (assertEqual "testValidateTrue" subject expected)--testValidateFalse :: Test-testValidateFalse =-  let subject = validate three (const False) seven-      expected = Failure three-  in  TestCase (assertEqual "testValidateFalse" subject expected)--tests :: Test-tests =-  let eitherP :: Proxy Either-      eitherP = Proxy-      validationP :: Proxy Validation-      validationP = Proxy-      generals :: forall v. (Validate v, Eq (v Int Int), Show (v Int Int)) => [Proxy v -> Test]-      generals =-        [ testEnsureLeftFalse-        , testEnsureLeftTrue-        , testEnsureRightFalse-        , testEnsureRightTrue-        , testOrElseLeft-        , testOrElseRight-        ]-      eithers = fmap ($ eitherP) generals-      validations = fmap ($ validationP) generals-  in  TestList $ [-    testYY-  , testYN-  , testNY-  , testNN-  , testValidationNel-  , testValidateFalse-  , testValidateTrue-  ] ++ eithers ++ validations-  where--main :: IO ()-main = do-  c <- runTestTT tests-  when (errors c > 0 || failures c > 0) exitFailure-

@@ -1,59 +1,90 @@ name:               validation-version:            1+version:            1.3.3 license:            BSD3 license-file:       LICENCE author:             Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart>-maintainer:         Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart>, Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer:         Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart> copyright:          Copyright (C) 2010-2013 Tony Morris, Nick Partridge                     Copyright (C) 2014,2015 NICTA Limited-                    Copyright (c) 2016,2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.+                    Copyright (c) 2016-2019 Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230+                    Copyright (c) 2019-2026 Tony Morris synopsis:           A data-type like Either but with an accumulating Applicative category:           Data description:-  <<http://i.imgur.com/uZnp9ke.png>>-  .-  A data-type like Either but with differing properties and type-class-  instances.+  <<https://logo.systemf.com.au/systemf-450x450.png>>   .-  Library support is provided for this different representation, include-  `lens`-related functions for converting between each and abstracting over their-  similarities.+  A data type like @Either@ but with an accumulating @Applicative@ instance.   .-  * `Validation`+  == @Validation@   .-  The `Validation` data type is isomorphic to `Either`, but has an instance-  of `Applicative` that accumulates on the error side. That is to say, if two-  (or more) errors are encountered, they are appended using a `Semigroup`+  The @Validation@ data type is isomorphic to @Either@, but has an instance+  of @Applicative@ that accumulates on the error side. That is to say, if two+  (or more) errors are encountered, they are appended using a @Semigroup@   operation.   .-  As a consequence of this `Applicative` instance, there is no corresponding-  `Bind` or `Monad` instance. `Validation` is an example of, "An applicative+  As a consequence of this @Applicative@ instance, there is no corresponding+  @Bind@ or @Monad@ instance. @Validation@ is an example of, "An applicative   functor that is not a monad."+  .+  The library provides:+  .+  * Classy optics (@GetValidation@, @HasValidation@, @ReviewValidation@,+    @AsValidation@) following the conventions of @makeClassy@ and+    @makeClassyPrisms@ from @lens@.+  * Polymorphic prisms (@__Failure@, @__Success@) for type-changing operations.+  * Isomorphisms to @Either@ and @(Bool, a)@.+  .+  == @ValidationMonadT@+  .+  @ValidationMonadT err m a@ is a monad transformer wrapping @m (Validation err a)@.+  Unlike @Validation@, it has short-circuiting @Applicative@, @Bind@, @Monad@,+  and @MonadError@ instances.+  .+  == Validators+  .+  Four validator newtypes wrap a validation function with different type+  parameter orders, enabling different class instances:+  .+  * @Validator x err a@ — @Bifunctor@, accumulating @Applicative@, @Either@-like @Alt@+  * @ValidatorProfunctor err x a@ — @Profunctor@, accumulating @Applicative@+  * @ValidatorMonadT x err f a@ — @Monad@, @MonadTrans@, @BindTrans@+  * @ValidatorMonadProfunctorT err f x a@ — @Profunctor@, @Monad@, @Category@, @Arrow@+  .+  All four are isomorphic and have cross-type optics instances.+  .+  @Validator@ is the odd one out in its @Alt@ instance. For the other three+  validators, @\<!\>@ accumulates errors when both sides fail. For @Validator@,+  @\<!\>@ behaves like @Either@: the first success wins, otherwise the second+  failure is returned. @Validator@ has no @Plus@ or @Alternative@ instance, and+  its @\<\>@ still accumulates errors. -homepage:           https://github.com/qfpl/validation-bug-reports:        https://github.com/qfpl/validation/issues+homepage:           https://github.com/system-f/validation+bug-reports:        https://github.com/system-f/validation/issues cabal-version:      >= 1.10 build-type:         Simple extra-source-files: changelog-tested-with:        GHC==8.4.1, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+tested-with:        GHC == 9.10.3, GHC == 9.8.4, GHC == 9.6.7  source-repository   head   type:             git-  location:         git@github.com:qfpl/validation.git+  location:         git@github.com:system-f/validation.git  library   default-language:                     Haskell2010    build-depends:-                      base          >= 4.5 && < 5-                    , deepseq       >= 1.2 && < 1.5-                    , semigroups    >= 0.8 && < 1-                    , semigroupoids >= 5   && < 6-                    , bifunctors    >= 5.1 && < 6-                    , lens          >= 4   && < 5-  if impl(ghc>=7.2) && impl(ghc<7.5)-    build-depends: ghc-prim == 0.2.0.0+                      base          >= 4.18    && < 5+                    , assoc         >= 1.1     && < 2+                    , deepseq       >= 1.4.8.1 && < 2+                    , either-n      >= 0.1     && < 0.2+                    , selective     >= 0.7     && < 1+                    , semigroupoids >= 6.0.0.1 && < 7+                    , bifunctors    >= 5.6     && < 6+                    , lens          >= 5.2.1   && < 6+                    , mtl           >= 2.3.1   && < 2.4+                    , profunctors   >= 5.6.2   && < 6+                    , transformers  >= 0.6.1.0 && < 0.7    ghc-options:                     -Wall@@ -63,6 +94,9 @@    exposed-modules:                     Data.Validation+                    Data.Validation.Validation+                    Data.Validation.ValidationMonad+                    Data.Validation.Validator  test-suite hedgehog   type:@@ -75,9 +109,13 @@                     Haskell2010    build-depends:-                      base       >= 3   && < 5-                    , hedgehog   >= 0.5 && < 0.6-                    , semigroups >= 0.8 && < 1+                      base          >= 4.18    && < 5+                    , assoc         >= 1.1     && < 2+                    , bifunctors    >= 5.6     && < 6+                    , either-n      >= 0.1     && < 0.2+                    , hedgehog      >= 1.2     && < 2+                    , lens          >= 5.2.1   && < 6+                    , semigroupoids >= 6.0.0.1 && < 7                     , validation    ghc-options:@@ -87,21 +125,19 @@   hs-source-dirs:                     test -test-suite hunit+test-suite doctest   type:                     exitcode-stdio-1.0    main-is:-                    hunit_tests.hs+                    doctest_tests.hs    default-language:                     Haskell2010    build-depends:-                      base       >= 3   && < 5-                    , HUnit      >= 1.5 && < 1.7-                    , lens       >= 4   && < 5-                    , semigroups >= 0.8 && < 1+                      base    >= 4.18     && < 5+                    , process >= 1.6.19.0 && < 2                     , validation    ghc-options: