Skip to content

Commit 7a7b301

Browse files
committed
Tests.QuickCheckUtils: clean-up
1 parent 9238e7b commit 7a7b301

File tree

1 file changed

+31
-25
lines changed

1 file changed

+31
-25
lines changed

tests/Tests/QuickCheckUtils.hs

Lines changed: 31 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,12 @@ module Tests.QuickCheckUtils
3232

3333
import Control.Arrow ((***))
3434
import Control.DeepSeq (NFData (..), deepseq)
35-
import Control.Exception (bracket)
3635
import Data.Char (isSpace)
3736
import Data.Coerce (coerce)
3837
import Data.Text.Foreign (I8)
3938
import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
4039
import Data.Word (Word8, Word16)
40+
import GHC.Num (integerLog2)
4141
import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
4242
import Tests.Utils
4343
import qualified Data.ByteString as B
@@ -50,6 +50,7 @@ import qualified Data.Text.Internal.Lazy as TL
5050
import qualified Data.Text.Internal.Lazy.Fusion as TLF
5151
import qualified Data.Text.Lazy as TL
5252
import qualified System.IO as IO
53+
import Control.Applicative (liftA2, liftA3)
5354

5455
genWord8 :: Gen Word8
5556
genWord8 = chooseAny
@@ -59,7 +60,7 @@ instance Arbitrary I8 where
5960
shrink = shrinkIntegral
6061

6162
instance Arbitrary B.ByteString where
62-
arbitrary = B.pack `fmap` listOf genWord8
63+
arbitrary = B.pack <$> listOf genWord8
6364
shrink = map B.pack . shrink . B.unpack
6465

6566
instance Arbitrary BL.ByteString where
@@ -69,10 +70,13 @@ instance Arbitrary BL.ByteString where
6970
, BL.fromChunks . map B.singleton <$> listOf genWord8
7071
-- so that a code point with 4 byte long utf8 representation
7172
-- 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
7680
]
7781
shrink xs = BL.fromChunks <$> shrink (BL.toChunks xs)
7882

@@ -84,7 +88,7 @@ newtype Sqrt a = Sqrt { unSqrt :: a }
8488
instance Arbitrary a => Arbitrary (Sqrt a) where
8589
arbitrary = coerce $ sized $ \n -> resize (smallish n) $ arbitrary @a
8690
where
87-
smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
91+
smallish = round . sqrt @Double . fromIntegral . abs
8892
shrink = coerce (shrink @a)
8993

9094
instance Arbitrary T.Text where
@@ -136,12 +140,12 @@ data DecodeErr = Lenient | Ignore | Strict | Replace
136140
deriving (Show, Eq, Bounded, Enum)
137141

138142
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
142146
genDecodeErr Replace = (\c _ _ -> c) <$>
143147
frequency
144-
[ (1, return Nothing)
148+
[ (1, pure Nothing)
145149
, (50, pure <$> arbitraryUnicodeChar)
146150
]
147151

@@ -232,29 +236,31 @@ instance Arbitrary (Precision Double) where
232236
shrink = coerce (shrink @(Maybe Int))
233237

234238
instance Arbitrary IO.Newline where
235-
arbitrary = oneof [return IO.LF, return IO.CRLF]
239+
arbitrary = oneof [pure IO.LF, pure IO.CRLF]
236240

237241
instance Arbitrary IO.NewlineMode where
238242
arbitrary = IO.NewlineMode <$> arbitrary <*> arbitrary
239243

240244
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+
]
246252

247253
-- This test harness is complex! What property are we checking?
248254
--
249255
-- Reading after writing a multi-line file should give the same
250256
-- results as were written.
251257
--
252258
-- 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.
258264
write_read :: (NFData a, Eq a, Show a)
259265
=> ([b] -> a)
260266
-> ((Char -> Bool) -> a -> b)
@@ -268,18 +274,18 @@ write_read _ _ _ _ (IO.NewlineMode IO.LF IO.CRLF) _ _ = discard
268274
write_read unline filt writer reader nl buf ts = ioProperty $
269275
(===t) <$> act
270276
where
271-
t = unline . map (filt (not . (`elem` "\r\n"))) $ ts
277+
t = unline . map (filt (`notElem` "\r\n")) $ ts
272278

273279
act = withTempFile $ \path h -> do
274280
IO.hSetNewlineMode h nl
275281
IO.hSetBuffering h buf
276282
() <- writer h t
277283
IO.hClose h
278-
bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do
284+
IO.withFile path IO.ReadMode $ \h' -> do
279285
IO.hSetNewlineMode h' nl
280286
IO.hSetBuffering h' buf
281287
r <- reader h'
282-
r `deepseq` return r
288+
r `deepseq` pure r
283289

284290
-- Generate various Unicode space characters with high probability
285291
arbitrarySpacyChar :: Gen Char

0 commit comments

Comments
 (0)