quickcheck-instances 0.3.3 → 0.3.4
raw patch · 6 files changed
+609/−609 lines, 6 filesdep ~arraydep ~textsetup-changed
Dependency ranges changed: array, text
Files
- CHANGES +42/−42
- LICENSE +30/−30
- Setup.hs +2/−2
- quickcheck-instances.cabal +51/−51
- src/Test/QuickCheck/Instances.hs +386/−386
- src/Test/QuickCheck/Instances/LegacyNumeric.hs +98/−98
CHANGES view
@@ -1,42 +1,42 @@-0.3.3--Author: Kyle Raftogianis <kylerafto@gmail.com>--* Generate UTC time offsets from -12:00 to +14:00--0.3.2--Author: Antoine Latter <aslatter@gmail.com>--* Allow building against newer QuickCheck--0.3.1--Author: Antoine Latter <aslatter@gmail.com>--* Allow building against newer bytestring--0.3.0--Author: Antoine Latter <aslatter@gmail.com>--* Update for QuickCheck-2.5.0-* Update instances for Ordering and RealFrac based on- instances provided in QuickCheck-2.5.0-* Allow building against newer containers packages--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+0.3.3 + +Author: Kyle Raftogianis <kylerafto@gmail.com> + +* Generate UTC time offsets from -12:00 to +14:00 + +0.3.2 + +Author: Antoine Latter <aslatter@gmail.com> + +* Allow building against newer QuickCheck + +0.3.1 + +Author: Antoine Latter <aslatter@gmail.com> + +* Allow building against newer bytestring + +0.3.0 + +Author: Antoine Latter <aslatter@gmail.com> + +* Update for QuickCheck-2.5.0 +* Update instances for Ordering and RealFrac based on + instances provided in QuickCheck-2.5.0 +* Allow building against newer containers packages + +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
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2012, Antoine Latter--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:-- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.-- * Neither the name of Antoine Latter nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c)2012, Antoine Latter + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Antoine Latter nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
quickcheck-instances.cabal view
@@ -1,51 +1,51 @@-Name: quickcheck-instances-Version: 0.3.3-Synopsis: Common quickcheck instances-Description: QuickCheck instances.- .- The goal is to supply QuickCheck instances for- types provided by the Haskell Platform.- .- Since all of these instances are provided as- orphans, I recommend that you do not use this library- within another library module, so that you don't- impose these instances on down-stream consumers of- your code.- .- For information on writing a test-suite with Cabal- see <http://www.haskell.org/cabal/users-guide/#test-suites>--License: BSD3-License-file: LICENSE-Author: Antoine Latter-Maintainer: aslatter@gmail.com-Homepage: https://github.com/aslatter/qc-instances-Bug-reports: https://github.com/aslatter/qc-instances/issues-Copyright: Copyright Antoine Latter, 2012-Category: Testing-Build-type: Simple-Extra-source-files: CHANGES-Cabal-version: >=1.6--Source-repository head- type: git- location: https://github.com/aslatter/qc-instances.git--Library- -- Modules exported by the library.- Exposed-modules: Test.QuickCheck.Instances- Hs-Source-Dirs: src - Build-depends: base < 5,-- array >= 0.3 && < 0.5,- bytestring >= 0.9 && < 0.11,- containers >= 0.3 && < 0.6,- old-time >= 1.0 && < 1.2,- QuickCheck >= 2.1 && < 2.7,- text >= 0.7 && < 0.12,- time >= 1.1 && < 1.5-- Ghc-options: -Wall- Other-modules: Test.QuickCheck.Instances.LegacyNumeric- -- Build-tools: - +Name: quickcheck-instances +Version: 0.3.4 +Synopsis: Common quickcheck instances +Description: QuickCheck instances. + . + The goal is to supply QuickCheck instances for + types provided by the Haskell Platform. + . + Since all of these instances are provided as + orphans, I recommend that you do not use this library + within another library module, so that you don't + impose these instances on down-stream consumers of + your code. + . + For information on writing a test-suite with Cabal + see <http://www.haskell.org/cabal/users-guide/#test-suites> + +License: BSD3 +License-file: LICENSE +Author: Antoine Latter +Maintainer: aslatter@gmail.com +Homepage: https://github.com/aslatter/qc-instances +Bug-reports: https://github.com/aslatter/qc-instances/issues +Copyright: Copyright Antoine Latter, 2012 +Category: Testing +Build-type: Simple +Extra-source-files: CHANGES +Cabal-version: >=1.6 + +Source-repository head + type: git + location: https://github.com/aslatter/qc-instances.git + +Library + -- Modules exported by the library. + Exposed-modules: Test.QuickCheck.Instances + Hs-Source-Dirs: src + Build-depends: base < 5, + + array >= 0.3 && < 0.6, + bytestring >= 0.9 && < 0.11, + containers >= 0.3 && < 0.6, + old-time >= 1.0 && < 1.2, + QuickCheck >= 2.1 && < 2.7, + text >= 0.7 && < 1.1, + time >= 1.1 && < 1.5 + + Ghc-options: -Wall + Other-modules: Test.QuickCheck.Instances.LegacyNumeric + -- Build-tools: +
src/Test/QuickCheck/Instances.hs view
@@ -1,386 +1,386 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-| -Instances are provided for the types in the packages:-- * array-- * bytestring-- * text-- * containers-- * old-time-- * time--Since all of these instances are provided as orphans, I recommend that-you do not use this library within another library module, so that you-don't impose these instances on down-stream consumers of your code.--For information on writing a test-suite with Cabal see-<http://www.haskell.org/cabal/users-guide/#test-suites>--}-module Test.QuickCheck.Instances () where--import Control.Applicative-import Data.Foldable (toList)-import Data.Int (Int32)-import Test.QuickCheck--import qualified Data.Array.IArray as Array-import qualified Data.Array.Unboxed as Array-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import qualified Data.Fixed as Fixed -- required for QC < 2.5.0-import qualified Data.IntMap as IntMap-import qualified Data.IntSet as IntSet-import qualified Data.Map as Map-import qualified Data.Sequence as Seq-import qualified Data.Set as Set-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import qualified Data.Time as Time-import qualified Data.Time.Clock.TAI as Time-import qualified Data.Tree as Tree-import qualified System.Time as OldTime--import Test.QuickCheck.Instances.LegacyNumeric()---- Array--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, Arbitrary i, Arbitrary e)- => Arbitrary (Array.UArray i e) where- arbitrary = arbitraryArray- shrink = shrinkArray--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 <- 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- shrink xs = BS.pack <$> shrink (BS.unpack xs)--instance Arbitrary BL.ByteString where- 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- shrink xs = TS.pack <$> shrink (TS.unpack xs)--instance Arbitrary TL.Text where- arbitrary = TL.pack <$> arbitrary- shrink xs = TL.pack <$> shrink (TL.unpack xs)--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- let n' = n `div` 2- nodes <- - if n' > 0- then do- k <- choose (0,n')- resize n' $ sequence [ arbitrary | _ <- [1..k] ]- else return []- return $ Tree.Node val nodes- shrink (Tree.Node val forest) =- Tree.Node <$> shrink val <*> shrink forest--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--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 <$> (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 <$> (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))- 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,14*60) -- utc offset (m)- <*> 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)--instance CoArbitrary Time.AbsoluteTime where- coarbitrary = coarbitrary . flip Time.diffAbsoluteTime Time.taiEpoch---- Introduced in QC 2.5.0-#if !(MIN_VERSION_QuickCheck(2,5,0))-instance Arbitrary Ordering where- arbitrary = arbitraryBoundedEnum- shrink GT = [EQ, LT]- shrink LT = [EQ]- shrink EQ = []--instance CoArbitrary Ordering where- coarbitrary GT = variant 1- coarbitrary EQ = variant 0- coarbitrary LT = variant (-1)--instance Fixed.HasResolution a => Arbitrary (Fixed.Fixed a) where- arbitrary = arbitrarySizedFractional- shrink = shrinkRealFrac--instance Fixed.HasResolution a => CoArbitrary (Fixed.Fixed a) where- coarbitrary = coarbitraryReal--arbitraryBoundedEnum :: (Bounded a, Enum a) => Gen a-arbitraryBoundedEnum =- do let mn = minBound- 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-#endif+{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| +Instances are provided for the types in the packages: + + * array + + * bytestring + + * text + + * containers + + * old-time + + * time + +Since all of these instances are provided as orphans, I recommend that +you do not use this library within another library module, so that you +don't impose these instances on down-stream consumers of your code. + +For information on writing a test-suite with Cabal see +<http://www.haskell.org/cabal/users-guide/#test-suites> +-} +module Test.QuickCheck.Instances () where + +import Control.Applicative +import Data.Foldable (toList) +import Data.Int (Int32) +import Test.QuickCheck + +import qualified Data.Array.IArray as Array +import qualified Data.Array.Unboxed as Array +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Fixed as Fixed -- required for QC < 2.5.0 +import qualified Data.IntMap as IntMap +import qualified Data.IntSet as IntSet +import qualified Data.Map as Map +import qualified Data.Sequence as Seq +import qualified Data.Set as Set +import qualified Data.Text as TS +import qualified Data.Text.Lazy as TL +import qualified Data.Time as Time +import qualified Data.Time.Clock.TAI as Time +import qualified Data.Tree as Tree +import qualified System.Time as OldTime + +import Test.QuickCheck.Instances.LegacyNumeric() + +-- Array + +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, Arbitrary i, Arbitrary e) + => Arbitrary (Array.UArray i e) where + arbitrary = arbitraryArray + shrink = shrinkArray + +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 <- 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 + shrink xs = BS.pack <$> shrink (BS.unpack xs) + +instance Arbitrary BL.ByteString where + 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 + shrink xs = TS.pack <$> shrink (TS.unpack xs) + +instance Arbitrary TL.Text where + arbitrary = TL.pack <$> arbitrary + shrink xs = TL.pack <$> shrink (TL.unpack xs) + +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 + let n' = n `div` 2 + nodes <- + if n' > 0 + then do + k <- choose (0,n') + resize n' $ sequence [ arbitrary | _ <- [1..k] ] + else return [] + return $ Tree.Node val nodes + shrink (Tree.Node val forest) = + Tree.Node <$> shrink val <*> shrink forest + +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 + +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 <$> (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 <$> (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)) + 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,14*60) -- utc offset (m) + <*> 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) + +instance CoArbitrary Time.AbsoluteTime where + coarbitrary = coarbitrary . flip Time.diffAbsoluteTime Time.taiEpoch + +-- Introduced in QC 2.5.0 +#if !(MIN_VERSION_QuickCheck(2,5,0)) +instance Arbitrary Ordering where + arbitrary = arbitraryBoundedEnum + shrink GT = [EQ, LT] + shrink LT = [EQ] + shrink EQ = [] + +instance CoArbitrary Ordering where + coarbitrary GT = variant 1 + coarbitrary EQ = variant 0 + coarbitrary LT = variant (-1) + +instance Fixed.HasResolution a => Arbitrary (Fixed.Fixed a) where + arbitrary = arbitrarySizedFractional + shrink = shrinkRealFrac + +instance Fixed.HasResolution a => CoArbitrary (Fixed.Fixed a) where + coarbitrary = coarbitraryReal + +arbitraryBoundedEnum :: (Bounded a, Enum a) => Gen a +arbitraryBoundedEnum = + do let mn = minBound + 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 +#endif
src/Test/QuickCheck/Instances/LegacyNumeric.hs view
@@ -1,98 +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+{-# 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