Clean up QuickCheckUtils

src/Data/Text/Lazy/Builder/RealFloat.hs

@@ -34,7 +34,7 @@ data FPFormat = Exponent
               | Generic
               -- ^ Use decimal notation for values between @0.1@ and
               -- @9,999,999@, and scientific notation otherwise.
-                deriving (Enum, Read, Show)
+                deriving (Enum, Read, Show, Bounded)
 
 -- | Show a signed 'RealFloat' value to full precision,
 -- using standard decimal notation for arguments whose absolute value lies

tests/Tests/Properties/Builder.hs

@@ -53,10 +53,10 @@ tb_decimal_word16 (a::Word16) = tb_decimal a
 tb_decimal_word32 (a::Word32) = tb_decimal a
 tb_decimal_word64 (a::Word64) = tb_decimal a
 
-tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a
-tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
-tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
-tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
+tb_decimal_big_int (Large (a::Int)) = tb_decimal a
+tb_decimal_big_int64 (Large (a::Int64)) = tb_decimal a
+tb_decimal_big_word (Large (a::Word)) = tb_decimal a
+tb_decimal_big_word64 (Large (a::Word64)) = tb_decimal a
 
 tb_hex :: (Integral a, Show a) => a -> Property
 tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

tests/Tests/Properties/LowLevel.hs

@@ -48,8 +48,7 @@ t_mul a b = mulRef a b === eval mul a b
 
 t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
 t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
-t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
-  where n = small m
+t_take_drop_16 (Small n) t = T.append (takeWord16 n t) (dropWord16 n t) === t
 t_use_from t = ioProperty $ (==t) <$> useAsPtr t fromPtr
 
 t_copy t = T.copy t === t

tests/Tests/Properties/Substrings.hs

@@ -21,8 +21,7 @@ import qualified Data.Text.Lazy as TL
 import qualified Tests.SlowFunctions as Slow
 
 s_take n          = L.take n      `eqP` (unpackS . S.take n)
-s_take_s m        = L.take n      `eqP` (unpackS . S.unstream . S.take n)
-  where n = small m
+s_take_s (Small n) = L.take n      `eqP` (unpackS . S.unstream . S.take n)
 sf_take (applyFun -> p) n
                   = (L.take n . L.filter p) `eqP`
                     (unpackS . S.take n . S.filter p)
@@ -33,8 +32,7 @@ tl_take n         = L.take n      `eqP` (unpackS . TL.take (fromIntegral n))
 tl_takeEnd n      = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`
                     (unpackS . TL.takeEnd n)
 s_drop n          = L.drop n      `eqP` (unpackS . S.drop n)
-s_drop_s m        = L.drop n      `eqP` (unpackS . S.unstream . S.drop n)
-  where n = small m
+s_drop_s (Small n) = L.drop n      `eqP` (unpackS . S.unstream . S.drop n)
 sf_drop (applyFun -> p) n
                   = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p)
 t_drop n          = L.drop n      `eqP` (unpackS . T.drop n)
@@ -43,11 +41,9 @@ t_dropEnd n       = (L.reverse . L.drop n . L.reverse) `eqP`
 tl_drop n         = L.drop n      `eqP` (unpackS . TL.drop (fromIntegral n))
 tl_dropEnd n      = (L.reverse . L.drop n . L.reverse) `eqP`
                     (unpackS . TL.dropEnd (fromIntegral n))
-s_take_drop m     = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
-  where n = small m
-s_take_drop_s m   = (L.take n . L.drop n) `eqP`
+s_take_drop (Small n) = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)
+s_take_drop_s (Small n) = (L.take n . L.drop n) `eqP`
                     (unpackS . S.unstream . S.take n . S.drop n)
-  where n = small m
 s_takeWhile (applyFun -> p)
                   = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
 s_takeWhile_s (applyFun -> p)

tests/Tests/QuickCheckUtils.hs

@@ -2,23 +2,20 @@
 -- instances, and comparison functions, so we can focus on the actual properties
 -- in the 'Tests.Properties' module.
 --
-{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveFunctor #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Tests.QuickCheckUtils
-    ( BigBounded(..)
-    , BigInt(..)
+    ( BigInt(..)
     , NotEmpty(..)
     , Sqrt(..)
     , SpacyString(..)
 
-    , Small(..)
-    , small
-
     , Precision(..)
     , precision
 
-    , integralRandomR
-
     , DecodeErr(..)
     , genDecodeErr
 
@@ -31,14 +28,13 @@ module Tests.QuickCheckUtils
     , write_read
     ) where
 
-import Control.Arrow (first, (***))
+import Control.Arrow ((***))
 import Control.DeepSeq (NFData (..), deepseq)
 import Control.Exception (bracket)
 import Data.Char (isSpace)
 import Data.Text.Foreign (I16)
 import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))
 import Data.Word (Word8, Word16)
-import System.Random (Random(..), RandomGen)
 import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))
 import Tests.Utils
 import qualified Data.ByteString as B
@@ -55,10 +51,6 @@ import qualified System.IO as IO
 genWord8 :: Gen Word8
 genWord8 = chooseAny
 
-instance Random I16 where
-    randomR = integralRandomR
-    random  = randomR (minBound,maxBound)
-
 instance Arbitrary I16 where
     arbitrary     = arbitrarySizedIntegral
     shrink        = shrinkIntegral
@@ -108,90 +100,21 @@ instance Arbitrary BigInt where
     shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
       where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
 
-newtype BigBounded a = BigBounded a
-                     deriving (Eq, Show)
-
-instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where
-    arbitrary = BigBounded <$> choose (minBound, maxBound)
-
 newtype NotEmpty a = NotEmpty { notEmpty :: a }
-    deriving (Eq, Ord)
-
-instance Show a => Show (NotEmpty a) where
-    show (NotEmpty a) = show a
-
-instance Functor NotEmpty where
-    fmap f (NotEmpty a) = NotEmpty (f a)
-
-instance Arbitrary a => Arbitrary (NotEmpty [a]) where
-    arbitrary   = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))
-    shrink      = shrinkNotEmpty null
+    deriving (Eq, Ord, Show)
 
 instance Arbitrary (NotEmpty T.Text) where
-    arbitrary   = (fmap T.pack) `fmap` arbitrary
-    shrink      = shrinkNotEmpty T.null
+    arbitrary   = fmap (NotEmpty . T.pack . getNonEmpty) arbitrary
+    shrink      = fmap (NotEmpty . T.pack . getNonEmpty)
+                . shrink . NonEmpty . T.unpack . notEmpty
 
 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
-           | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
-           | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
-    deriving (Eq, Ord, Enum, Bounded)
-
-small :: Integral a => Small -> a
-small = fromIntegral . fromEnum
-
-intf :: (Int -> Int -> Int) -> Small -> Small -> Small
-intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)
-
-instance Show Small where
-    show = show . fromEnum
-
-instance Read Small where
-    readsPrec n = map (first toEnum) . readsPrec n
-
-instance Num Small where
-    fromInteger = toEnum . fromIntegral
-    signum _ = 1
-    abs = id
-    (+) = intf (+)
-    (-) = intf (-)
-    (*) = intf (*)
-
-instance Real Small where
-    toRational = toRational . fromEnum
-
-instance Integral Small where
-    toInteger = toInteger . fromEnum
-    quotRem a b = (toEnum x, toEnum y)
-        where (x, y) = fromEnum a `quotRem` fromEnum b
-
-instance Random Small where
-    randomR = integralRandomR
-    random  = randomR (minBound,maxBound)
-
-instance Arbitrary Small where
-    arbitrary     = choose (minBound, maxBound)
-    shrink        = shrinkIntegral
-
-integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
-integralRandomR  (a,b) g = case randomR (fromIntegral a :: Integer,
-                                         fromIntegral b :: Integer) g of
-                            (x,h) -> (fromIntegral x, h)
+    arbitrary   = fmap (NotEmpty . TL.pack . getNonEmpty) arbitrary
+    shrink      = fmap (NotEmpty . TL.pack . getNonEmpty)
+                . shrink . NonEmpty . TL.unpack . notEmpty
 
 data DecodeErr = Lenient | Ignore | Strict | Replace
-               deriving (Show, Eq)
+               deriving (Show, Eq, Bounded, Enum)
 
 genDecodeErr :: DecodeErr -> Gen T.OnDecodeError
 genDecodeErr Lenient = return T.lenientDecode
@@ -203,7 +126,7 @@ genDecodeErr Replace = (\c _ _ -> c) <$> frequency
   ]
 
 instance Arbitrary DecodeErr where
-    arbitrary = elements [Lenient, Ignore, Strict, Replace]
+    arbitrary = arbitraryBoundedEnum
 
 class Stringy s where
     packS    :: String -> s
@@ -262,7 +185,7 @@ eqPSqrt :: (Eq a, Show a, Stringy s) =>
 eqPSqrt f g s = eqP f g (unSqrt s)
 
 instance Arbitrary FPFormat where
-    arbitrary = elements [Exponent, Fixed, Generic]
+    arbitrary = arbitraryBoundedEnum
 
 newtype Precision a = Precision (Maybe Int)
                     deriving (Eq, Show)

text.cabal

@@ -202,7 +202,6 @@ test-suite tests
     bytestring,
     deepseq,
     directory,
-    random,
     tasty,
     tasty-hunit,
     tasty-quickcheck,