on master help sign in
Improve Arbitrary instances
17ac55dBryan O'Sullivan
tests/Tests/QuickCheckUtils.hs+15−2
@@ -58,10 +58,12 @@ instance Random I16 where
58 random = randomR (minBound,maxBound)
58 random = randomR (minBound,maxBound)
59
59
60instance Arbitrary I16 where
60instance Arbitrary I16 where
61− arbitrary = choose (minBound,maxBound)
61+ arbitrary = arbitrarySizedIntegral
62+ shrink = shrinkIntegral
62
63
63instance Arbitrary B.ByteString where
64instance Arbitrary B.ByteString where
64 arbitrary = B.pack `fmap` arbitrary
65 arbitrary = B.pack `fmap` arbitrary
66+ shrink = map B.pack . shrink . B.unpack
65
67
66#if !MIN_VERSION_base(4,4,0)
68#if !MIN_VERSION_base(4,4,0)
67instance Random Word8 where
69instance Random Word8 where
@@ -130,9 +132,11 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
130
132
131instance Arbitrary T.Text where
133instance Arbitrary T.Text where
132 arbitrary = T.pack `fmap` arbitrary
134 arbitrary = T.pack `fmap` arbitrary
135+ shrink = map T.pack . shrink . T.unpack
133
136
134instance Arbitrary TL.Text where
137instance Arbitrary TL.Text where
135 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
138 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
139+ shrink = map TL.pack . shrink . TL.unpack
136
140
137newtype NotEmpty a = NotEmpty { notEmpty :: a }
141newtype NotEmpty a = NotEmpty { notEmpty :: a }
138 deriving (Eq, Ord)
142 deriving (Eq, Ord)
@@ -145,15 +149,23 @@ instance Functor NotEmpty where
145
149
146instance Arbitrary a => Arbitrary (NotEmpty [a]) where
150instance Arbitrary a => Arbitrary (NotEmpty [a]) where
147 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
151 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
152+ shrink = shrinkNotEmpty null
148
153
149instance Arbitrary (NotEmpty T.Text) where
154instance Arbitrary (NotEmpty T.Text) where
150 arbitrary = (fmap T.pack) `fmap` arbitrary
155 arbitrary = (fmap T.pack) `fmap` arbitrary
156+ shrink = shrinkNotEmpty T.null
151
157
152instance Arbitrary (NotEmpty TL.Text) where
158instance Arbitrary (NotEmpty TL.Text) where
153 arbitrary = (fmap TL.pack) `fmap` arbitrary
159 arbitrary = (fmap TL.pack) `fmap` arbitrary
160+ shrink = shrinkNotEmpty TL.null
154
161
155instance Arbitrary (NotEmpty B.ByteString) where
162instance Arbitrary (NotEmpty B.ByteString) where
156 arbitrary = (fmap B.pack) `fmap` arbitrary
163 arbitrary = (fmap B.pack) `fmap` arbitrary
164+ shrink = shrinkNotEmpty B.null
165+
166+shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]
167+shrinkNotEmpty isNull (NotEmpty xs) =
168+ [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]
157
169
158data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
170data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
159 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
171 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
@@ -194,7 +206,8 @@ instance Random Small where
194 random = randomR (minBound,maxBound)
206 random = randomR (minBound,maxBound)
195
207
196instance Arbitrary Small where
208instance Arbitrary Small where
197− arbitrary = choose (minBound,maxBound)
209+ arbitrary = arbitrarySizedIntegral
210+ shrink = shrinkIntegral
198
211
199integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
212integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
200integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
213integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,