genvalidity-containers 0.8.0.2 → 0.9.0.0

raw patch · 15 files changed

+203/−137 lines, 15 filesdep ~containersdep ~genvaliditydep ~validity-containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, genvalidity, validity-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• bench/Main.hs +14/−12
• genvalidity-containers.cabal +11/−8
• src/Data/GenValidity/Containers.hs +6/−5
• src/Data/GenValidity/Map.hs +8/−11
• src/Data/GenValidity/Sequence.hs +9/−4
• src/Data/GenValidity/Set.hs +41/−10
• test/Data/GenValidity/Containers/MapSpec.hs +30/−0
• test/Data/GenValidity/Containers/SeqSpec.hs +13/−0
• test/Data/GenValidity/Containers/SetSpec.hs +46/−0
• test/Data/GenValidity/Containers/TreeSpec.hs +13/−0
• test/Test/Validity/Containers/MapSpec.hs +0/−30
• test/Test/Validity/Containers/SeqSpec.hs +0/−14
• test/Test/Validity/Containers/SetSpec.hs +0/−29
• test/Test/Validity/Containers/TreeSpec.hs +0/−14

@@ -2,6 +2,18 @@  ## [Unreleased] +## [0.9.0.0] - 2020-06-14++### Added++* `genMapOf`+* `genSeqOf`+* `genSetOf`++### Changed++* Improved the generation of Set, Seq and Map to generate more appropriately (bigger) sized collections+ ## [0.8.0.2] - 2020-02-10  ### Changed

@@ -1,26 +1,28 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Main where +import Criterion.Main as Criterion+import Data.GenValidity+import Data.GenValidity.Containers+import Data.GenValidity.Criterion import Data.Map (Map) import Data.Sequence (Seq) import Data.Set (Set) import Data.Tree (Forest, Tree)--import Criterion.Main as Criterion---import Data.GenValidity.Containers ()-import Data.GenValidity.Criterion+import Test.QuickCheck  main :: IO () main =   Criterion.defaultMain-    [ genValidBench @(Set Int)-    , genValidBench @(Seq Int)-    , genValidBench @(Tree Int)-    , genValidBench @(Forest Int)-    , genValidBench @(Map Int Int)+    [ genValidBench @(Set Int),+      genValidBench @(Seq Int),+      genValidBench @(Tree Int),+      genValidBench @(Forest Int),+      genValidBench @(Map Int Int),+      genBenchSizes "genSeqOf" $ genSeqOf (genValid :: Gen Int),+      genBenchSizes "genSetOf" $ genSetOf (genValid :: Gen Int),+      genBenchSizes "genMapOf" $ genMapOf (genValid :: Gen (Int, Int))     ]

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: cc5a5331fe04afda9869d3afa266c4dca21b717141d42d91d701385413187885+-- hash: 1f475d682a51c1839b38c10a051dbd9df5a0b7f4cd1323be22c26605a4495c48  name:           genvalidity-containers-version:        0.8.0.2+version:        0.9.0.0 synopsis:       GenValidity support for containers category:       Testing homepage:       https://github.com/NorfairKing/validity#readme@@ -39,7 +39,7 @@   build-depends:       QuickCheck     , base >=4.9 && <=5-    , containers+    , containers >=0.6.0.1     , genvalidity >=0.8     , validity >=0.5     , validity-containers >=0.3@@ -49,16 +49,17 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Test.Validity.Containers.MapSpec-      Test.Validity.Containers.SeqSpec-      Test.Validity.Containers.SetSpec-      Test.Validity.Containers.TreeSpec+      Data.GenValidity.Containers.MapSpec+      Data.GenValidity.Containers.SeqSpec+      Data.GenValidity.Containers.SetSpec+      Data.GenValidity.Containers.TreeSpec       Paths_genvalidity_containers   hs-source-dirs:       test/   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall   build-depends:-      base >=4.9 && <=5+      QuickCheck+    , base >=4.9 && <=5     , containers     , genvalidity >=0.7     , genvalidity-containers >=0.5@@ -66,6 +67,7 @@     , genvalidity-property >=0.5     , hspec     , validity >=0.9+    , validity-containers   default-language: Haskell2010  benchmark genvalidity-containers-bench@@ -81,6 +83,7 @@     , base >=4.9 && <=5     , containers     , criterion+    , genvalidity     , genvalidity-containers     , genvalidity-criterion   default-language: Haskell2010

@@ -1,8 +1,9 @@ module Data.GenValidity.Containers-    ( module Containers-    ) where+  ( module Containers,+  )+where -import Data.GenValidity.Map as Containers ()-import Data.GenValidity.Sequence as Containers ()-import Data.GenValidity.Set as Containers ()+import Data.GenValidity.Map as Containers+import Data.GenValidity.Sequence as Containers+import Data.GenValidity.Set as Containers import Data.GenValidity.Tree as Containers

@@ -2,7 +2,8 @@ {-# LANGUAGE CPP #-}  module Data.GenValidity.Map-    ( genStructurallyValidMapOf+    ( genMapOf+    , genStructurallyValidMapOf     , genStructurallyValidMapOfInvalidValues #if MIN_VERSION_containers(0,5,9)     , genStructurallyInvalidMap@@ -47,7 +48,7 @@     shrinkUnchecked = fmap M.fromList . shrinkUnchecked . M.toList #endif instance (Show k, Ord k, GenValid k, GenValid v) => GenValid (Map k v) where-    genValid = M.fromList <$> genValid+    genValid = genMapOf genValid     shrinkValid = fmap M.fromList . shrinkValid . M.toList #if MIN_VERSION_containers(0,5,9) instance (Show k, Ord k, GenUnchecked k, GenInvalid k, GenUnchecked v, GenInvalid v) => GenInvalid (Map k v) where@@ -58,16 +59,12 @@ instance (Show k, Ord k, GenUnchecked k, GenInvalid k, GenUnchecked v, GenInvalid v) => GenInvalid (Map k v) where     genInvalid = genStructurallyValidMapOfInvalidValues #endif++genMapOf :: Ord k => Gen (k, v) -> Gen (Map k v)+genMapOf = genStructurallyValidMapOf+ genStructurallyValidMapOf :: Ord k => Gen (k, v) -> Gen (Map k v)-genStructurallyValidMapOf g =-    sized $ \n ->-        case n of-            0 -> pure M.empty-            _ -> do-                (kv, m) <- genSplit n-                (key, val) <- resize kv g-                rest <- resize m $ genStructurallyValidMapOf g-                pure $ M.insert key val rest+genStructurallyValidMapOf g = M.fromList <$> genListOf g  -- Note: M.fromList <$> genInvalid does not work because of this line in the Data.Map documentation: -- ' If the list contains more than one value for the same key, the last value for the key is retained.'

@@ -1,7 +1,10 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} -module Data.GenValidity.Sequence where+module Data.GenValidity.Sequence (+    genSeqOf,+  ) where+import Test.QuickCheck #if !MIN_VERSION_base(4,8,0) import Data.Functor ((<$>)) #endif@@ -13,13 +16,15 @@ import qualified Data.Sequence as S  instance GenUnchecked v => GenUnchecked (Seq v) where-    genUnchecked = S.fromList <$> genUnchecked+    genUnchecked = genSeqOf genUnchecked     shrinkUnchecked = fmap S.fromList . shrinkUnchecked . toList  instance GenValid v => GenValid (Seq v) where-    genValid = S.fromList <$> genValid+    genValid = genSeqOf genValid     shrinkValid = fmap S.fromList . shrinkValid . toList  instance (GenUnchecked v, GenInvalid v) => GenInvalid (Seq v) where-    genInvalid = S.fromList <$> genInvalid     shrinkInvalid = fmap S.fromList . shrinkInvalid . toList++genSeqOf :: Gen v -> Gen (Seq v)+genSeqOf g = S.fromList <$> genListOf g

@@ -2,19 +2,28 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Data.GenValidity.Set-    ( genStructurallyValidSetOf+    ( genSetOf+    , genStructurallyValidSetOf     , genStructurallyValidSetOfInvalidValues #if MIN_VERSION_containers(0,5,9)     , genStructurallyInvalidSet #endif+    , genSeperate+    , genSeperateFor+    , genSeperateForNE+    , genValidSeperateFor+    , genValidSeperateForNE     ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), pure) #endif import Data.GenValidity import Data.Validity.Set ()+import Data.Containers.ListUtils import Test.QuickCheck +import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE import Data.Set (Set) import qualified Data.Set as S #if MIN_VERSION_containers(0,5,9)@@ -56,16 +65,12 @@ instance (Ord v, GenUnchecked v, GenInvalid v) => GenInvalid (Set v) where     genInvalid = genStructurallyValidSetOfInvalidValues #endif++genSetOf :: Ord v => Gen v -> Gen (Set v)+genSetOf = genStructurallyValidSetOf+ genStructurallyValidSetOf :: Ord v => Gen v -> Gen (Set v)-genStructurallyValidSetOf g =-    sized $ \n ->-        case n of-            0 -> pure S.empty-            _ -> do-                (v, m) <- genSplit n-                val <- resize v g-                rest <- resize m $ genStructurallyValidSetOf g-                pure $ S.insert val rest+genStructurallyValidSetOf g = S.fromList <$> genListOf g  -- Note: M.fromList <$> genInvalid does not work because of this line in the Data.Set documentation: -- ' If the list contains more than one value for the same key, the last value for the key is retained.'@@ -84,3 +89,29 @@         then scale (+ 1) genStructurallyInvalidSet         else pure v #endif++genValidSeperateFor :: (GenValid b, Eq b) => [a] -> Gen [(b, a)]+genValidSeperateFor = genSeperateFor genValid++genValidSeperateForNE :: (GenValid b, Eq b) => NonEmpty a -> Gen (NonEmpty (b, a))+genValidSeperateForNE = genSeperateForNE genValid++#if MIN_VERSION_containers(0,6,0)+genSeperate :: Ord a => Gen a -> Gen [a]+genSeperate g = nubOrd <$> genListOf g+#else+genSeperate :: Eq a => Gen a -> Gen [a]+genSeperate g = nub <$> genListOf g+#endif++-- TODO these two can likely be optimised+genSeperateFor :: Eq b => Gen b -> [a] -> Gen [(b, a)]+genSeperateFor _ [] = pure []+genSeperateFor g (a : as) = NE.toList <$> genSeperateForNE g (a :| as)++genSeperateForNE :: Eq b => Gen b -> NonEmpty a -> Gen (NonEmpty (b, a))+genSeperateForNE g (a :| as) = do+  restTups <- genSeperateFor g as+  b <- g `suchThat` (`notElem` map fst restTups)+  pure ((b, a) :| restTups)+

@@ -0,0 +1,30 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.MapSpec where++import Test.Hspec++import Data.GenValidity+import Data.GenValidity.Map+import Data.Map (Map)+import Test.Validity.GenValidity++spec :: Spec+spec = do+    describe "genStructurallyValidMapOf" $+        it "produces valid maps" $+        genGeneratesValid+            (genStructurallyValidMapOf @Rational @Rational genValid)+    describe "genStructurallyValidMapOfInvalidValues" $+        it "produces valid maps" $+        genGeneratesInvalid+            (genStructurallyValidMapOfInvalidValues @Rational @Rational)+#if MIN_VERSION_containers(0,5,9)+    describe "genStructurallyInvalidMap" $+        it "produces invalid maps" $+        genGeneratesInvalid+            (genStructurallyInvalidMap @Rational @Rational)+#endif+    genValidSpec @(Map Int Rational)+    genValiditySpec @(Map Rational Rational)

@@ -0,0 +1,13 @@+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.SeqSpec where++import Data.GenValidity.Sequence ()+import Data.Sequence (Seq)+import Test.Hspec+import Test.Validity.GenValidity++spec :: Spec+spec = do+  genValidSpec @(Seq Int)+  genValiditySpec @(Seq Rational)

@@ -0,0 +1,46 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.SetSpec where++import Data.GenValidity+import Data.GenValidity.Set+import Data.Set (Set)+import Data.Validity.Containers+import Test.Hspec+import Test.QuickCheck+import Test.Validity++spec :: Spec+spec = do+    describe "genStructurallyValidSetOf" $+        it "produces valid sets" $+        genGeneratesValid+            (genStructurallyValidSetOf @Rational genValid)+    describe "genStructurallyValidSetOfInvalidValues" $+        it "produces valid sets" $+        genGeneratesInvalid+            (genStructurallyValidSetOfInvalidValues @Rational)+#if MIN_VERSION_containers(0,5,9)+    describe "genStructurallyInvalidSet" $+        it "produces invalid sets" $+        genGeneratesInvalid (genStructurallyInvalidSet @Rational)+#endif+    genValidSpec @(Set Int)+    genValiditySpec @(Set Rational)+    describe "genSeperate" $ do+      it "generates values that are seperate" $+        forAll (genSeperate genUnchecked) $ \ls -> distinctOrd (ls :: [Int])+      it "generates values that are seperate" $+        forAll (genSeperate genValid) $ \ls -> distinctOrd (ls :: [Int])+    describe "genSeperateFor" $ do+      it "generates values that are seperate" $+        forAllValid $ \ls ->+          forAll (genSeperateFor genUnchecked ls) $ \tups -> distinctOrd (map fst (tups :: [(Int, Int)]))+      it "generates values that are seperate" $+        forAllValid $ \ls ->+          forAll (genSeperateFor genValid ls) $ \tups -> distinctOrd  (map fst(tups :: [(Int, Int)]))+    describe "genValidSeperateFor" $+      it "generates values that are seperate" $+      forAllValid $ \ls ->+        forAll (genValidSeperateFor ls) $ \tups -> distinctOrd (map fst (tups :: [(Int, Int)]))

@@ -0,0 +1,13 @@+{-# LANGUAGE TypeApplications #-}++module Data.GenValidity.Containers.TreeSpec where++import Data.GenValidity.Tree ()+import Data.Tree (Tree)+import Test.Hspec+import Test.Validity++spec :: Spec+spec = do+  genValidSpec @(Tree Int)+  genValiditySpec @(Tree Rational)

@@ -1,30 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeApplications #-}--module Test.Validity.Containers.MapSpec where--import Test.Hspec--import Data.GenValidity-import Data.GenValidity.Map-import Data.Map (Map)-import Test.Validity.GenValidity--spec :: Spec-spec = do-    describe "genStructurallyValidMapOf" $-        it "produces valid maps" $-        genGeneratesValid-            (genStructurallyValidMapOf @Rational @Rational genValid)-    describe "genStructurallyValidMapOfInvalidValues" $-        it "produces valid maps" $-        genGeneratesInvalid-            (genStructurallyValidMapOfInvalidValues @Rational @Rational)-#if MIN_VERSION_containers(0,5,9)-    describe "genStructurallyInvalidMap" $-        it "produces invalid maps" $-        genGeneratesInvalid-            (genStructurallyInvalidMap @Rational @Rational)-#endif-    genValidSpec @(Map Int Rational)-    genValiditySpec @(Map Rational Rational)

@@ -1,14 +0,0 @@-{-# LANGUAGE TypeApplications #-}--module Test.Validity.Containers.SeqSpec where--import Test.Hspec--import Data.GenValidity.Sequence ()-import Data.Sequence (Seq)-import Test.Validity.GenValidity--spec :: Spec-spec = do-    genValidSpec @(Seq Int)-    genValiditySpec @(Seq Rational)

@@ -1,29 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeApplications #-}--module Test.Validity.Containers.SetSpec where--import Test.Hspec--import Data.GenValidity-import Data.GenValidity.Set-import Data.Set (Set)-import Test.Validity.GenValidity--spec :: Spec-spec = do-    describe "genStructurallyValidSetOf" $-        it "produces valid sets" $-        genGeneratesValid-            (genStructurallyValidSetOf @Rational genValid)-    describe "genStructurallyValidSetOfInvalidValues" $-        it "produces valid sets" $-        genGeneratesInvalid-            (genStructurallyValidSetOfInvalidValues @Rational)-#if MIN_VERSION_containers(0,5,9)-    describe "genStructurallyInvalidSet" $-        it "produces invalid sets" $-        genGeneratesInvalid (genStructurallyInvalidSet @Rational)-#endif-    genValidSpec @(Set Int)-    genValiditySpec @(Set Rational)

@@ -1,14 +0,0 @@-{-# LANGUAGE TypeApplications #-}--module Test.Validity.Containers.TreeSpec where--import Test.Hspec--import Data.GenValidity.Tree ()-import Data.Tree (Tree)-import Test.Validity--spec :: Spec-spec = do-  genValidSpec @(Tree Int)-  genValiditySpec @(Tree Rational)