diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,9 @@ +0.3.13 + +Author: Oleg Grenrus + +* Add case-insensitive instances + 0.3.12 Author: Oleg Grenrus diff --git a/quickcheck-instances.cabal b/quickcheck-instances.cabal --- a/quickcheck-instances.cabal +++ b/quickcheck-instances.cabal @@ -1,5 +1,5 @@ Name: quickcheck-instances -Version: 0.3.12 +Version: 0.3.13 Synopsis: Common quickcheck instances Description: QuickCheck instances. . @@ -13,41 +13,49 @@ your code. . For information on writing a test-suite with Cabal - see + 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 +Author: Antoine Latter +Maintainer: Oleg Grenrus +Homepage: https://github.com/phadej/qc-instances +Bug-reports: https://github.com/phadej/qc-instances/issues Copyright: Copyright Antoine Latter, 2012-2014 Category: Testing Build-type: Simple Extra-source-files: CHANGES Cabal-version: >=1.6 -Tested-with: GHC >= 7.6 && < 8.1 +Tested-With: + GHC==7.4.2, + GHC==7.6.3, + GHC==7.8.4, + GHC==7.10.3, + GHC==8.0.2, + GHC==8.2.1 Source-repository head type: git - location: https://github.com/aslatter/qc-instances.git + location: https://github.com/phadej/qc-instances.git Library -- Modules exported by the library. Exposed-modules: Test.QuickCheck.Instances Hs-Source-Dirs: src - Build-depends: base < 5, + Build-depends: base >=4.5 && < 5, array >= 0.3 && < 0.6, bytestring >= 0.9 && < 0.11, + case-insensitive >=1.2.0.4 && <1.3, containers >= 0.3 && < 0.6, hashable >= 1.1.2.3 && < 1.3, unordered-containers >= 0.2.1 && < 0.3, old-time >= 1.0 && < 1.2, - QuickCheck >= 2.1 && < 2.9, + QuickCheck >= 2.1 && < 2.10, + tagged >= 0.8.5 && <0.9, text >= 0.7 && < 1.3, - time >= 1.1 && < 1.7, - vector >= 0.9 && <0.12, + time >= 1.1 && < 1.9, + vector >= 0.9 && <0.13, scientific >=0.2 && <0.4 Ghc-options: -Wall 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 @@ -8,6 +8,8 @@ * bytestring + * case-insensitive + * containers * old-time @@ -29,6 +31,7 @@ import Control.Applicative import Control.Arrow +import Control.Monad import Data.Foldable (toList) import Data.Int (Int32) import Data.Hashable @@ -40,6 +43,7 @@ import qualified Data.Array.Unboxed as Array import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL +import qualified Data.CaseInsensitive as CI import qualified Data.Fixed as Fixed -- required for QC < 2.5.0 import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet @@ -48,6 +52,7 @@ import qualified Data.Set as Set import qualified Data.HashSet as HS import qualified Data.HashMap.Lazy as HML +import qualified Data.Tagged as Tagged (Tagged (..)) import qualified Data.Text as TS import qualified Data.Text.Lazy as TL import qualified Data.Time as Time @@ -234,19 +239,31 @@ instance (CoArbitrary k, CoArbitrary v) => CoArbitrary (HML.HashMap k v) where coarbitrary = coarbitrary . HML.toList +#if MIN_VERSION_hashable(1,2,5) +instance (Hashable a, Arbitrary a) => Arbitrary (Hashed a) where + arbitrary = hashed <$> arbitrary + +instance CoArbitrary (Hashed a) where + coarbitrary x = coarbitrary (hashed x) +#endif + 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 + arbitrary = sized $ \n -> do -- Sized is the size of the trees. + value <- arbitrary + pars <- arbPartition (n - 1) + forest <- forM pars $ \i -> resize i arbitrary + return $ Tree.Node value forest + where + arbPartition :: Int -> Gen [Int] + arbPartition 0 = pure [] + arbPartition 1 = pure [1] + arbPartition k = do + first <- elements [1..k] + rest <- arbPartition $ k - first + return $ first : rest + shrink (Tree.Node val forest) = - Tree.Node <$> shrink val <*> shrink forest + forest ++ [Tree.Node e fs | (e, fs) <- shrink (val, forest)] instance CoArbitrary a => CoArbitrary (Tree.Tree a) where coarbitrary (Tree.Node val forest) = @@ -480,3 +497,24 @@ instance (Function a, Integral a) => Function (Ratio a) where function = functionMap (numerator &&& denominator) (uncurry (%)) #endif + +instance (CI.FoldCase a, Arbitrary a) => Arbitrary (CI.CI a) where + arbitrary = CI.mk <$> arbitrary + shrink = fmap CI.mk . shrink . CI.original + +instance CoArbitrary a => CoArbitrary (CI.CI a) where + coarbitrary = coarbitrary . CI.original + +instance (CI.FoldCase a, Function a) => Function (CI.CI a) where + function = functionMap CI.mk CI.original + +-- Tagged +instance Arbitrary b => Arbitrary (Tagged.Tagged a b) where + arbitrary = Tagged.Tagged <$> arbitrary + shrink = fmap Tagged.Tagged . shrink . Tagged.unTagged + +instance CoArbitrary b => CoArbitrary (Tagged.Tagged a b) where + coarbitrary = coarbitrary . Tagged.unTagged + +instance Function b => Function (Tagged.Tagged a b) where + function = functionMap Tagged.unTagged Tagged.Tagged