genvalidity-containers 0.8.0.0 → 0.8.0.1

raw patch · 3 files changed

+52/−26 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• genvalidity-containers.cabal +2/−2
• src/Data/GenValidity/Tree.hs +43/−24

@@ -2,6 +2,13 @@  ## [Unreleased] +## [0.8.0.1] - 2019-12-04++### Changed++* Changed the way trees are generated.+  They will no longer be as top-heavy or under-sized.+ ## [0.8.0.0] - 2019-09-23  ### Changed

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4c25162115ada25ea382b2e5d07237592332b9603f0045b8adde3fc2f285f87a+-- hash: 441a213ff410a2036dd1d487852265991c03456927b9866914542413775969d8  name:           genvalidity-containers-version:        0.8.0.0+version:        0.8.0.1 synopsis:       GenValidity support for containers description:    Please see README.md category:       Testing

@@ -7,6 +7,8 @@ import Data.Functor ((<$>)) #endif import Data.GenValidity+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE import Data.Validity.Tree ()  import Test.QuickCheck@@ -14,38 +16,55 @@ 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)]+  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)]+  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+  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 =-    sized $ \n -> do-        size <- upTo n-        (a, b) <- genSplit size-        value <- resize a func-        forest <- resize b $ genListOf $ genTreeOf func-        return $ Node value forest+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)++        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)+                ]