[commit: packages/containers] changelog-foldtree, cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-184-generic, revert-408-bugfix_394: Fix Arbitrary instance for FingerTree (0086aa7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/containers

On branches: changelog-foldtree,cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-184-generic,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/0086aa753795237cec28be6d2a261708eb7dacf6

>---------------------------------------------------------------

commit 0086aa753795237cec28be6d2a261708eb7dacf6
Author: Ross Paterson <ross at soi.city.ac.uk>
Date:   Fri Dec 19 23:24:20 2014 +0000

    Fix Arbitrary instance for FingerTree
    
    The previous version never generated deep trees containing Empty.
    Also tweaked the size handling so that the tree size is closer to the
    specified size (though it can still run over a bit).


>---------------------------------------------------------------

0086aa753795237cec28be6d2a261708eb7dacf6
 tests/seq-properties.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/tests/seq-properties.hs b/tests/seq-properties.hs
index 4f4f468..def17b3 100644
--- a/tests/seq-properties.hs
+++ b/tests/seq-properties.hs
@@ -112,7 +112,15 @@ instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where
         arb :: (Arbitrary a, Sized a) => Int -> Gen (FingerTree a)
         arb 0 = return Empty
         arb 1 = Single <$> arbitrary
-        arb n = deep <$> arbitrary <*> arb (n `div` 2) <*> arbitrary
+        arb n = do
+            pr <- arbitrary
+            sf <- arbitrary
+            let n_pr = Prelude.length (toList pr)
+            let n_sf = Prelude.length (toList sf)
+            -- adding n `div` 7 ensures that n_m >= 0, and makes more Singles
+            let n_m = max (n `div` 7) ((n - n_pr - n_sf) `div` 3)
+            m <- arb n_m
+            return $ deep pr m sf
 
     shrink (Deep _ (One a) Empty (One b)) = [Single a, Single b]
     shrink (Deep _ pr m sf) =