quickcheck-instances-0.3.30/0000755000000000000000000000000007346545000014065 5ustar0000000000000000quickcheck-instances-0.3.30/CHANGES0000644000000000000000000001075607346545000015071 0ustar00000000000000000.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 0.3.25.1 * Support `QuickCheck-2.14.2` * Support `bytestring-0.11` 0.3.25 * Add types from `time-1.11` / `time-compat-1.9.4`: `Month`, `Quarter`, `QuarterOfYear` 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. 0.3.22 * Add `Void` instances. 0.3.21 * Use time-compat * Add `Function` instances for vector, unordered-containers, scientific, nats 0.3.20 * Support QuickCheck-2.13 * Faster ByteString `arbitrary` 0.3.19 * Instances for `MaybeT` 0.3.18 * `ShortByteString` instances for all supported `bytestring` 0.3.17 * Support GHC-8.4.1 * Split package into per-package modules * Add instances for `ShortByteString` * Add Function `ByteString` and `ShortByteString` instances (bytestring >= 0.10.4) * Enable PolyKinds for `Tagged` instances (GHC >= 7.6) 0.3.16.1 * Support QuickCheck-2.11 * Bump lower bounds on boot-library dependencies to the versions distributed with GHC-7.4.2 * Bump lower bound on some other dependencies, as cannot test previous lower bound (no install-plans). 0.3.16 * Instances for `Semigroup` newtypes: `Min`, `Max`, `First`, `Last`, `Option` and `WrappedMonoid`. 0.3.15 * `QuickCheck-2.10` support. * `Arbitrary1/2` instances. 0.3.14 * Fix `Tree` bug. * Add `UUID` instances. 0.3.13 Author: Oleg Grenrus * Add case-insensitive instances 0.3.12 Author: Oleg Grenrus * Add vector and scientific instances Author: RyanGlScott * Fix build with GHC 8.0.1, QuickCheck-2.8.2 0.3.11 Author: Timo von Holtz * Add some Instances for Function Author: Antoine Latter * Allow building against QuickCheck 2.8. 0.3.10 Author: Antoine Latter * Allow building against newer versions of the time package. 0.3.9 Author: RyanGlScott * Bump text upper version bounds 0.3.8 Author: Antoine Latter * Allow building against QuickCheck version 2.7 0.3.7 Author: Antoine Latter * Update list of covered libraries. * Allow newer version of "text" as a dependency. 0.3.6 Author: Joao Cristovao * Added unordered-containers. 0.3.5 Author: Antoine Latter * No change - bumping version to re-upload to hackage, due to bugs in the 0.3.4 tarball. 0.3.4 Author: Antoine Latter * Allow newer versions of "text" and "array" as dependencies. 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 quickcheck-instances-0.3.30/LICENSE0000644000000000000000000000276507346545000015104 0ustar0000000000000000Copyright (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. quickcheck-instances-0.3.30/Setup.hs0000644000000000000000000000005607346545000015522 0ustar0000000000000000import Distribution.Simple main = defaultMain quickcheck-instances-0.3.30/bench/0000755000000000000000000000000007346545000015144 5ustar0000000000000000quickcheck-instances-0.3.30/bench/ByteString.hs0000644000000000000000000000112407346545000017570 0ustar0000000000000000module Main where import qualified Data.ByteString as BS import System.IO (hPutStrLn, stderr) import qualified Test.QuickCheck as QC import Test.QuickCheck.Instances.ByteString () import qualified Test.QuickCheck.Monadic as QCM -- BS.pack 6.53s -- current: 0.07s main :: IO () main = QC.quickCheckWith args $ QC.property $ \bsList -> QCM.monadicIO $ do QCM.run $ hPutStrLn stderr (show $ sum $ map BS.length bsList) QCM.assert True where args = QC.stdArgs { QC.maxSize = 1000 } quickcheck-instances-0.3.30/quickcheck-instances.cabal0000644000000000000000000001144207346545000021152 0ustar0000000000000000name: quickcheck-instances version: 0.3.30 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. license: BSD3 license-file: LICENSE author: Antoine Latter , Oleg Grenrus maintainer: Oleg Grenrus homepage: https://github.com/haskellari/qc-instances bug-reports: https://github.com/haskellari/qc-instances/issues copyright: Copyright 2012-2016 Antoine Latter, 2017-2019 Oleg Grenrus 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.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3 || ==9.8.1 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 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 Test.QuickCheck.Instances.DataFix 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.These Test.QuickCheck.Instances.Time Test.QuickCheck.Instances.Transformer Test.QuickCheck.Instances.UnorderedContainers Test.QuickCheck.Instances.UUID Test.QuickCheck.Instances.Vector Test.QuickCheck.Instances.Void other-modules: Test.QuickCheck.Instances.CustomPrelude hs-source-dirs: src build-depends: base >=4.5 && <4.20 , QuickCheck >=2.14.1 && <2.14.4 , splitmix >=0.0.2 && <0.2 build-depends: array >=0.4.0.0 && <0.6 , bytestring >=0.9.2.1 && <0.13 , 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.5 , integer-logarithms >=1.0.3 && <1.1 , old-time >=1.1.0.0 && <1.2 , OneTuple >=0.3 && <0.5 , primitive >=0.6.4.0 && <0.9 , scientific >=0.3.6.2 && <0.4 , strict >=0.4 && <0.6 , tagged >=0.8.6 && <0.9 , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2 , these >=1.1.1.1 && <1.3 , time-compat >=1.9.4 && <1.10 , transformers >=0.3.0.0 && <0.7 , transformers-compat >=0.6.5 && <0.8 , unordered-containers >=0.2.2.0 && <0.3 , uuid-types >=1.0.4 && <1.1 , vector >=0.12.3.1 && <0.14 -- version is irrelevant. build-depends: time if impl(ghc >=8.0 && <9.4) build-depends: data-array-byte >=0.1.0.1 && <0.2 if !impl(ghc >=8.0) build-depends: semigroups >=0.18.5 && <0.21 if !impl(ghc >=7.10) build-depends: nats >=1.1.2 && <1.2 , void >=0.7.2 && <0.8 if flag(bytestring-builder) build-depends: bytestring <0.10.4.0 , bytestring-builder >=0.10.4 && <0.11 else build-depends: bytestring >=0.10.4.0 if impl(ghc >=7.8) exposed-modules: Test.QuickCheck.Instances.Text.Short build-depends: text-short >=0.1.3 && <0.2 ghc-options: -Wall test-suite self-test default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: test build-depends: 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 , bytestring , QuickCheck , quickcheck-instances quickcheck-instances-0.3.30/src/Test/QuickCheck/0000755000000000000000000000000007346545000017605 5ustar0000000000000000quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances.hs0000644000000000000000000000337607346545000022101 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Instances are provided for the types in the packages: * array * bytestring * case-insensitive * 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. For information on writing a test-suite with Cabal see -} 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.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.These () import Test.QuickCheck.Instances.Time () import Test.QuickCheck.Instances.Transformer () import Test.QuickCheck.Instances.UnorderedContainers () import Test.QuickCheck.Instances.UUID () import Test.QuickCheck.Instances.Vector () import Test.QuickCheck.Instances.Void () #ifdef MIN_VERSION_text_short import Test.QuickCheck.Instances.Text.Short () #endif quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/0000755000000000000000000000000007346545000021534 5ustar0000000000000000quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Array.hs0000644000000000000000000000351207346545000023147 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Array () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Control.Applicative (liftA2) import Data.Ix (Ix (..)) import Test.QuickCheck import qualified Data.Array.IArray as Array import qualified Data.Array.Unboxed as Array ------------------------------------------------------------------------------- -- array ------------------------------------------------------------------------------- instance (Num i, Ix i, Arbitrary i) => Arbitrary1 (Array.Array i) where liftArbitrary = liftA2 makeArray arbitrary . liftArbitrary liftShrink = shrinkArray instance (Num i, Ix i, Arbitrary i, Arbitrary a) => Arbitrary (Array.Array i a) where arbitrary = arbitrary1 shrink = shrink1 instance (Ix i, CoArbitrary i, CoArbitrary a) => CoArbitrary (Array.Array i a) where coarbitrary arr = coarbitrary (Array.bounds arr, Array.elems arr) instance (Num i, Ix i, Array.IArray Array.UArray a, Arbitrary i, Arbitrary a) => Arbitrary (Array.UArray i a) where arbitrary = liftA2 makeArray arbitrary arbitrary shrink = shrinkArray shrink instance (Ix i, Array.IArray Array.UArray a, CoArbitrary i, CoArbitrary a) => CoArbitrary (Array.UArray i a) where coarbitrary arr = coarbitrary (Array.bounds arr, Array.elems arr) shrinkArray :: (Num i, Ix i, Array.IArray arr a, Arbitrary i) => (a -> [a]) -> arr i a -> [arr i a] shrinkArray shr arr = [ makeArray lo xs | xs <- liftShrink shr (Array.elems arr) ] ++ [ makeArray lo' (Array.elems arr) | lo' <- shrink lo ] where (lo, _) = Array.bounds arr makeArray :: (Num i, Ix i, Array.IArray arr a) => i -> [a] -> arr i a makeArray lo xs = Array.listArray (lo, lo + fromIntegral (length xs - 1)) xs quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Array/0000755000000000000000000000000007346545000022612 5ustar0000000000000000quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Array/Byte.hs0000644000000000000000000000161407346545000024053 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Array.Byte () where #if !MIN_VERSION_primitive(0,8,0) && MIN_VERSION_base(4,9,0) import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck.Instances.Primitive () import Test.QuickCheck import Data.Array.Byte (ByteArray (..)) import qualified Data.Primitive as P -- | @since 0.3.28 instance Arbitrary ByteArray where arbitrary = fromP <$> arbitrary shrink ba = fromP <$> shrink (toP ba) -- | @since 0.3.28 instance CoArbitrary ByteArray where coarbitrary ba = coarbitrary (toP ba) -- | @since 0.3.28 instance Function ByteArray where function = functionMap toP fromP toP :: ByteArray -> P.ByteArray toP (ByteArray ba) = P.ByteArray ba fromP :: P.ByteArray -> ByteArray fromP (P.ByteArray ba) = ByteArray ba #endif quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/ByteString.hs0000644000000000000000000000457207346545000024172 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.ByteString () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Data.Word (Word8) import Test.QuickCheck import Test.QuickCheck.Gen import Test.QuickCheck.Random (QCGen (..)) import qualified System.Random.SplitMix as SM import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS ------------------------------------------------------------------------------- -- bytestring ------------------------------------------------------------------------------- instance Arbitrary BS.ByteString where arbitrary = MkGen $ \(QCGen g0) size -> if size <= 0 then BS.empty else let (i, g1) = SM.nextInt g0 size' = i `mod` size in fst (BS.unfoldrN size' gen g1) where gen :: SM.SMGen -> Maybe (Word8, SM.SMGen) gen !g = Just (fromIntegral w64, g') where ~(w64, g') = SM.nextWord64 g shrink xs = BS.pack <$> shrink (BS.unpack xs) instance CoArbitrary BS.ByteString where coarbitrary = coarbitrary . BS.unpack instance Function BS.ByteString where function = functionMap BS.unpack BS.pack instance Arbitrary LBS.ByteString where arbitrary = MkGen $ \(QCGen g0) size -> if size <= 0 then LBS.empty else let (i, g1) = SM.nextInt g0 size' = i `mod` size in LBS.unfoldr gen (size', g1) where gen :: (Int, SM.SMGen) -> Maybe (Word8, (Int, SM.SMGen)) gen (!i, !g) | i <= 0 = Nothing | otherwise = Just (fromIntegral w64, (i - 1, g')) where ~(w64, g') = SM.nextWord64 g shrink xs = LBS.pack <$> shrink (LBS.unpack xs) instance CoArbitrary LBS.ByteString where coarbitrary = coarbitrary . LBS.unpack instance Function LBS.ByteString where function = functionMap LBS.unpack LBS.pack instance Arbitrary SBS.ShortByteString where arbitrary = SBS.pack <$> arbitrary shrink xs = SBS.pack <$> shrink (SBS.unpack xs) instance CoArbitrary SBS.ShortByteString where coarbitrary = coarbitrary . SBS.unpack instance Function SBS.ShortByteString where function = functionMap SBS.unpack SBS.pack quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/CaseInsensitive.hs0000644000000000000000000000151107346545000025162 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.CaseInsensitive () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck import qualified Data.CaseInsensitive as CI ------------------------------------------------------------------------------- -- case-insensitive ------------------------------------------------------------------------------- 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 quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Containers.hs0000644000000000000000000000353707346545000024205 0ustar0000000000000000{-# 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 quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/CustomPrelude.hs0000644000000000000000000000152507346545000024666 0ustar0000000000000000-- | 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) quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/DataFix.hs0000644000000000000000000000225007346545000023407 0ustar0000000000000000{-# 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) quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Hashable.hs0000644000000000000000000000161007346545000023575 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Hashable () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Data.Hashable (Hashable, Hashed, hashed) #if MIN_VERSION_hashable(1,4,0) import Data.Hashable (hashedHash) #else import Data.Hashable (hash) #endif import Test.QuickCheck ------------------------------------------------------------------------------- -- 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 #if MIN_VERSION_hashable(1,4,0) coarbitrary x = coarbitrary (hashedHash x :: Int) #else coarbitrary x = coarbitrary (hash x :: Int) #endif #endif quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Natural.hs0000644000000000000000000000145307346545000023501 0ustar0000000000000000{-# 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 quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/OldTime.hs0000644000000000000000000000560507346545000023433 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.OldTime () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Data.Int (Int32) import Test.QuickCheck import qualified System.Time as OldTime ------------------------------------------------------------------------------- -- 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 sec 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 sec ] ++ [ td { OldTime.tdPicosec = p' } | p' <- shrink picosec ] instance CoArbitrary OldTime.TimeDiff where coarbitrary (OldTime.TimeDiff year month day hour minute sec picosec) = coarbitrary year . coarbitrary month . coarbitrary day . coarbitrary hour . coarbitrary minute . coarbitrary sec . 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 sec picosec wDay yDay tzName tz isDST) = coarbitrary year . coarbitrary month . coarbitrary day . coarbitrary hour . coarbitrary minute . coarbitrary sec . coarbitrary picosec . coarbitrary wDay . coarbitrary yDay . coarbitrary tzName . coarbitrary tz . coarbitrary isDST quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Primitive.hs0000644000000000000000000000204107346545000024035 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Primitive () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Data.Word (Word8) import Test.QuickCheck import qualified Data.Primitive as P ------------------------------------------------------------------------------- -- ByteArray ------------------------------------------------------------------------------- -- | @since 0.3.28 instance Arbitrary P.ByteArray where arbitrary = byteArrayFromList <$> arbitrary shrink ba = byteArrayFromList <$> shrink (byteArrayToList ba) -- | @since 0.3.28 instance CoArbitrary P.ByteArray where coarbitrary ba = coarbitrary (byteArrayToList ba) -- | @since 0.3.28 instance Function P.ByteArray where function = functionMap byteArrayToList byteArrayFromList byteArrayFromList :: [Word8] -> P.ByteArray byteArrayFromList = P.byteArrayFromList byteArrayToList :: P.ByteArray -> [Word8] byteArrayToList = P.foldrByteArray (:) [] quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Scientific.hs0000644000000000000000000000206407346545000024152 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Scientific () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck import qualified Data.Scientific as Scientific ------------------------------------------------------------------------------- -- scientific ------------------------------------------------------------------------------- instance Arbitrary Scientific.Scientific where arbitrary = do c <- arbitrary e <- arbitrary return $ Scientific.scientific c e shrink s = map (uncurry Scientific.scientific) $ shrink (Scientific.coefficient s, Scientific.base10Exponent s) instance CoArbitrary Scientific.Scientific where coarbitrary s = coarbitrary (Scientific.coefficient s, Scientific.base10Exponent s) instance Function Scientific.Scientific where function = functionMap (\s -> (Scientific.coefficient s, Scientific.base10Exponent s)) (uncurry Scientific.scientific) quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Semigroup.hs0000644000000000000000000000752607346545000024054 0ustar0000000000000000{-# 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 #if !(MIN_VERSION_base(4,16,0)) 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 #endif quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Solo.hs0000644000000000000000000000135707346545000023012 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Solo () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude #if MIN_VERSION_OneTuple(0,4,0) import Data.Tuple.Solo (Solo (MkSolo), getSolo) #else import Data.Tuple.Solo (Solo (Solo), getSolo) #define MkSolo Solo #endif import Test.QuickCheck instance Arbitrary1 Solo where liftArbitrary = fmap MkSolo liftShrink shr = map MkSolo . shr . getSolo instance Arbitrary a => Arbitrary (Solo a) where arbitrary = arbitrary1 shrink = shrink1 instance CoArbitrary a => CoArbitrary (Solo a) where coarbitrary = coarbitrary . getSolo instance Function a => Function (Solo a) where function = functionMap getSolo MkSolo quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Strict.hs0000644000000000000000000001024407346545000023341 0ustar0000000000000000{-# 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) quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Tagged.hs0000644000000000000000000000300007346545000023254 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Tagged () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Data.Proxy (Proxy (Proxy)) import Test.QuickCheck import qualified Data.Tagged as Tagged (Tagged (..)) ------------------------------------------------------------------------------- -- tagged ------------------------------------------------------------------------------- instance Arbitrary2 Tagged.Tagged where liftArbitrary2 _ arb = Tagged.Tagged <$> arb liftShrink2 _ shr = fmap Tagged.Tagged . shr . Tagged.unTagged instance Arbitrary1 (Tagged.Tagged a) where liftArbitrary arb = Tagged.Tagged <$> arb liftShrink shr = fmap Tagged.Tagged . shr . Tagged.unTagged instance Arbitrary b => Arbitrary (Tagged.Tagged a b) where arbitrary = arbitrary1 shrink = shrink1 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 instance Arbitrary1 Proxy where liftArbitrary _ = pure Proxy liftShrink _ _ = [] instance Arbitrary (Proxy a) where arbitrary = pure Proxy shrink _ = [] instance CoArbitrary (Proxy a) where coarbitrary _ = id instance Function (Proxy a) where function = functionMap (const ()) (const Proxy) quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Text.hs0000644000000000000000000000201307346545000023010 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Text () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck import qualified Data.Text as T import qualified Data.Text.Lazy as LT ------------------------------------------------------------------------------- -- text ------------------------------------------------------------------------------- instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary shrink xs = T.pack <$> shrink (T.unpack xs) instance Arbitrary LT.Text where arbitrary = LT.pack <$> arbitrary shrink xs = LT.pack <$> shrink (LT.unpack xs) instance CoArbitrary T.Text where coarbitrary = coarbitrary . T.unpack instance CoArbitrary LT.Text where coarbitrary = coarbitrary . LT.unpack instance Function T.Text where function = functionMap T.unpack T.pack instance Function LT.Text where function = functionMap LT.unpack LT.pack quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Text/0000755000000000000000000000000007346545000022460 5ustar0000000000000000quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Text/Short.hs0000644000000000000000000000134507346545000024116 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# 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 quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/These.hs0000644000000000000000000000474307346545000023150 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.These () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck import Data.Functor.These (These1 (..)) import Data.These (These (..)) ------------------------------------------------------------------------------- -- These ------------------------------------------------------------------------------- -- | @since 0.3.23 instance Arbitrary2 These where liftArbitrary2 arbA arbB = oneof [ This <$> arbA , That <$> arbB , These <$> arbA <*> arbB ] liftShrink2 shrA _shrB (This x) = This <$> shrA x liftShrink2 _shrA shrB (That y) = That <$> shrB y liftShrink2 shrA shrB (These x y) = [This x, That y] ++ [These x' y' | (x', y') <- liftShrink2 shrA shrB (x, y)] -- | @since 0.3.23 instance (Arbitrary a) => Arbitrary1 (These a) where liftArbitrary = liftArbitrary2 arbitrary liftShrink = liftShrink2 shrink -- | @since 0.3.23 instance (Arbitrary a, Arbitrary b) => Arbitrary (These a b) where arbitrary = arbitrary1 shrink = shrink1 -- | @since 0.3.23 instance (Function a, Function b) => Function (These a b) where function = functionMap g f where g (This a) = Left a g (That b) = Right (Left b) g (These a b) = Right (Right (a, b)) f (Left a) = This a f (Right (Left b)) = That b f (Right (Right (a, b))) = These a b -- | @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 , That1 <$> liftArbitrary arb , These1 <$> liftArbitrary arb <*> liftArbitrary arb ] liftShrink shr (This1 x) = This1 <$> liftShrink shr x liftShrink shr (That1 y) = That1 <$> liftShrink shr y liftShrink shr (These1 x y) = [ This1 x, That1 y ] ++ [ These1 x' y' | (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 quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Time.hs0000644000000000000000000002044207346545000022770 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Time () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Test.QuickCheck import qualified Data.Time.Calendar.Compat as Time import qualified Data.Time.Calendar.Month.Compat as Time import qualified Data.Time.Calendar.Quarter.Compat as Time import qualified Data.Time.Clock.Compat as Time import qualified Data.Time.Clock.System.Compat as Time import qualified Data.Time.Clock.TAI.Compat as Time import qualified Data.Time.LocalTime.Compat as Time ------------------------------------------------------------------------------- -- 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 Function Time.Day where function = functionMap Time.toModifiedJulianDay Time.ModifiedJulianDay 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 Function Time.DiffTime where function = functionMap toRational fromRational 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 Function Time.UTCTime where function = functionMap (\(Time.UTCTime day dt) -> (day,dt)) (uncurry Time.UTCTime) instance Arbitrary Time.NominalDiffTime where arbitrary = arbitrarySizedFractional shrink = shrinkRealFrac instance CoArbitrary Time.NominalDiffTime where coarbitrary = coarbitraryReal instance Function Time.NominalDiffTime where function = functionMap toRational fromRational 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 sec) = [ tod { Time.todHour = h' } | h' <- shrink hour ] ++ [ tod { Time.todMin = m' } | m' <- shrink minute ] ++ [ tod { Time.todSec = s' } | s' <- shrink sec ] instance CoArbitrary Time.TimeOfDay where coarbitrary (Time.TimeOfDay hour minute sec) = coarbitrary hour . coarbitrary minute . coarbitrary sec 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 instance Arbitrary Time.DayOfWeek where arbitrary = elements [Time.Monday .. Time.Sunday] instance CoArbitrary Time.DayOfWeek where coarbitrary = coarbitrary . fromEnum instance Function Time.DayOfWeek where function = functionMap fromEnum toEnum instance Arbitrary Time.SystemTime where arbitrary = Time.MkSystemTime <$> arbitrary <*> nano where -- generate 0 often. nano = frequency [ (1, pure 0) , (15, choose (0, 999999999)) ] shrink (Time.MkSystemTime s n) = map (uncurry Time.MkSystemTime) (shrink (s, n)) instance CoArbitrary Time.SystemTime where coarbitrary (Time.MkSystemTime s n) = coarbitrary (s, n) instance Function Time.SystemTime where function = functionMap (\(Time.MkSystemTime s n) -> (s, n)) (uncurry Time.MkSystemTime) instance Arbitrary Time.CalendarDiffDays where arbitrary = Time.CalendarDiffDays <$> arbitrary <*> arbitrary shrink (Time.CalendarDiffDays m d) = map (uncurry Time.CalendarDiffDays) (shrink (m, d)) instance CoArbitrary Time.CalendarDiffDays where coarbitrary (Time.CalendarDiffDays m d) = coarbitrary (m, d) instance Function Time.CalendarDiffDays where function = functionMap (\(Time.CalendarDiffDays m d) -> (m, d)) (uncurry Time.CalendarDiffDays) instance Arbitrary Time.CalendarDiffTime where arbitrary = Time.CalendarDiffTime <$> arbitrary <*> arbitrary shrink (Time.CalendarDiffTime m d) = map (uncurry Time.CalendarDiffTime) (shrink (m, d)) instance CoArbitrary Time.CalendarDiffTime where coarbitrary (Time.CalendarDiffTime m nt) = coarbitrary (m, nt) instance Function Time.CalendarDiffTime where function = functionMap (\(Time.CalendarDiffTime m nt) -> (m, nt)) (uncurry Time.CalendarDiffTime) instance Arbitrary Time.Month where arbitrary = do y <- arbitrary m <- chooseInt (1,12) return (Time.fromYearMonth (y + 2000) m) shrink mm = case Time.toYearMonth mm of (y, m) -> do (y', m') <- shrink (y - 2000, m) return (Time.fromYearMonth (y' + 2000) m') instance CoArbitrary Time.Month where coarbitrary (Time.MkMonth m) = coarbitrary m instance Function Time.Month where function = functionMap (\(Time.MkMonth m) -> m) Time.MkMonth instance Arbitrary Time.QuarterOfYear where arbitrary = elements [ Time.Q1 .. Time.Q4 ] instance CoArbitrary Time.QuarterOfYear where coarbitrary = coarbitrary . fromEnum instance Function Time.QuarterOfYear where function = functionBoundedEnum instance Arbitrary Time.Quarter where arbitrary = do y <- arbitrary q <- arbitrary return (Time.fromYearQuarter (y + 2000) q) shrink qq = case Time.toYearQuarter qq of (y, q) -> do (y', q') <- shrink (y - 2000, q) return (Time.fromYearQuarter (y' + 2000) q') instance CoArbitrary Time.Quarter where coarbitrary (Time.MkQuarter x) = coarbitrary x instance Function Time.Quarter where function = functionMap (\(Time.MkQuarter x) -> x) Time.MkQuarter quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Transformer.hs0000644000000000000000000000453107346545000024375 0ustar0000000000000000{-# 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 (..)) import Test.QuickCheck ------------------------------------------------------------------------------- -- transformers ------------------------------------------------------------------------------- -- TODO: CoArbitrary and Function, needs Coarbitrary1 and Function1 instance (Arbitrary1 m) => Arbitrary1 (MaybeT m) where liftArbitrary = fmap MaybeT . liftArbitrary . liftArbitrary liftShrink shr (MaybeT m) = map MaybeT (liftShrink (liftShrink shr) m) instance (Arbitrary1 m, Arbitrary a) => Arbitrary (MaybeT m a) where arbitrary = arbitrary1 shrink = shrink1 instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (Sum f g) where liftArbitrary arb = oneof [fmap InL (liftArbitrary arb), fmap InR (liftArbitrary arb)] liftShrink shr (InL f) = map InL (liftShrink shr f) 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 quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/UUID.hs0000644000000000000000000000203007346545000022631 0ustar0000000000000000{-# 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 (Word64) import Test.QuickCheck import Test.QuickCheck.Gen (chooseUpTo) import qualified Data.UUID.Types as UUID ------------------------------------------------------------------------------- -- uuid ------------------------------------------------------------------------------- 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 = 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.toWords64 uuidFromWords64 quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/UnorderedContainers.hs0000644000000000000000000000315107346545000026045 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.UnorderedContainers () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude import Data.Hashable (Hashable) import Test.QuickCheck import qualified Data.HashMap.Lazy as HML import qualified Data.HashSet as HS ------------------------------------------------------------------------------- -- unordered-containers ------------------------------------------------------------------------------- instance (Hashable a, Eq a, Arbitrary a) => Arbitrary (HS.HashSet a) where arbitrary = HS.fromList <$> arbitrary shrink hashset = HS.fromList <$> shrink (HS.toList hashset) instance CoArbitrary a => CoArbitrary (HS.HashSet a) where coarbitrary = coarbitrary . HS.toList instance (Hashable a, Eq a, Function a) => Function (HS.HashSet a) where function = functionMap HS.toList HS.fromList instance (Hashable k, Eq k, Arbitrary k) => Arbitrary1 (HML.HashMap k) where liftArbitrary arb = HML.fromList <$> liftArbitrary (liftArbitrary2 arbitrary arb) liftShrink shr m = HML.fromList <$> liftShrink (liftShrink2 shrink shr) (HML.toList m) instance (Hashable k, Eq k, Arbitrary k, Arbitrary v) => Arbitrary (HML.HashMap k v) where arbitrary = arbitrary1 shrink = shrink1 instance (CoArbitrary k, CoArbitrary v) => CoArbitrary (HML.HashMap k v) where coarbitrary = coarbitrary . HML.toList instance (Hashable k, Eq k, Function k, Function v) => Function (HML.HashMap k v) where function = functionMap HML.toList HML.fromList quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Vector.hs0000644000000000000000000000455107346545000023337 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Vector () where import Prelude () import Test.QuickCheck.Instances.CustomPrelude 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 ------------------------------------------------------------------------------- -- vector ------------------------------------------------------------------------------- instance Arbitrary1 Vector.Vector where liftArbitrary = fmap Vector.fromList . liftArbitrary liftShrink shr = fmap Vector.fromList . liftShrink shr . Vector.toList instance Arbitrary a => Arbitrary (Vector.Vector a) where arbitrary = arbitrary1 shrink = shrink1 instance CoArbitrary a => CoArbitrary (Vector.Vector a) where coarbitrary = coarbitraryVector instance Function a => Function (Vector.Vector a) where function = functionVector instance (SVector.Storable a, Arbitrary a) => Arbitrary (SVector.Vector a) where arbitrary = arbitraryVector shrink = shrinkVector instance (SVector.Storable a, CoArbitrary a) => CoArbitrary (SVector.Vector a) where coarbitrary = coarbitraryVector instance (SVector.Storable a, Function a) => Function (SVector.Vector a) where function = functionVector instance (UVector.Unbox a, Arbitrary a) => Arbitrary (UVector.Vector a) where arbitrary = arbitraryVector shrink = shrinkVector instance (UVector.Unbox a, CoArbitrary a) => CoArbitrary (UVector.Vector a) where coarbitrary = coarbitraryVector instance (UVector.Unbox a, Function a) => Function (UVector.Vector a) where function = functionVector arbitraryVector :: (GVector.Vector v a, Arbitrary a) => Gen (v a) arbitraryVector = GVector.fromList `fmap` arbitrary shrinkVector :: (GVector.Vector v a, Arbitrary a) => v a -> [v a] shrinkVector = fmap GVector.fromList . shrink . GVector.toList coarbitraryVector :: (GVector.Vector v a, CoArbitrary a) => v a -> Gen b -> Gen b coarbitraryVector = coarbitrary . GVector.toList functionVector :: (GVector.Vector v a, Function a) => (v a -> c) -> v a :-> c functionVector = functionMap GVector.toList GVector.fromList quickcheck-instances-0.3.30/src/Test/QuickCheck/Instances/Void.hs0000644000000000000000000000074007346545000022772 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} module Test.QuickCheck.Instances.Void where import Test.QuickCheck import Data.Void (Void, absurd) ------------------------------------------------------------------------------- -- void ------------------------------------------------------------------------------- instance CoArbitrary Void where coarbitrary = absurd -- | All @'Void' -> a@ functions are 'absurd'. instance Function Void where function _ = functionVoid absurd quickcheck-instances-0.3.30/test/0000755000000000000000000000000007346545000015044 5ustar0000000000000000quickcheck-instances-0.3.30/test/Tests.hs0000644000000000000000000000147607346545000016512 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main (main) where import Data.Proxy (Proxy (..)) import Test.QuickCheck import Test.QuickCheck.Instances () import qualified Data.Tree as Tree import qualified Data.Primitive as Prim import Data.UUID.Types (UUID) #if MIN_VERSION_base(4,9,0) import qualified Data.Array.Byte as AB #endif -- | Example law: == (and thus ===) should be reflexive. eqReflexive :: (Eq a, Show a) => Proxy a -> a -> Property eqReflexive _ x = x === x main :: IO () main = do quickCheck $ eqReflexive (Proxy :: Proxy Int) quickCheck $ eqReflexive (Proxy :: Proxy (Tree.Tree Int)) quickCheck $ eqReflexive (Proxy :: Proxy UUID) quickCheck $ eqReflexive (Proxy :: Proxy Prim.ByteArray) #if MIN_VERSION_base(4,9,0) quickCheck $ eqReflexive (Proxy :: Proxy AB.ByteArray) #endif