quickcheck-instances 0.3.4 → 0.3.5
raw patch · 6 files changed
+622/−609 lines, 6 filessetup-changed
Files
- CHANGES +55/−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,55 @@-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.5++Author: Antoine Latter <aslatter@gmail.com>++* No change - bumping version to re-upload to hackage, due to bugs in+the 0.3.4 tarball.++0.3.4++Author: Antoine Latter <aslatter@gmail.com>++* Allow newer versions of "text" and "array" as dependencies.++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.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: - +Name: quickcheck-instances+Version: 0.3.5+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