-- | Type classes for random generation of values.{-# LANGUAGE CPP #-}{-# LANGUAGE FlexibleContexts #-}#ifndef NO_GENERICS{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeOperators #-}{-# LANGUAGE FlexibleInstances, KindSignatures, ScopedTypeVariables #-}{-# LANGUAGE MultiParamTypeClasses #-}#if __GLASGOW_HASKELL__ >= 710#define OVERLAPPING_ {-# OVERLAPPING #-}#else{-# LANGUAGE OverlappingInstances #-}#define OVERLAPPING_#endif#endif#ifndef NO_POLYKINDS{-# LANGUAGE PolyKinds #-}#endif#ifndef NO_SAFE_HASKELL{-# LANGUAGE Safe #-}#endifmoduleTest.QuickCheck.Arbitrary(-- * Arbitrary and CoArbitrary classesArbitrary(..),CoArbitrary(..)-- ** Unary and Binary classes,Arbitrary1(..),arbitrary1,shrink1,Arbitrary2(..),arbitrary2,shrink2-- ** Helper functions for implementing arbitrary,arbitrarySizedIntegral-- :: Integral a => Gen a,arbitrarySizedNatural-- :: Integral a => Gen a,arbitraryBoundedIntegral-- :: (Bounded a, Integral a) => Gen a,arbitrarySizedBoundedIntegral-- :: (Bounded a, Integral a) => Gen a,arbitrarySizedFractional-- :: Fractional a => Gen a,arbitraryBoundedRandom-- :: (Bounded a, Random a) => Gen a,arbitraryBoundedEnum-- :: (Bounded a, Enum a) => Gen a-- ** Generators for various kinds of character,arbitraryUnicodeChar-- :: Gen Char,arbitraryASCIIChar-- :: Gen Char,arbitraryPrintableChar-- :: Gen Char-- ** Helper functions for implementing shrink#ifndef NO_GENERICS,genericShrink-- :: (Generic a, Arbitrary a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) => a -> [a],subterms-- :: (Generic a, Arbitrary a, GSubterms (Rep a) a) => a -> [a],recursivelyShrink-- :: (Generic a, RecursivelyShrink (Rep a)) => a -> [a],genericCoarbitrary-- :: (Generic a, GCoArbitrary (Rep a)) => a -> Gen b -> Gen b#endif,shrinkNothing-- :: a -> [a],shrinkList-- :: (a -> [a]) -> [a] -> [[a]],shrinkMap-- :: Arbitrary a -> (a -> b) -> (b -> a) -> b -> [b],shrinkMapBy-- :: (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b],shrinkIntegral-- :: Integral a => a -> [a],shrinkRealFrac-- :: RealFrac a => a -> [a]-- ** Helper functions for implementing coarbitrary,coarbitraryIntegral-- :: Integral a => a -> Gen b -> Gen b,coarbitraryReal-- :: Real a => a -> Gen b -> Gen b,coarbitraryShow-- :: Show a => a -> Gen b -> Gen b,coarbitraryEnum-- :: Enum a => a -> Gen b -> Gen b,(><)-- ** Generators which use arbitrary,vector-- :: Arbitrary a => Int -> Gen [a],orderedList-- :: (Ord a, Arbitrary a) => Gen [a],infiniteList-- :: Arbitrary a => Gen [a])where---------------------------------------------------------------------------- importsimportControl.ApplicativeimportData.Foldable(toList)importSystem.Random(Random)importTest.QuickCheck.GenimportTest.QuickCheck.RandomimportTest.QuickCheck.Gen.Unsafe{-
import Data.Generics
( (:*:)(..)
, (:+:)(..)
, Unit(..)
)
-}importData.Char(ord,isLower,isUpper,toLower,isDigit,isSpace,isPrint,generalCategory,GeneralCategory(..))#ifndef NO_FIXEDimportData.Fixed(Fixed,HasResolution)#endifimportData.Ratio(Ratio,(%),numerator,denominator)importData.Complex(Complex((:+)))importData.List(sort,nub)importData.Version(Version(..))importControl.Monad(liftM,liftM2,liftM3,liftM4,liftM5)importData.Int(Int8,Int16,Int32,Int64)importData.Word(Word,Word8,Word16,Word32,Word64)importSystem.Exit(ExitCode(..))#ifndef NO_CTYPESimportForeign.C.Types#endif#ifndef NO_GENERICSimportGHC.Generics#endifimportqualifiedData.SetasSetimportqualifiedData.MapasMapimportqualifiedData.IntSetasIntSetimportqualifiedData.IntMapasIntMapimportqualifiedData.SequenceasSequenceimportqualifiedData.MonoidasMonoid#ifndef NO_TRANSFORMERSimportData.Functor.IdentityimportData.Functor.ConstantimportData.Functor.ComposeimportData.Functor.Product#endif---------------------------------------------------------------------------- ** class Arbitrary-- | Random generation and shrinking of values.---- QuickCheck provides @Arbitrary@ instances for most types in @base@,-- except those which incur extra dependencies.-- For a wider range of @Arbitrary@ instances see the-- <http://hackage.haskell.org/package/quickcheck-instances quickcheck-instances>-- package.classArbitraryawhere-- | A generator for values of the given type.---- It is worth spending time thinking about what sort of test data-- you want - good generators are often the difference between-- finding bugs and not finding them. You can use 'sample',-- 'label' and 'classify' to check the quality of your test data.---- There is no generic @arbitrary@ implementation included because we don't-- know how to make a high-quality one. If you want one, consider using the-- <http://hackage.haskell.org/package/testing-feat testing-feat> package.---- The <http://www.cse.chalmers.se/~rjmh/QuickCheck/manual.html QuickCheck manual>-- goes into detail on how to write good generators. Make sure to look at it,-- especially if your type is recursive!arbitrary::Gena-- | Produces a (possibly) empty list of all the possible-- immediate shrinks of the given value.---- The default implementation returns the empty list, so will not try to-- shrink the value. If your data type has no special invariants, you can-- enable shrinking by defining @shrink = 'genericShrink'@, but by customising-- the behaviour of @shrink@ you can often get simpler counterexamples.---- Most implementations of 'shrink' should try at least three things:---- 1. Shrink a term to any of its immediate subterms.-- You can use 'subterms' to do this.---- 2. Recursively apply 'shrink' to all immediate subterms.-- You can use 'recursivelyShrink' to do this.---- 3. Type-specific shrinkings such as replacing a constructor by a-- simpler constructor.---- For example, suppose we have the following implementation of binary trees:---- > data Tree a = Nil | Branch a (Tree a) (Tree a)---- We can then define 'shrink' as follows:---- > shrink Nil = []-- > shrink (Branch x l r) =-- > -- shrink Branch to Nil-- > [Nil] ++-- > -- shrink to subterms-- > [l, r] ++-- > -- recursively shrink subterms-- > [Branch x' l' r' | (x', l', r') <- shrink (x, l, r)]---- There are a couple of subtleties here:---- * QuickCheck tries the shrinking candidates in the order they-- appear in the list, so we put more aggressive shrinking steps-- (such as replacing the whole tree by @Nil@) before smaller-- ones (such as recursively shrinking the subtrees).---- * It is tempting to write the last line as-- @[Branch x' l' r' | x' <- shrink x, l' <- shrink l, r' <- shrink r]@-- but this is the /wrong thing/! It will force QuickCheck to shrink-- @x@, @l@ and @r@ in tandem, and shrinking will stop once /one/ of-- the three is fully shrunk.---- There is a fair bit of boilerplate in the code above.-- We can avoid it with the help of some generic functions.-- The function 'genericShrink' tries shrinking a term to all of its-- subterms and, failing that, recursively shrinks the subterms.-- Using it, we can define 'shrink' as:---- > shrink x = shrinkToNil x ++ genericShrink x-- > where-- > shrinkToNil Nil = []-- > shrinkToNil (Branch _ l r) = [Nil]---- 'genericShrink' is a combination of 'subterms', which shrinks-- a term to any of its subterms, and 'recursivelyShrink', which shrinks-- all subterms of a term. These may be useful if you need a bit more-- control over shrinking than 'genericShrink' gives you.---- A final gotcha: we cannot define 'shrink' as simply @'shrink' x = Nil:'genericShrink' x@-- as this shrinks @Nil@ to @Nil@, and shrinking will go into an-- infinite loop.---- If all this leaves you bewildered, you might try @'shrink' = 'genericShrink'@ to begin with,-- after deriving @Generic@ for your type. However, if your data type has any-- special invariants, you will need to check that 'genericShrink' can't break those invariants.shrink::a->[a]shrink_=[]-- | Lifting of the 'Arbitrary' class to unary type constructors.classArbitrary1fwhereliftArbitrary::Gena->Gen(fa)liftShrink::(a->[a])->fa->[fa]liftShrink__=[]arbitrary1::(Arbitrary1f,Arbitrarya)=>Gen(fa)arbitrary1=liftArbitraryarbitraryshrink1::(Arbitrary1f,Arbitrarya)=>fa->[fa]shrink1=liftShrinkshrink-- | Lifting of the 'Arbitrary' class to binary type constructors.classArbitrary2fwhereliftArbitrary2::Gena->Genb->Gen(fab)liftShrink2::(a->[a])->(b->[b])->fab->[fab]liftShrink2___=[]arbitrary2::(Arbitrary2f,Arbitrarya,Arbitraryb)=>Gen(fab)arbitrary2=liftArbitrary2arbitraryarbitraryshrink2::(Arbitrary2f,Arbitrarya,Arbitraryb)=>fab->[fab]shrink2=liftShrink2shrinkshrink#ifndef NO_GENERICS-- | Shrink a term to any of its immediate subterms,-- and also recursively shrink all subterms.genericShrink::(Generica,RecursivelyShrink(Repa),GSubterms(Repa)a)=>a->[a]genericShrinkx=subtermsx++recursivelyShrinkx-- | Recursively shrink all immediate subterms.recursivelyShrink::(Generica,RecursivelyShrink(Repa))=>a->[a]recursivelyShrink=mapto.grecursivelyShrink.fromclassRecursivelyShrinkfwheregrecursivelyShrink::fa->[fa]instance(RecursivelyShrinkf,RecursivelyShrinkg)=>RecursivelyShrink(f:*:g)wheregrecursivelyShrink(x:*:y)=[x':*:y|x'<-grecursivelyShrinkx]++[x:*:y'|y'<-grecursivelyShrinky]instance(RecursivelyShrinkf,RecursivelyShrinkg)=>RecursivelyShrink(f:+:g)wheregrecursivelyShrink(L1x)=mapL1(grecursivelyShrinkx)grecursivelyShrink(R1x)=mapR1(grecursivelyShrinkx)instanceRecursivelyShrinkf=>RecursivelyShrink(M1icf)wheregrecursivelyShrink(M1x)=mapM1(grecursivelyShrinkx)instanceArbitrarya=>RecursivelyShrink(K1ia)wheregrecursivelyShrink(K1x)=mapK1(shrinkx)instanceRecursivelyShrinkU1wheregrecursivelyShrinkU1=[]instanceRecursivelyShrinkV1where-- The empty type can't be shrunk to anything.grecursivelyShrink_=[]-- | All immediate subterms of a term.subterms::(Generica,GSubterms(Repa)a)=>a->[a]subterms=gSubterms.fromclassGSubtermsfawhere-- | Provides the immediate subterms of a term that are of the same type-- as the term itself.---- Requires a constructor to be stripped off; this means it skips through-- @M1@ wrappers and returns @[]@ on everything that's not `(:*:)` or `(:+:)`.---- Once a `(:*:)` or `(:+:)` constructor has been reached, this function-- delegates to `gSubtermsIncl` to return the immediately next constructor-- available.gSubterms::fa->[a]instanceGSubtermsV1awhere-- The empty type can't be shrunk to anything.gSubterms_=[]instanceGSubtermsU1awheregSubtermsU1=[]instance(GSubtermsInclfa,GSubtermsInclga)=>GSubterms(f:*:g)awheregSubterms(l:*:r)=gSubtermsIncll++gSubtermsInclrinstance(GSubtermsInclfa,GSubtermsInclga)=>GSubterms(f:+:g)awheregSubterms(L1x)=gSubtermsInclxgSubterms(R1x)=gSubtermsInclxinstanceGSubtermsfa=>GSubterms(M1icf)awheregSubterms(M1x)=gSubtermsxinstanceGSubterms(K1ia)bwheregSubterms(K1_)=[]classGSubtermsInclfawhere-- | Provides the immediate subterms of a term that are of the same type-- as the term itself.---- In contrast to `gSubterms`, this returns the immediate next constructor-- available.gSubtermsIncl::fa->[a]instanceGSubtermsInclV1awhere-- The empty type can't be shrunk to anything.gSubtermsIncl_=[]instanceGSubtermsInclU1awheregSubtermsInclU1=[]instance(GSubtermsInclfa,GSubtermsInclga)=>GSubtermsIncl(f:*:g)awheregSubtermsIncl(l:*:r)=gSubtermsIncll++gSubtermsInclrinstance(GSubtermsInclfa,GSubtermsInclga)=>GSubtermsIncl(f:+:g)awheregSubtermsIncl(L1x)=gSubtermsInclxgSubtermsIncl(R1x)=gSubtermsInclxinstanceGSubtermsInclfa=>GSubtermsIncl(M1icf)awheregSubtermsIncl(M1x)=gSubtermsInclx-- This is the important case: We've found a term of the same type.instanceOVERLAPPING_GSubtermsIncl(K1ia)awheregSubtermsIncl(K1x)=[x]instanceOVERLAPPING_GSubtermsIncl(K1ia)bwheregSubtermsIncl(K1_)=[]#endif-- instancesinstance(CoArbitrarya)=>Arbitrary1((->)a)whereliftArbitraryarbB=promote(`coarbitrary`arbB)instance(CoArbitrarya,Arbitraryb)=>Arbitrary(a->b)wherearbitrary=arbitrary1instanceArbitrary()wherearbitrary=return()instanceArbitraryBoolwherearbitrary=choose(False,True)shrinkTrue=[False]shrinkFalse=[]instanceArbitraryOrderingwherearbitrary=elements[LT,EQ,GT]shrinkGT=[EQ,LT]shrinkLT=[EQ]shrinkEQ=[]instanceArbitrary1MaybewhereliftArbitraryarb=frequency[(1,returnNothing),(3,liftMJustarb)]liftShrinkshr(Justx)=Nothing:[Justx'|x'<-shrx]liftShrink_Nothing=[]instanceArbitrarya=>Arbitrary(Maybea)wherearbitrary=arbitrary1shrink=shrink1instanceArbitrary2EitherwhereliftArbitrary2arbAarbB=oneof[liftMLeftarbA,liftMRightarbB]liftShrink2shrA_(Leftx)=[Leftx'|x'<-shrAx]liftShrink2_shrB(Righty)=[Righty'|y'<-shrBy]instanceArbitrarya=>Arbitrary1(Eithera)whereliftArbitrary=liftArbitrary2arbitraryliftShrink=liftShrink2shrinkinstance(Arbitrarya,Arbitraryb)=>Arbitrary(Eitherab)wherearbitrary=arbitrary2shrink=shrink2instanceArbitrary1[]whereliftArbitrary=listOfliftShrink=shrinkListinstanceArbitrarya=>Arbitrary[a]wherearbitrary=arbitrary1shrink=shrink1-- | Shrink a list of values given a shrinking function for individual values.shrinkList::(a->[a])->[a]->[[a]]shrinkListshrxs=concat[removesknxs|k<-takeWhile(>0)(iterate(`div`2)n)]++shrinkOnexswheren=lengthxsshrinkOne[]=[]shrinkOne(x:xs)=[x':xs|x'<-shrx]++[x:xs'|xs'<-shrinkOnexs]removesknxs|k>n=[]|nullxs2=[[]]|otherwise=xs2:map(xs1++)(removesk(n-k)xs2)wherexs1=takekxsxs2=dropkxs{-
-- "standard" definition for lists:
shrink [] = []
shrink (x:xs) = [ xs ]
++ [ x:xs' | xs' <- shrink xs ]
++ [ x':xs | x' <- shrink x ]
-}instanceIntegrala=>Arbitrary(Ratioa)wherearbitrary=arbitrarySizedFractionalshrink=shrinkRealFracinstance(RealFloata,Arbitrarya)=>Arbitrary(Complexa)wherearbitrary=liftM2(:+)arbitraryarbitraryshrink(x:+y)=[x':+y|x'<-shrinkx]++[x:+y'|y'<-shrinky]#ifndef NO_FIXEDinstanceHasResolutiona=>Arbitrary(Fixeda)wherearbitrary=arbitrarySizedFractionalshrink=shrinkRealFrac#endifinstanceArbitrary2(,)whereliftArbitrary2=liftM2(,)liftShrink2shrAshrB(x,y)=[(x',y)|x'<-shrAx]++[(x,y')|y'<-shrBy]instance(Arbitrarya)=>Arbitrary1((,)a)whereliftArbitrary=liftArbitrary2arbitraryliftShrink=liftShrink2shrinkinstance(Arbitrarya,Arbitraryb)=>Arbitrary(a,b)wherearbitrary=arbitrary2shrink=shrink2instance(Arbitrarya,Arbitraryb,Arbitraryc)=>Arbitrary(a,b,c)wherearbitrary=liftM3(,,)arbitraryarbitraryarbitraryshrink(x,y,z)=[(x',y',z')|(x',(y',z'))<-shrink(x,(y,z))]instance(Arbitrarya,Arbitraryb,Arbitraryc,Arbitraryd)=>Arbitrary(a,b,c,d)wherearbitrary=liftM4(,,,)arbitraryarbitraryarbitraryarbitraryshrink(w,x,y,z)=[(w',x',y',z')|(w',(x',(y',z')))<-shrink(w,(x,(y,z)))]instance(Arbitrarya,Arbitraryb,Arbitraryc,Arbitraryd,Arbitrarye)=>Arbitrary(a,b,c,d,e)wherearbitrary=liftM5(,,,,)arbitraryarbitraryarbitraryarbitraryarbitraryshrink(v,w,x,y,z)=[(v',w',x',y',z')|(v',(w',(x',(y',z'))))<-shrink(v,(w,(x,(y,z))))]instance(Arbitrarya,Arbitraryb,Arbitraryc,Arbitraryd,Arbitrarye,Arbitraryf)=>Arbitrary(a,b,c,d,e,f)wherearbitrary=return(,,,,,)<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitraryshrink(u,v,w,x,y,z)=[(u',v',w',x',y',z')|(u',(v',(w',(x',(y',z')))))<-shrink(u,(v,(w,(x,(y,z)))))]instance(Arbitrarya,Arbitraryb,Arbitraryc,Arbitraryd,Arbitrarye,Arbitraryf,Arbitraryg)=>Arbitrary(a,b,c,d,e,f,g)wherearbitrary=return(,,,,,,)<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitraryshrink(t,u,v,w,x,y,z)=[(t',u',v',w',x',y',z')|(t',(u',(v',(w',(x',(y',z'))))))<-shrink(t,(u,(v,(w,(x,(y,z))))))]instance(Arbitrarya,Arbitraryb,Arbitraryc,Arbitraryd,Arbitrarye,Arbitraryf,Arbitraryg,Arbitraryh)=>Arbitrary(a,b,c,d,e,f,g,h)wherearbitrary=return(,,,,,,,)<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitraryshrink(s,t,u,v,w,x,y,z)=[(s',t',u',v',w',x',y',z')|(s',(t',(u',(v',(w',(x',(y',z')))))))<-shrink(s,(t,(u,(v,(w,(x,(y,z)))))))]instance(Arbitrarya,Arbitraryb,Arbitraryc,Arbitraryd,Arbitrarye,Arbitraryf,Arbitraryg,Arbitraryh,Arbitraryi)=>Arbitrary(a,b,c,d,e,f,g,h,i)wherearbitrary=return(,,,,,,,,)<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitraryshrink(r,s,t,u,v,w,x,y,z)=[(r',s',t',u',v',w',x',y',z')|(r',(s',(t',(u',(v',(w',(x',(y',z'))))))))<-shrink(r,(s,(t,(u,(v,(w,(x,(y,z))))))))]instance(Arbitrarya,Arbitraryb,Arbitraryc,Arbitraryd,Arbitrarye,Arbitraryf,Arbitraryg,Arbitraryh,Arbitraryi,Arbitraryj)=>Arbitrary(a,b,c,d,e,f,g,h,i,j)wherearbitrary=return(,,,,,,,,,)<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitrary<*>arbitraryshrink(q,r,s,t,u,v,w,x,y,z)=[(q',r',s',t',u',v',w',x',y',z')|(q',(r',(s',(t',(u',(v',(w',(x',(y',z')))))))))<-shrink(q,(r,(s,(t,(u,(v,(w,(x,(y,z)))))))))]-- typical instance for primitive (numerical) typesinstanceArbitraryIntegerwherearbitrary=arbitrarySizedIntegralshrink=shrinkIntegralinstanceArbitraryIntwherearbitrary=arbitrarySizedIntegralshrink=shrinkIntegralinstanceArbitraryInt8wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryInt16wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryInt32wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryInt64wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryWordwherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryWord8wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryWord16wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryWord32wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryWord64wherearbitrary=arbitrarySizedBoundedIntegralshrink=shrinkIntegralinstanceArbitraryCharwherearbitrary=frequency[(3,arbitraryASCIIChar),(1,arbitraryUnicodeChar)]shrinkc=filter(<.c)$nub$['a','b','c']++[toLowerc|isUpperc]++['A','B','C']++['1','2','3']++[' ','\n']wherea<.b=stampa<stampbstampa=((not(isLowera),not(isUppera),not(isDigita)),(not(a==' '),not(isSpacea),a))instanceArbitraryFloatwherearbitrary=arbitrarySizedFractionalshrink=shrinkRealFracinstanceArbitraryDoublewherearbitrary=arbitrarySizedFractionalshrink=shrinkRealFrac#ifndef NO_CTYPESinstanceArbitraryCCharwherearbitrary=CChar<$>arbitraryshrink(CCharx)=CChar<$>shrinkxinstanceArbitraryCSCharwherearbitrary=CSChar<$>arbitraryshrink(CSCharx)=CSChar<$>shrinkxinstanceArbitraryCUCharwherearbitrary=CUChar<$>arbitraryshrink(CUCharx)=CUChar<$>shrinkxinstanceArbitraryCShortwherearbitrary=CShort<$>arbitraryshrink(CShortx)=CShort<$>shrinkxinstanceArbitraryCUShortwherearbitrary=CUShort<$>arbitraryshrink(CUShortx)=CUShort<$>shrinkxinstanceArbitraryCIntwherearbitrary=CInt<$>arbitraryshrink(CIntx)=CInt<$>shrinkxinstanceArbitraryCUIntwherearbitrary=CUInt<$>arbitraryshrink(CUIntx)=CUInt<$>shrinkxinstanceArbitraryCLongwherearbitrary=CLong<$>arbitraryshrink(CLongx)=CLong<$>shrinkxinstanceArbitraryCULongwherearbitrary=CULong<$>arbitraryshrink(CULongx)=CULong<$>shrinkxinstanceArbitraryCPtrdiffwherearbitrary=CPtrdiff<$>arbitraryshrink(CPtrdiffx)=CPtrdiff<$>shrinkxinstanceArbitraryCSizewherearbitrary=CSize<$>arbitraryshrink(CSizex)=CSize<$>shrinkxinstanceArbitraryCWcharwherearbitrary=CWchar<$>arbitraryshrink(CWcharx)=CWchar<$>shrinkxinstanceArbitraryCSigAtomicwherearbitrary=CSigAtomic<$>arbitraryshrink(CSigAtomicx)=CSigAtomic<$>shrinkxinstanceArbitraryCLLongwherearbitrary=CLLong<$>arbitraryshrink(CLLongx)=CLLong<$>shrinkxinstanceArbitraryCULLongwherearbitrary=CULLong<$>arbitraryshrink(CULLongx)=CULLong<$>shrinkxinstanceArbitraryCIntPtrwherearbitrary=CIntPtr<$>arbitraryshrink(CIntPtrx)=CIntPtr<$>shrinkxinstanceArbitraryCUIntPtrwherearbitrary=CUIntPtr<$>arbitraryshrink(CUIntPtrx)=CUIntPtr<$>shrinkxinstanceArbitraryCIntMaxwherearbitrary=CIntMax<$>arbitraryshrink(CIntMaxx)=CIntMax<$>shrinkxinstanceArbitraryCUIntMaxwherearbitrary=CUIntMax<$>arbitraryshrink(CUIntMaxx)=CUIntMax<$>shrinkxinstanceArbitraryCClockwherearbitrary=CClock<$>arbitraryshrink(CClockx)=CClock<$>shrinkxinstanceArbitraryCTimewherearbitrary=CTime<$>arbitraryshrink(CTimex)=CTime<$>shrinkxinstanceArbitraryCUSecondswherearbitrary=CUSeconds<$>arbitraryshrink(CUSecondsx)=CUSeconds<$>shrinkxinstanceArbitraryCSUSecondswherearbitrary=CSUSeconds<$>arbitraryshrink(CSUSecondsx)=CSUSeconds<$>shrinkxinstanceArbitraryCFloatwherearbitrary=CFloat<$>arbitraryshrink(CFloatx)=CFloat<$>shrinkxinstanceArbitraryCDoublewherearbitrary=CDouble<$>arbitraryshrink(CDoublex)=CDouble<$>shrinkx#endif-- Arbitrary instances for container typesinstance(Orda,Arbitrarya)=>Arbitrary(Set.Seta)wherearbitrary=fmapSet.fromListarbitraryshrink=mapSet.fromList.shrink.Set.toListinstance(Ordk,Arbitraryk)=>Arbitrary1(Map.Mapk)whereliftArbitrary=fmapMap.fromList.liftArbitrary.liftArbitraryliftShrinkshr=mapMap.fromList.liftShrink(liftShrinkshr).Map.toListinstance(Ordk,Arbitraryk,Arbitraryv)=>Arbitrary(Map.Mapkv)wherearbitrary=arbitrary1shrink=shrink1instanceArbitraryIntSet.IntSetwherearbitrary=fmapIntSet.fromListarbitraryshrink=mapIntSet.fromList.shrink.IntSet.toListinstanceArbitrary1IntMap.IntMapwhereliftArbitrary=fmapIntMap.fromList.liftArbitrary.liftArbitraryliftShrinkshr=mapIntMap.fromList.liftShrink(liftShrinkshr).IntMap.toListinstanceArbitrarya=>Arbitrary(IntMap.IntMapa)wherearbitrary=arbitrary1shrink=shrink1instanceArbitrary1Sequence.SeqwhereliftArbitrary=fmapSequence.fromList.liftArbitraryliftShrinkshr=mapSequence.fromList.liftShrinkshr.toListinstanceArbitrarya=>Arbitrary(Sequence.Seqa)wherearbitrary=arbitrary1shrink=shrink1-- Arbitrary instance for ZiplistinstanceArbitrary1ZipListwhereliftArbitrary=fmapZipList.liftArbitraryliftShrinkshr=mapZipList.liftShrinkshr.getZipListinstanceArbitrarya=>Arbitrary(ZipLista)wherearbitrary=arbitrary1shrink=shrink1#ifndef NO_TRANSFORMERS-- Arbitrary instance for transformers' FunctorsinstanceArbitrary1IdentitywhereliftArbitrary=fmapIdentityliftShrinkshr=mapIdentity.shr.runIdentityinstanceArbitrarya=>Arbitrary(Identitya)wherearbitrary=arbitrary1shrink=shrink1instanceArbitrary2ConstantwhereliftArbitrary2arbA_=fmapConstantarbAliftShrink2shrA_=fmapConstant.shrA.getConstantinstanceArbitrarya=>Arbitrary1(Constanta)whereliftArbitrary=liftArbitrary2arbitraryliftShrink=liftShrink2shrink-- Have to be defined explicitly, as Constant is kind polymorphicinstanceArbitrarya=>Arbitrary(Constantab)wherearbitrary=fmapConstantarbitraryshrink=mapConstant.shrink.getConstantinstance(Arbitrary1f,Arbitrary1g)=>Arbitrary1(Productfg)whereliftArbitraryarb=liftM2Pair(liftArbitraryarb)(liftArbitraryarb)liftShrinkshr(Pairfg)=[Pairf'g|f'<-liftShrinkshrf]++[Pairfg'|g'<-liftShrinkshrg]instance(Arbitrary1f,Arbitrary1g,Arbitrarya)=>Arbitrary(Productfga)wherearbitrary=arbitrary1shrink=shrink1instance(Arbitrary1f,Arbitrary1g)=>Arbitrary1(Composefg)whereliftArbitrary=fmapCompose.liftArbitrary.liftArbitraryliftShrinkshr=mapCompose.liftShrink(liftShrinkshr).getComposeinstance(Arbitrary1f,Arbitrary1g,Arbitrarya)=>Arbitrary(Composefga)wherearbitrary=arbitrary1shrink=shrink1#endif-- Arbitrary instance for ConstinstanceArbitrary2ConstwhereliftArbitrary2arbA_=fmapConstarbAliftShrink2shrA_=fmapConst.shrA.getConstinstanceArbitrarya=>Arbitrary1(Consta)whereliftArbitrary=liftArbitrary2arbitraryliftShrink=liftShrink2shrink-- Have to be defined explicitly, as Const is kind polymorphicinstanceArbitrarya=>Arbitrary(Constab)wherearbitrary=fmapConstarbitraryshrink=mapConst.shrink.getConstinstanceArbitrary(ma)=>Arbitrary(WrappedMonadma)wherearbitrary=WrapMonad<$>arbitraryshrink(WrapMonada)=mapWrapMonad(shrinka)instanceArbitrary(abc)=>Arbitrary(WrappedArrowabc)wherearbitrary=WrapArrow<$>arbitraryshrink(WrapArrowa)=mapWrapArrow(shrinka)-- Arbitrary instances for MonoidinstanceArbitrarya=>Arbitrary(Monoid.Duala)wherearbitrary=fmapMonoid.Dualarbitraryshrink=mapMonoid.Dual.shrink.Monoid.getDualinstance(Arbitrarya,CoArbitrarya)=>Arbitrary(Monoid.Endoa)wherearbitrary=fmapMonoid.Endoarbitraryshrink=mapMonoid.Endo.shrink.Monoid.appEndoinstanceArbitraryMonoid.Allwherearbitrary=fmapMonoid.Allarbitraryshrink=mapMonoid.All.shrink.Monoid.getAllinstanceArbitraryMonoid.Anywherearbitrary=fmapMonoid.Anyarbitraryshrink=mapMonoid.Any.shrink.Monoid.getAnyinstanceArbitrarya=>Arbitrary(Monoid.Suma)wherearbitrary=fmapMonoid.Sumarbitraryshrink=mapMonoid.Sum.shrink.Monoid.getSuminstanceArbitrarya=>Arbitrary(Monoid.Producta)wherearbitrary=fmapMonoid.Productarbitraryshrink=mapMonoid.Product.shrink.Monoid.getProduct#if defined(MIN_VERSION_base)#if MIN_VERSION_base(3,0,0)instanceArbitrarya=>Arbitrary(Monoid.Firsta)wherearbitrary=fmapMonoid.Firstarbitraryshrink=mapMonoid.First.shrink.Monoid.getFirstinstanceArbitrarya=>Arbitrary(Monoid.Lasta)wherearbitrary=fmapMonoid.Lastarbitraryshrink=mapMonoid.Last.shrink.Monoid.getLast#endif#if MIN_VERSION_base(4,8,0)instanceArbitrary(fa)=>Arbitrary(Monoid.Altfa)wherearbitrary=fmapMonoid.Altarbitraryshrink=mapMonoid.Alt.shrink.Monoid.getAlt#endif#endif-- | Generates 'Version' with non-empty non-negative @versionBranch@, and empty @versionTags@instanceArbitraryVersionwherearbitrary=sized$\n->dok<-choose(0,log2n)xs<-vectorOf(k+1)arbitrarySizedNaturalreturn(Versionxs[])wherelog2::Int->Intlog2n|n<=1=0|otherwise=1+log2(n`div`2)shrink(Versionxs_)=[Versionxs'[]|xs'<-shrinkxs,lengthxs'>0,all(>=0)xs']instanceArbitraryQCGenwherearbitrary=MkGen(\g_->g)instanceArbitraryExitCodewherearbitrary=frequency[(1,returnExitSuccess),(3,liftMExitFailurearbitrary)]shrink(ExitFailurex)=ExitSuccess:[ExitFailurex'|x'<-shrinkx]shrink_=[]-- ** Helper functions for implementing arbitrary-- | Generates an integral number. The number can be positive or negative-- and its maximum absolute value depends on the size parameter.arbitrarySizedIntegral::Integrala=>GenaarbitrarySizedIntegral=sized$\n->inBoundsfromInteger(choose(-toIntegern,toIntegern))-- | Generates a natural number. The number's maximum value depends on-- the size parameter.arbitrarySizedNatural::Integrala=>GenaarbitrarySizedNatural=sized$\n->inBoundsfromInteger(choose(0,toIntegern))inBounds::Integrala=>(Integer->a)->GenInteger->GenainBoundsfig=fmapfi(g`suchThat`(\x->toInteger(fix)==x))-- | Generates a fractional number. The number can be positive or negative-- and its maximum absolute value depends on the size parameter.arbitrarySizedFractional::Fractionala=>GenaarbitrarySizedFractional=sized$\n->letn'=toIntegernindoa<-choose((-n')*precision,n'*precision)b<-choose(1,precision)return(fromRational(a%b))whereprecision=9999999999999::Integer-- Useful for getting at minBound and maxBound without having to-- fiddle around with asTypeOf.withBounds::Boundeda=>(a->a->Gena)->GenawithBoundsk=kminBoundmaxBound-- | Generates an integral number. The number is chosen uniformly from-- the entire range of the type. You may want to use-- 'arbitrarySizedBoundedIntegral' instead.arbitraryBoundedIntegral::(Boundeda,Integrala)=>GenaarbitraryBoundedIntegral=withBounds$\mnmx->don<-choose(toIntegermn,toIntegermx)return(fromIntegern)-- | Generates an element of a bounded type. The element is-- chosen from the entire range of the type.arbitraryBoundedRandom::(Boundeda,Randoma)=>GenaarbitraryBoundedRandom=choose(minBound,maxBound)-- | Generates an element of a bounded enumeration.arbitraryBoundedEnum::(Boundeda,Enuma)=>GenaarbitraryBoundedEnum=withBounds$\mnmx->don<-choose(fromEnummn,fromEnummx)return(toEnumn)-- | Generates an integral number from a bounded domain. The number is-- chosen from the entire range of the type, but small numbers are-- generated more often than big numbers. Inspired by demands from-- Phil Wadler.arbitrarySizedBoundedIntegral::(Boundeda,Integrala)=>GenaarbitrarySizedBoundedIntegral=withBounds$\mnmx->sized$\s->doletbitsn|n==0=0|otherwise=1+bits(n`quot`2)k=2^(s*(bitsmn`max`bitsmx`max`40)`div`80)n<-choose(toIntegermn`max`(-k),toIntegermx`min`k)return(fromIntegern)-- ** Generators for various kinds of character-- | Generates any Unicode character (but not a surrogate)arbitraryUnicodeChar::GenChararbitraryUnicodeChar=arbitraryBoundedEnum`suchThat`(not.isSurrogate)whereisSurrogatec=generalCategoryc==Surrogate-- | Generates a random ASCII character (0-127).arbitraryASCIIChar::GenChararbitraryASCIIChar=choose('\0','\127')-- | Generates a printable Unicode character.arbitraryPrintableChar::GenChararbitraryPrintableChar=arbitrary`suchThat`isPrint-- ** Helper functions for implementing shrink-- | Returns no shrinking alternatives.shrinkNothing::a->[a]shrinkNothing_=[]-- | Map a shrink function to another domain. This is handy if your data type-- has special invariants, but is /almost/ isomorphic to some other type.---- @-- shrinkOrderedList :: (Ord a, Arbitrary a) => [a] -> [[a]]-- shrinkOrderedList = shrinkMap sort id---- shrinkSet :: (Ord a, Arbitrary a) => Set a -> Set [a]-- shrinkSet = shrinkMap fromList toList-- @shrinkMap::Arbitrarya=>(a->b)->(b->a)->b->[b]shrinkMapfg=shrinkMapByfgshrink-- | Non-overloaded version of `shrinkMap`.shrinkMapBy::(a->b)->(b->a)->(a->[a])->b->[b]shrinkMapByfgshr=mapf.shr.g-- | Shrink an integral number.shrinkIntegral::Integrala=>a->[a]shrinkIntegralx=nub$[-x|x<0,-x>x]++[x'|x'<-takeWhile(<<x)(0:[x-i|i<-tail(iterate(`quot`2)x)])]where-- a << b is "morally" abs a < abs b, but taking care of overflow.a<<b=case(a>=0,b>=0)of(True,True)->a<b(False,False)->a>b(True,False)->a+b<0(False,True)->a+b>0-- | Shrink a fraction.shrinkRealFrac::RealFraca=>a->[a]shrinkRealFracx=nub$[-x|x<0]++mapfromInteger(shrinkIntegral(truncatex))---------------------------------------------------------------------------- ** CoArbitrary#ifndef NO_GENERICS-- | Used for random generation of functions.---- If you are using a recent GHC, there is a default definition of-- 'coarbitrary' using 'genericCoarbitrary', so if your type has a-- 'Generic' instance it's enough to say---- > instance CoArbitrary MyType---- You should only use 'genericCoarbitrary' for data types where-- equality is structural, i.e. if you can't have two different-- representations of the same value. An example where it's not-- safe is sets implemented using binary search trees: the same-- set can be represented as several different trees.-- Here you would have to explicitly define-- @coarbitrary s = coarbitrary (toList s)@.#else-- | Used for random generation of functions.#endifclassCoArbitraryawhere-- | Used to generate a function of type @a -> b@.-- The first argument is a value, the second a generator.-- You should use 'variant' to perturb the random generator;-- the goal is that different values for the first argument will-- lead to different calls to 'variant'. An example will help:---- @-- instance CoArbitrary a => CoArbitrary [a] where-- coarbitrary [] = 'variant' 0-- coarbitrary (x:xs) = 'variant' 1 . coarbitrary (x,xs)-- @coarbitrary::a->Genb->Genb#ifndef NO_GENERICSdefaultcoarbitrary::(Generica,GCoArbitrary(Repa))=>a->Genb->Genbcoarbitrary=genericCoarbitrary-- | Generic CoArbitrary implementation.genericCoarbitrary::(Generica,GCoArbitrary(Repa))=>a->Genb->GenbgenericCoarbitrary=gCoarbitrary.fromclassGCoArbitraryfwheregCoarbitrary::fa->Genb->GenbinstanceGCoArbitraryU1wheregCoarbitraryU1=idinstance(GCoArbitraryf,GCoArbitraryg)=>GCoArbitrary(f:*:g)where-- Like the instance for tuples.gCoarbitrary(l:*:r)=gCoarbitraryl.gCoarbitraryrinstance(GCoArbitraryf,GCoArbitraryg)=>GCoArbitrary(f:+:g)where-- Like the instance for Either.gCoarbitrary(L1x)=variant0.gCoarbitraryxgCoarbitrary(R1x)=variant1.gCoarbitraryxinstanceGCoArbitraryf=>GCoArbitrary(M1icf)wheregCoarbitrary(M1x)=gCoarbitraryxinstanceCoArbitrarya=>GCoArbitrary(K1ia)wheregCoarbitrary(K1x)=coarbitraryx#endif{-# DEPRECATED (><) "Use ordinary function composition instead" #-}-- | Combine two generator perturbing functions, for example the-- results of calls to 'variant' or 'coarbitrary'.(><)::(Gena->Gena)->(Gena->Gena)->(Gena->Gena)(><)=(.)instance(Arbitrarya,CoArbitraryb)=>CoArbitrary(a->b)wherecoarbitraryfgen=doxs<-arbitrarycoarbitrary(mapfxs)geninstanceCoArbitrary()wherecoarbitrary_=idinstanceCoArbitraryBoolwherecoarbitraryFalse=variant0coarbitraryTrue=variant1instanceCoArbitraryOrderingwherecoarbitraryGT=variant0coarbitraryEQ=variant1coarbitraryLT=variant2instanceCoArbitrarya=>CoArbitrary(Maybea)wherecoarbitraryNothing=variant0coarbitrary(Justx)=variant1.coarbitraryxinstance(CoArbitrarya,CoArbitraryb)=>CoArbitrary(Eitherab)wherecoarbitrary(Leftx)=variant0.coarbitraryxcoarbitrary(Righty)=variant1.coarbitraryyinstanceCoArbitrarya=>CoArbitrary[a]wherecoarbitrary[]=variant0coarbitrary(x:xs)=variant1.coarbitrary(x,xs)instance(Integrala,CoArbitrarya)=>CoArbitrary(Ratioa)wherecoarbitraryr=coarbitrary(numeratorr,denominatorr)#ifndef NO_FIXEDinstanceHasResolutiona=>CoArbitrary(Fixeda)wherecoarbitrary=coarbitraryReal#endifinstance(RealFloata,CoArbitrarya)=>CoArbitrary(Complexa)wherecoarbitrary(x:+y)=coarbitraryx.coarbitraryyinstance(CoArbitrarya,CoArbitraryb)=>CoArbitrary(a,b)wherecoarbitrary(x,y)=coarbitraryx.coarbitraryyinstance(CoArbitrarya,CoArbitraryb,CoArbitraryc)=>CoArbitrary(a,b,c)wherecoarbitrary(x,y,z)=coarbitraryx.coarbitraryy.coarbitraryzinstance(CoArbitrarya,CoArbitraryb,CoArbitraryc,CoArbitraryd)=>CoArbitrary(a,b,c,d)wherecoarbitrary(x,y,z,v)=coarbitraryx.coarbitraryy.coarbitraryz.coarbitraryvinstance(CoArbitrarya,CoArbitraryb,CoArbitraryc,CoArbitraryd,CoArbitrarye)=>CoArbitrary(a,b,c,d,e)wherecoarbitrary(x,y,z,v,w)=coarbitraryx.coarbitraryy.coarbitraryz.coarbitraryv.coarbitraryw-- typical instance for primitive (numerical) typesinstanceCoArbitraryIntegerwherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryIntwherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryInt8wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryInt16wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryInt32wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryInt64wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryWordwherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryWord8wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryWord16wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryWord32wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryWord64wherecoarbitrary=coarbitraryIntegralinstanceCoArbitraryCharwherecoarbitrary=coarbitrary.ordinstanceCoArbitraryFloatwherecoarbitrary=coarbitraryRealinstanceCoArbitraryDoublewherecoarbitrary=coarbitraryReal-- Coarbitrary instances for container typesinstanceCoArbitrarya=>CoArbitrary(Set.Seta)wherecoarbitrary=coarbitrary.Set.toListinstance(CoArbitraryk,CoArbitraryv)=>CoArbitrary(Map.Mapkv)wherecoarbitrary=coarbitrary.Map.toListinstanceCoArbitraryIntSet.IntSetwherecoarbitrary=coarbitrary.IntSet.toListinstanceCoArbitrarya=>CoArbitrary(IntMap.IntMapa)wherecoarbitrary=coarbitrary.IntMap.toListinstanceCoArbitrarya=>CoArbitrary(Sequence.Seqa)wherecoarbitrary=coarbitrary.toList-- CoArbitrary instance for ZiplistinstanceCoArbitrarya=>CoArbitrary(ZipLista)wherecoarbitrary=coarbitrary.getZipList#ifndef NO_TRANSFORMERS-- CoArbitrary instance for transformers' FunctorsinstanceCoArbitrarya=>CoArbitrary(Identitya)wherecoarbitrary=coarbitrary.runIdentityinstanceCoArbitrarya=>CoArbitrary(Constantab)wherecoarbitrary=coarbitrary.getConstant#endif-- CoArbitrary instance for ConstinstanceCoArbitrarya=>CoArbitrary(Constab)wherecoarbitrary=coarbitrary.getConst-- CoArbitrary instances for MonoidinstanceCoArbitrarya=>CoArbitrary(Monoid.Duala)wherecoarbitrary=coarbitrary.Monoid.getDualinstance(Arbitrarya,CoArbitrarya)=>CoArbitrary(Monoid.Endoa)wherecoarbitrary=coarbitrary.Monoid.appEndoinstanceCoArbitraryMonoid.Allwherecoarbitrary=coarbitrary.Monoid.getAllinstanceCoArbitraryMonoid.Anywherecoarbitrary=coarbitrary.Monoid.getAnyinstanceCoArbitrarya=>CoArbitrary(Monoid.Suma)wherecoarbitrary=coarbitrary.Monoid.getSuminstanceCoArbitrarya=>CoArbitrary(Monoid.Producta)wherecoarbitrary=coarbitrary.Monoid.getProduct#if defined(MIN_VERSION_base)#if MIN_VERSION_base(3,0,0)instanceCoArbitrarya=>CoArbitrary(Monoid.Firsta)wherecoarbitrary=coarbitrary.Monoid.getFirstinstanceCoArbitrarya=>CoArbitrary(Monoid.Lasta)wherecoarbitrary=coarbitrary.Monoid.getLast#endif#if MIN_VERSION_base(4,8,0)instanceCoArbitrary(fa)=>CoArbitrary(Monoid.Altfa)wherecoarbitrary=coarbitrary.Monoid.getAlt#endif#endifinstanceCoArbitraryVersionwherecoarbitrary(Versionab)=coarbitrary(a,b)-- ** Helpers for implementing coarbitrary-- | A 'coarbitrary' implementation for integral numbers.coarbitraryIntegral::Integrala=>a->Genb->GenbcoarbitraryIntegral=variant-- | A 'coarbitrary' implementation for real numbers.coarbitraryReal::Reala=>a->Genb->GenbcoarbitraryRealx=coarbitrary(toRationalx)-- | 'coarbitrary' helper for lazy people :-).coarbitraryShow::Showa=>a->Genb->GenbcoarbitraryShowx=coarbitrary(showx)-- | A 'coarbitrary' implementation for enums.coarbitraryEnum::Enuma=>a->Genb->GenbcoarbitraryEnum=variant.fromEnum---------------------------------------------------------------------------- ** arbitrary generators-- these are here and not in Gen because of the Arbitrary class constraint-- | Generates a list of a given length.vector::Arbitrarya=>Int->Gen[a]vectork=vectorOfkarbitrary-- | Generates an ordered list.orderedList::(Orda,Arbitrarya)=>Gen[a]orderedList=sort`fmap`arbitrary-- | Generates an infinite list.infiniteList::Arbitrarya=>Gen[a]infiniteList=infiniteListOfarbitrary---------------------------------------------------------------------------- the end.