validation 1 → 1.1
raw patch · 5 files changed
+61/−41 lines, 5 filesdep ~hedgehogsetup-changed
Dependency ranges changed: hedgehog
Files
- Setup.hs +0/−2
- changelog +4/−0
- src/Data/Validation.hs +14/−12
- test/hunit_tests.hs +39/−23
- validation.cabal +4/−4
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
changelog view
@@ -1,3 +1,7 @@+1.1++* Generalise types of `validate` and `ensure` functions to use `Maybe` instead of `Bool`+ 1 * Rename `AccValidation` to `Validation`
src/Data/Validation.hs view
@@ -50,7 +50,6 @@ 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)@@ -68,7 +67,7 @@ #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) #endif-import Prelude(Show)+import Prelude(Show, Maybe(..)) -- | An @Validation@ is either a value of the type @err@ or @a@, similar to 'Either'. However,@@ -114,6 +113,7 @@ (<*>) = (<.>) +-- | For two errors, this instance reports only the last of them. instance Alt (Validation err) where Failure _ <!> x = x@@ -202,16 +202,18 @@ Failure e -> rnf e Success a -> rnf a --- | 'validate's the @a@ with the given predicate, returning @e@ if the predicate does not hold.+-- | 'validate's an @a@ producing an updated optional value, returning+-- @e@ in the empty case. -- -- This can be thought of as having the less general type: -- -- @--- validate :: e -> (a -> Bool) -> a -> Validation e a+-- validate :: e -> (a -> Maybe b) -> a -> Validation e b -- @-validate :: Validate v => e -> (a -> Bool) -> a -> v e a-validate e p a =- if p a then _Success # a else _Failure # e+validate :: Validate v => e -> (a -> Maybe b) -> a -> v e b+validate e p a = case p a of+ Nothing -> _Failure # e+ Just b -> _Success # b -- | 'validationNel' is 'liftError' specialised to 'NonEmpty' lists, since -- they are a common semigroup to use.@@ -265,15 +267,16 @@ codiagonal :: Validation a a -> a codiagonal = valueOr id --- | 'ensure' leaves the validation unchanged when the predicate holds, or--- fails with @e@ otherwise.+-- | 'ensure' ensures that a validation remains unchanged upon failure,+-- updating a successful validation with an optional value that could fail+-- 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 :: e -> (a -> Maybe b) -> Validation e a -> Validation e b -- @-ensure :: Validate v => e -> (a -> Bool) -> v e a -> v e a+ensure :: Validate v => e -> (a -> Maybe b) -> v e a -> v e b ensure e p = over _Validation $ \v -> case v of Failure x -> Failure x@@ -370,4 +373,3 @@ -- | '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-
test/hunit_tests.hs view
@@ -19,6 +19,9 @@ three :: Int three = 3 +four :: Int+four = 4+ testYY :: Test testYY = let subject = _Success # (+1) <*> _Success # seven :: Validation String Int@@ -48,30 +51,35 @@ 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+testEnsureLeftNothing, testEnsureLeftJust, testEnsureRightNothing,+ testEnsureRightJust, testEnsureRightJust', testOrElseRight, testOrElseLeft :: forall v. (Validate v, Eq (v Int Int), Show (v Int Int)) => Proxy v -> Test -testEnsureLeftFalse _ =+testEnsureLeftNothing _ = let subject :: v Int Int- subject = ensure three (const False) (_Failure # seven)+ subject = ensure three (const Nothing) (_Failure # seven) in TestCase (assertEqual "ensure Left False" subject (_Failure # seven)) -testEnsureLeftTrue _ =+testEnsureLeftJust _ = let subject :: v Int Int- subject = ensure three (const True) (_Failure # seven)+ subject = ensure three (Just . id) (_Failure # seven) in TestCase (assertEqual "ensure Left True" subject (_Failure # seven)) -testEnsureRightFalse _ =+testEnsureRightNothing _ = let subject :: v Int Int- subject = ensure three (const False) (_Success # seven)+ subject = ensure three (const Nothing) (_Success # seven) in TestCase (assertEqual "ensure Right False" subject (_Failure # three)) -testEnsureRightTrue _ =+testEnsureRightJust _ = let subject :: v Int Int- subject = ensure three (const True ) (_Success # seven)+ subject = ensure three (Just . id) (_Success # seven) in TestCase (assertEqual "ensure Right True" subject (_Success # seven)) +testEnsureRightJust' _ =+ let subject :: v Int Int+ subject = ensure three (const $ Just four) (_Success # seven)+ in TestCase (assertEqual "ensure Right True" subject (_Success # four))+ testOrElseRight _ = let v :: v Int Int v = _Success # seven@@ -84,16 +92,23 @@ subject = v `orElse` three in TestCase (assertEqual "orElseLeft" subject three) -testValidateTrue :: Test-testValidateTrue =- let subject = validate three (const True) seven+testValidateJust :: Test+testValidateJust =+ let subject = validate three (Just . id) seven expected = Success seven in TestCase (assertEqual "testValidateTrue" subject expected) -testValidateFalse :: Test-testValidateFalse =- let subject = validate three (const False) seven+testValidateJust' :: Test+testValidateJust' =+ let subject = validate three (const $ Just four) seven+ expected = Success four+ in TestCase (assertEqual "testValidateTrue" subject expected)++testValidateNothing :: Test+testValidateNothing =+ let subject = validate three (const option) seven expected = Failure three+ option = Nothing :: Maybe Int in TestCase (assertEqual "testValidateFalse" subject expected) tests :: Test@@ -104,10 +119,11 @@ validationP = Proxy generals :: forall v. (Validate v, Eq (v Int Int), Show (v Int Int)) => [Proxy v -> Test] generals =- [ testEnsureLeftFalse- , testEnsureLeftTrue- , testEnsureRightFalse- , testEnsureRightTrue+ [ testEnsureLeftNothing+ , testEnsureLeftJust+ , testEnsureRightNothing+ , testEnsureRightJust+ , testEnsureRightJust' , testOrElseLeft , testOrElseRight ]@@ -119,8 +135,9 @@ , testNY , testNN , testValidationNel- , testValidateFalse- , testValidateTrue+ , testValidateNothing+ , testValidateJust+ , testValidateJust' ] ++ eithers ++ validations where @@ -128,4 +145,3 @@ main = do c <- runTestTT tests when (errors c > 0 || failures c > 0) exitFailure-
validation.cabal view
@@ -1,12 +1,12 @@ name: validation-version: 1+version: 1.1 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ɐɥ> 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. synopsis: A data-type like Either but with an accumulating Applicative category: Data description:@@ -35,7 +35,7 @@ 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==8.6.4, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 source-repository head type: git@@ -76,7 +76,7 @@ build-depends: base >= 3 && < 5- , hedgehog >= 0.5 && < 0.6+ , hedgehog >= 0.5 && < 0.7 , semigroups >= 0.8 && < 1 , validation