genvalidity 0.9.0.1 → 0.9.1.0

raw patch · 4 files changed

+156/−88 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• genvalidity.cabal +2/−2
• src/Data/GenValidity.hs +3/−16
• src/Data/GenValidity/Utils.hs +87/−12
• test/Data/GenValiditySpec.hs +64/−58

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f4100c2ff93efc9358e859fdff17d5b68f1a71aed4f88e4bcf2dd2e57ae0a795+-- hash: ba44fb99e6f91291452e903b6e2cb6d5b566b8e667c27442668d66fa1abff13f  name:           genvalidity-version:        0.9.0.1+version:        0.9.1.0 synopsis:       Testing utilities for the validity library description:    Note: There are companion instance packages for this library:                 .

@@ -101,7 +101,6 @@ import Data.Fixed (Fixed(..), HasResolution) #if MIN_VERSION_base(4,9,0) import Data.List.NonEmpty (NonEmpty((:|)))-import qualified Data.List.NonEmpty as NE #endif #if MIN_VERSION_base(4,8,0) import Data.Word (Word8, Word16, Word32, Word64)@@ -515,27 +514,15 @@  #if MIN_VERSION_base(4,9,0) instance GenUnchecked a => GenUnchecked (NonEmpty a) where-    genUnchecked = do-      l <- genUnchecked-      case NE.nonEmpty l of-        Nothing -> scale (+1) genUnchecked-        Just ne -> pure ne+    genUnchecked = genNonEmptyOf genUnchecked     shrinkUnchecked (v :| vs) = [ e :| es | (e, es) <- shrinkUnchecked (v, vs)]  instance GenValid a => GenValid (NonEmpty a) where-    genValid = do-      l <- genValid-      case NE.nonEmpty l of-        Nothing -> scale (+1) genValid-        Just ne -> pure ne+    genValid = genNonEmptyOf genValid     shrinkValid (v :| vs) = [ e :| es | (e, es) <- shrinkValid (v, vs)]  instance (GenUnchecked a, GenInvalid a) => GenInvalid (NonEmpty a) where-    genInvalid = do-      l <- genInvalid-      case NE.nonEmpty l of-        Nothing -> scale (+1) genInvalid-        Just ne -> pure ne+    genInvalid = genNonEmptyOf genInvalid #endif  instance GenUnchecked a => GenUnchecked [a] where

@@ -21,9 +21,15 @@     , genSplit3     , genSplit4     , genSplit5+    , genSplit6+    , genSplit7+    , genSplit8     , arbPartition     , shuffle     , genListOf+#if MIN_VERSION_base(4,9,0)+    , genNonEmptyOf+#endif       -- ** Helper functions for implementing shrinking functions     , shrinkTuple     , shrinkT2@@ -36,12 +42,16 @@ import Data.List (sortBy) import Data.Ord (comparing) #endif+#if MIN_VERSION_base(4,9,0)+import Data.List.NonEmpty(NonEmpty(..))+import qualified Data.List.NonEmpty as NE+#endif  #if MIN_VERSION_base(4,8,0)-import Control.Monad (forM)+import Control.Monad (forM, replicateM) #else import Control.Applicative ((<$>), (<*>), pure)-import Control.Monad (forM)+import Control.Monad (forM, replicateM) #endif -- | 'upTo' generates an integer between 0 (inclusive) and 'n'. upTo :: Int -> Gen Int@@ -87,16 +97,72 @@         (d, e) <- genSplit z         return (a, b, c, d, e) --- | 'arbPartition n' generates a list 'ls' such that 'sum ls' equals 'n'.+-- | 'genSplit6 a' generates a sextuple '(b, c, d, e, f, g)' such that 'b + c + d + e + f + g' equals 'a'.+genSplit6 :: Int -> Gen (Int, Int, Int, Int, Int, Int)+genSplit6 n+    | n < 0 = pure (0, 0, 0, 0, 0, 0)+    | otherwise = do+        (y, z) <- genSplit n+        (a, b, c) <- genSplit3 y+        (d, e, f) <- genSplit3 z+        return (a, b, c, d, e, f)++-- | 'genSplit7 a' generates a septtuple '(b, c, d, e, f, g)' such that 'b + c + d + e + f + g' equals 'a'.+genSplit7 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int)+genSplit7 n+    | n < 0 = pure (0, 0, 0, 0, 0, 0, 0)+    | otherwise = do+        (y, z) <- genSplit n+        (a, b, c) <- genSplit3 y+        (d, e, f, g) <- genSplit4 z+        return (a, b, c, d, e, f, g)++-- | 'genSplit8 a' generates a octtuple '(b, c, d, e, f, g, h)' such that 'b + c + d + e + f + g + h' equals 'a'.+genSplit8 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int, Int)+genSplit8 n+    | n < 0 = pure (0, 0, 0, 0, 0, 0, 0, 0)+    | otherwise = do+        (y, z) <- genSplit n+        (a, b, c, d) <- genSplit4 y+        (e, f, g, h) <- genSplit4 z+        return (a, b, c, d, e, f, g, h)+++-- | 'arbPartition n' generates a list 'ls' such that 'sum ls' equals 'n', approximately. arbPartition :: Int -> Gen [Int]-arbPartition i = go i >>= shuffle+arbPartition 0 = pure []+arbPartition i = genLen i >>= go i   where-    go k-        | k <= 0 = pure []-        | otherwise = do-            first <- choose (1, k)-            rest <- arbPartition $ k - first-            return $ first : rest+    genLen :: Int -> Gen Int+    genLen maxLen = round . invT (fromIntegral maxLen) <$> choose (0, 1)++    -- Use a triangle distribution for generating the+    -- length of the list+    -- with minimum length '0', mode length '2'+    -- and given max length.+    invT :: Double -> Double -> Double+    invT maxLen u =+      let a = 0+          b = maxLen+          c = 2+          fc = (c - a) / (b - a)+      in if u < fc+        then a + sqrt (u * (b - a) * (c - a) )+        else b - sqrt ((1 - u) * (b - a) * (b - c))+++    go :: Int -> Int -> Gen [Int]+    go size len = do+      us <- replicateM len $ choose (0, 1)+      let invs = map (invE 0.25) us+      -- Rescale the sizes to (approximately) sum to the given size.+      pure $ map (round . (* (fromIntegral size / sum invs))) invs++    -- Use an exponential distribution for generating the+    -- sizes in the partition.+    invE :: Double -> Double -> Double+    invE lambda u = - log (1 - u) / lambda+ #if !MIN_VERSION_QuickCheck(2,8,0) -- | Generates a random permutation of the given list. shuffle :: [a] -> Gen [a]@@ -104,6 +170,16 @@     ns <- vectorOf (length xs) (choose (minBound :: Int, maxBound))     return (map snd (sortBy (comparing fst) (zip ns xs))) #endif++#if MIN_VERSION_base(4,9,0)+genNonEmptyOf :: Gen a -> Gen (NonEmpty a)+genNonEmptyOf gen = do+  l <- genListOf gen+  case NE.nonEmpty l of+    Nothing -> scale (+1) $ genNonEmptyOf gen+    Just ne -> pure ne+#endif+ -- | A version of @listOf@ that takes size into account more accurately. -- -- This generator distributes the size that is is given among the values@@ -111,8 +187,7 @@ genListOf :: Gen a -> Gen [a] genListOf func =     sized $ \n -> do-        size <- upTo n-        pars <- arbPartition size+        pars <- arbPartition n         forM pars $ \i -> resize i func  shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]

@@ -1,6 +1,6 @@ module Data.GenValiditySpec-  ( spec-  ) where+    ( spec+    ) where  import Test.Hspec import Test.QuickCheck@@ -9,59 +9,65 @@  spec :: Spec spec = do-  describe "genUtf16SurrogateCodePoint" $-    it "generates Utf16 surrogate codepoints" $-    forAll genUtf16SurrogateCodePoint $ (`shouldSatisfy` isUtf16SurrogateCodePoint)-  describe "upTo" $ do-    it "returns only positive integers" $-      forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (>= 0))-    it "returns only integers smaller than or equal to the given number" $-      forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (<= (max n 0)))-  describe "genSplit" $ 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" $-      forAll arbitrary $ \i -> forAll (genSplit i) $ \(a, b) -> a + b `shouldBe` max 0 i-  describe "genSplit3" $ do-    it "returns positive integers" $-      forAll arbitrary $ \i ->-        forAll (genSplit3 i) $ \(a, b, c) -> do-          a `shouldSatisfy` (>= 0)-          b `shouldSatisfy` (>= 0)-          c `shouldSatisfy` (>= 0)-    it "returns three integers such that the sum is the original integer" $-      forAll arbitrary $ \i -> forAll (genSplit3 i) $ \(a, b, c) -> a + b + c `shouldBe` max 0 i-  describe "genSplit4" $ do-    it "returns positive integers" $-      forAll arbitrary $ \i ->-        forAll (genSplit4 i) $ \(a, b, c, d) -> do-          a `shouldSatisfy` (>= 0)-          b `shouldSatisfy` (>= 0)-          c `shouldSatisfy` (>= 0)-          d `shouldSatisfy` (>= 0)-    it "returns four integers such that the sum is the original integer" $-      forAll arbitrary $ \i ->-        forAll (genSplit4 i) $ \(a, b, c, d) -> a + b + c + d `shouldBe` max 0 i-  describe "genSplit5" $ do-    it "returns positive integers" $-      forAll arbitrary $ \i ->-        forAll (genSplit5 i) $ \(a, b, c, d, e) -> do-          a `shouldSatisfy` (>= 0)-          b `shouldSatisfy` (>= 0)-          c `shouldSatisfy` (>= 0)-          d `shouldSatisfy` (>= 0)-          e `shouldSatisfy` (>= 0)-    it "returns four integers such that the sum is the original integer" $-      forAll arbitrary $ \i ->-        forAll (genSplit5 i) $ \(a, b, c, d, e) -> a + b + c + d + e `shouldBe` max 0 i-  describe "arbPartition" $ 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" $-      forAll arbitrary $ \n -> forAll (arbPartition n) $ \p -> p `shouldSatisfy` all (> 0)-    it "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+    describe "genUtf16SurrogateCodePoint" $+        it "generates Utf16 surrogate codepoints" $+            forAll genUtf16SurrogateCodePoint $ (`shouldSatisfy` isUtf16SurrogateCodePoint)++    describe "upTo" $ do+        it "returns only positive integers" $+            forAll arbitrary $ \n -> forAll (upTo n) (`shouldSatisfy` (>= 0))+        it "returns only integers smaller than or equal to the given number" $+            forAll arbitrary $ \n ->+                forAll (upTo n) (`shouldSatisfy` (<= (max n 0)))+    describe "genSplit" $ 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" $+            forAll arbitrary $ \i ->+                forAll (genSplit i) $ \(a, b) -> a + b `shouldBe` max 0 i+    describe "genSplit3" $ do+        it "returns positive integers" $+            forAll arbitrary $ \i ->+                forAll (genSplit3 i) $ \(a, b, c) -> do+                    a `shouldSatisfy` (>= 0)+                    b `shouldSatisfy` (>= 0)+                    c `shouldSatisfy` (>= 0)+        it "returns three integers such that the sum is the original integer" $+            forAll arbitrary $ \i ->+                forAll (genSplit3 i) $ \(a, b, c) ->+                    a + b + c `shouldBe` max 0 i+    describe "genSplit4" $ do+        it "returns positive integers" $+            forAll arbitrary $ \i ->+                forAll (genSplit4 i) $ \(a, b, c, d) -> do+                    a `shouldSatisfy` (>= 0)+                    b `shouldSatisfy` (>= 0)+                    c `shouldSatisfy` (>= 0)+                    d `shouldSatisfy` (>= 0)+        it "returns four integers such that the sum is the original integer" $+            forAll arbitrary $ \i ->+                forAll (genSplit4 i) $ \(a, b, c, d) ->+                    a + b + c + d `shouldBe` max 0 i+    describe "genSplit5" $ do+        it "returns positive integers" $+            forAll arbitrary $ \i ->+                forAll (genSplit5 i) $ \(a, b, c, d, e) -> do+                    a `shouldSatisfy` (>= 0)+                    b `shouldSatisfy` (>= 0)+                    c `shouldSatisfy` (>= 0)+                    d `shouldSatisfy` (>= 0)+                    e `shouldSatisfy` (>= 0)+        it "returns four integers such that the sum is the original integer" $+            forAll arbitrary $ \i ->+                forAll (genSplit5 i) $ \(a, b, c, d, e) ->+                    a + b + c + d + e `shouldBe` max 0 i+    describe "arbPartition" $ do+        it "returns an empty list upon strictly negative input" $+            forAll (arbitrary `suchThat` (< 0)) $ \n ->+                forAll (arbPartition n) (`shouldBe` [])+        it "returns a list of positive integers" $+            forAll arbitrary $ \n ->+                forAll (arbPartition n) $ \p -> p `shouldSatisfy` all (>= 0)