diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,4 +1,12 @@ -0.3.33 +0.3.24 + +* Add `strict` instances. +* Add `data-fix` instances. +* Improve 'Arbitrary Tree' instance and add `Function Tree` instance. +* Require `QuickCheck-2.14.1` +* Drop `base-compat` dependency + +0.3.23 * Add `these` instances. 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.23 +version: 0.3.24 synopsis: Common quickcheck instances description: QuickCheck instances. @@ -58,11 +58,13 @@ Test.QuickCheck.Instances.ByteString Test.QuickCheck.Instances.CaseInsensitive Test.QuickCheck.Instances.Containers + Test.QuickCheck.Instances.DataFix Test.QuickCheck.Instances.Hashable Test.QuickCheck.Instances.Natural Test.QuickCheck.Instances.OldTime Test.QuickCheck.Instances.Scientific Test.QuickCheck.Instances.Semigroup + Test.QuickCheck.Instances.Strict Test.QuickCheck.Instances.Tagged Test.QuickCheck.Instances.Text Test.QuickCheck.Instances.These @@ -73,24 +75,27 @@ Test.QuickCheck.Instances.Vector Test.QuickCheck.Instances.Void + other-modules: Test.QuickCheck.Instances.CustomPrelude hs-source-dirs: src build-depends: base >=4.5 && <4.15 - , QuickCheck >=2.13.2 && <2.15 - , splitmix >=0.0.2 && <0.1 + , QuickCheck >=2.14.1 && <2.14.2 + , splitmix >=0.0.2 && <0.2 build-depends: array >=0.4.0.0 && <0.6 - , base-compat >=0.10.5 && <0.12 , bytestring >=0.9.2.1 && <0.11 , 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.2.0.0 && <0.4 - , tagged >=0.8.5 && <0.9 - , text >=1.0.0.0 && <1.3 - , these >=1.1 && <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.2.2 && <1.10 , transformers >=0.3.0.0 && <0.6 , transformers-compat >=0.6.5 && <0.7 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 @@ -33,12 +33,14 @@ 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.Scientific () import Test.QuickCheck.Instances.Semigroup () +import Test.QuickCheck.Instances.Strict () import Test.QuickCheck.Instances.Tagged () import Test.QuickCheck.Instances.Text () import Test.QuickCheck.Instances.These () 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.Array () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Control.Applicative (liftA2) import Data.Ix (Ix (..)) 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.ByteString () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Data.Word (Word8) import Test.QuickCheck 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.CaseInsensitive () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck 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 @@ -4,11 +4,12 @@ module Test.QuickCheck.Instances.Containers () where import Prelude () -import Prelude.Compat - -import Data.Traversable (for) +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 @@ -17,12 +18,14 @@ ------------------------------------------------------------------------------- instance Arbitrary1 Tree.Tree where - liftArbitrary arb = go + liftArbitrary arb = sized $ \n -> do + k <- chooseInt (0, n) + go k where - go = sized $ \n -> do -- Sized is the size of the trees. + go n = do -- n is the size of the trees. value <- arb pars <- arbPartition (n - 1) -- can go negative! - forest <- for pars $ \i -> resize i go + forest <- traverse go pars return $ Tree.Node value forest arbPartition :: Int -> Gen [Int] @@ -30,9 +33,9 @@ LT -> pure [] EQ -> pure [1] GT -> do - first <- elements [1..k] + first <- chooseInt (1, k) rest <- arbPartition $ k - first - return $ first : rest + shuffle (first : rest) liftShrink shr = go where @@ -48,3 +51,6 @@ 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) diff --git a/src/Test/QuickCheck/Instances/CustomPrelude.hs b/src/Test/QuickCheck/Instances/CustomPrelude.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances/CustomPrelude.hs @@ -0,0 +1,27 @@ +-- | Custom prelude. +-- +-- We don't need much, and we don't care about precise types +-- (Monad or Applicative constraints, e.g.) +-- So this is simple approach. +-- +module Test.QuickCheck.Instances.CustomPrelude ( + module Export, +) where + +import Control.Applicative as Export (Applicative (pure, (<*>)), (<$>)) +import Data.Traversable as Export (Traversable (..)) +import Prelude as Export + (Bounded (..), Either (..), Enum (..), Eq (..), Functor (..), + Maybe (..), Monad ((>>=)), Ord (..), Ordering (..), const, flip, fst, + id, otherwise, replicate, return, uncurry, ($), (.)) + +-- lists +import Prelude as Export (length, map, (++)) + +-- numbers +import Prelude as Export + (Double, Fractional (..), Int, Integral (..), Num (..), Real (..), + fromIntegral) + +-- errors +import Prelude as Export (error, undefined) diff --git a/src/Test/QuickCheck/Instances/DataFix.hs b/src/Test/QuickCheck/Instances/DataFix.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances/DataFix.hs @@ -0,0 +1,32 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Test.QuickCheck.Instances.DataFix () where + +import Prelude () +import Test.QuickCheck.Instances.CustomPrelude + +import Data.Fix (Fix (..), Mu (..), Nu (..), unfoldMu, unfoldNu, foldMu, foldNu) +import Test.QuickCheck (Arbitrary (..), Arbitrary1 (..), Gen, sized) + +import Math.NumberTheory.Logarithms (intLog2) + +------------------------------------------------------------------------------- +-- data-fix +------------------------------------------------------------------------------- + +instance Arbitrary1 f => Arbitrary (Fix f) where + arbitrary = sized arb where + arb :: Arbitrary1 f => Int -> Gen (Fix f) + arb n = fmap Fix $ liftArbitrary (arb (smaller n)) + + smaller n | n <= 0 = 0 + | otherwise = intLog2 n + + shrink = go where go (Fix f) = map Fix (liftShrink go f) + +instance (Arbitrary1 f, Functor f) => Arbitrary (Mu f) where + arbitrary = unfoldMu unFix <$> arbitrary + shrink mu = unfoldMu unFix <$> shrink (foldMu Fix mu) + +instance (Arbitrary1 f, Functor f) => Arbitrary (Nu f) where + arbitrary = unfoldNu unFix <$> arbitrary + shrink nu = unfoldNu unFix <$> shrink (foldNu Fix nu) 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.Hashable () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Data.Hashable (Hashable, Hashed, hashed) 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.OldTime () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Data.Int (Int32) 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.Scientific () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.Semigroup () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Control.Applicative (liftA2) import Data.List.NonEmpty (NonEmpty (..), nonEmpty) diff --git a/src/Test/QuickCheck/Instances/Strict.hs b/src/Test/QuickCheck/Instances/Strict.hs new file mode 100644 --- /dev/null +++ b/src/Test/QuickCheck/Instances/Strict.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Test.QuickCheck.Instances.Strict () where + +import Prelude () +import Test.QuickCheck.Instances.CustomPrelude + +import Test.QuickCheck + +import qualified Data.Strict as S + +------------------------------------------------------------------------------- +-- Pair +------------------------------------------------------------------------------- + +-- | @since 0.3.24 +instance Arbitrary2 S.Pair where + liftArbitrary2 arbA arbB = (S.:!:) <$> arbA <*> arbB + + liftShrink2 shrA shrB (x S.:!: y) = uncurry (S.:!:) <$> + liftShrink2 shrA shrB (x, y) + +-- | @since 0.3.24 +instance (Arbitrary a) => Arbitrary1 (S.Pair a) where + liftArbitrary = liftArbitrary2 arbitrary + liftShrink = liftShrink2 shrink + +-- | @since 0.3.24 +instance (Arbitrary a, Arbitrary b) => Arbitrary (S.Pair a b) where + arbitrary = arbitrary1 + shrink = shrink1 + +-- | @since 0.3.24 +instance (Function a, Function b) => Function (S.Pair a b) where + function = functionMap S.toLazy S.toStrict + +-- | @since 0.3.24 +instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (S.Pair a b) + +------------------------------------------------------------------------------- +-- Maybe +------------------------------------------------------------------------------- + +-- | @since 0.3.24 +instance Arbitrary1 S.Maybe where + liftArbitrary arb = frequency + [ (1, pure S.Nothing) + , (9, S.Just <$> arb) + ] + + liftShrink _shr S.Nothing = [] + liftShrink shr (S.Just x) = S.Nothing : map S.Just (shr x) + +-- | @since 0.3.24 +instance (Arbitrary a) => Arbitrary (S.Maybe a) where + arbitrary = arbitrary1 + shrink = shrink1 + +-- | @since 0.3.24 +instance (Function a) => Function (S.Maybe a) where + function = functionMap S.toLazy S.toStrict + +-- | @since 0.3.24 +instance (CoArbitrary a) => CoArbitrary (S.Maybe a) + +------------------------------------------------------------------------------- +-- Either +------------------------------------------------------------------------------- + +-- | @since 0.3.24 +instance Arbitrary2 S.Either where + liftArbitrary2 arbA arbB = oneof + [ S.Left <$> arbA + , S.Right <$> arbB + ] + + liftShrink2 shrA _shrB (S.Left x) = S.Left <$> shrA x + liftShrink2 _shrA shrB (S.Right y) = S.Right <$> shrB y + +-- | @since 0.3.24 +instance (Arbitrary a) => Arbitrary1 (S.Either a) where + liftArbitrary = liftArbitrary2 arbitrary + liftShrink = liftShrink2 shrink + +-- | @since 0.3.24 +instance (Arbitrary a, Arbitrary b) => Arbitrary (S.Either a b) where + arbitrary = arbitrary1 + shrink = shrink1 + +-- | @since 0.3.24 +instance (Function a, Function b) => Function (S.Either a b) where + function = functionMap S.toLazy S.toStrict + +-- | @since 0.3.24 +instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (S.Either a b) + +------------------------------------------------------------------------------- +-- These +------------------------------------------------------------------------------- + +-- | @since 0.3.24 +instance Arbitrary2 S.These where + liftArbitrary2 arbA arbB = oneof + [ S.This <$> arbA + , S.That <$> arbB + , S.These <$> arbA <*> arbB + ] + + liftShrink2 shrA _shrB (S.This x) = S.This <$> shrA x + liftShrink2 _shrA shrB (S.That y) = S.That <$> shrB y + liftShrink2 shrA shrB (S.These x y) = + [S.This x, S.That y] ++ [S.These x' y' | (x', y') <- liftShrink2 shrA shrB (x, y)] + +-- | @since 0.3.24 +instance (Arbitrary a) => Arbitrary1 (S.These a) where + liftArbitrary = liftArbitrary2 arbitrary + liftShrink = liftShrink2 shrink + +-- | @since 0.3.24 +instance (Arbitrary a, Arbitrary b) => Arbitrary (S.These a b) where + arbitrary = arbitrary1 + shrink = shrink1 + +-- | @since 0.3.24 +instance (Function a, Function b) => Function (S.These a b) where + function = functionMap g f + where + g (S.This a) = Left a + g (S.That b) = Right (Left b) + g (S.These a b) = Right (Right (a, b)) + + f (Left a) = S.This a + f (Right (Left b)) = S.That b + f (Right (Right (a, b))) = S.These a b + +-- | @since 0.3.24 +instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (S.These a b) 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 @@ -7,7 +7,7 @@ module Test.QuickCheck.Instances.Tagged () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Data.Proxy (Proxy (Proxy)) 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.Text () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.These () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck @@ -15,7 +15,7 @@ -- These ------------------------------------------------------------------------------- --- | @since 0.7.4 +-- | @since 0.3.23 instance Arbitrary2 These where liftArbitrary2 arbA arbB = oneof [ This <$> arbA @@ -28,17 +28,17 @@ liftShrink2 shrA shrB (These x y) = [This x, That y] ++ [These x' y' | (x', y') <- liftShrink2 shrA shrB (x, y)] --- | @since 0.7.4 +-- | @since 0.3.23 instance (Arbitrary a) => Arbitrary1 (These a) where liftArbitrary = liftArbitrary2 arbitrary liftShrink = liftShrink2 shrink --- | @since 0.7.1 +-- | @since 0.3.23 instance (Arbitrary a, Arbitrary b) => Arbitrary (These a b) where arbitrary = arbitrary1 shrink = shrink1 --- | @since 0.7.1 +-- | @since 0.3.23 instance (Function a, Function b) => Function (These a b) where function = functionMap g f where @@ -50,13 +50,14 @@ f (Right (Left b)) = That b f (Right (Right (a, b))) = These a b --- | @since 0.7.1 +-- | @since 0.3.23 instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (These a b) ------------------------------------------------------------------------------- -- These1 ------------------------------------------------------------------------------- +-- | @since 0.3.23 instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (These1 f g) where liftArbitrary arb = oneof [ This1 <$> liftArbitrary arb @@ -72,6 +73,7 @@ | (x', y') <- liftShrink2 (liftShrink shr) (liftShrink shr) (x, y) ] +-- | @since 0.3.23 instance (Arbitrary1 f, Arbitrary1 g, Arbitrary a) => Arbitrary (These1 f g a) where arbitrary = arbitrary1 shrink = shrink1 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.Time () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.Transformer () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Control.Monad.Trans.Maybe (MaybeT (..)) import Data.Functor.Sum (Sum (..)) 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.UUID () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Data.Word (Word32) 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 @@ -4,7 +4,7 @@ module Test.QuickCheck.Instances.UnorderedContainers () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Data.Hashable (Hashable) 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 @@ -5,7 +5,7 @@ module Test.QuickCheck.Instances.Vector () where import Prelude () -import Prelude.Compat +import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck import Test.QuickCheck.Function ((:->))