Tests.QuickCheckUtils: use coerce

Author: Anton-Latukha

tests/Tests/QuickCheckUtils.hs

@@ -79,13 +79,13 @@ instance Arbitrary BL.ByteString where
 -- | For tests that have O(n^2) running times or input sizes, resize
 -- their inputs to the square root of the originals.
 newtype Sqrt a = Sqrt { unSqrt :: a }
-    deriving (Eq, Show)
+ deriving (Eq, Show)
 
 instance Arbitrary a => Arbitrary (Sqrt a) where
-    arbitrary = fmap Sqrt $ sized $ \n -> resize (smallish n) arbitrary
+    arbitrary = coerce $ sized $ \n -> resize (smallish n) $ arbitrary @a
      where
       smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
-    shrink = map Sqrt . shrink . unSqrt
+    shrink = coerce (shrink @a)
 
 instance Arbitrary T.Text where
     arbitrary = T.pack <$> listOf arbitraryUnicodeChar -- without surrogates
@@ -96,17 +96,23 @@ instance Arbitrary TL.Text where
     shrink = map TL.pack . shrink . TL.unpack
 
 newtype BigInt = Big Integer
-               deriving (Eq, Show)
+ deriving (Eq, Show)
 
 instance Arbitrary BigInt where
     arbitrary = do
-      e <- choose (1::Int,200)
-      Big <$> choose (10^(e-1),10^e)
-    shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
-      where l = truncate (logBase 2 (fromIntegral a) :: Double) :: Integer
+      e <- choose @Int (1,200)
+      coerce $ choose @Integer (10^(e-1),10^e)
+
+    shrink ba = [coerce (a `div` 2^(l-e)) | e <- shrink l]
+     where
+      a :: Integer
+      a = coerce ba
+      l :: Word
+      l = integerLog2 a
 
 newtype NotEmpty a = NotEmpty { notEmpty :: a }
-    deriving (Eq, Ord, Show)
+ deriving (Eq, Ord, Show)
+
 
 instance Arbitrary (NotEmpty T.Text) where
     arbitrary   = fmap (NotEmpty . T.pack . getNonEmpty) arbitrary
@@ -119,16 +125,17 @@ instance Arbitrary (NotEmpty TL.Text) where
                 . shrink . NonEmpty . TL.unpack . notEmpty
 
 data DecodeErr = Lenient | Ignore | Strict | Replace
-               deriving (Show, Eq, Bounded, Enum)
+ deriving (Show, Eq, Bounded, Enum)
 
 genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
 genDecodeErr Lenient = return T.lenientDecode
 genDecodeErr Ignore  = return T.ignore
 genDecodeErr Strict  = return T.strictDecode
-genDecodeErr Replace = (\c _ _ -> c) <$> frequency
-  [ (1, return Nothing)
-  , (50, Just <$> arbitraryUnicodeChar)
-  ]
+genDecodeErr Replace = (\c _ _ -> c) <$>
+  frequency
+    [ (1, return Nothing)
+    , (50, pure <$> arbitraryUnicodeChar)
+    ]
 
 instance Arbitrary DecodeErr where
     arbitrary = arbitraryBoundedEnum
@@ -193,25 +200,28 @@ instance Arbitrary FPFormat where
     arbitrary = arbitraryBoundedEnum
 
 newtype Precision a = Precision (Maybe Int)
-                    deriving (Eq, Show)
+ deriving (Eq, Show)
 
+--  Deprecated on 2021-10-05
 precision :: a -> Precision a -> Maybe Int
-precision _ (Precision prec) = prec
+precision _ = coerce
+{-# DEPRECATED precision "Use @coerce@ with types instead" #-}
 
 arbitraryPrecision :: Int -> Gen (Precision a)
-arbitraryPrecision maxDigits = Precision <$> do
-  n <- choose (-1,maxDigits)
-  return $ if n == -1
-           then Nothing
-           else Just n
+arbitraryPrecision maxDigits = do
+  n <- choose (0,maxDigits)
+  frequency
+    [ (1, pure $ coerce $ Nothing @Int)
+    , (n, pure $ coerce $ Just n)
+    ]
 
 instance Arbitrary (Precision Float) where
     arbitrary = arbitraryPrecision 11
-    shrink    = map Precision . shrink . precision undefined
+    shrink    = coerce (shrink @(Maybe Int))
 
 instance Arbitrary (Precision Double) where
     arbitrary = arbitraryPrecision 22
-    shrink    = map Precision . shrink . precision undefined
+    shrink    = coerce (shrink @(Maybe Int))
 
 instance Arbitrary IO.Newline where
     arbitrary = oneof [return IO.LF, return IO.CRLF]
@@ -274,5 +284,5 @@ newtype SpacyString = SpacyString { getSpacyString :: String }
   deriving (Eq, Ord, Show, Read)
 
 instance Arbitrary SpacyString where
-  arbitrary = SpacyString `fmap` listOf arbitrarySpacyChar
-  shrink (SpacyString xs) = SpacyString `fmap` shrink xs
+  arbitrary = coerce $ listOf arbitrarySpacyChar
+  shrink = coerce (shrink @[Char])