genvalidity 0.2.0.4 → 0.3.0.0

raw patch · 3 files changed

+217/−111 lines, 3 filesdep ~QuickCheckdep ~validityPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, validity

API changes (from Hackage documentation)

Files

• genvalidity.cabal +3/−1
• src/Data/GenRelativeValidity.hs +10/−4
• src/Data/GenValidity.hs +204/−106

@@ -1,5 +1,5 @@ name:                genvalidity-version:             0.2.0.4+version:             0.3.0.0 synopsis:            Testing utilities for the validity library description:   Note: There are companion instance packages for this library:@@ -7,6 +7,8 @@   * <https://hackage.haskell.org/package/genvalidity-text genvalidity-text>   .   * <https://hackage.haskell.org/package/genvalidity-containers genvalidity-containers>+  .+  * <https://hackage.haskell.org/package/genvalidity-path genvalidity-path>  homepage:            https://github.com/NorfairKing/validity#readme license:             MIT

@@ -1,20 +1,26 @@ {-# LANGUAGE MultiParamTypeClasses #-}+ module Data.GenRelativeValidity     ( module Data.RelativeValidity     , module Data.GenRelativeValidity     ) where -import           Data.RelativeValidity-import           Data.GenValidity+import Data.GenValidity+import Data.RelativeValidity -import           Test.QuickCheck+import Test.QuickCheck -class (GenValidity a, RelativeValidity a b) => GenRelativeValidity a b where+class (GenUnchecked a, RelativeValidity a b) =>+      GenRelativeUnchecked a b where     genUncheckedFor :: b -> Gen a     genUncheckedFor _ = genUnchecked +class (GenValid a, RelativeValidity a b) =>+      GenRelativeValid a b where     genValidFor :: b -> Gen a     genValidFor b = genValid `suchThat` (`isValidFor` b) +class (GenUnchecked a, RelativeValidity a b, GenRelativeUnchecked a b) =>+      GenRelativeInvalid a b where     genInvalidFor :: b -> Gen a     genInvalidFor b = genUncheckedFor b `suchThat` (not . (`isValidFor` b))

@@ -10,21 +10,23 @@     @(Prime <$> arbitrary) `suchThat` isValid@     but this is tedious and inefficient. -    The @GenValidity@ type class allows you to specify how to (efficiently)-    generate data of the given type to allow for easier and quicker testing.-    Just implementing @genUnchecked@ already gives you access to @genValid@ and-    @genInvalid@ but writing custom implementations of these functions may speed-    up the generation of data.+    The @GenValid@ type class allows you to specify how to (efficiently)+    generate valid data of the given type to allow for easier and quicker testing.+    Just instantiating @GenUnchecked@ already gives you access to a default instance+    of @GenValid@ and @GenInvalid@ but writing custom implementations of these functions+    may speed up the generation of data.      For example, to generate primes, we don't have to consider even numbers other     than 2. A more efficient implementation could then look as follows: -    > instance GenValidity Prime where+    > instance GenUnchecked Prime where     >     genUnchecked = Prime <$> arbitrary++    > instance GenValid Prime where     >     genValid = Prime <$>     >        (oneof     >          [ pure 2-    >          , (\y -> 2 * y + 1) <$> (arbitrary `suchThat` (> 0) `suchThat` isPrime)+    >          , ((\y -> 2 * abs y + 1) <$> arbitrary) `suchThat` isPrime)     >          ])  @@ -40,27 +42,28 @@     >             Nothing -> return () -- Can happen     >             Just output -> output `shouldSatisfy` isValid     -}- module Data.GenValidity     ( module Data.Validity     , module Data.GenValidity     ) where -import           Data.Validity+import Data.Validity -import           Test.QuickCheck+import Test.QuickCheck -import           Control.Monad   (forM)+import Control.Monad (forM) --- | A class of types for which @Validity@-related values can be generated.------ If you also write @Arbitrary@ instances for @GenValidity@ types, it may be--- best to simply write @arbitrary = genValid@.-class Validity a => GenValidity a where-    -- | Generate a truly arbitrary datum, this should cover all possible-    -- values in the type+-- | A class of types for which truly arbitrary values can be generated.+class GenUnchecked a where     genUnchecked :: Gen a +-- | A class of types for which valid values can be generated.+--+-- If you also write @Arbitrary@ instances for @GenValid@ types, it may be+-- best to simply write @arbitrary = genValid@.+class (Validity a, GenUnchecked a) =>+      GenValid a where+    genValid :: Gen a     -- | Generate a valid datum, this should cover all possible valid values in     -- the type     --@@ -71,9 +74,12 @@     -- 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 valid     -- data, otherwise your testing may not cover all cases.-    genValid :: Gen a     genValid = genUnchecked `suchThat` isValid +-- | A class of types for which invalid values can be generated.+class (Validity a, GenUnchecked a) =>+      GenInvalid a where+    genInvalid :: Gen a     -- | Generate an invalid datum, this should cover all possible invalid     -- values     --@@ -82,125 +88,217 @@     -- 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 :: Gen a     genInvalid = genUnchecked `suchThat` (not . isValid)-    {-# MINIMAL genUnchecked #-} -instance (GenValidity a, GenValidity b) => GenValidity (a, b) where-    genUnchecked = sized $ \n -> do-        (r, s) <- genSplit n-        a <- resize r genUnchecked-        b <- resize s genUnchecked-        return (a, b)+instance (GenUnchecked a, GenUnchecked b) =>+         GenUnchecked (a, b) where+    genUnchecked =+        sized $ \n -> do+            (r, s) <- genSplit n+            a <- resize r genUnchecked+            b <- resize s genUnchecked+            return (a, b) -    genValid = sized $ \n -> do-        (r, s) <- genSplit n-        a <- resize r genValid-        b <- resize s genValid-        return (a, b)+instance (GenValid a, GenValid b) =>+         GenValid (a, b) where+    genValid =+        sized $ \n -> do+            (r, s) <- genSplit n+            a <- resize r genValid+            b <- resize s genValid+            return (a, b) -    genInvalid = sized $ \n -> do-        (r, s) <- genSplit n-        oneof-            [ do-                a <- resize r genUnchecked-                b <- resize s genInvalid-                return (a, b)-            , do-                a <- resize r genInvalid-                b <- resize s genUnchecked-                return (a, b)-            ]+instance (GenInvalid a, GenInvalid b) =>+         GenInvalid (a, b) where+    genInvalid =+        sized $ \n -> do+            (r, s) <- genSplit n+            oneof+                [ do a <- resize r genUnchecked+                     b <- resize s genInvalid+                     return (a, b)+                , do a <- resize r genInvalid+                     b <- resize s genUnchecked+                     return (a, b)+                ] -instance (GenValidity a, GenValidity b, GenValidity c) => GenValidity (a, b, c) where-    genUnchecked = sized $ \n -> do-        (r, s, t) <- genSplit3 n-        a <- resize r genUnchecked-        b <- resize s genUnchecked-        c <- resize t genUnchecked-        return (a, b, c)+instance (GenUnchecked a, GenUnchecked b) =>+         GenUnchecked (Either a b) where+    genUnchecked = oneof [Left <$> genUnchecked, Right <$> genUnchecked] -    genValid = sized $ \n -> do-        (r, s, t) <- genSplit3 n-        a <- resize r genValid-        b <- resize s genValid-        c <- resize t genValid-        return (a, b, c)+instance (GenValid a, GenValid b) =>+         GenValid (Either a b) where+    genValid = oneof [Left <$> genValid, Right <$> genValid] -    genInvalid = sized $ \n -> do-        (r, s, t) <- genSplit3 n-        oneof-            [ do-                a <- resize r genInvalid-                b <- resize s genUnchecked-                c <- resize t genUnchecked-                return (a, b, c)-            , do-                a <- resize r genUnchecked-                b <- resize s genInvalid-                c <- resize t genUnchecked-                return (a, b, c)-            , do-                a <- resize r genUnchecked-                b <- resize s genUnchecked-                c <- resize t genInvalid-                return (a, b, c)-            ] -instance GenValidity a => GenValidity (Maybe a) where+-- | 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+    genInvalid = oneof [Left <$> genInvalid, Right <$> genInvalid]++instance (GenUnchecked a, GenUnchecked b, GenUnchecked c) =>+         GenUnchecked (a, b, c) where+    genUnchecked =+        sized $ \n -> do+            (r, s, t) <- genSplit3 n+            a <- resize r genUnchecked+            b <- resize s genUnchecked+            c <- resize t genUnchecked+            return (a, b, c)++instance (GenValid a, GenValid b, GenValid c) =>+         GenValid (a, b, c) where+    genValid =+        sized $ \n -> do+            (r, s, t) <- genSplit3 n+            a <- resize r genValid+            b <- resize s genValid+            c <- resize t genValid+            return (a, b, c)++-- | 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 (a, b, c) where+    genInvalid =+        sized $ \n -> do+            (r, s, t) <- genSplit3 n+            oneof+                [ do a <- resize r genInvalid+                     b <- resize s genUnchecked+                     c <- resize t genUnchecked+                     return (a, b, c)+                , do a <- resize r genUnchecked+                     b <- resize s genInvalid+                     c <- resize t genUnchecked+                     return (a, b, c)+                , do a <- resize r genUnchecked+                     b <- resize s genUnchecked+                     c <- resize t genInvalid+                     return (a, b, c)+                ]++instance GenUnchecked a =>+         GenUnchecked (Maybe a) where     genUnchecked = oneof [pure Nothing, Just <$> genUnchecked]-    genValid     = oneof [pure Nothing, Just <$> genValid]-    genInvalid   = Just <$> genInvalid +instance GenValid a =>+         GenValid (Maybe a) where+    genValid = oneof [pure Nothing, Just <$> genValid] +instance GenInvalid a =>+         GenInvalid (Maybe a) where+    genInvalid = Just <$> genInvalid++instance GenUnchecked a =>+         GenUnchecked [a] where+    genUnchecked = genListOf genUnchecked+ -- | If we can generate values of a certain type, we can also generate lists of -- them.--- This instance ensures that @genValid@ generates only lists of valid data and--- that @genInvalid@ generates lists of data such that there is at least one--- value in there that does not satisfy @isValid@, the rest is unchecked.-instance GenValidity a => GenValidity [a] where-    genUnchecked = genListOf genUnchecked+instance GenValid a =>+         GenValid [a] where+    genValid = genListOf genValid -    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+    genInvalid =+        sized $ \n -> do+            (x, y, z) <- genSplit3 n+            before <- resize x $ genListOf genUnchecked+            middle <- resize y genInvalid+            after <- resize z $ genListOf genUnchecked+            return $ before ++ [middle] ++ after -    -- | At least one invalid value in the list, the rest could be either.-    genInvalid   = sized $ \n -> do-        (x, y, z) <- genSplit3 n-        before <- resize x $ genListOf genUnchecked-        middle <- resize y genInvalid-        after  <- resize z $ genListOf genUnchecked-        return $ before ++ [middle] ++ after+instance GenUnchecked () where+    genUnchecked = arbitrary +instance GenValid ()++instance GenUnchecked Bool where+    genUnchecked = arbitrary++instance GenValid Bool++instance GenUnchecked Ordering where+    genUnchecked = arbitrary++instance GenValid Ordering++instance GenUnchecked Char where+    genUnchecked = arbitrary++instance GenValid Char++instance GenUnchecked Int where+    genUnchecked = arbitrary++instance GenValid Int++instance GenUnchecked Word where+    genUnchecked = arbitrary++instance GenValid Word++instance GenUnchecked Float where+    genUnchecked = arbitrary++instance GenValid Float where+    genValid = arbitrary++-- | Either 'NaN' or 'Infinity'.+instance GenInvalid Float where+    genInvalid = elements [read "NaN", read "Infinity"]++instance GenUnchecked Double where+    genUnchecked = arbitrary++instance GenValid Double++-- | Either 'NaN' or 'Infinity'.+instance GenInvalid Double where+    genInvalid = elements [read "NaN", read "Infinity"]++instance GenUnchecked Integer where+    genUnchecked = arbitrary++instance GenValid Integer++-- | 'upTo' generates an integer between 0 (inclusive) and 'n'. upTo :: Int -> Gen Int upTo n     | n <= 0 = pure 0     | otherwise = elements [0 .. n] +-- | 'genSplit a' generates a tuple '(b, c)' such that 'b + c' equals 'a'. genSplit :: Int -> Gen (Int, Int) genSplit n-    | n < 0     = pure (0, 0)-    | otherwise = elements [ (i, n - i) | i <- [0..n] ]+    | n < 0 = pure (0, 0)+    | otherwise = elements [(i, n - i) | i <- [0 .. n]] +-- | 'genSplit 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)+    | n < 0 = pure (0, 0, 0)     | otherwise = do-    (a, z) <- genSplit n-    (b, c) <- genSplit z-    return (a, b, c)+        (a, z) <- genSplit n+        (b, c) <- genSplit z+        return (a, b, c) +-- | 'arbPartition n' generates a list 'ls' such that 'sum ls' equals 'n'. arbPartition :: Int -> Gen [Int] arbPartition k     | k <= 0 = pure []     | otherwise = do-    first <- elements [1..k]-    rest <- arbPartition $ k - first-    return $ first : rest+        first <- elements [1 .. k]+        rest <- arbPartition $ k - first+        return $ first : rest  -- | A version of @listOf@ that takes size into account more accurately. genListOf :: Gen a -> Gen [a]-genListOf func = sized $ \n -> do-    size <- upTo n-    pars <- arbPartition size-    forM pars $ \i -> resize i func-+genListOf func =+    sized $ \n -> do+        size <- upTo n+        pars <- arbPartition size+        forM pars $ \i -> resize i func