diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,74 @@ +0.4 + +* Depend on QuickCheck-2.17.1.0 + Drop instances for Natural, ByteArray, Solo, NonEmpty, Data.Semigroup.* + These should be now provided by QuickCheck package. + +0.3.33 + +* Add instances for strict vectors + +0.3.32 + +* Add instances for primitive vectors + +0.3.31 + +* Support GHC-8.6.5...GHC-9.10.1 + +0.3.30 + +* Improve Arbitrary UUID instance + + Previously "small" UUIDs were generated, e.g. + + ``` + 00000001-0000-0001-0000-000000000001 + 00000002-0000-0000-0000-000200000002 + 00000004-0000-0004-0000-000400000001 + 00000005-0000-0000-0000-000500000007 + 00000001-0000-000d-0000-00050000000e + ``` + + but now they are uniformly random + + ``` + c4683284-bfe3-224b-29a6-1e7f11ceef65 + 7bf6564d-5dcf-3e37-b13d-867085f54dae + 5b006243-0a70-9321-6594-20dde3d72112 + 2d8ed56e-ed20-7258-7c1f-b46fa9b87946 + f1503184-9d3c-aacd-e9a7-36c655b70f41 + ``` + +0.3.29.1 + +* Support `OneTuple-0.4` + +0.3.29 + +* Support `primitive-0.8` +* Use `data-array-byte` shim package for instances for `Data.Array.Byte.ByteArray` + +0.3.28 + +* Add instances for `Data.Array.Byte.ByteArray` (`base-4.17`) +* Add instances for `Data.Primitive.ByteArray` (`primitive`) + +0.3.27 + +* Add instances for `Backwards`, `Reverse` and `Lift` from `transformers` + +0.3.26.1 + +* Support `hashable-1.4` + +0.3.26 + +* Support base-4.16 / GHC-9.2 +* Add instances for `text-short`'s `ShortText` type +* Add instances for `Solo` +* Fix bug in `CoArbitrary (Hashed a)` instance + 0.3.25.2 * Fix bug in QuarterOfYear instance diff --git a/quickcheck-instances.cabal b/quickcheck-instances.cabal --- a/quickcheck-instances.cabal +++ b/quickcheck-instances.cabal @@ -1,5 +1,6 @@ +cabal-version: 2.2 name: quickcheck-instances -version: 0.3.25.2 +version: 0.4 synopsis: Common quickcheck instances description: QuickCheck instances. @@ -12,11 +13,8 @@ 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: BSD-3-Clause license-file: LICENSE author: Antoine Latter , Oleg Grenrus @@ -28,33 +26,32 @@ category: Testing build-type: Simple extra-source-files: CHANGES -cabal-version: >=1.10 tested-with: - GHC ==7.4.2 - || ==7.6.3 - || ==7.8.4 - || ==7.10.3 - || ==8.0.2 - || ==8.2.2 - || ==8.4.4 - || ==8.6.5 - || ==8.8.4 - || ==8.10.3 + GHC ==8.10.7 + || ==9.0.2 + || ==9.2.8 + || ==9.4.8 + || ==9.6.7 + || ==9.8.4 + || ==9.10.2 + || ==9.12.2 source-repository head type: git location: https://github.com/haskellari/qc-instances.git -flag bytestring-builder - description: Use bytestring-builder (with old bytestring) - default: False - manual: False - library - default-language: Haskell2010 + default-language: Haskell2010 + default-extensions: + BangPatterns + FlexibleContexts + FlexibleInstances + TypeOperators + exposed-modules: Test.QuickCheck.Instances Test.QuickCheck.Instances.Array + Test.QuickCheck.Instances.Array.Byte Test.QuickCheck.Instances.ByteString Test.QuickCheck.Instances.CaseInsensitive Test.QuickCheck.Instances.Containers @@ -62,11 +59,14 @@ Test.QuickCheck.Instances.Hashable Test.QuickCheck.Instances.Natural Test.QuickCheck.Instances.OldTime + Test.QuickCheck.Instances.Primitive Test.QuickCheck.Instances.Scientific Test.QuickCheck.Instances.Semigroup + Test.QuickCheck.Instances.Solo Test.QuickCheck.Instances.Strict Test.QuickCheck.Instances.Tagged Test.QuickCheck.Instances.Text + Test.QuickCheck.Instances.Text.Short Test.QuickCheck.Instances.These Test.QuickCheck.Instances.Time Test.QuickCheck.Instances.Transformer @@ -75,54 +75,37 @@ Test.QuickCheck.Instances.Vector Test.QuickCheck.Instances.Void - other-modules: Test.QuickCheck.Instances.CustomPrelude - hs-source-dirs: src + other-modules: Test.QuickCheck.Instances.CustomPrelude + hs-source-dirs: src build-depends: - base >=4.5 && <4.15 - , QuickCheck >=2.14.1 && <2.14.3 - , splitmix >=0.0.2 && <0.2 + , base >=4.12.0.0 && <4.22 + , QuickCheck >=2.17.1.0 && <2.17.2 + , splitmix >=0.1.3.2 && <0.2 build-depends: - array >=0.4.0.0 && <0.6 - , bytestring >=0.9.2.1 && <0.12 - , case-insensitive >=1.2.0.4 && <1.3 - , containers >=0.4.2.1 && <0.7 - , data-fix >=0.3 && <0.4 - , hashable >=1.2.7.0 && <1.4 - , integer-logarithms >=1.0.3 && <1.1 - , old-time >=1.1.0.0 && <1.2 - , scientific >=0.3.6.2 && <0.4 - , strict >=0.4 && <0.5 - , tagged >=0.8.6 && <0.9 - , text >=1.2.3.0 && <1.3 - , these >=1.1.1.1 && <1.2 - , time-compat >=1.9.4 && <1.10 - , transformers >=0.3.0.0 && <0.6 - , transformers-compat >=0.6.5 && <0.7 - , unordered-containers >=0.2.2.0 && <0.3 - , uuid-types >=1.0.3 && <1.1 - , vector >=0.9 && <0.13 - - -- version is irrelevant. - build-depends: time - - if !impl(ghc >=8.0) - build-depends: semigroups >=0.18.5 && <0.20 - - if !impl(ghc >=7.10) - build-depends: - nats >=1 && <1.2 - , void >=0.7.2 && <0.8 - - if flag(bytestring-builder) - build-depends: - bytestring >=0 && <0.10.4.0 - , bytestring-builder >=0.10.4 && <0.11 + , array >=0.5.4.0 && <0.6 + , bytestring >=0.10.12.0 && <0.13 + , case-insensitive >=1.2.0.11 && <1.3 + , data-fix >=0.3 && <0.4 + , hashable >=1.4.4.0 && <1.6 + , integer-logarithms >=1.0.3.1 && <1.1 + , old-time >=1.1.0.0 && <1.2 + , scientific >=0.3.8.0 && <0.4 + , strict >=0.5 && <0.6 + , tagged >=0.8.8 && <0.9 + , text >=1.2.4.1 && <1.3 || >=2.0 && <2.2 + , text-short >=0.1.4 && <0.2 + , these >=1.2.1 && <1.3 + , time-compat >=1.9.4 && <1.10 + , transformers >=0.5.6.2 && <0.7 + , unordered-containers >=0.2.20 && <0.3 + , uuid-types >=1.0.6 && <1.1 + , vector >=0.13.2.0 && <0.14 - else - build-depends: bytestring >=0.10.4.0 + if impl(ghc <9.4) + build-depends: data-array-byte >=0.1.0.1 && <0.2 - ghc-options: -Wall + ghc-options: -Wall test-suite self-test default-language: Haskell2010 @@ -130,20 +113,23 @@ main-is: Tests.hs hs-source-dirs: test build-depends: - base + , base , containers + , primitive , QuickCheck , quickcheck-instances - , tagged , uuid-types + if impl(ghc >=8.0 && <9.4) + build-depends: data-array-byte + benchmark bytestring-gen default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: ByteString.hs hs-source-dirs: bench build-depends: - base + , base , bytestring , QuickCheck , quickcheck-instances 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,6 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Instances are provided for the types in the packages: @@ -12,14 +9,30 @@ * containers + * data-fix + + * OneTuple + * old-time + * strict + * text + * text-short + + * these + * time * unordered-containers + * uuid + + * primitive + + * vector + 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. @@ -30,19 +43,22 @@ module Test.QuickCheck.Instances () where import Test.QuickCheck.Instances.Array () +import Test.QuickCheck.Instances.Array.Byte () import Test.QuickCheck.Instances.ByteString () import Test.QuickCheck.Instances.CaseInsensitive () import Test.QuickCheck.Instances.Containers () import Test.QuickCheck.Instances.DataFix () import Test.QuickCheck.Instances.Hashable () import Test.QuickCheck.Instances.Natural () -import Test.QuickCheck.Instances.Natural () import Test.QuickCheck.Instances.OldTime () +import Test.QuickCheck.Instances.Primitive () import Test.QuickCheck.Instances.Scientific () import Test.QuickCheck.Instances.Semigroup () +import Test.QuickCheck.Instances.Solo () import Test.QuickCheck.Instances.Strict () import Test.QuickCheck.Instances.Tagged () import Test.QuickCheck.Instances.Text () +import Test.QuickCheck.Instances.Text.Short () import Test.QuickCheck.Instances.These () import Test.QuickCheck.Instances.Time () import Test.QuickCheck.Instances.Transformer () diff --git a/src/Test/QuickCheck/Instances/Array.hs b/src/Test/QuickCheck/Instances/Array.hs --- a/src/Test/QuickCheck/Instances/Array.hs +++ b/src/Test/QuickCheck/Instances/Array.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Array () where diff --git a/src/Test/QuickCheck/Instances/Array/Byte.hs b/src/Test/QuickCheck/Instances/Array/Byte.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances/Array/Byte.hs @@ -0,0 +1,4 @@ +module Test.QuickCheck.Instances.Array.Byte () where + +import Prelude () +import Test.QuickCheck.Instances.Primitive () diff --git a/src/Test/QuickCheck/Instances/ByteString.hs b/src/Test/QuickCheck/Instances/ByteString.hs --- a/src/Test/QuickCheck/Instances/ByteString.hs +++ b/src/Test/QuickCheck/Instances/ByteString.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.ByteString () where diff --git a/src/Test/QuickCheck/Instances/CaseInsensitive.hs b/src/Test/QuickCheck/Instances/CaseInsensitive.hs --- a/src/Test/QuickCheck/Instances/CaseInsensitive.hs +++ b/src/Test/QuickCheck/Instances/CaseInsensitive.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.CaseInsensitive () where diff --git a/src/Test/QuickCheck/Instances/Containers.hs b/src/Test/QuickCheck/Instances/Containers.hs --- a/src/Test/QuickCheck/Instances/Containers.hs +++ b/src/Test/QuickCheck/Instances/Containers.hs @@ -1,58 +1,1 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Containers () where - -#if !MIN_VERSION_QuickCheck(2,14,2) -import Prelude () -import Test.QuickCheck.Instances.CustomPrelude - -import Test.QuickCheck - (Arbitrary (..), Arbitrary1 (..), CoArbitrary (..), Function (..), Gen, - arbitrary1, chooseInt, functionMap, liftShrink2, shrink1, shuffle, - sized) - -import qualified Data.Tree as Tree - -------------------------------------------------------------------------------- --- containers -------------------------------------------------------------------------------- - -instance Arbitrary1 Tree.Tree where - liftArbitrary arb = sized $ \n -> do - k <- chooseInt (0, n) - go k - where - go n = do -- n is the size of the trees. - value <- arb - pars <- arbPartition (n - 1) -- can go negative! - forest <- traverse go pars - return $ Tree.Node value forest - - arbPartition :: Int -> Gen [Int] - arbPartition k = case compare k 1 of - LT -> pure [] - EQ -> pure [1] - GT -> do - first <- chooseInt (1, k) - rest <- arbPartition $ k - first - shuffle (first : rest) - - liftShrink shr = go - where - go (Tree.Node val forest) = forest ++ - [ Tree.Node e fs - | (e, fs) <- liftShrink2 shr (liftShrink go) (val, forest) - ] - -instance Arbitrary a => Arbitrary (Tree.Tree a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (Tree.Tree a) where - coarbitrary (Tree.Node val forest) = - coarbitrary val . coarbitrary forest - -instance Function a => Function (Tree.Tree a) where - function = functionMap (\(Tree.Node x xs) -> (x,xs)) (uncurry Tree.Node) -#endif diff --git a/src/Test/QuickCheck/Instances/Hashable.hs b/src/Test/QuickCheck/Instances/Hashable.hs --- a/src/Test/QuickCheck/Instances/Hashable.hs +++ b/src/Test/QuickCheck/Instances/Hashable.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Hashable () where @@ -7,6 +5,7 @@ import Test.QuickCheck.Instances.CustomPrelude import Data.Hashable (Hashable, Hashed, hashed) +import Data.Hashable (hashedHash) import Test.QuickCheck @@ -14,10 +13,8 @@ -- hashable ------------------------------------------------------------------------------- -#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 + coarbitrary x = coarbitrary (hashedHash x :: Int) diff --git a/src/Test/QuickCheck/Instances/Natural.hs b/src/Test/QuickCheck/Instances/Natural.hs --- a/src/Test/QuickCheck/Instances/Natural.hs +++ b/src/Test/QuickCheck/Instances/Natural.hs @@ -1,27 +1,2 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Natural () where - -import Prelude () - -import Numeric.Natural (Natural) - -import Test.QuickCheck - (Arbitrary (..), CoArbitrary (..), arbitrarySizedNatural, - coarbitraryIntegral, shrinkIntegral) -import Test.QuickCheck.Function (Function (..), functionIntegral) - -------------------------------------------------------------------------------- --- nats -------------------------------------------------------------------------------- - -instance Arbitrary Natural where - arbitrary = arbitrarySizedNatural - shrink = shrinkIntegral - -instance CoArbitrary Natural where - coarbitrary = coarbitraryIntegral - -instance Function Natural where - function = functionIntegral diff --git a/src/Test/QuickCheck/Instances/OldTime.hs b/src/Test/QuickCheck/Instances/OldTime.hs --- a/src/Test/QuickCheck/Instances/OldTime.hs +++ b/src/Test/QuickCheck/Instances/OldTime.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.OldTime () where diff --git a/src/Test/QuickCheck/Instances/Primitive.hs b/src/Test/QuickCheck/Instances/Primitive.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances/Primitive.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Test.QuickCheck.Instances.Primitive () where diff --git a/src/Test/QuickCheck/Instances/Scientific.hs b/src/Test/QuickCheck/Instances/Scientific.hs --- a/src/Test/QuickCheck/Instances/Scientific.hs +++ b/src/Test/QuickCheck/Instances/Scientific.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Scientific () where diff --git a/src/Test/QuickCheck/Instances/Semigroup.hs b/src/Test/QuickCheck/Instances/Semigroup.hs --- a/src/Test/QuickCheck/Instances/Semigroup.hs +++ b/src/Test/QuickCheck/Instances/Semigroup.hs @@ -1,126 +1,2 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Semigroup () where - -import Prelude () -import Test.QuickCheck.Instances.CustomPrelude - -import Control.Applicative (liftA2) -import Data.List.NonEmpty (NonEmpty (..), nonEmpty) -import Data.Maybe (mapMaybe) - -import Test.QuickCheck - -import qualified Data.Semigroup as Semi - -------------------------------------------------------------------------------- --- semigroups -------------------------------------------------------------------------------- - -instance Arbitrary1 NonEmpty where - liftArbitrary arb = liftA2 (:|) arb (liftArbitrary arb) - liftShrink shr (x :| xs) = mapMaybe nonEmpty . liftShrink shr $ x : xs - -instance Arbitrary a => Arbitrary (NonEmpty a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (NonEmpty a) where - coarbitrary (x :| xs) = coarbitrary (x, xs) - -instance Function a => Function (NonEmpty a) where - function = functionMap g h - where - g (x :| xs) = (x, xs) - h (x, xs) = x :| xs - - -instance Arbitrary1 Semi.Min where - liftArbitrary arb = Semi.Min <$> arb - liftShrink shr = map Semi.Min . shr . Semi.getMin - -instance Arbitrary a => Arbitrary (Semi.Min a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (Semi.Min a) where - coarbitrary = coarbitrary . Semi.getMin - -instance Function a => Function (Semi.Min a) where - function = functionMap Semi.getMin Semi.Min - - -instance Arbitrary1 Semi.Max where - liftArbitrary arb = Semi.Max <$> arb - liftShrink shr = map Semi.Max . shr . Semi.getMax - -instance Arbitrary a => Arbitrary (Semi.Max a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (Semi.Max a) where - coarbitrary = coarbitrary . Semi.getMax - -instance Function a => Function (Semi.Max a) where - function = functionMap Semi.getMax Semi.Max - - -instance Arbitrary1 Semi.First where - liftArbitrary arb = Semi.First <$> arb - liftShrink shr = map Semi.First . shr . Semi.getFirst - -instance Arbitrary a => Arbitrary (Semi.First a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (Semi.First a) where - coarbitrary = coarbitrary . Semi.getFirst - -instance Function a => Function (Semi.First a) where - function = functionMap Semi.getFirst Semi.First - - -instance Arbitrary1 Semi.Last where - liftArbitrary arb = Semi.Last <$> arb - liftShrink shr = map Semi.Last . shr . Semi.getLast - -instance Arbitrary a => Arbitrary (Semi.Last a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (Semi.Last a) where - coarbitrary = coarbitrary . Semi.getLast - -instance Function a => Function (Semi.Last a) where - function = functionMap Semi.getLast Semi.Last - - -instance Arbitrary1 Semi.WrappedMonoid where - liftArbitrary arb = Semi.WrapMonoid <$> arb - liftShrink shr = map Semi.WrapMonoid . shr . Semi.unwrapMonoid - -instance Arbitrary a => Arbitrary (Semi.WrappedMonoid a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (Semi.WrappedMonoid a) where - coarbitrary = coarbitrary . Semi.unwrapMonoid - -instance Function a => Function (Semi.WrappedMonoid a) where - function = functionMap Semi.unwrapMonoid Semi.WrapMonoid - - -instance Arbitrary1 Semi.Option where - liftArbitrary arb = Semi.Option <$> liftArbitrary arb - liftShrink shr = map Semi.Option . liftShrink shr . Semi.getOption - -instance Arbitrary a => Arbitrary (Semi.Option a) where - arbitrary = arbitrary1 - shrink = shrink1 - -instance CoArbitrary a => CoArbitrary (Semi.Option a) where - coarbitrary = coarbitrary . Semi.getOption - -instance Function a => Function (Semi.Option a) where - function = functionMap Semi.getOption Semi.Option diff --git a/src/Test/QuickCheck/Instances/Solo.hs b/src/Test/QuickCheck/Instances/Solo.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances/Solo.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Test.QuickCheck.Instances.Solo () where diff --git a/src/Test/QuickCheck/Instances/Strict.hs b/src/Test/QuickCheck/Instances/Strict.hs --- a/src/Test/QuickCheck/Instances/Strict.hs +++ b/src/Test/QuickCheck/Instances/Strict.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Strict () where diff --git a/src/Test/QuickCheck/Instances/Tagged.hs b/src/Test/QuickCheck/Instances/Tagged.hs --- a/src/Test/QuickCheck/Instances/Tagged.hs +++ b/src/Test/QuickCheck/Instances/Tagged.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} -#endif {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Tagged () where diff --git a/src/Test/QuickCheck/Instances/Text.hs b/src/Test/QuickCheck/Instances/Text.hs --- a/src/Test/QuickCheck/Instances/Text.hs +++ b/src/Test/QuickCheck/Instances/Text.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Text () where diff --git a/src/Test/QuickCheck/Instances/Text/Short.hs b/src/Test/QuickCheck/Instances/Text/Short.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances/Text/Short.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Test.QuickCheck.Instances.Text.Short () where + +import Prelude () +import Test.QuickCheck.Instances.CustomPrelude + +import Test.QuickCheck + +import qualified Data.Text.Short as T + +------------------------------------------------------------------------------- +-- text +------------------------------------------------------------------------------- + +instance Arbitrary T.ShortText where + arbitrary = T.pack <$> arbitrary + shrink xs = T.pack <$> shrink (T.unpack xs) + +instance CoArbitrary T.ShortText where + coarbitrary = coarbitrary . T.unpack + +instance Function T.ShortText where + function = functionMap T.unpack T.pack diff --git a/src/Test/QuickCheck/Instances/These.hs b/src/Test/QuickCheck/Instances/These.hs --- a/src/Test/QuickCheck/Instances/These.hs +++ b/src/Test/QuickCheck/Instances/These.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.These () where diff --git a/src/Test/QuickCheck/Instances/Time.hs b/src/Test/QuickCheck/Instances/Time.hs --- a/src/Test/QuickCheck/Instances/Time.hs +++ b/src/Test/QuickCheck/Instances/Time.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Time () where @@ -39,11 +37,7 @@ 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 diff --git a/src/Test/QuickCheck/Instances/Transformer.hs b/src/Test/QuickCheck/Instances/Transformer.hs --- a/src/Test/QuickCheck/Instances/Transformer.hs +++ b/src/Test/QuickCheck/Instances/Transformer.hs @@ -1,11 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Transformer () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude +import Control.Applicative.Backwards (Backwards (..)) +import Control.Applicative.Lift (Lift (..)) +import Data.Functor.Reverse (Reverse (..)) + import Control.Monad.Trans.Maybe (MaybeT (..)) import Data.Functor.Sum (Sum (..)) @@ -31,5 +33,34 @@ liftShrink shr (InR g) = map InR (liftShrink shr g) instance (Arbitrary1 f, Arbitrary1 g, Arbitrary a) => Arbitrary (Sum f g a) where + arbitrary = arbitrary1 + shrink = shrink1 + +instance Arbitrary1 f => Arbitrary1 (Backwards f) where + liftArbitrary arb = fmap Backwards (liftArbitrary arb) + liftShrink shr (Backwards xs) = map Backwards (liftShrink shr xs) + +instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Backwards f a) where + arbitrary = arbitrary1 + shrink = shrink1 + +instance Arbitrary1 f => Arbitrary1 (Reverse f) where + liftArbitrary arb = fmap Reverse (liftArbitrary arb) + liftShrink shr (Reverse xs) = map Reverse (liftShrink shr xs) + +instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Reverse f a) where + arbitrary = arbitrary1 + shrink = shrink1 + +instance Arbitrary1 f => Arbitrary1 (Lift f) where + liftArbitrary arb = oneof + [ fmap Pure arb + , fmap Other (liftArbitrary arb) + ] + + liftShrink shr (Pure x) = map Pure (shr x) + liftShrink shr (Other xs) = map Other (liftShrink shr xs) + +instance (Arbitrary1 f, Arbitrary a) => Arbitrary (Lift f a) where arbitrary = arbitrary1 shrink = shrink1 diff --git a/src/Test/QuickCheck/Instances/UUID.hs b/src/Test/QuickCheck/Instances/UUID.hs --- a/src/Test/QuickCheck/Instances/UUID.hs +++ b/src/Test/QuickCheck/Instances/UUID.hs @@ -1,14 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.UUID () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude -import Data.Word (Word32) +import Data.Word (Word64) import Test.QuickCheck +import Test.QuickCheck.Gen (chooseUpTo) import qualified Data.UUID.Types as UUID @@ -16,16 +15,19 @@ -- uuid ------------------------------------------------------------------------------- -uuidFromWords :: (Word32, Word32, Word32, Word32) -> UUID.UUID -uuidFromWords (a,b,c,d) = UUID.fromWords a b c d +uuidFromWords64 :: (Word64, Word64) -> UUID.UUID +uuidFromWords64 (a,b) = UUID.fromWords64 a b +uniformWord64 :: Gen Word64 +uniformWord64 = chooseUpTo maxBound + -- | Uniform distribution. instance Arbitrary UUID.UUID where - arbitrary = uuidFromWords <$> arbitrary - shrink = map uuidFromWords . shrink . UUID.toWords + arbitrary = UUID.fromWords64 <$> uniformWord64 <*> uniformWord64 + shrink = map uuidFromWords64 . shrink . UUID.toWords64 instance CoArbitrary UUID.UUID where coarbitrary = coarbitrary . UUID.toWords instance Function UUID.UUID where - function = functionMap UUID.toWords uuidFromWords + function = functionMap UUID.toWords64 uuidFromWords64 diff --git a/src/Test/QuickCheck/Instances/UnorderedContainers.hs b/src/Test/QuickCheck/Instances/UnorderedContainers.hs --- a/src/Test/QuickCheck/Instances/UnorderedContainers.hs +++ b/src/Test/QuickCheck/Instances/UnorderedContainers.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.UnorderedContainers () where diff --git a/src/Test/QuickCheck/Instances/Vector.hs b/src/Test/QuickCheck/Instances/Vector.hs --- a/src/Test/QuickCheck/Instances/Vector.hs +++ b/src/Test/QuickCheck/Instances/Vector.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Vector () where @@ -10,10 +7,12 @@ import Test.QuickCheck import Test.QuickCheck.Function ((:->)) -import qualified Data.Vector as Vector -import qualified Data.Vector.Generic as GVector -import qualified Data.Vector.Storable as SVector -import qualified Data.Vector.Unboxed as UVector +import qualified Data.Vector as Vector +import qualified Data.Vector.Generic as GVector +import qualified Data.Vector.Primitive as PVector +import qualified Data.Vector.Storable as SVector +import qualified Data.Vector.Unboxed as UVector +import qualified Data.Vector.Strict as BVector ------------------------------------------------------------------------------- -- vector @@ -52,6 +51,32 @@ coarbitrary = coarbitraryVector instance (UVector.Unbox a, Function a) => Function (UVector.Vector a) where + function = functionVector + +-- | @since 0.3.32 +instance (PVector.Prim a, Arbitrary a) => Arbitrary (PVector.Vector a) where + arbitrary = arbitraryVector + shrink = shrinkVector + +-- | @since 0.3.32 +instance (PVector.Prim a, CoArbitrary a) => CoArbitrary (PVector.Vector a) where + coarbitrary = coarbitraryVector + +-- | @since 0.3.32 +instance (PVector.Prim a, Function a) => Function (PVector.Vector a) where + function = functionVector + +-- | @since 0.3.33 +instance (Arbitrary a) => Arbitrary (BVector.Vector a) where + arbitrary = arbitraryVector + shrink = shrinkVector + +-- | @since 0.3.33 +instance (CoArbitrary a) => CoArbitrary (BVector.Vector a) where + coarbitrary = coarbitraryVector + +-- | @since 0.3.33 +instance (Function a) => Function (BVector.Vector a) where function = functionVector arbitraryVector :: (GVector.Vector v a, Arbitrary a) => Gen (v a) diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -1,12 +1,17 @@ module Main (main) where -import Data.Proxy (Proxy (..)) +import Data.Proxy (Proxy (..)) +import Numeric.Natural (Natural) import Test.QuickCheck import Test.QuickCheck.Instances () -import qualified Data.Tree as Tree -import Data.UUID.Types (UUID) +import qualified Data.Array.Byte as AB +import qualified Data.Primitive as Prim +import qualified Data.Tree as Tree +import Data.UUID.Types (UUID) + + -- | Example law: == (and thus ===) should be reflexive. eqReflexive :: (Eq a, Show a) @@ -17,6 +22,9 @@ main :: IO () main = do + quickCheck $ eqReflexive (Proxy :: Proxy Natural) quickCheck $ eqReflexive (Proxy :: Proxy Int) quickCheck $ eqReflexive (Proxy :: Proxy (Tree.Tree Int)) quickCheck $ eqReflexive (Proxy :: Proxy UUID) + quickCheck $ eqReflexive (Proxy :: Proxy Prim.ByteArray) + quickCheck $ eqReflexive (Proxy :: Proxy AB.ByteArray)