A better test for gh-99

tests/Tests/Properties.hs

@@ -741,8 +741,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool
 tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)
 
 tb_decimal_integer (a::Integer) = tb_decimal a
-tb_decimal_integer_big = forAll big tb_decimal
-  where big = choose (20::Int,200) >>= \e -> choose (10^(e-1),10^e::Integer)
+tb_decimal_integer_big (Big a) = tb_decimal a
 tb_decimal_int (a::Int) = tb_decimal a
 tb_decimal_int8 (a::Int8) = tb_decimal a
 tb_decimal_int16 (a::Int16) = tb_decimal a

tests/Tests/QuickCheckUtils.hs

@@ -18,6 +18,7 @@ module Tests.QuickCheckUtils
     , unsquare
     , smallArbitrary
 
+    , BigInt(..)
     , NotEmpty (..)
 
     , Small (..)
@@ -37,6 +38,7 @@ module Tests.QuickCheckUtils
     , write_read
     ) where
 
+import Control.Applicative ((<$>))
 import Control.Arrow (first, (***))
 import Control.DeepSeq (NFData (..), deepseq)
 import Control.Exception (bracket)
@@ -160,6 +162,14 @@ instance Arbitrary TL.Text where
     arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary
     shrink = map TL.pack . shrink . TL.unpack
 
+newtype BigInt = Big Integer
+               deriving (Eq, Show)
+
+instance Arbitrary BigInt where
+    arbitrary = choose (20::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)
+    shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]
+      where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer
+
 newtype NotEmpty a = NotEmpty { notEmpty :: a }
     deriving (Eq, Ord)