validation 0.6.2 → 0.6.3
raw patch · 7 files changed
+231/−206 lines, 7 filesdep +deepseqdep +ghc-primdep −mtldep −transformers
Dependencies added: deepseq, ghc-prim
Dependencies removed: mtl, transformers
Files
- changelog +5/−0
- src/Data/Validation.hs +24/−5
- test/hedgehog.hs +0/−63
- test/hedgehog_tests.hs +62/−0
- test/hunit.hs +0/−127
- test/hunit_tests.hs +131/−0
- validation.cabal +9/−11
changelog view
@@ -1,3 +1,8 @@+0.6.3++* Add `Generic` and `NFData` instances+* Make AccValidation Apply and Applicative lazier+ 0.6.2 * Add `bindValidation` and `validationed`
src/Data/Validation.hs view
@@ -1,7 +1,12 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-} +#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE DeriveGeneric #-}+#endif+ -- | A data type similar to @Data.Either@ that accumulates failures. module Data.Validation (@@ -36,6 +41,7 @@ ) 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)@@ -59,6 +65,9 @@ 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) @@ -75,7 +84,12 @@ data AccValidation err a = AccFailure err | AccSuccess a- deriving (Eq, Ord, Show, Data, Typeable)+ deriving (+ Eq, Ord, Show, Data, Typeable+#if __GLASGOW_HASKELL__ >= 702+ , Generic+#endif+ ) instance Functor (AccValidation err) where fmap _ (AccFailure e) =@@ -85,10 +99,9 @@ {-# INLINE fmap #-} instance Semigroup err => Apply (AccValidation err) where- AccFailure e1 <.> AccFailure e2 =- AccFailure (e1 <> e2)- AccFailure e1 <.> AccSuccess _ =- AccFailure e1+ AccFailure e1 <.> b = AccFailure $ case b of+ AccFailure e2 -> e1 <> e2+ AccSuccess _ -> e1 AccSuccess _ <.> AccFailure e2 = AccFailure e2 AccSuccess f <.> AccSuccess a =@@ -182,6 +195,12 @@ AccFailure a -> AccSuccess a AccSuccess e -> AccFailure e) {-# INLINE swapped #-}++instance (NFData e, NFData a) => NFData (AccValidation e a) where+ rnf v =+ case v of+ AccFailure e -> rnf e+ AccSuccess a -> rnf a -- | 'validate's the @a@ with the given predicate, returning @e@ if the predicate does not hold. --
− test/hedgehog.hs
@@ -1,63 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Control.Applicative (liftA3)-import Control.Monad (join, unless)-import Data.Semigroup ((<>))-import Data.Monoid (Monoid (mappend))-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 (AccValidation (AccSuccess, AccFailure))--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)- ]-- unless result $- exitFailure--genAccValidation :: Gen e -> Gen a -> Gen (AccValidation e a)-genAccValidation e a = Gen.choice [fmap AccFailure e, fmap AccSuccess a]--testGen :: Gen (AccValidation [String] Int)-testGen =- let range = Range.linear 1 50- string = Gen.string range Gen.unicode- strings = Gen.list range string- in genAccValidation strings Gen.enumBounded--mkAssoc :: (AccValidation [String] Int -> AccValidation [String] Int -> AccValidation [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)--prop_semigroup :: Property-prop_semigroup = mkAssoc (<>)--prop_monoid_assoc :: Property-prop_monoid_assoc = mkAssoc mappend--prop_monoid_left_id :: Property-prop_monoid_left_id =- property $ do- x <- forAll testGen- (mempty `mappend` x) === x--prop_monoid_right_id :: Property-prop_monoid_right_id =- property $ do- x <- forAll testGen- (x `mappend` mempty) === x-
+ test/hedgehog_tests.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++import Control.Applicative (liftA3)+import Control.Monad (join, unless)+import Data.Semigroup ((<>))+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 (AccValidation (AccSuccess, AccFailure))++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)+ ]++ unless result $+ exitFailure++genAccValidation :: Gen e -> Gen a -> Gen (AccValidation e a)+genAccValidation e a = Gen.choice [fmap AccFailure e, fmap AccSuccess a]++testGen :: Gen (AccValidation [String] Int)+testGen =+ let range = Range.linear 1 50+ string = Gen.string range Gen.unicode+ strings = Gen.list range string+ in genAccValidation strings Gen.enumBounded++mkAssoc :: (AccValidation [String] Int -> AccValidation [String] Int -> AccValidation [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)++prop_semigroup :: Property+prop_semigroup = mkAssoc (<>)++prop_monoid_assoc :: Property+prop_monoid_assoc = mkAssoc mappend++prop_monoid_left_id :: Property+prop_monoid_left_id =+ property $ do+ x <- forAll testGen+ (mempty `mappend` x) === x++prop_monoid_right_id :: Property+prop_monoid_right_id =+ property $ do+ x <- forAll testGen+ (x `mappend` mempty) === x+
− test/hunit.hs
@@ -1,127 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where--import Test.HUnit--import Prelude hiding (length)-import Control.Lens ((#))-import Data.Foldable (length)-import Data.Proxy (Proxy (Proxy))-import Data.Validation (AccValidation (AccSuccess, AccFailure), Validate, _Failure, _Success, ensure,- orElse, validate, validation, validationNel)--seven :: Int-seven = 7--three :: Int-three = 3--testYY :: Test-testYY =- let subject = _Success # (+1) <*> _Success # seven :: AccValidation String Int- expected = AccSuccess 8- in TestCase (assertEqual "Success <*> Success" subject expected)--testNY :: Test-testNY =- let subject = _Failure # ["f1"] <*> _Success # seven :: AccValidation [String] Int- expected = AccFailure ["f1"]- in TestCase (assertEqual "Failure <*> Success" subject expected)--testYN :: Test-testYN =- let subject = _Success # (+1) <*> _Failure # ["f2"] :: AccValidation [String] Int- expected = AccFailure ["f2"]- in TestCase (assertEqual "Success <*> Failure" subject expected)--testNN :: Test-testNN =- let subject = _Failure # ["f1"] <*> _Failure # ["f2"] :: AccValidation [String] Int- expected = AccFailure ["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 = AccSuccess seven- in TestCase (assertEqual "testValidateTrue" subject expected)--testValidateFalse :: Test-testValidateFalse =- let subject = validate three (const True) seven- expected = AccFailure three- in TestCase (assertEqual "testValidateFalse" subject expected)--tests :: Test-tests =- let eitherP :: Proxy Either- eitherP = Proxy- validationP :: Proxy AccValidation- 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 Counts-main = runTestTT tests-
+ test/hunit_tests.hs view
@@ -0,0 +1,131 @@+{-# 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 (AccValidation (AccSuccess, AccFailure), 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 :: AccValidation String Int+ expected = AccSuccess 8+ in TestCase (assertEqual "Success <*> Success" subject expected)++testNY :: Test+testNY =+ let subject = _Failure # ["f1"] <*> _Success # seven :: AccValidation [String] Int+ expected = AccFailure ["f1"]+ in TestCase (assertEqual "Failure <*> Success" subject expected)++testYN :: Test+testYN =+ let subject = _Success # (+1) <*> _Failure # ["f2"] :: AccValidation [String] Int+ expected = AccFailure ["f2"]+ in TestCase (assertEqual "Success <*> Failure" subject expected)++testNN :: Test+testNN =+ let subject = _Failure # ["f1"] <*> _Failure # ["f2"] :: AccValidation [String] Int+ expected = AccFailure ["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 = AccSuccess seven+ in TestCase (assertEqual "testValidateTrue" subject expected)++testValidateFalse :: Test+testValidateFalse =+ let subject = validate three (const False) seven+ expected = AccFailure three+ in TestCase (assertEqual "testValidateFalse" subject expected)++tests :: Test+tests =+ let eitherP :: Proxy Either+ eitherP = Proxy+ validationP :: Proxy AccValidation+ 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+
validation.cabal view
@@ -1,12 +1,12 @@ name: validation-version: 0.6.2+version: 0.6.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ɐɥ> copyright: Copyright (C) 2010-2013 Tony Morris, Nick Partridge-copyright: Copyright (C) 2014,2015 NICTA Limited-copyright: Copyright (c) 2016,2017, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.+ Copyright (C) 2014,2015 NICTA Limited+ Copyright (c) 2016,2017, 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,27 +35,25 @@ cabal-version: >= 1.10 build-type: Simple extra-source-files: changelog-tested-with: GHC==8.2.1, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+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 source-repository head type: git location: git@github.com:qfpl/validation.git -flag small_base- description: Choose the new, split-up base package.- library default-language: Haskell2010 build-depends: base >= 3 && < 5- , mtl >= 2.0 && < 2.3+ , deepseq >= 1.2 && < 1.5 , semigroups >= 0.8 && < 1 , semigroupoids >= 5 && < 6 , bifunctors >= 5.1 && < 6 , lens >= 4 && < 5- , transformers >= 0.3 && < 0.6+ if impl(ghc>=7.2) && impl(ghc<7.5)+ build-depends: ghc-prim == 0.2.0.0 ghc-options: -Wall@@ -71,7 +69,7 @@ exitcode-stdio-1.0 main-is:- hedgehog.hs+ hedgehog_tests.hs default-language: Haskell2010@@ -94,7 +92,7 @@ exitcode-stdio-1.0 main-is:- hunit.hs+ hunit_tests.hs default-language: Haskell2010