@@ -32,12 +32,12 @@ module Tests.QuickCheckUtils
32
32
33
33
import Control.Arrow ((***) )
34
34
import Control.DeepSeq (NFData (.. ), deepseq )
35
- import Control.Exception (bracket )
36
35
import Data.Char (isSpace )
37
36
import Data.Coerce (coerce )
38
37
import Data.Text.Foreign (I8 )
39
38
import Data.Text.Lazy.Builder.RealFloat (FPFormat (.. ))
40
39
import Data.Word (Word8 , Word16 )
40
+ import GHC.Num (integerLog2 )
41
41
import Test.QuickCheck hiding (Fixed (.. ), Small (.. ), (.&.) )
42
42
import Tests.Utils
43
43
import qualified Data.ByteString as B
@@ -50,6 +50,7 @@ import qualified Data.Text.Internal.Lazy as TL
50
50
import qualified Data.Text.Internal.Lazy.Fusion as TLF
51
51
import qualified Data.Text.Lazy as TL
52
52
import qualified System.IO as IO
53
+ import Control.Applicative (liftA2 , liftA3 )
53
54
54
55
genWord8 :: Gen Word8
55
56
genWord8 = chooseAny
@@ -59,7 +60,7 @@ instance Arbitrary I8 where
59
60
shrink = shrinkIntegral
60
61
61
62
instance Arbitrary B. ByteString where
62
- arbitrary = B. pack `fmap` listOf genWord8
63
+ arbitrary = B. pack <$> listOf genWord8
63
64
shrink = map B. pack . shrink . B. unpack
64
65
65
66
instance Arbitrary BL. ByteString where
@@ -69,10 +70,13 @@ instance Arbitrary BL.ByteString where
69
70
, BL. fromChunks . map B. singleton <$> listOf genWord8
70
71
-- so that a code point with 4 byte long utf8 representation
71
72
-- could appear split over 3 non-singleton chunks
72
- , (\ a b c -> BL. fromChunks [a, b, c])
73
- <$> arbitrary
74
- <*> ((\ a b -> B. pack [a, b]) <$> genWord8 <*> genWord8)
75
- <*> arbitrary
73
+ , liftA3 (\ a b c -> BL. fromChunks [a, b, c])
74
+ arbitrary
75
+ (liftA2 (\ a b -> B. pack [a, b])
76
+ genWord8
77
+ genWord8
78
+ )
79
+ arbitrary
76
80
]
77
81
shrink xs = BL. fromChunks <$> shrink (BL. toChunks xs)
78
82
@@ -84,7 +88,7 @@ newtype Sqrt a = Sqrt { unSqrt :: a }
84
88
instance Arbitrary a => Arbitrary (Sqrt a ) where
85
89
arbitrary = coerce $ sized $ \ n -> resize (smallish n) $ arbitrary @ a
86
90
where
87
- smallish = round . ( sqrt :: Double -> Double ) . fromIntegral . abs
91
+ smallish = round . sqrt @ Double . fromIntegral . abs
88
92
shrink = coerce (shrink @ a )
89
93
90
94
instance Arbitrary T. Text where
@@ -136,12 +140,12 @@ data DecodeErr = Lenient | Ignore | Strict | Replace
136
140
deriving (Show , Eq , Bounded , Enum )
137
141
138
142
genDecodeErr :: DecodeErr -> Gen T. OnDecodeError
139
- genDecodeErr Lenient = return T. lenientDecode
140
- genDecodeErr Ignore = return T. ignore
141
- genDecodeErr Strict = return T. strictDecode
143
+ genDecodeErr Lenient = pure T. lenientDecode
144
+ genDecodeErr Ignore = pure T. ignore
145
+ genDecodeErr Strict = pure T. strictDecode
142
146
genDecodeErr Replace = (\ c _ _ -> c) <$>
143
147
frequency
144
- [ (1 , return Nothing )
148
+ [ (1 , pure Nothing )
145
149
, (50 , pure <$> arbitraryUnicodeChar)
146
150
]
147
151
@@ -232,29 +236,31 @@ instance Arbitrary (Precision Double) where
232
236
shrink = coerce (shrink @ (Maybe Int ))
233
237
234
238
instance Arbitrary IO. Newline where
235
- arbitrary = oneof [return IO. LF , return IO. CRLF ]
239
+ arbitrary = oneof [pure IO. LF , pure IO. CRLF ]
236
240
237
241
instance Arbitrary IO. NewlineMode where
238
242
arbitrary = IO. NewlineMode <$> arbitrary <*> arbitrary
239
243
240
244
instance Arbitrary IO. BufferMode where
241
- arbitrary = oneof [ return IO. NoBuffering ,
242
- return IO. LineBuffering ,
243
- return (IO. BlockBuffering Nothing ),
244
- (IO. BlockBuffering . Just . (+ 1 ) . fromIntegral ) `fmap`
245
- (arbitrary :: Gen Word16 ) ]
245
+ arbitrary =
246
+ oneof
247
+ [ pure IO. NoBuffering
248
+ , pure IO. LineBuffering
249
+ , pure (IO. BlockBuffering Nothing )
250
+ , IO. BlockBuffering . pure . succ . fromIntegral <$> arbitrary @ Word16
251
+ ]
246
252
247
253
-- This test harness is complex! What property are we checking?
248
254
--
249
255
-- Reading after writing a multi-line file should give the same
250
256
-- results as were written.
251
257
--
252
258
-- What do we vary while checking this property?
253
- -- * The lines themselves, scrubbed to contain neither CR nor LF. (By
254
- -- working with a list of lines, we ensure that the data will
255
- -- sometimes contain line endings.)
256
- -- * Newline translation mode.
257
- -- * Buffering.
259
+ -- * The lines themselves, scrubbed to contain neither CR nor LF. (By
260
+ -- working with a list of lines, we ensure that the data will
261
+ -- sometimes contain line endings.)
262
+ -- * Newline translation mode.
263
+ -- * Buffering.
258
264
write_read :: (NFData a , Eq a , Show a )
259
265
=> ([b ] -> a )
260
266
-> ((Char -> Bool ) -> a -> b )
@@ -268,18 +274,18 @@ write_read _ _ _ _ (IO.NewlineMode IO.LF IO.CRLF) _ _ = discard
268
274
write_read unline filt writer reader nl buf ts = ioProperty $
269
275
(=== t) <$> act
270
276
where
271
- t = unline . map (filt (not . ( `elem ` " \r\n " ) )) $ ts
277
+ t = unline . map (filt (`notElem ` " \r\n " )) $ ts
272
278
273
279
act = withTempFile $ \ path h -> do
274
280
IO. hSetNewlineMode h nl
275
281
IO. hSetBuffering h buf
276
282
() <- writer h t
277
283
IO. hClose h
278
- bracket ( IO. openFile path IO. ReadMode) IO. hClose $ \ h' -> do
284
+ IO. withFile path IO. ReadMode $ \ h' -> do
279
285
IO. hSetNewlineMode h' nl
280
286
IO. hSetBuffering h' buf
281
287
r <- reader h'
282
- r `deepseq` return r
288
+ r `deepseq` pure r
283
289
284
290
-- Generate various Unicode space characters with high probability
285
291
arbitrarySpacyChar :: Gen Char
0 commit comments