From 17ac55dfc31178b571ca2e6c8b088f5281c23e56 Mon Sep 17 00:00:00 2001
From: Bryan O'Sullivan <bos@serpentine.com>
Date: Tue, 7 Jan 2014 21:53:18 -0800
Subject: [PATCH] Improve Arbitrary instances
---
tests/Tests/QuickCheckUtils.hs | 17 +++++++++++++++--
1 file changed, 15 insertions(+), 2 deletions(-)
diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs
index d4895645..c2ed6e7c 100644
--- a/tests/Tests/QuickCheckUtils.hs
+++ b/tests/Tests/QuickCheckUtils.hs
@@ -58,10 +58,12 @@ instance Random I16 where
random = randomR (minBound,maxBound)
instance Arbitrary I16 where
- arbitrary = choose (minBound,maxBound)
+ arbitrary = arbitrarySizedIntegral
+ shrink = shrinkIntegral
instance Arbitrary B.ByteString where
arbitrary = B.pack `fmap` arbitrary
+ shrink = map B.pack . shrink . B.unpack
#if !MIN_VERSION_base(4,4,0)
instance Random Word8 where
@@ -130,9 +132,11 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
instance Arbitrary T.Text where
arbitrary = T.pack `fmap` arbitrary
+ shrink = map T.pack . shrink . T.unpack
instance Arbitrary TL.Text where
arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
+ shrink = map TL.pack . shrink . TL.unpack
newtype NotEmpty a = NotEmpty { notEmpty :: a }
deriving (Eq, Ord)
@@ -145,15 +149,23 @@ instance Functor NotEmpty where
instance Arbitrary a => Arbitrary (NotEmpty [a]) where
arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
+ shrink = shrinkNotEmpty null
instance Arbitrary (NotEmpty T.Text) where
arbitrary = (fmap T.pack) `fmap` arbitrary
+ shrink = shrinkNotEmpty T.null
instance Arbitrary (NotEmpty TL.Text) where
arbitrary = (fmap TL.pack) `fmap` arbitrary
+ shrink = shrinkNotEmpty TL.null
instance Arbitrary (NotEmpty B.ByteString) where
arbitrary = (fmap B.pack) `fmap` arbitrary
+ shrink = shrinkNotEmpty B.null
+
+shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]
+shrinkNotEmpty isNull (NotEmpty xs) =
+ [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]
data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
| S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
@@ -194,7 +206,8 @@ instance Random Small where
random = randomR (minBound,maxBound)
instance Arbitrary Small where
- arbitrary = choose (minBound,maxBound)
+ arbitrary = arbitrarySizedIntegral
+ shrink = shrinkIntegral
integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
--
GitLab