genvalidity-containers 0.9.0.0 → 1.0.0.0

raw patch · 12 files changed

+115/−306 lines, 12 filesdep ~genvaliditydep ~genvalidity-containersdep ~genvalidity-propertysetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: genvalidity, genvalidity-containers, genvalidity-property

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−1
• LICENSE +1/−1
• Setup.hs +0/−3
• genvalidity-containers.cabal +8/−9
• src/Data/GenValidity/Map.hs +9/−83
• src/Data/GenValidity/Sequence.hs +9/−19
• src/Data/GenValidity/Set.hs +17/−87
• src/Data/GenValidity/Tree.hs +28/−52
• test/Data/GenValidity/Containers/MapSpec.hs +7/−19
• test/Data/GenValidity/Containers/SeqSpec.hs +1/−1
• test/Data/GenValidity/Containers/SetSpec.hs +20/−30
• test/Data/GenValidity/Containers/TreeSpec.hs +1/−1

@@ -1,6 +1,19 @@ # Changelog -## [Unreleased]+## [1.0.0.0] - 2021-11-20++### Changed++* Compatibility with `genvalidity >= 1.0.0.0`++### Removed++* `genStructurallyValidMapOf`+* `genStructurallyValidMapOfInvalidValues`+* `genStructurallyInvalidMap`+* `genStructurallyValidSetOf`+* `genStructurallyValidSetOfInvalidValues`+* `genStructurallyInvalidSet`  ## [0.9.0.0] - 2020-06-14 

@@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016-2020 Tom Sydney Kerckhove+Copyright (c) 2016-2021 Tom Sydney Kerckhove  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain

@@ -1,24 +1,23 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 1f475d682a51c1839b38c10a051dbd9df5a0b7f4cd1323be22c26605a4495c48  name:           genvalidity-containers-version:        0.9.0.0+version:        1.0.0.0 synopsis:       GenValidity support for containers category:       Testing homepage:       https://github.com/NorfairKing/validity#readme bug-reports:    https://github.com/NorfairKing/validity/issues author:         Tom Sydney Kerckhove maintainer:     syd@cs-syd.eu-copyright:      Copyright: (c) 2016-2020 Tom Sydney Kerckhove+copyright:      Copyright: (c) 2016-2021 Tom Sydney Kerckhove license:        MIT license-file:   LICENSE build-type:     Simple extra-source-files:+    LICENSE     CHANGELOG.md  source-repository head@@ -40,7 +39,7 @@       QuickCheck     , base >=4.9 && <=5     , containers >=0.6.0.1-    , genvalidity >=0.8+    , genvalidity >=1.0     , validity >=0.5     , validity-containers >=0.3   default-language: Haskell2010@@ -61,10 +60,10 @@       QuickCheck     , base >=4.9 && <=5     , containers-    , genvalidity >=0.7-    , genvalidity-containers >=0.5+    , genvalidity+    , genvalidity-containers     , genvalidity-hspec-    , genvalidity-property >=0.5+    , genvalidity-property     , hspec     , validity >=0.9     , validity-containers

@@ -1,93 +1,19 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}  module Data.GenValidity.Map-    ( genMapOf-    , genStructurallyValidMapOf-    , genStructurallyValidMapOfInvalidValues-#if MIN_VERSION_containers(0,5,9)-    , genStructurallyInvalidMap-#endif-    ) where-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (pure, (<$>), (<*>))-#endif-import Data.GenValidity-import Data.Validity.Map ()-import Test.QuickCheck+  ( genMapOf,+  )+where +import Data.GenValidity import Data.Map (Map) import qualified Data.Map as M-#if MIN_VERSION_containers(0,5,9)-import qualified Data.Map.Internal as Internal-#endif+import Data.Validity.Map ()+import Test.QuickCheck -#if MIN_VERSION_containers(0,5,9)-instance (Ord k, GenUnchecked k, GenUnchecked v) => GenUnchecked (Map k v) where-    genUnchecked =-        sized $ \n ->-            case n of-                0 -> pure Internal.Tip-                _ -> do-                    (a, b, c, d, e) <- genSplit5 n-                    Internal.Bin <$> resize a genUnchecked <*>-                        resize b genUnchecked <*>-                        resize c genUnchecked <*>-                        resize d genUnchecked <*>-                        resize e genUnchecked-    shrinkUnchecked Internal.Tip = []-    shrinkUnchecked (Internal.Bin s k a m1 m2) =-        Internal.Tip :-        [m1, m2] ++-        [ Internal.Bin s' k' a' m1' m2'-        | (s', k', a', m1', m2') <- shrinkUnchecked (s, k, a, m1, m2)-        ]-#else-instance (Ord k, GenUnchecked k, GenUnchecked v) => GenUnchecked (Map k v) where-    genUnchecked = M.fromList <$> genUnchecked-    shrinkUnchecked = fmap M.fromList . shrinkUnchecked . M.toList-#endif instance (Show k, Ord k, GenValid k, GenValid v) => GenValid (Map k v) where-    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-    genInvalid =-        oneof-            [genStructurallyValidMapOfInvalidValues, genStructurallyInvalidMap]-#else-instance (Show k, Ord k, GenUnchecked k, GenInvalid k, GenUnchecked v, GenInvalid v) => GenInvalid (Map k v) where-    genInvalid = genStructurallyValidMapOfInvalidValues-#endif+  genValid = genMapOf genValid+  shrinkValid = fmap M.fromList . shrinkValid . M.toList  genMapOf :: Ord k => Gen (k, v) -> Gen (Map k v)-genMapOf = genStructurallyValidMapOf--genStructurallyValidMapOf :: Ord k => Gen (k, v) -> Gen (Map k v)-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.'-genStructurallyValidMapOfInvalidValues ::-       (Ord k, GenUnchecked k, GenInvalid k, GenUnchecked v, GenInvalid v) => Gen (Map k v)-genStructurallyValidMapOfInvalidValues =-    sized $ \n -> do-        (k, v, m) <- genSplit3 n-        let go g1 g2 = do-                key <- resize k g1-                val <- resize v g2-                rest <--                    resize m $-                    genStructurallyValidMapOf $-                    (,) <$> genUnchecked <*> genUnchecked-                pure $ M.insert key val rest-        oneof [go genInvalid genUnchecked, go genUnchecked genInvalid]-#if MIN_VERSION_containers(0,5,9)-genStructurallyInvalidMap ::-       (Show k, Ord k, GenUnchecked k, GenUnchecked v) => Gen (Map k v)-genStructurallyInvalidMap = do-    v <- genUnchecked-    if M.valid v-        then scale (+ 1) genStructurallyInvalidMap-        else pure v-#endif+genMapOf g = M.fromList <$> genListOf g

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

@@ -1,94 +1,30 @@-{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Data.GenValidity.Set-    ( 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+  ( genSetOf,+    genSeperate,+    genSeperateFor,+    genSeperateForNE,+    genValidSeperateFor,+    genValidSeperateForNE,+  )+where -import Data.List.NonEmpty (NonEmpty(..))+import Data.Containers.ListUtils+import Data.GenValidity+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)-import qualified Data.Set.Internal as Internal-#endif-#if MIN_VERSION_containers(0,5,9)-instance (Ord v, GenUnchecked v) => GenUnchecked (Set v) where-    genUnchecked =-        sized $ \n ->-            case n of-                0 -> pure Internal.Tip-                _ -> do-                    (a, b, c, d) <- genSplit4 n-                    Internal.Bin <$> resize a genUnchecked <*>-                        resize b genUnchecked <*>-                        resize c genUnchecked <*>-                        resize d genUnchecked-    shrinkUnchecked Internal.Tip = []-    shrinkUnchecked (Internal.Bin s a s1 s2) =-        Internal.Tip :-        [s1, s2] ++-        [ Internal.Bin s' a' s1' s2'-        | (s', a', s1', s2') <- shrinkUnchecked (s, a, s1, s2)-        ]-#else-instance (Ord v, GenUnchecked v) => GenUnchecked (Set v) where-    genUnchecked = S.fromList <$> genUnchecked-    shrinkUnchecked = fmap S.fromList . shrinkUnchecked . S.toList-#endif+import Data.Validity.Set ()+import Test.QuickCheck+ instance (Ord v, GenValid v) => GenValid (Set v) where-    genValid = S.fromList <$> genValid-    shrinkValid = fmap S.fromList . shrinkValid . S.toList-#if MIN_VERSION_containers(0,5,9)-instance (Ord v, GenUnchecked v, GenInvalid v) => GenInvalid (Set v) where-    genInvalid =-        oneof-            [genStructurallyValidSetOfInvalidValues, genStructurallyInvalidSet]-#else-instance (Ord v, GenUnchecked v, GenInvalid v) => GenInvalid (Set v) where-    genInvalid = genStructurallyValidSetOfInvalidValues-#endif+  genValid = S.fromList <$> genValid+  shrinkValid = fmap S.fromList . shrinkValid . S.toList  genSetOf :: Ord v => Gen v -> Gen (Set v)-genSetOf = genStructurallyValidSetOf--genStructurallyValidSetOf :: Ord v => Gen v -> Gen (Set v)-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.'-genStructurallyValidSetOfInvalidValues :: (Ord v, GenUnchecked v, GenInvalid v) => Gen (Set v)-genStructurallyValidSetOfInvalidValues =-    sized $ \n -> do-        (v, m) <- genSplit n-        val <- resize v genInvalid-        rest <- resize m $ genStructurallyValidSetOf genUnchecked-        pure $ S.insert val rest-#if MIN_VERSION_containers(0,5,9)-genStructurallyInvalidSet :: (Ord v, GenUnchecked v) => Gen (Set v)-genStructurallyInvalidSet = do-    v <- genUnchecked-    if S.valid v-        then scale (+ 1) genStructurallyInvalidSet-        else pure v-#endif+genSetOf g = S.fromList <$> genListOf g  genValidSeperateFor :: (GenValid b, Eq b) => [a] -> Gen [(b, a)] genValidSeperateFor = genSeperateFor genValid@@ -96,13 +32,8 @@ 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)]@@ -114,4 +45,3 @@   restTups <- genSeperateFor g as   b <- g `suchThat` (`notElem` map fst restTups)   pure ((b, a) :| restTups)-

@@ -1,70 +1,46 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE CPP #-}  module Data.GenValidity.Tree where-#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<*>))-import Data.Functor ((<$>))-#endif+ import Data.GenValidity-import Data.List.NonEmpty (NonEmpty(..))+import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE+import Data.Tree import Data.Validity.Tree ()- import Test.QuickCheck -import Data.Tree--instance GenUnchecked a => GenUnchecked (Tree a) where-  genUnchecked = genTreeOf genUnchecked-  shrinkUnchecked (Node v ts) = [Node v' ts' | (v', ts') <- shrinkUnchecked (v, ts)]- instance GenValid a => GenValid (Tree a) where   genValid = genTreeOf genValid   shrinkValid (Node v ts) = [Node v' ts' | (v', ts') <- shrinkValid (v, ts)] --- | There should be at least one invalid element, either it's here or it's--- further down the tree.-instance (GenUnchecked a, GenInvalid a) => GenInvalid (Tree a) where-  genInvalid =-    sized $ \n -> do-      size <- upTo n-      (a, b) <- genSplit size-      oneof-        [ Node <$> resize a genInvalid <*> resize b genUnchecked-        , Node <$> resize a genUnchecked <*> resize b genInvalid-        ]-  shrinkInvalid (Node v ts) =-    if isInvalid v-      then Node <$> shrinkInvalid v <*> shrinkUnchecked ts-      else Node <$> shrinkUnchecked v <*> shrinkInvalid ts- -- | Generate a tree of values that are generated as specified. -- -- This takes the size parameter much better into account genTreeOf :: Gen a -> Gen (Tree a) genTreeOf func = do-    ne <- genNonEmptyOf func-    turnIntoTree ne- where-        turnIntoTree :: NonEmpty a -> Gen (Tree a)-        turnIntoTree (e :| es) = do-          groups <- turnIntoGroups es-          subtrees <- mapM turnIntoTree groups-          pure (Node e subtrees)+  ne <- genNonEmptyOf func+  turnIntoTree ne+  where+    turnIntoTree :: NonEmpty a -> Gen (Tree a)+    turnIntoTree (e :| es) = do+      groups <- turnIntoGroups es+      subtrees <- mapM turnIntoTree groups+      pure (Node e subtrees) -        turnIntoGroups :: [a] -> Gen [NonEmpty a]-        turnIntoGroups = go []-          where-            go :: [a] -> [a] -> Gen [NonEmpty a]-            go acc [] =-              case NE.nonEmpty acc of-                Nothing -> pure []-                Just ne -> pure [ne]-            go acc (e:es) =-              frequency-                [ ( 1-                  , do rest <- go [] es-                       pure ((e :| acc) : rest))-                , (4, go (e : acc) es)-                ]+    turnIntoGroups :: [a] -> Gen [NonEmpty a]+    turnIntoGroups = go []+      where+        go :: [a] -> [a] -> Gen [NonEmpty a]+        go acc [] =+          case NE.nonEmpty acc of+            Nothing -> pure []+            Just ne -> pure [ne]+        go acc (e : es) =+          frequency+            [ ( 1,+                do+                  rest <- go [] es+                  pure ((e :| acc) : rest)+              ),+              (4, go (e : acc) es)+            ]

@@ -1,30 +1,18 @@-{-# 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.Hspec 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)+  describe "genMapOf" $+    it "produces valid maps" $+      genGeneratesValid+        (genMapOf @Rational @Rational genValid)+  genValidSpec @(Map Int Rational)+  genValidSpec @(Map Rational Rational)

@@ -10,4 +10,4 @@ spec :: Spec spec = do   genValidSpec @(Seq Int)-  genValiditySpec @(Seq Rational)+  genValidSpec @(Seq Rational)

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE TypeApplications #-}  module Data.GenValidity.Containers.SetSpec where@@ -13,34 +12,25 @@  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" $+  describe "genSetOf" $+    it "produces valid sets" $+      genGeneratesValid+        (genSetOf @Rational genValid)+  genValidSpec @(Set Int)+  genValidSpec @(Set Rational)+  describe "genSeperate" $ do+    it "generates values that are seperate" $+      forAll (genSeperate genValid) $ \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 genValid 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)]))

@@ -10,4 +10,4 @@ spec :: Spec spec = do   genValidSpec @(Tree Int)-  genValiditySpec @(Tree Rational)+  genValidSpec @(Tree Rational)