quickcheck-instances 0.1.0 → 0.2.0
raw patch · 4 files changed
+302/−26 lines, 4 files
Files
- CHANGES +15/−0
- quickcheck-instances.cabal +3/−3
- src/Test/QuickCheck/Instances.hs +186/−23
- src/Test/QuickCheck/Instances/LegacyNumeric.hs +98/−0
+ CHANGES view
@@ -0,0 +1,15 @@+0.2.0++Author: Antoine Latter <aslatter@gmail.com>++* Add support for older versions of QuickCheck.++Author: PHO <pho@cielonegro.org>++* Provide 'CoArbitrary' instances for types.++* Provide 'shrink' for more instances of 'Arbitrary'.++0.1.0++* Initial release
quickcheck-instances.cabal view
@@ -1,5 +1,5 @@ Name: quickcheck-instances-Version: 0.1.0+Version: 0.2.0 Synopsis: Common quickcheck instances Description: QuickCheck instances. .@@ -24,7 +24,7 @@ Copyright: Copyright Antoine Latter, 2012 Category: Testing Build-type: Simple--- Extra-source-files: +Extra-source-files: CHANGES Cabal-version: >=1.6 Source-repository head@@ -46,6 +46,6 @@ time >= 1.1 && < 1.5 Ghc-options: -Wall- -- Other-modules: + Other-modules: Test.QuickCheck.Instances.LegacyNumeric -- Build-tools:
src/Test/QuickCheck/Instances.hs view
@@ -1,10 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Instances are provided for the types in the packages: - * array - We only provide instances for arrays inexed by- Integral types.+ * array * bytestring @@ -47,24 +47,46 @@ import qualified Data.Tree as Tree import qualified System.Time as OldTime +import Test.QuickCheck.Instances.LegacyNumeric()+ -- Array -instance (Array.Ix i, Integral i, Arbitrary e) => Arbitrary (Array.Array i e) where+instance (Array.Ix i, Arbitrary i, Arbitrary e) => Arbitrary (Array.Array i e) where arbitrary = arbitraryArray+ shrink = shrinkArray -instance (Array.IArray Array.UArray e, Array.Ix i, Integral i, Arbitrary e)+instance (Array.IArray Array.UArray e, Array.Ix i, Arbitrary i, Arbitrary e) => Arbitrary (Array.UArray i e) where arbitrary = arbitraryArray+ shrink = shrinkArray -arbitraryArray :: (Array.IArray a e, Array.Ix i, Integral i, Arbitrary e) => Gen (a i e)+instance (Array.Ix i, CoArbitrary i, CoArbitrary e) => CoArbitrary (Array.Array i e) where+ coarbitrary = coarbitraryArray++instance (Array.IArray Array.UArray e, Array.Ix i, CoArbitrary i, CoArbitrary e)+ => CoArbitrary (Array.UArray i e) where+ coarbitrary = coarbitraryArray++arbitraryArray :: (Array.IArray a e, Array.Ix i, Arbitrary i, Arbitrary e) => Gen (a i e) arbitraryArray = do- b1 <- arbitrarySizedIntegral- b2 <- arbitrarySizedIntegral+ b1 <- arbitrary+ b2 <- arbitrary let bounds = if b1 < b2 then (b1,b2) else (b2,b1) elms <- vector (Array.rangeSize bounds) return $ Array.listArray bounds elms +shrinkArray :: (Array.IArray a e, Array.Ix i, Arbitrary i, Arbitrary e) => a i e -> [a i e]+shrinkArray a =+ -- Shrink each elements but don't change the size of array.+ let bounds = Array.bounds a+ elmss = shrink <$> Array.elems a+ in Array.listArray bounds <$> elmss++coarbitraryArray :: (Array.IArray a e, Array.Ix i, CoArbitrary i, CoArbitrary e)+ => a i e -> Gen c -> Gen c+coarbitraryArray = coarbitrary . Array.assocs+ -- ByteString instance Arbitrary BS.ByteString where arbitrary = BS.pack <$> arbitrary@@ -74,6 +96,12 @@ arbitrary = BL.pack <$> arbitrary shrink xs = BL.pack <$> shrink (BL.unpack xs) +instance CoArbitrary BS.ByteString where+ coarbitrary = coarbitrary . BS.unpack++instance CoArbitrary BL.ByteString where+ coarbitrary = coarbitrary . BL.unpack+ -- Text instance Arbitrary TS.Text where arbitrary = TS.pack <$> arbitrary@@ -83,28 +111,48 @@ arbitrary = TL.pack <$> arbitrary shrink xs = TL.pack <$> shrink (TL.unpack xs) --- Containers+instance CoArbitrary TS.Text where+ coarbitrary = coarbitrary . TS.unpack +instance CoArbitrary TL.Text where+ coarbitrary = coarbitrary . TL.unpack++-- Containers instance Arbitrary a => Arbitrary (IntMap.IntMap a) where arbitrary = IntMap.fromList <$> arbitrary shrink m = IntMap.fromList <$> shrink (IntMap.toList m) +instance CoArbitrary a => CoArbitrary (IntMap.IntMap a) where+ coarbitrary = coarbitrary . IntMap.toList+ instance Arbitrary IntSet.IntSet where arbitrary = IntSet.fromList <$> arbitrary shrink set = IntSet.fromList <$> shrink (IntSet.toList set) +instance CoArbitrary IntSet.IntSet where+ coarbitrary = coarbitrary . IntSet.toList+ instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where arbitrary = Map.fromList <$> arbitrary shrink m = Map.fromList <$> shrink (Map.toList m) +instance (CoArbitrary k, CoArbitrary v) => CoArbitrary (Map.Map k v) where+ coarbitrary = coarbitrary . Map.toList+ instance Arbitrary a => Arbitrary (Seq.Seq a) where arbitrary = Seq.fromList <$> arbitrary shrink xs = Seq.fromList <$> shrink (toList xs) +instance CoArbitrary a => CoArbitrary (Seq.Seq a) where+ coarbitrary = coarbitrary . toList+ instance (Ord a, Arbitrary a) => Arbitrary (Set.Set a) where arbitrary = Set.fromList <$> arbitrary shrink set = Set.fromList <$> shrink (Set.toList set) +instance CoArbitrary a => CoArbitrary (Set.Set a) where+ coarbitrary = coarbitrary . Set.toList+ instance Arbitrary a => Arbitrary (Tree.Tree a) where arbitrary = sized $ \n -> do val <- arbitrary@@ -118,96 +166,208 @@ return $ Tree.Node val nodes shrink (Tree.Node val forest) = Tree.Node <$> shrink val <*> shrink forest- --- old-time +instance CoArbitrary a => CoArbitrary (Tree.Tree a) where+ coarbitrary (Tree.Node val forest) =+ coarbitrary val >< coarbitrary forest++-- old-time instance Arbitrary OldTime.Month where arbitrary = arbitraryBoundedEnum +instance CoArbitrary OldTime.Month where+ coarbitrary = coarbitraryEnum+ instance Arbitrary OldTime.Day where arbitrary = arbitraryBoundedEnum +instance CoArbitrary OldTime.Day where+ coarbitrary = coarbitraryEnum+ instance Arbitrary OldTime.ClockTime where arbitrary = OldTime.TOD <$> choose (0, fromIntegral (maxBound :: Int32)) <*> choose (0, 1000000000000 - 1)+ shrink (OldTime.TOD s p) =+ [ OldTime.TOD s' p | s' <- shrink s ] +++ [ OldTime.TOD s p' | p' <- shrink p ] +instance CoArbitrary OldTime.ClockTime where+ coarbitrary (OldTime.TOD s p) =+ coarbitrary s >< coarbitrary p+ instance Arbitrary OldTime.TimeDiff where -- a bit of a cheat ... arbitrary = OldTime.normalizeTimeDiff <$> (OldTime.diffClockTimes <$> arbitrary <*> arbitrary)+ shrink td@(OldTime.TimeDiff year month day hour minute second picosec) =+ [ td { OldTime.tdYear = y' } | y' <- shrink year ] +++ [ td { OldTime.tdMonth = m' } | m' <- shrink month ] +++ [ td { OldTime.tdDay = d' } | d' <- shrink day ] +++ [ td { OldTime.tdHour = h' } | h' <- shrink hour ] +++ [ td { OldTime.tdMin = m' } | m' <- shrink minute ] +++ [ td { OldTime.tdSec = s' } | s' <- shrink second ] +++ [ td { OldTime.tdPicosec = p' } | p' <- shrink picosec ] +instance CoArbitrary OldTime.TimeDiff where+ coarbitrary (OldTime.TimeDiff year month day hour minute second picosec) =+ coarbitrary year ><+ coarbitrary month ><+ coarbitrary day ><+ coarbitrary hour ><+ coarbitrary minute ><+ coarbitrary second ><+ coarbitrary picosec+ -- UTC only instance Arbitrary OldTime.CalendarTime where arbitrary = OldTime.toUTCTime <$> arbitrary --- time+instance CoArbitrary OldTime.CalendarTime where+ coarbitrary (OldTime.CalendarTime+ year month day hour minute second picosec+ wDay yDay tzName tz isDST) =+ coarbitrary year ><+ coarbitrary month ><+ coarbitrary day ><+ coarbitrary hour ><+ coarbitrary minute ><+ coarbitrary second ><+ coarbitrary picosec ><+ coarbitrary wDay ><+ coarbitrary yDay ><+ coarbitrary tzName ><+ coarbitrary tz ><+ coarbitrary isDST +-- time instance Arbitrary Time.Day where- arbitrary =- Time.ModifiedJulianDay- <$> choose (gregToNum 1200 1 1, gregToNum 2999 1 1)+ arbitrary = Time.ModifiedJulianDay <$> (2000 +) <$> arbitrary+ shrink = (Time.ModifiedJulianDay <$>) . shrink . Time.toModifiedJulianDay +instance CoArbitrary Time.Day where+ coarbitrary = coarbitrary . Time.toModifiedJulianDay+ instance Arbitrary Time.UniversalTime where- arbitrary =- Time.ModJulianDate- <$> toRational `fmap` choose (gregToNum 1200 1 1 :: Double, gregToNum 2999 1 1)+ arbitrary = Time.ModJulianDate <$> (2000 +) <$> arbitrary+ shrink = (Time.ModJulianDate <$>) . shrink . Time.getModJulianDate +instance CoArbitrary Time.UniversalTime where+ coarbitrary = coarbitrary . Time.getModJulianDate+ instance Arbitrary Time.DiffTime where arbitrary = arbitrarySizedFractional+#if MIN_VERSION_time(1,3,0)+ shrink = shrinkRealFrac+#else+ shrink = (fromRational <$>) . shrink . toRational+#endif +instance CoArbitrary Time.DiffTime where+ coarbitrary = coarbitraryReal+ instance Arbitrary Time.UTCTime where- arbitrary = Time.UTCTime <$> arbitrary <*> (fromRational . toRational <$> choose (0::Double, 86400))+ arbitrary =+ Time.UTCTime+ <$> arbitrary+ <*> (fromRational . toRational <$> choose (0::Double, 86400))+ shrink ut@(Time.UTCTime day dayTime) =+ [ ut { Time.utctDay = d' } | d' <- shrink day ] +++ [ ut { Time.utctDayTime = t' } | t' <- shrink dayTime ] +instance CoArbitrary Time.UTCTime where+ coarbitrary (Time.UTCTime day dayTime) =+ coarbitrary day >< coarbitrary dayTime+ instance Arbitrary Time.NominalDiffTime where arbitrary = arbitrarySizedFractional+ shrink = shrinkRealFrac +instance CoArbitrary Time.NominalDiffTime where+ coarbitrary = coarbitraryReal+ instance Arbitrary Time.TimeZone where arbitrary = Time.TimeZone <$> choose (-12*60*60,12*60*60) -- utc offset (s) <*> arbitrary -- is summer time <*> (sequence . replicate 4 $ choose ('A','Z'))+ shrink tz@(Time.TimeZone minutes summerOnly name) =+ [ tz { Time.timeZoneMinutes = m' } | m' <- shrink minutes ] +++ [ tz { Time.timeZoneSummerOnly = s' } | s' <- shrink summerOnly ] +++ [ tz { Time.timeZoneName = n' } | n' <- shrink name ] +instance CoArbitrary Time.TimeZone where+ coarbitrary (Time.TimeZone minutes summerOnly name) =+ coarbitrary minutes >< coarbitrary summerOnly >< coarbitrary name+ instance Arbitrary Time.TimeOfDay where arbitrary = Time.TimeOfDay <$> choose (0, 23) -- hour <*> choose (0, 59) -- minute <*> (fromRational . toRational <$> choose (0::Double, 60)) -- picoseconds, via double+ shrink tod@(Time.TimeOfDay hour minute second) =+ [ tod { Time.todHour = h' } | h' <- shrink hour ] +++ [ tod { Time.todMin = m' } | m' <- shrink minute ] +++ [ tod { Time.todSec = s' } | s' <- shrink second ] +instance CoArbitrary Time.TimeOfDay where+ coarbitrary (Time.TimeOfDay hour minute second) =+ coarbitrary hour >< coarbitrary minute >< coarbitrary second+ instance Arbitrary Time.LocalTime where arbitrary = Time.LocalTime <$> arbitrary <*> arbitrary+ shrink lt@(Time.LocalTime day tod) =+ [ lt { Time.localDay = d' } | d' <- shrink day ] +++ [ lt { Time.localTimeOfDay = t' } | t' <- shrink tod ] +instance CoArbitrary Time.LocalTime where+ coarbitrary (Time.LocalTime day tod) =+ coarbitrary day >< coarbitrary tod+ instance Arbitrary Time.ZonedTime where arbitrary = Time.ZonedTime <$> arbitrary <*> arbitrary+ shrink zt@(Time.ZonedTime lt zone) =+ [ zt { Time.zonedTimeToLocalTime = l' } | l' <- shrink lt ] +++ [ zt { Time.zonedTimeZone = z' } | z' <- shrink zone ] +instance CoArbitrary Time.ZonedTime where+ coarbitrary (Time.ZonedTime lt zone) =+ coarbitrary lt >< coarbitrary zone+ instance Arbitrary Time.AbsoluteTime where arbitrary = Time.addAbsoluteTime <$> arbitrary <*> return Time.taiEpoch+ shrink at =+ (`Time.addAbsoluteTime` at) <$> shrink (Time.diffAbsoluteTime at Time.taiEpoch) --- | Given a year, month, and day return a number suitable for--- use as a Day or UniversalTime-gregToNum :: Num a => Integer -> Int -> Int -> a-gregToNum year month day =- fromInteger . Time.toModifiedJulianDay $ Time.fromGregorian year month day+instance CoArbitrary Time.AbsoluteTime where+ coarbitrary = coarbitrary . flip Time.diffAbsoluteTime Time.taiEpoch -- WARNING: from base, should be moved to QC library instance Arbitrary Ordering where arbitrary = arbitraryBoundedEnum +instance CoArbitrary Ordering where+ coarbitrary = coarbitraryEnum+ instance Fixed.HasResolution a => Arbitrary (Fixed.Fixed a) where arbitrary = arbitrarySizedFractional+ shrink = shrinkRealFrac +instance Fixed.HasResolution a => CoArbitrary (Fixed.Fixed a) where+ coarbitrary = coarbitraryReal+ -- WARNING: should be moved to QC library arbitraryBoundedEnum :: (Bounded a, Enum a) => Gen a arbitraryBoundedEnum =@@ -215,3 +375,6 @@ mx = maxBound `asTypeOf` mn n <- choose (fromEnum mn, fromEnum mx) return (toEnum n `asTypeOf` mn)++coarbitraryEnum :: Enum a => a -> Gen c -> Gen c+coarbitraryEnum = variant . fromEnum
+ src/Test/QuickCheck/Instances/LegacyNumeric.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-++Contents of this file copyright the QuickCheck team, 2010.+QuickCheck was available under the BSD3 license at that time. ++-}++module Test.QuickCheck.Instances.LegacyNumeric() where++#if !(MIN_VERSION_QuickCheck(2,1,2))++import Data.Int+import Data.Word+import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen++-- | Generates an integral number from a bounded domain. The number is+-- chosen from the entire range of the type, but small numbers are+-- generated more often than big numbers. Inspired by demands from+-- Phil Wadler.+arbitrarySizedBoundedIntegral :: (Bounded a, Integral a) => Gen a+arbitrarySizedBoundedIntegral =+ sized $ \s ->+ do let mn = minBound+ mx = maxBound `asTypeOf` mn+ bits n | n `quot` 2 == 0 = 0+ | otherwise = 1 + bits (n `quot` 2)+ k = 2^(s*(bits mn `max` bits mx `max` 40) `div` 100)+ n <- choose (toInteger mn `max` (-k), toInteger mx `min` k)+ return (fromInteger n `asTypeOf` mn)++instance Arbitrary Int8 where+ arbitrary = arbitrarySizedBoundedIntegral + shrink = shrinkIntegral++instance Arbitrary Int16 where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance Arbitrary Int32 where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance Arbitrary Int64 where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance Arbitrary Word where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance Arbitrary Word8 where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance Arbitrary Word16 where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance Arbitrary Word32 where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance Arbitrary Word64 where+ arbitrary = arbitrarySizedBoundedIntegral+ shrink = shrinkIntegral++instance CoArbitrary Int8 where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Int16 where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Int32 where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Int64 where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Word where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Word8 where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Word16 where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Word32 where+ coarbitrary = coarbitraryIntegral++instance CoArbitrary Word64 where+ coarbitrary = coarbitraryIntegral++#endif