diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,42 +1,42 @@ -0.3.3 - -Author: Kyle Raftogianis - -* Generate UTC time offsets from -12:00 to +14:00 - -0.3.2 - -Author: Antoine Latter - -* Allow building against newer QuickCheck - -0.3.1 - -Author: Antoine Latter - -* Allow building against newer bytestring - -0.3.0 - -Author: Antoine Latter - -* 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 - -* Add support for older versions of QuickCheck. - -Author: PHO - -* Provide 'CoArbitrary' instances for types. - -* Provide 'shrink' for more instances of 'Arbitrary'. - -0.1.0 - -* Initial release +0.3.3 + +Author: Kyle Raftogianis + +* Generate UTC time offsets from -12:00 to +14:00 + +0.3.2 + +Author: Antoine Latter + +* Allow building against newer QuickCheck + +0.3.1 + +Author: Antoine Latter + +* Allow building against newer bytestring + +0.3.0 + +Author: Antoine Latter + +* 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 + +* Add support for older versions of QuickCheck. + +Author: PHO + +* Provide 'CoArbitrary' instances for types. + +* Provide 'shrink' for more instances of 'Arbitrary'. + +0.1.0 + +* Initial release diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/quickcheck-instances.cabal b/quickcheck-instances.cabal --- a/quickcheck-instances.cabal +++ b/quickcheck-instances.cabal @@ -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 - -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 + +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: + diff --git a/src/Test/QuickCheck/Instances.hs b/src/Test/QuickCheck/Instances.hs --- a/src/Test/QuickCheck/Instances.hs +++ b/src/Test/QuickCheck/Instances.hs @@ -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 - --} -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 + +-} +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 diff --git a/src/Test/QuickCheck/Instances/LegacyNumeric.hs b/src/Test/QuickCheck/Instances/LegacyNumeric.hs --- a/src/Test/QuickCheck/Instances/LegacyNumeric.hs +++ b/src/Test/QuickCheck/Instances/LegacyNumeric.hs @@ -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