genvalidity 0.3.2.0 → 0.4.0.0

raw patch · 3 files changed

+291/−63 lines, 3 filesdep ~validityPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: validity

API changes (from Hackage documentation)

Files

• genvalidity.cabal +22/−8
• src/Data/GenValidity.hs +262/−48
• test/Data/GenValiditySpec.hs +7/−7

@@ -1,5 +1,5 @@ name: genvalidity-version: 0.3.2.0+version: 0.4.0.0 cabal-version: >=1.10 build-type: Simple license: MIT@@ -11,13 +11,26 @@ description:     Note: There are companion instance packages for this library:     .-    * <https://hackage.haskell.org/package/genvalidity-text genvalidity-text>+    * <https://hackage.haskell.org/package/genvalidity-aeson genvalidity-aeson>     .-    * <https://hackage.haskell.org/package/genvalidity-time genvalidity-time>+    * <https://hackage.haskell.org/package/genvalidity-bytestring genvalidity-bytestring>     .     * <https://hackage.haskell.org/package/genvalidity-containers genvalidity-containers>     .     * <https://hackage.haskell.org/package/genvalidity-path genvalidity-path>+    .+    * <https://hackage.haskell.org/package/genvalidity-scientific genvalidity-scientific>+    .+    * <https://hackage.haskell.org/package/genvalidity-text genvalidity-text>+    .+    * <https://hackage.haskell.org/package/genvalidity-time genvalidity-time>+    .+    * <https://hackage.haskell.org/package/genvalidity-unordered-containers genvalidity-unordered-containers>+    .+    * <https://hackage.haskell.org/package/genvalidity-uuid genvalidity-uuid>+    .+    * <https://hackage.haskell.org/package/genvalidity-vector genvalidity-vector>+    . category: Testing author: Tom Sydney Kerckhove @@ -26,17 +39,18 @@     location: https://github.com/NorfairKing/validity  library+    +    if impl(ghc >=8.0.0)+        ghc-options: -Wno-redundant-constraints     exposed-modules:         Data.GenValidity         Data.GenRelativeValidity     build-depends:-        base >= 4.7 && <5,-        validity >=0.3 && <0.4,+        base >=4.7 && <5,+        validity >=0.4 && <0.5,         QuickCheck >=2.7 && <2.10     default-language: Haskell2010     hs-source-dirs: src-    if impl(ghc >= 8.0.0)-        ghc-options: -Wno-redundant-constraints  test-suite genvalidity-test     type: exitcode-stdio-1.0@@ -44,7 +58,7 @@     build-depends:         base -any,         hspec -any,-        QuickCheck,+        QuickCheck -any,         genvalidity -any     default-language: Haskell2010     hs-source-dirs: test

@@ -33,19 +33,27 @@     Typical examples of tests involving validity could look as follows:      > it "succeeds when given valid input" $ do-    >     forAll genValid $ \input ->+    >     forAllValid $ \input ->     >         myFunction input `shouldSatisfy` isRight      > it "produces valid output when it succeeds" $ do-    >     forAll genUnchecked $ \input ->+    >     forAllUnchecked $ \input ->     >         case myFunction input of     >             Nothing -> return () -- Can happen     >             Just output -> output `shouldSatisfy` isValid     -}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 710+#define OVERLAPPING_ {-# OVERLAPPING #-}+#else+{-# LANGUAGE OverlappingInstances  #-}+#define OVERLAPPING_+#endif  module Data.GenValidity     ( module Data.Validity@@ -55,22 +63,49 @@ import Data.Validity  import Data.Fixed (Fixed(..), HasResolution)-import Data.Word (Word, Word8, Word16)+import Data.Word (Word, Word8, Word16, Word32, Word64) import GHC.Generics import GHC.Real (Ratio(..))  import Test.QuickCheck hiding (Fixed) -import Control.Applicative ((<$>), pure)+import Control.Applicative ((<*>), (<$>), pure) import Control.Monad (forM) +{-# ANN module "HLint: ignore Reduce duplication" #-}+ -- | A class of types for which truly arbitrary values can be generated.+--+-- === Automatic instances with 'Generic'+-- An instance of this class can be made automatically if the type in question+-- has a 'Generic' instance. This instance will try to use 'genUnchecked' to+-- generate all structural sub-parts of the value that is being generated.+--+-- Example:+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- >+-- > data MyType = MyType Double String+-- >     deriving (Show, Eq, Generic)+-- >+-- > instance GenUnchecked MyType+--+-- generates something like:+--+-- > instance GenUnchecked MyType where+-- >     genUnchecked = MyType <$> genUnchecked <*> genUnchecked class GenUnchecked a where     genUnchecked :: Gen a     default genUnchecked :: (Generic a, GGenUnchecked (Rep a)) =>         Gen a     genUnchecked = to <$> gGenUnchecked +    shrinkUnchecked :: a -> [a]+    default shrinkUnchecked ::+        (Generic a, GUncheckedRecursivelyShrink (Rep a), GUncheckedSubterms (Rep a) a) =>+        a -> [a]+    shrinkUnchecked = gShrinkUnchecked+ -- | A class of types for which valid values can be generated. -- -- If you also write @Arbitrary@ instances for @GenValid@ types, it may be@@ -90,6 +125,9 @@     -- data, otherwise your testing may not cover all cases.     genValid = genUnchecked `suchThat` isValid +    shrinkValid :: a -> [a]+    shrinkValid = filter isValid . shrinkUnchecked+ -- | A class of types for which invalid values can be generated. class (Validity a, GenUnchecked a) =>       GenInvalid a where@@ -97,15 +135,17 @@     -- | Generate an invalid datum, this should cover all possible invalid     -- values     ---    -- > genInvalid = genUnchecked `suchThat` (not . isValid)+    -- > genInvalid = genUnchecked `suchThat` isInvalid     --     -- To speed up testing, it may be a good idea to implement this yourself.     -- If you do, make sure that it is possible to generate all possible     -- invalid data, otherwise your testing may not cover all cases.-    genInvalid = genUnchecked `suchThat` (not . isValid)+    genInvalid = genUnchecked `suchThat` isInvalid -instance (GenUnchecked a, GenUnchecked b) =>-         GenUnchecked (a, b) where+    shrinkInvalid :: a -> [a]+    shrinkInvalid = filter isInvalid . shrinkUnchecked++instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (a, b) where     genUnchecked =         sized $ \n -> do             (r, s) <- genSplit n@@ -113,8 +153,7 @@             b <- resize s genUnchecked             return (a, b) -instance (GenValid a, GenValid b) =>-         GenValid (a, b) where+instance (GenValid a, GenValid b) => GenValid (a, b) where     genValid =         sized $ \n -> do             (r, s) <- genSplit n@@ -122,8 +161,7 @@             b <- resize s genValid             return (a, b) -instance (GenInvalid a, GenInvalid b) =>-         GenInvalid (a, b) where+instance (GenInvalid a, GenInvalid b) => GenInvalid (a, b) where     genInvalid =         sized $ \n -> do             (r, s) <- genSplit n@@ -136,17 +174,14 @@                      return (a, b)                 ] -instance (GenUnchecked a, GenUnchecked b) =>-         GenUnchecked (Either a b) where+instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (Either a b) where     genUnchecked = oneof [Left <$> genUnchecked, Right <$> genUnchecked] -instance (GenValid a, GenValid b) =>-         GenValid (Either a b) where+instance (GenValid a, GenValid b) => GenValid (Either a b) where     genValid = oneof [Left <$> genValid, Right <$> genValid]  -- | This instance ensures that the generated tupse contains at least one invalid element. The other element is unchecked.-instance (GenInvalid a, GenInvalid b) =>-         GenInvalid (Either a b) where+instance (GenInvalid a, GenInvalid b) => GenInvalid (Either a b) where     genInvalid = oneof [Left <$> genInvalid, Right <$> genInvalid]  instance (GenUnchecked a, GenUnchecked b, GenUnchecked c) =>@@ -159,8 +194,7 @@             c <- resize t genUnchecked             return (a, b, c) -instance (GenValid a, GenValid b, GenValid c) =>-         GenValid (a, b, c) where+instance (GenValid a, GenValid b, GenValid c) => GenValid (a, b, c) where     genValid =         sized $ \n -> do             (r, s, t) <- genSplit3 n@@ -190,32 +224,78 @@                      return (a, b, c)                 ] -instance GenUnchecked a =>-         GenUnchecked (Maybe a) where+instance (GenUnchecked a, GenUnchecked b, GenUnchecked c, GenUnchecked d) =>+         GenUnchecked (a, b, c, d) where+    genUnchecked =+        sized $ \n -> do+            (r, s, t, u) <- genSplit4 n+            a <- resize r genUnchecked+            b <- resize s genUnchecked+            c <- resize t genUnchecked+            d <- resize u genUnchecked+            return (a, b, c, d)++instance (GenValid a, GenValid b, GenValid c, GenValid d) =>+         GenValid (a, b, c, d) where+    genValid =+        sized $ \n -> do+            (r, s, t, u) <- genSplit4 n+            a <- resize r genValid+            b <- resize s genValid+            c <- resize t genValid+            d <- resize u genValid+            return (a, b, c, d)++-- | This instance ensures that the generated triple contains at least one invalid element. The other two are unchecked.+instance (GenInvalid a, GenInvalid b, GenInvalid c, GenInvalid d) =>+         GenInvalid (a, b, c, d) where+    genInvalid =+        sized $ \n -> do+            (r, s, t, u) <- genSplit4 n+            oneof+                [ do a <- resize r genInvalid+                     b <- resize s genUnchecked+                     c <- resize t genUnchecked+                     d <- resize u genUnchecked+                     return (a, b, c, d)+                , do a <- resize r genUnchecked+                     b <- resize s genInvalid+                     c <- resize t genUnchecked+                     d <- resize u genUnchecked+                     return (a, b, c, d)+                , do a <- resize r genUnchecked+                     b <- resize s genUnchecked+                     c <- resize t genInvalid+                     d <- resize u genUnchecked+                     return (a, b, c, d)+                , do a <- resize r genUnchecked+                     b <- resize s genUnchecked+                     c <- resize t genUnchecked+                     d <- resize u genInvalid+                     return (a, b, c, d)+                ]++instance GenUnchecked a => GenUnchecked (Maybe a) where     genUnchecked = oneof [pure Nothing, Just <$> genUnchecked] -instance GenValid a =>-         GenValid (Maybe a) where+instance GenValid a => GenValid (Maybe a) where     genValid = oneof [pure Nothing, Just <$> genValid] -instance GenInvalid a =>-         GenInvalid (Maybe a) where+instance GenInvalid a => GenInvalid (Maybe a) where     genInvalid = Just <$> genInvalid -instance GenUnchecked a =>-         GenUnchecked [a] where+instance GenUnchecked a => GenUnchecked [a] where     genUnchecked = genListOf genUnchecked+    shrinkUnchecked = shrinkList shrinkUnchecked  -- | If we can generate values of a certain type, we can also generate lists of -- them.-instance GenValid a =>-         GenValid [a] where+instance GenValid a => GenValid [a] where     genValid = genListOf genValid  -- | This instance ensures that the generated list contains at least one element -- that satisfies 'isInvalid'. The rest is unchecked.-instance GenInvalid a =>-         GenInvalid [a] where+instance GenInvalid a => GenInvalid [a] where     genInvalid =         sized $ \n -> do             (x, y, z) <- genSplit3 n@@ -226,46 +306,67 @@  instance GenUnchecked () where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid ()  instance GenUnchecked Bool where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Bool  instance GenUnchecked Ordering where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Ordering  instance GenUnchecked Char where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Char  instance GenUnchecked Int where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Int  instance GenUnchecked Word where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Word  instance GenUnchecked Word8 where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Word8  instance GenUnchecked Word16 where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Word16 +instance GenUnchecked Word32 where+    genUnchecked = arbitrary+    shrinkUnchecked = shrink++instance GenValid Word32++instance GenUnchecked Word64 where+    genUnchecked = arbitrary+    shrinkUnchecked = shrink++instance GenValid Word64+ instance GenUnchecked Float where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Float where     genValid = arbitrary@@ -276,6 +377,7 @@  instance GenUnchecked Double where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Double @@ -285,6 +387,7 @@  instance GenUnchecked Integer where     genUnchecked = arbitrary+    shrinkUnchecked = shrink  instance GenValid Integer @@ -293,16 +396,27 @@         n <- genUnchecked         d <- genUnchecked         pure $ n :% d+    shrinkUnchecked = shrink  instance GenValid (Ratio Integer) -instance HasResolution a =>-         GenUnchecked (Fixed a) where+instance HasResolution a => GenUnchecked (Fixed a) where     genUnchecked = MkFixed <$> genUnchecked+    shrinkUnchecked = shrink -instance HasResolution a =>-         GenValid (Fixed a)+instance HasResolution a => GenValid (Fixed a) +shrinkT2+  :: (a -> [a])+  -> (a, a) -> [(a, a)]+shrinkT2 s (a, b) = (,) <$> s a <*> s b++shrinkT3+  :: (a -> [a])+  -> (a, a, a) -> [(a, a, a)]+shrinkT3 s (a, b, c) = (,,) <$> s a <*> s b <*> s c++ -- | 'upTo' generates an integer between 0 (inclusive) and 'n'. upTo :: Int -> Gen Int upTo n@@ -313,9 +427,12 @@ genSplit :: Int -> Gen (Int, Int) genSplit n     | n < 0 = pure (0, 0)-    | otherwise = elements [(i, n - i) | i <- [0 .. n]]+    | otherwise = do+        i <- choose (0, n)+        let j = n - i+        pure (i, j) --- | 'genSplit a' generates a triple '(b, c, d)' such that 'b + c + d' equals 'a'.+-- | 'genSplit3 a' generates a triple '(b, c, d)' such that 'b + c + d' equals 'a'. genSplit3 :: Int -> Gen (Int, Int, Int) genSplit3 n     | n < 0 = pure (0, 0, 0)@@ -324,6 +441,16 @@         (b, c) <- genSplit z         return (a, b, c) +-- | 'genSplit4 a' generates a quadruple '(b, c, d, e)' such that 'b + c + d + e' equals 'a'.+genSplit4 :: Int -> Gen (Int, Int, Int, Int)+genSplit4 n+    | n < 0 = pure (0, 0, 0, 0)+    | otherwise = do+        (y, z) <- genSplit n+        (a, b) <- genSplit y+        (c, d) <- genSplit z+        return (a, b, c, d)+ -- | 'arbPartition n' generates a list 'ls' such that 'sum ls' equals 'n'. arbPartition :: Int -> Gen [Int] arbPartition k@@ -347,21 +474,108 @@ instance GGenUnchecked U1 where     gGenUnchecked = pure U1 -instance (GGenUnchecked a, GGenUnchecked b) =>-         GGenUnchecked (a :*: b) where+instance (GGenUnchecked a, GGenUnchecked b) => GGenUnchecked (a :*: b) where     gGenUnchecked = do         g1 <- gGenUnchecked         g2 <- gGenUnchecked         pure $ g1 :*: g2 -instance (GGenUnchecked a, GGenUnchecked b) =>-         GGenUnchecked (a :+: b) where+instance (GGenUnchecked a, GGenUnchecked b) => GGenUnchecked (a :+: b) where     gGenUnchecked = oneof [L1 <$> gGenUnchecked, R1 <$> gGenUnchecked] -instance (GGenUnchecked a) =>-         GGenUnchecked (M1 i c a) where+instance (GGenUnchecked a) => GGenUnchecked (M1 i c a) where     gGenUnchecked = M1 <$> gGenUnchecked -instance (GenUnchecked a) =>-         GGenUnchecked (K1 i a) where+instance (GenUnchecked a) => GGenUnchecked (K1 i a) where     gGenUnchecked = K1 <$> genUnchecked+++-- | Shrink a term to any of its immediate subterms,+-- and also recursively shrink all subterms.+gShrinkUnchecked :: (Generic a, GUncheckedRecursivelyShrink (Rep a), GUncheckedSubterms (Rep a) a) => a -> [a]+gShrinkUnchecked x = uncheckedSubterms x ++ uncheckedRecursivelyShrink x++-- | Recursively shrink all immediate uncheckedSubterms.+uncheckedRecursivelyShrink :: (Generic a, GUncheckedRecursivelyShrink (Rep a)) => a -> [a]+uncheckedRecursivelyShrink = map to . gUncheckedRecursivelyShrink . from++class GUncheckedRecursivelyShrink f where+  gUncheckedRecursivelyShrink :: f a -> [f a]++instance (GUncheckedRecursivelyShrink f, GUncheckedRecursivelyShrink g) => GUncheckedRecursivelyShrink (f :*: g) where+  gUncheckedRecursivelyShrink (x :*: y) =+      [x' :*: y | x' <- gUncheckedRecursivelyShrink x] +++      [x :*: y' | y' <- gUncheckedRecursivelyShrink y]++instance (GUncheckedRecursivelyShrink f, GUncheckedRecursivelyShrink g) => GUncheckedRecursivelyShrink (f :+: g) where+  gUncheckedRecursivelyShrink (L1 x) = map L1 (gUncheckedRecursivelyShrink x)+  gUncheckedRecursivelyShrink (R1 x) = map R1 (gUncheckedRecursivelyShrink x)++instance GUncheckedRecursivelyShrink f => GUncheckedRecursivelyShrink (M1 i c f) where+  gUncheckedRecursivelyShrink (M1 x) = map M1 (gUncheckedRecursivelyShrink x)++instance GenUnchecked a => GUncheckedRecursivelyShrink (K1 i a) where+  gUncheckedRecursivelyShrink (K1 x) = map K1 (shrinkUnchecked x)++instance GUncheckedRecursivelyShrink U1 where+  gUncheckedRecursivelyShrink U1 = []++instance GUncheckedRecursivelyShrink V1 where+  -- The empty type can't be shrunk to anything.+  gUncheckedRecursivelyShrink _ = []+++-- | All immediate uncheckedSubterms of a term.+uncheckedSubterms :: (Generic a, GUncheckedSubterms (Rep a) a) => a -> [a]+uncheckedSubterms = gUncheckedSubterms . from+++class GUncheckedSubterms f a where+  gUncheckedSubterms :: f a -> [a]++instance GUncheckedSubterms V1 a where+  gUncheckedSubterms _ = []++instance GUncheckedSubterms U1 a where+  gUncheckedSubterms U1 = []++instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubterms (f :*: g) a where+  gUncheckedSubterms (l :*: r) = gUncheckedSubtermsIncl l ++ gUncheckedSubtermsIncl r++instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubterms (f :+: g) a where+  gUncheckedSubterms (L1 x) = gUncheckedSubtermsIncl x+  gUncheckedSubterms (R1 x) = gUncheckedSubtermsIncl x++instance GUncheckedSubterms f a => GUncheckedSubterms (M1 i c f) a where+  gUncheckedSubterms (M1 x) = gUncheckedSubterms x++instance GUncheckedSubterms (K1 i a) b where+  gUncheckedSubterms (K1 _) = []+++class GUncheckedSubtermsIncl f a where+  gUncheckedSubtermsIncl :: f a -> [a]++instance GUncheckedSubtermsIncl V1 a where+  gUncheckedSubtermsIncl _ = []++instance GUncheckedSubtermsIncl U1 a where+  gUncheckedSubtermsIncl U1 = []++instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubtermsIncl (f :*: g) a where+  gUncheckedSubtermsIncl (l :*: r) = gUncheckedSubtermsIncl l ++ gUncheckedSubtermsIncl r++instance (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubtermsIncl (f :+: g) a where+  gUncheckedSubtermsIncl (L1 x) = gUncheckedSubtermsIncl x+  gUncheckedSubtermsIncl (R1 x) = gUncheckedSubtermsIncl x++instance GUncheckedSubtermsIncl f a => GUncheckedSubtermsIncl (M1 i c f) a where+  gUncheckedSubtermsIncl (M1 x) = gUncheckedSubtermsIncl x++-- This is the important case: We've found a term of the same type.+instance OVERLAPPING_ GUncheckedSubtermsIncl (K1 i a) a where+  gUncheckedSubtermsIncl (K1 x) = [x]++instance OVERLAPPING_ GUncheckedSubtermsIncl (K1 i a) b where+  gUncheckedSubtermsIncl (K1 _) = []+

@@ -9,26 +9,26 @@  spec :: Spec spec = do-    describe "upTo" $ do-        it "returns only positive integers" $ do+    describe "upTo" $+        it "returns only positive integers" $             forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (>= 0))     describe "genSplit" $ do-        it "returns positive integers" $ do+        it "returns positive integers" $             forAll arbitrary $ \i ->                 forAll (genSplit i) $ \(a, b) -> do                     a `shouldSatisfy` (>= 0)                     b `shouldSatisfy` (>= 0)-        it "returns two integers such that the sum is the original integer" $ do+        it "returns two integers such that the sum is the original integer" $             forAll (arbitrary `suchThat` (>= 0)) $ \i ->                 forAll (genSplit i) $ \(a, b) -> a + b `shouldBe` i     describe "arbPartition" $ do-        it "returns an empty list upon strictly negative input" $ do+        it "returns an empty list upon strictly negative input" $             forAll (arbitrary `suchThat` (< 0)) $ \n ->                 forAll (arbPartition n) (`shouldBe` [])-        it "returns a list of strictly positive integers" $ do+        it "returns a list of strictly positive integers" $             forAll arbitrary $ \n ->                 forAll (arbPartition n) $ \p -> p `shouldSatisfy` all (> 0)         it-            "returns a list of integers that sum to the original positive integer" $ do+            "returns a list of integers that sum to the original positive integer" $             forAll (arbitrary `suchThat` (>= 0)) $ \n ->                 forAll (arbPartition n) $ \p -> sum p `shouldBe` n