master..0a1f9dc · typeable/generic-arbitrary

.github/workflows/haskell-ci.ymldeleted−29

since splitsnapshots

unifiedsplit

@@ -1,29 +0,0 @@

1−name: Haskell-CI

2−on: [push, pull_request]

3−jobs:

4− linux:

5− name: GHC-${{ matrix.ghc-version }}

6− runs-on: ubuntu-latest

7− strategy:

8− matrix:

9− ghc-version:

10− - 8.6.5

11− - 8.10.7

12− - 9.0.2

13− - 9.2.4

14− - 9.4.3

15− - 9.8.1

16− steps:

17− - uses: actions/checkout@v3

18− - uses: haskell/actions/setup@v2

19− with:

20− enable-stack: true

21− ghc-version: ${{ matrix.ghc-version }}

22− stack-version: 'latest'

23− - uses: actions/cache@v3

24− with:

25− path: |

26− ~/.stack

27− ./.stack-work

28− key: ${{ matrix.ghc-version }}

29− - run: stack --stack-yaml ghc-${{ matrix.ghc-version }}.yaml --install-ghc test --fast --haddock

.gitignore−1

@@ -4,4 +4,3 @@ dist

4.cabal-sandbox/

5cabal.sandbox.config

6dist-newstyle

7−TAGS

CHANGELOG.md+1−28

@@ -1,35 +1,8 @@

1−1.0.1.2

1+0.3.0

2−-------

3−

4−* Fix dependency bounds (including retroactively), and compilation with warnings.

5−

6−1.0.1.1

7−-------

8−

9−* Fix compilation with GHC 9.8.3

10−

11−1.0.1

12−-----

13−

14−* Compillability by GHC-9.2.4

15−* Fix cabal `tested-with` field

16−

17−1.0.0

18-----

2-----

19

3

20* Fixed issue with too big terms in case of recursive types

4* Fixed issue with too big terms in case of recursive types

21* Recpect the `size` argument

5* Recpect the `size` argument

22−* Types with parameters require `Arg` now

23−

24−0.2.2

25−-----

26−

27−* Resolved an issue where the size of the generators could become negative

28−

29−0.2.1

30−-----

31−

32−* Added compatibility with GHC 9.2.1

33

6

340.2.0

70.2.0

35-----

8-----

README.md+2−121

@@ -1,31 +1,14 @@

1# generic-arbitrary

2

3−[![Haskell-CI](https://github.com/typeable/generic-arbitrary/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/typeable/generic-arbitrary/actions/workflows/haskell-ci.yml)

3+[![Build Status](https://travis-ci.org/typeable/generic-arbitrary.svg?branch=master)](https://travis-ci.org/typeable/generic-arbitrary)

4

5−# What?

6−

7−Package for deriving `Arbitrary` via `Generic`.

5+Deriving `Arbitrary` via `Generic`.

8

6

9``` haskell

7``` haskell

10import GHC.Generics (Generic)

8import GHC.Generics (Generic)

11import Test.QuickCheck

9import Test.QuickCheck

12import Test.QuickCheck.Arbitrary.Generic

10import Test.QuickCheck.Arbitrary.Generic

13

11

14−data Expr

15− = Lit Int

16− | Add Expr Expr

17− | Mul Expr Expr

18− deriving (Eq, Show, Generic)

19− deriving Arbitrary via (GenericArbitrary Expr)

20−```

21−

22−Older versions of this package had a problem with hanging `arbitrary`

23−method. Since `1.0.0` this problem almost solved.

24−

25−For `QuickCheck` older than `2.14.0` the `GenericArbitrary` is not available, so

26−you will need to write instances more verbosely

27−

28−``` haskell

29data Expr

12data Expr

30 = Lit Int

13 = Lit Int

31 | Add Expr Expr

14 | Add Expr Expr

@@ -36,105 +19,3 @@ instance Arbitrary Expr where

36 arbitrary = genericArbitrary

19 arbitrary = genericArbitrary

37 shrink = genericShrink

20 shrink = genericShrink

38```

21```

39−

40−Which is generally the same.

41−

42−# Infinite terms problem

43−

44−The `generic-arbitrary` can partially handle the problem with recursive

45−types. Assume the type `R`

46−

47−``` haskell

48−data R = R R

49− deriving Generic

50−```

51−

52−there is no instance

53−

54−``` haskell

55−instance Arbitrary R where

56− arbitrary = genericArbitrary

57− shrink = genericShrink

58−```

59−

60−If you try to compile this you will get a type level error

61−

62−> • R refers to itself in all constructors

63−

64−Which means that there is no finite term for `R` because it is recursive in all

65−it's constructors. But, if you correct the definition of `R` like this.

66−

67−``` haskell

68−data R = R R | F

69− deriving Generic

70−```

71−

72−Then it will compile. And the `arbitrary` generated will not hang forever,

73−because it respects the `size` parameter.

74−

75−## Limitation

76−

77−There is a limitation of recursion detection:

78−

79−``` haskell

80−data R1 = R1 R2

81− deriving (Eq, Ord, Show, Generic)

82− deriving anyclass NFData

83− deriving Arbitrary via (GenericArbitrary R1)

84−

85−data R2 = R2 R1

86− deriving (Eq, Ord, Show, Generic)

87− deriving anyclass NFData

88− deriving Arbitrary via (GenericArbitrary R2)

89−```

90−

91−This code will compile and the `arbitrary` generated will always hang. Yes,

92−there is a problem with mutually recursive types.

93−

94−# Type parameters

95−

96−Now let's see an example of datatype with parameters

97−

98−``` haskell

99−data A a = A a

100− deriving (Eq, Ord, Show)

101− deriving anyclass NFData

102− deriving (Generic)

103−

104−instance (Arbitrary a) => Arbitrary (A a) where

105− arbitrary = genericArbitrary

106− shrink = genericShrink

107−```

108−

109−It should work from first glance, but when compile it will throw an error:

110−

111−```

112−• Could not deduce (Test.QuickCheck.Arbitrary.Generic.GArbitrary

113− (A a)

114− (GHC.Generics.D1

115− ('GHC.Generics.MetaData "A" "ParametersTest" "main" 'False)

116− (GHC.Generics.C1

117− ('GHC.Generics.MetaCons "A" 'GHC.Generics.PrefixI 'False)

118− (GHC.Generics.S1

119− ('GHC.Generics.MetaSel

120− 'Nothing

121− 'GHC.Generics.NoSourceUnpackedness

122− 'GHC.Generics.NoSourceStrictness

123− 'GHC.Generics.DecidedLazy)

124− (GHC.Generics.Rec0 a))))

125− (TypesDiffer (A a) a))

126− arising from a use of ‘genericArbitrary’

127−```

128−

129−Here the `TypesDiffer` is a type familty dealing with recursive types and

130−helping us to eliminate inproper instances. To convince the compiller, that the

131−`a` parameter is not an `A a` we must fix the instance with additional

132−constraint `Arg (A a) a`

133−

134−``` haskell

135−instance (Arg (A a) a, Arbitrary a) => Arbitrary (A a) where

136− arbitrary = genericArbitrary

137− shrink = genericShrink

138−```

139−

140−Now everything compiles and works as expected.

generic-arbitrary.cabal+18−26

@@ -1,10 +1,10 @@

1name: generic-arbitrary

2−version: 1.0.1.2

2+version: 0.3.0

3synopsis: Generic implementation for QuickCheck's Arbitrary

4description:

5 Generic implementations of methods of the 'Arbitrary' class from the

6 QuickCheck library. The approach taken here can lead to diverging instances

7− for mutually recursive types but is safe for simply recursive ones and guarantees

7+ for recursive types but is safe for non-recursive ones and guarantees

8 flat distribution for constructors of sum-types.

9

10license: MIT

@@ -15,14 +15,13 @@ homepage: http://github.com/typeable/generic-arbitrary#readme

15category: Generic

16build-type: Simple

17extra-source-files: CHANGELOG.md

18− , README.md

19−cabal-version: 2.0

18+cabal-version: 1.22

20−tested-with: GHC == 8.6.5

19+tested-with: GHC == 7.10.3

21− , GHC == 8.10.7

20+ , GHC == 8.0.2

22− , GHC == 9.0.2

21+ , GHC == 8.2.2

23− , GHC == 9.2.4

22+ , GHC == 8.4.1

24− , GHC == 9.4.3

25− , GHC == 9.8.1

23+ , GHC == 8.6.5

24+ , GHC == 8.10.1

26

25

27source-repository head

26source-repository head

28 type: git

27 type: git

@@ -31,7 +30,7 @@ source-repository head

31library

30library

32 exposed-modules: Test.QuickCheck.Arbitrary.Generic

31 exposed-modules: Test.QuickCheck.Arbitrary.Generic

33 build-depends: base >=4.8 && <5

32 build-depends: base >=4.8 && <5

34− , QuickCheck >=2.8

33+ , QuickCheck >= 2.14

35 hs-source-dirs: src

34 hs-source-dirs: src

36 default-language: Haskell2010

35 default-language: Haskell2010

37 default-extensions: AllowAmbiguousTypes

36 default-extensions: AllowAmbiguousTypes

@@ -59,27 +58,20 @@ test-suite test

59 hs-source-dirs: test

58 hs-source-dirs: test

60 main-is: Test.hs

59 main-is: Test.hs

61 default-language: Haskell2010

60 default-language: Haskell2010

62− build-depends: base >=4.12 && <5

61+ build-depends: base >= 4.8 && <5

63− , QuickCheck >=2.10

62+ , QuickCheck

64 , deepseq

63 , deepseq

65 , generic-arbitrary

64 , generic-arbitrary

66− , tasty >=1.4.2 || <1.4.0.1

65+ , tasty

67− , tasty-discover >= 2.0.0

66+ , tasty-discover

68− , tasty-hunit >= 0.9.2

67+ , tasty-hunit

69 , tasty-quickcheck

68 , tasty-quickcheck

70− other-modules: Auxiliary

71− , EnumTest

72− , LimitationDemo

73− , NoTypecheckTest

69+ other-modules: NoTypecheckTest

74− , ParametersTest

75 , RecursiveTest

70 , RecursiveTest

76 default-extensions: AllowAmbiguousTypes

71 default-extensions: AllowAmbiguousTypes

77 , CPP

72 , CPP

78 , DataKinds

73 , DataKinds

79− , DeriveAnyClass

80 , DeriveGeneric

74 , DeriveGeneric

81− , DerivingStrategies

82− , DerivingVia

83 , FlexibleContexts

75 , FlexibleContexts

84 , FlexibleInstances

76 , FlexibleInstances

85 , GeneralizedNewtypeDeriving

77 , GeneralizedNewtypeDeriving

@@ -88,14 +80,14 @@ test-suite test

88 , PolyKinds

80 , PolyKinds

89 , RankNTypes

81 , RankNTypes

90 , ScopedTypeVariables

82 , ScopedTypeVariables

91− , TypeApplications

92 , TypeFamilies

83 , TypeFamilies

93 , TypeOperators

84 , TypeOperators

94 , TypeSynonymInstances

85 , TypeSynonymInstances

95 , UndecidableInstances

86 , UndecidableInstances

96 , ViewPatterns

87 , ViewPatterns

97− build-tool-depends: tasty-discover:tasty-discover

88+ build-tools: tasty-discover

98 ghc-options: -Wall

89 ghc-options: -Wall

99 -threaded

90 -threaded

100 -rtsopts

91 -rtsopts

101 "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"

92 "-with-rtsopts=-N -A64m -qb0 -n4m -T -I1"

93+ default-extensions: DeriveGeneric

ghc-8.10.7.yamldeleted−1

@@ -1 +0,0 @@

1−resolver: lts-18.18

ghc-8.10.7.yaml.lockdeleted−12

@@ -1,12 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/lock_files

5−

6−packages: []

7−snapshots:

8−- completed:

9− sha256: 63539429076b7ebbab6daa7656cfb079393bf644971156dc349d7c0453694ac2

10− size: 586296

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/18.yaml

12− original: lts-18.18

ghc-8.6.5.yamldeleted−1

@@ -1 +0,0 @@

1−resolver: lts-13.21

ghc-8.6.5.yaml.lockdeleted−12

@@ -1,12 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/lock_files

5−

6−packages: []

7−snapshots:

8−- completed:

9− sha256: eff2de19a6d4691ccbf6edc1fba858f1918683047dce0f09adede874bbd2a8f3

10− size: 498180

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/21.yaml

12− original: lts-13.21

ghc-9.0.2.yamldeleted−1

@@ -1 +0,0 @@

1−resolver: lts-19.20

ghc-9.0.2.yaml.lockdeleted−12

@@ -1,12 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/lock_files

5−

6−packages: []

7−snapshots:

8−- completed:

9− sha256: be747117bed6d462806c883352c3206325b23480825103f5c87884e97e52819a

10− size: 619173

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/20.yaml

12− original: lts-19.20

ghc-9.2.4.yamldeleted−1

@@ -1 +0,0 @@

1−resolver: nightly-2022-08-24

ghc-9.2.4.yaml.lockdeleted−12

@@ -1,12 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/lock_files

5−

6−packages: []

7−snapshots:

8−- completed:

9− sha256: ff431937a638ebfaa5e6fec13c7ae575f01e02744d6ca5e5b1554f78cb5f88ad

10− size: 631953

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/8/24.yaml

12− original: nightly-2022-08-24

ghc-9.4.3.yamldeleted−1

@@ -1 +0,0 @@

1−resolver: nightly-2022-12-26

ghc-9.4.3.yaml.lockdeleted−12

@@ -1,12 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/lock_files

5−

6−packages: []

7−snapshots:

8−- completed:

9− sha256: bbe432b2abd6d866aa37f65a8129a5f858b7c6eaae9464f8bc2814ce92ac2d15

10− size: 573163

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/12/26.yaml

12− original: nightly-2022-12-26

ghc-9.8.1.yamldeleted−1

@@ -1 +0,0 @@

1−resolver: nightly-2024-01-12

ghc-9.8.1.yaml.lockdeleted−12

@@ -1,12 +0,0 @@

1−# This file was autogenerated by Stack.

2−# You should not edit this file by hand.

3−# For more information, please see the documentation at:

4−# https://docs.haskellstack.org/en/stable/lock_files

5−

6−packages: []

7−snapshots:

8−- completed:

9− sha256: 8f06e87750f95bc8620644ea22344ad023c3c5aa6efa854747aa70093898fd79

10− size: 556465

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2024/1/12.yaml

12− original: nightly-2024-01-12

src/Test/QuickCheck/Arbitrary/Generic.hs+21−168

@@ -1,14 +1,6 @@

1−#if __GLASGOW_HASKELL__ >= 806

1+{- |

2−{-# OPTIONS_GHC -Wno-star-is-type #-}

3−#endif

4−#if __GLASGOW_HASKELL__ >= 800

5−{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

6−#endif

7−

8−{-|

9

2

10−This module is a generic implementation of the 'arbitrary' method. Example

3+Generic implementation of the 'arbitrary' method. Example usage:

11−usage:

12

4

13@

5@

14data Foo = Foo

6data Foo = Foo

@@ -33,184 +25,45 @@ data Foo = Foo

33

25

34The generated 'arbitrary' method is equivalent to

26The generated 'arbitrary' method is equivalent to

35

27

36−@

37−Foo '<$>' arbitrary '<*>' arbitrary

28+@Foo <$> arbitrary <*> arbitrary@.

38−@.

39−

40−It can also handle a recursive types problem. Assuming a type

41−

42−@

43−data R = R R

44− deriving Generic

45−@

46−

47−there is no instance

48−

49−@

50−instance Arbitrary R where

51− arbitrary = genericArbitrary

52− shrink = genericShrink

53−@

54−

55−If you try to compile this you will get a type level error

56−

57−> • R refers to itself in all constructors

58−

59−Which means that there is no finite term for @R@ because it is recursive. But,

60−if you correct the definition of @R@ like this.

61−

62−@

63−data R = R R | F

64− deriving Generic

65−@

66−

67−Then it will compile. And the @arbitrary@ generated will not hang forever, because

68−it respects the @size@ parameter.

69−

70−There is a limitation of recursion detection:

71−

72−@

73−data R1 = R1 R2

74− deriving (Eq, Ord, Show, Generic)

75− deriving anyclass NFData

76− deriving Arbitrary via (GenericArbitrary R1)

77−

78−data R2 = R2 R1

79− deriving (Eq, Ord, Show, Generic)

80− deriving anyclass NFData

81− deriving Arbitrary via (GenericArbitrary R2)

82−@

83−

84−This code will compile and the @arbitrary@ generated will always hang. Yes,

85−there is a problem with mutually recursive types.

86−

87−Now lets see an example of datatype with parameters

88−

89−@

90−data A a = A a

91− deriving (Eq, Ord, Show)

92− deriving anyclass NFData

93− deriving (Generic)

94−

95−instance (Arbitrary a) => Arbitrary (A a) where

96− arbitrary = genericArbitrary

97− shrink = genericShrink

98−@

99−

100−It should work from first glance, but when compile it will throw an error:

101−

102−@

103− • Could not deduce (Test.QuickCheck.Arbitrary.Generic.GArbitrary

104− (A a)

105− (GHC.Generics.D1

106− ('GHC.Generics.MetaData "A" "ParametersTest" "main" 'False)

107− (GHC.Generics.C1

108− ('GHC.Generics.MetaCons "A" 'GHC.Generics.PrefixI 'False)

109− (GHC.Generics.S1

110− ('GHC.Generics.MetaSel

111− 'Nothing

112− 'GHC.Generics.NoSourceUnpackedness

113− 'GHC.Generics.NoSourceStrictness

114− 'GHC.Generics.DecidedLazy)

115− (GHC.Generics.Rec0 a))))

116− (TypesDiffer (A a) a))

117− arising from a use of ‘genericArbitrary’

118−@

119−

120−Here the @TypesDiffer@ is a type familty dealing with recursive types and

121−helping us to eliminate inproper instances. To convince the compiller, that the

122−@a@ parameter is not an @A a@ we must fix the instance with additional constraint

123−

124−@

125−instance (Arg (A a) a, Arbitrary a) => Arbitrary (A a) where

126− arbitrary = genericArbitrary

127− shrink = genericShrink

128−@

129−

130−Now everything compiles and works as expected.

131

29

132-}

30-}

133

31

134module Test.QuickCheck.Arbitrary.Generic

32module Test.QuickCheck.Arbitrary.Generic

135− ( -- * Main

136− genericArbitrary

137−#if MIN_VERSION_QuickCheck(2, 14, 0)

138− , GenericArbitrary(..)

33+ ( GenericArbitrary(..)

139−#endif

140− , Arg

141− -- * Internal

142− , GArbitrary

143− , FiniteSum

144− , FiniteSumElem

145− , Finite

146− , AllFieldsFinal

147− , TypesDiffer

148− , ArgumentsCount

149− , SumLen

150− -- * Reexports

151 , Arbitrary(..)

34 , Arbitrary(..)

35+ , Arg

36+ , genericArbitrary

152 , genericShrink

37 , genericShrink

153 ) where

38 ) where

154

39

155import Control.Applicative

40import Control.Applicative

41+import Data.Coerce (coerce)

156import Data.Proxy

42import Data.Proxy

157import Data.Type.Bool

43import Data.Type.Bool

158import GHC.Generics as G

44import GHC.Generics as G

159import GHC.TypeLits

45import GHC.TypeLits

160−import Prelude

161import Test.QuickCheck as QC

46import Test.QuickCheck as QC

162−#if MIN_VERSION_QuickCheck(2, 14, 0)

163−import Data.Coerce (coerce)

164import Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink)

47import Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink)

165

48

166−

167−

168−-- | Newtype for @DerivingVia@

169−--

170−-- Usage:

171−--

172−-- @

173−-- data Foo = Foo

174−-- { _fooX :: X

175−-- , _fooY :: Y

176−-- } deriving (Generic)

177−-- deriving (Arbitrary) via GenericArbitrary Foo

178−-- @

179−--

180−-- @since 1.0.0

181newtype GenericArbitrary a = GenericArbitrary { unGenericArbitrary :: a }

49newtype GenericArbitrary a = GenericArbitrary { unGenericArbitrary :: a }

182 deriving (Show, Eq)

50 deriving (Show, Eq)

183

51

184instance

52instance

185 ( Generic a,

53 ( Generic a,

186− GArbitrary a (Rep a) some,

54+ GArbitrary a (Rep a) 'True,

187 RecursivelyShrink (Rep a),

55 RecursivelyShrink (Rep a),

188 GSubterms (Rep a) a

56 GSubterms (Rep a) a

189 ) => Arbitrary (GenericArbitrary a) where

57 ) => Arbitrary (GenericArbitrary a) where

190 arbitrary = coerce (genericArbitrary :: Gen a)

58 arbitrary = coerce (genericArbitrary :: Gen a)

191 shrink = coerce (genericShrink :: a -> [a])

59 shrink = coerce (genericShrink :: a -> [a])

192−#endif

193−

194−-- | Constraint helper for types with parameters

195−--

196−-- Usage:

197−--

198−-- @

199−-- data A a = A a

200−-- deriving (Generic)

201−-- instance (Arg (A a) a, Arbitrary a) => Arbitrary (A a) where

202−-- arbitrary = genericArbitrary

203−-- shrink = genericShrink

204−-- @

205−--

206−-- @since 1.0.0

207−

208−type Arg self field = (TypesDiffer self field ~ 'True)

209

60

210type family TypesDiffer a b where

61type family TypesDiffer a b where

211 TypesDiffer a a = 'False

62 TypesDiffer a a = 'False

212 TypesDiffer a b = 'True

63 TypesDiffer a b = 'True

213

64

65+type Arg self field = (TypesDiffer self field ~ 'True)

66+

214type family AllFieldsFinal self (a :: * -> *) :: Bool where

67type family AllFieldsFinal self (a :: * -> *) :: Bool where

215 AllFieldsFinal self U1 = 'True

68 AllFieldsFinal self U1 = 'True

216 AllFieldsFinal self (a :*: b) = AllFieldsFinal self a && AllFieldsFinal self b

69 AllFieldsFinal self (a :*: b) = AllFieldsFinal self a && AllFieldsFinal self b

@@ -246,8 +99,8 @@ class (Finite self a ~ finite) => GArbitrary self a (finite :: Bool) where

246 gArbitrary :: Proxy self -> QC.Gen (a x)

99 gArbitrary :: Proxy self -> QC.Gen (a x)

247

100

248instance

101instance

249− ( GArbitrary self (M1 C c f) 'True

102+ ( GArbitrary self (C1 c f) 'True

250− ) => GArbitrary self (M1 D t (M1 C c f)) 'True where

103+ ) => GArbitrary self (D1 t (C1 c f)) 'True where

251 gArbitrary _ = M1 <$> gArbitrary (Proxy :: Proxy self)

104 gArbitrary _ = M1 <$> gArbitrary (Proxy :: Proxy self)

252

105

253-- | The constructor meta information

106-- | The constructor meta information

@@ -255,7 +108,7 @@ instance

255 ( GArbitrary self f some

108 ( GArbitrary self f some

256 , KnownNat (ArgumentsCount f)

109 , KnownNat (ArgumentsCount f)

257 , AllFieldsFinal self f ~ some

110 , AllFieldsFinal self f ~ some

258− ) => GArbitrary self (M1 C c f) some where

111+ ) => GArbitrary self (C1 c f) some where

259 gArbitrary _ = M1 <$> scale predNat (gArbitrary (Proxy :: Proxy self))

112 gArbitrary _ = M1 <$> scale predNat (gArbitrary (Proxy :: Proxy self))

260 where

113 where

261 argumentsCount = fromIntegral $ natVal (Proxy :: Proxy (ArgumentsCount f))

114 argumentsCount = fromIntegral $ natVal (Proxy :: Proxy (ArgumentsCount f))

@@ -268,14 +121,14 @@ instance GArbitrary self U1 'True where

268 gArbitrary _ = pure U1

121 gArbitrary _ = pure U1

269

122

270-- | Constructor field meta information

123-- | Constructor field meta information

271−instance GArbitrary self f some => GArbitrary self (M1 S t f) some where

124+instance GArbitrary self f some => GArbitrary self (S1 t f) some where

272 gArbitrary _ = M1 <$> gArbitrary (Proxy :: Proxy self)

125 gArbitrary _ = M1 <$> gArbitrary (Proxy :: Proxy self)

273

126

274-- | Data of the constructor field

127-- | Data of the constructor field

275instance

128instance

276 ( Arbitrary t

129 ( Arbitrary t

277− , Finite self (K1 R t) ~ some

130+ , Finite self (Rec0 t) ~ some

278− ) => GArbitrary self (K1 R t) some where

131+ ) => GArbitrary self (Rec0 t) some where

279 gArbitrary _ = K1 <$> arbitrary

132 gArbitrary _ = K1 <$> arbitrary

280

133

281-- | Product

134-- | Product

@@ -291,7 +144,7 @@ instance

291instance

144instance

292 ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")

145 ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")

293 , AllFieldsFinal self f ~ 'False

146 , AllFieldsFinal self f ~ 'False

294− ) => GArbitrary self (M1 D t (M1 C c f)) 'False where

147+ ) => GArbitrary self (D1 t (C1 c f)) 'False where

295 gArbitrary _ = error "Unreachable"

148 gArbitrary _ = error "Unreachable"

296#endif

149#endif

297

150

@@ -299,7 +152,7 @@ instance

299instance

152instance

300 ( FiniteSum self a b af bf

153 ( FiniteSum self a b af bf

301 , GArbitrary self (a :+: b) 'True

154 , GArbitrary self (a :+: b) 'True

302− ) => GArbitrary self (M1 D t (a :+: b)) 'True where

155+ ) => GArbitrary self (D1 t (a :+: b)) 'True where

303 gArbitrary _ = sized $ \s -> M1 <$>

156 gArbitrary _ = sized $ \s -> M1 <$>

304 if s > 1

157 if s > 1

305 then gArbitrary (Proxy :: Proxy self)

158 then gArbitrary (Proxy :: Proxy self)

@@ -355,8 +208,8 @@ instance

355 finiteElem _ = finiteSum (Proxy :: Proxy self)

208 finiteElem _ = finiteSum (Proxy :: Proxy self)

356

209

357instance

210instance

358− ( GArbitrary self (M1 C c f) 'True

211+ ( GArbitrary self (C1 c f) 'True

359− ) => FiniteSumElem self (M1 C c f) where

212+ ) => FiniteSumElem self (C1 c f) where

360 finiteElem _ = [gArbitrary (Proxy :: Proxy self)]

213 finiteElem _ = [gArbitrary (Proxy :: Proxy self)]

361

214

362

215

@@ -364,7 +217,7 @@ instance

364instance

217instance

365 ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")

218 ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")

366 , (Finite self a || Finite self b) ~ 'False

219 , (Finite self a || Finite self b) ~ 'False

367− ) => GArbitrary self (M1 D t (a :+: b)) 'False where

220+ ) => GArbitrary self (D1 t (a :+: b)) 'False where

368 gArbitrary _ = error "Unreachable"

221 gArbitrary _ = error "Unreachable"

369#endif

222#endif

370

223

stack.yaml+5−1

@@ -1 +1,5 @@

1−resolver: lts-19.2

1+resolver: lts-13.21

2+

3+extra-deps:

4+ - QuickCheck-2.14

5+ - splitmix-0.0.5

stack.yaml.lock+19−5

@@ -3,10 +3,24 @@

3# For more information, please see the documentation at:

4# https://docs.haskellstack.org/en/stable/lock_files

5

6−packages: []

6+packages:

7+- completed:

8+ hackage: QuickCheck-2.14@sha256:3f536a4b86bef7ec39025f04ef8d76c5ac5a78ba0b42e660b25d0a8f9c811045,7004

9+ pantry-tree:

10+ size: 2203

11+ sha256: 7067593c50ff2e5e83c637ac73009f4bd8f43c29ff256e976bbb14674033abe9

12+ original:

13+ hackage: QuickCheck-2.14

14+- completed:

15+ hackage: splitmix-0.0.5@sha256:4a49661be63f5aea0e132e9ab51be918789bb4dceb4ab9b15b85ba9cbbef5999,5412

16+ pantry-tree:

17+ size: 1148

18+ sha256: b41d4f60cfabab8b02840906191013ee06fe2357371103a471c7cc55eda9e462

19+ original:

20+ hackage: splitmix-0.0.5

7snapshots:

21snapshots:

8- completed:

22- completed:

9− sha256: e7e57649a12f6178d1158e4b6f1f1885ed56d210ae6174385271cecc9b1ea974

10− size: 617368

23+ size: 498180

11− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/2.yaml

24+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/21.yaml

25+ sha256: eff2de19a6d4691ccbf6edc1fba858f1918683047dce0f09adede874bbd2a8f3

12− original: lts-19.2

26+ original: lts-13.21

test/Auxiliary.hsdeleted−10

@@ -1,10 +0,0 @@

1−module Auxiliary where

2−

3−import Control.Exception

4−import Test.QuickCheck

5−

6−failGeneration :: forall a. (Arbitrary a, Show a) => IO ()

7−failGeneration = do

8− try (generate (arbitrary :: Gen a) >>= print) >>= \case

9− Left (_ :: SomeException) -> pure ()

10− Right _ -> error "Error expected"

test/EnumTest.hsdeleted−24

@@ -1,24 +0,0 @@

1−#if __GLASGOW_HASKELL__ >= 806 && __GLASGOW_HASKELL__ <= 900

2−{-# OPTIONS_GHC -fconstraint-solver-iterations=5 #-}

3−#elif __GLASGOW_HASKELL__ >= 902

4−{-# OPTIONS_GHC -fconstraint-solver-iterations=6 #-}

5−#endif

6−

7−

8−

9−module EnumTest where

10−

11−import Control.DeepSeq

12−import GHC.Generics

13−import Test.QuickCheck

14−import Test.QuickCheck.Arbitrary.Generic

15−

16−data Country = PL | GB | RU | RO | CZ | HR | SK | DE | NL | ES | BR

17− deriving (Generic, NFData, Show)

18−

19−instance Arbitrary Country where

20− arbitrary = genericArbitrary

21− shrink = genericShrink

22−

23−prop_CountryTest :: Country -> Property

24−prop_CountryTest = total

test/LimitationDemo.hsdeleted−37

@@ -1,37 +0,0 @@

1−module LimitationDemo where

2−

3−import Control.DeepSeq

4−import GHC.Generics (Generic)

5−import Test.QuickCheck

6−import Test.QuickCheck.Arbitrary.Generic

7−

8−-- As you can see, we have this instance generated, but it will definitely lead

9−-- to generating an infinite term (and the only term). The recursion detection

10−-- doesn't work here

11−data R1 = R1 R2

12− deriving (Eq, Ord, Show, Generic)

13− deriving anyclass NFData

14−#if MIN_VERSION_QuickCheck(2, 14, 0)

15− deriving Arbitrary via (GenericArbitrary R1)

16−#else

17−instance Arbitrary R1 where

18− arbitrary = genericArbitrary

19− shrink = genericShrink

20−#endif

21−

22−data R2 = R2 R1

23− deriving (Eq, Ord, Show, Generic)

24− deriving anyclass NFData

25−#if MIN_VERSION_QuickCheck(2, 14, 0)

26− deriving Arbitrary via (GenericArbitrary R2)

27−#else

28−instance Arbitrary R2 where

29− arbitrary = genericArbitrary

30− shrink = genericShrink

31−#endif

32−

33−-- To force the instance realy be generated

34−usage :: IO ()

35−usage = do

36− r1 :: R1 <- generate arbitrary

37− print r1 -- haha

test/NoTypecheckTest.hs+7−5

@@ -1,23 +1,25 @@

1{-# OPTIONS_GHC -fdefer-type-errors #-}

2−{-# OPTIONS_GHC -Wno-deferred-type-errors #-}

3

2

4-- | Test that infinite types has no Arbitrary instance

3-- | Test that infinite types has no Arbitrary instance

5

4

6module NoTypecheckTest where

5module NoTypecheckTest where

7

6

8−import Auxiliary

7+import Control.Exception

9import GHC.Generics (Generic)

8import GHC.Generics (Generic)

10import Test.QuickCheck

9import Test.QuickCheck

11import Test.QuickCheck.Arbitrary.Generic

10import Test.QuickCheck.Arbitrary.Generic

12

11

13−-- | Recursive infinite type which can not have valid Arbitrary instance

12+

14data R = R R

13data R = R R

15 deriving (Eq, Show, Generic)

14 deriving (Eq, Show, Generic)

16

15

17−-- | Instance which must not compile, but we are using deferred type errors

16+-- | Instance which must not be valid

18instance Arbitrary R where

17instance Arbitrary R where

19 arbitrary = genericArbitrary

18 arbitrary = genericArbitrary

20 shrink = genericShrink

19 shrink = genericShrink

21

20

22unit_mustFail :: IO ()

21unit_mustFail :: IO ()

23−unit_mustFail = failGeneration @R

22+unit_mustFail = do

23+ try (generate (arbitrary :: Gen R) >>= print) >>= \case

24+ Left (_ :: SomeException) -> pure ()

25+ Right _ -> error "Error expected"

test/ParametersTest.hsdeleted−34

@@ -1,34 +0,0 @@

1−{-# OPTIONS_GHC -fdefer-type-errors #-}

2−{-# OPTIONS_GHC -Wno-deferred-type-errors #-}

3−

4−module ParametersTest where

5−

6−import Auxiliary

7−import Control.DeepSeq

8−import GHC.Generics (Generic)

9−import Test.QuickCheck

10−import Test.QuickCheck.Arbitrary.Generic

11−

12−data A a = A a

13− deriving (Eq, Ord, Show)

14− deriving anyclass NFData

15− deriving (Generic)

16−

17−instance (Arbitrary a) => Arbitrary (A a) where

18− arbitrary = genericArbitrary

19− shrink = genericShrink

20−

21−data B a = B a

22− deriving (Eq, Ord, Show)

23− deriving anyclass NFData

24− deriving (Generic)

25−

26−instance (Arg (B a) a, Arbitrary a) => Arbitrary (B a) where

27− arbitrary = genericArbitrary

28− shrink = genericShrink

29−

30−unit_argumentConstraintFail :: IO ()

31−unit_argumentConstraintFail = failGeneration @(A Int)

32−

33−prop_properArgumentConstraint :: B Int -> Property

34−prop_properArgumentConstraint = total

test/RecursiveTest.hs+25−43

@@ -1,56 +1,45 @@

1−{-# LANGUAGE DerivingStrategies #-}

2−{-# LANGUAGE DerivingVia #-}

3−{-# LANGUAGE DeriveAnyClass #-}

4−{-# OPTIONS_GHC -fconstraint-solver-iterations=5 #-} -- GHC-9.2.4

5−

6-- | Testing that our Arbitrary instances do not get stuck and respect the

1-- | Testing that our Arbitrary instances do not get stuck and respect the

7-- `size` parameter while generating.

2-- `size` parameter while generating.

8

3

9module RecursiveTest where

4module RecursiveTest where

10

5

11−import Control.DeepSeq (NFData)

6+import Control.DeepSeq

12import GHC.Generics (Generic)

7import GHC.Generics (Generic)

13import Test.QuickCheck

8import Test.QuickCheck

14import Test.QuickCheck.Arbitrary.Generic

9import Test.QuickCheck.Arbitrary.Generic

15

10

16data Unit = Unit

11data Unit = Unit

17 deriving (Eq, Show, Generic)

12 deriving (Eq, Show, Generic)

18− deriving anyclass NFData

13+

19−#if MIN_VERSION_QuickCheck(2, 14, 0)

14+instance NFData Unit

20− deriving Arbitrary via (GenericArbitrary Unit)

15+

21−#else

22instance Arbitrary Unit where

16instance Arbitrary Unit where

23 arbitrary = genericArbitrary

17 arbitrary = genericArbitrary

24 shrink = genericShrink

18 shrink = genericShrink

25−#endif

26

19

27prop_unitTotal :: Unit -> Property

20prop_unitTotal :: Unit -> Property

28prop_unitTotal = total

21prop_unitTotal = total

29

22

30data Single = Single Int

23data Single = Single Int

31 deriving (Eq, Show, Generic)

24 deriving (Eq, Show, Generic)

32− deriving anyclass NFData

25+

33−#if MIN_VERSION_QuickCheck(2, 14, 0)

26+instance NFData Single

34− deriving Arbitrary via (GenericArbitrary Single)

27+

35−#else

36instance Arbitrary Single where

28instance Arbitrary Single where

37 arbitrary = genericArbitrary

29 arbitrary = genericArbitrary

38 shrink = genericShrink

30 shrink = genericShrink

39−#endif

40

31

41prop_singleTotal :: Single -> Property

32prop_singleTotal :: Single -> Property

42prop_singleTotal = total

33prop_singleTotal = total

43

34

44data Multiple = M1 | M2 | M3 Int

35data Multiple = M1 | M2 | M3 Int

45 deriving (Eq, Show, Generic)

36 deriving (Eq, Show, Generic)

46− deriving anyclass NFData

37+

47−#if MIN_VERSION_QuickCheck(2, 14, 0)

38+instance NFData Multiple

48− deriving Arbitrary via (GenericArbitrary Multiple)

39+

49−#else

50instance Arbitrary Multiple where

40instance Arbitrary Multiple where

51 arbitrary = genericArbitrary

41 arbitrary = genericArbitrary

52 shrink = genericShrink

42 shrink = genericShrink

53−#endif

54

43

55prop_multipleTotal :: Multiple -> Property

44prop_multipleTotal :: Multiple -> Property

56prop_multipleTotal = total

45prop_multipleTotal = total

@@ -60,14 +49,12 @@ data Rec = Rec

60 , single :: Single

49 , single :: Single

61 , multiple :: Multiple

50 , multiple :: Multiple

62 } deriving (Eq, Show, Generic)

51 } deriving (Eq, Show, Generic)

63− deriving anyclass NFData

52+

64−#if MIN_VERSION_QuickCheck(2, 14, 0)

53+instance NFData Rec

65− deriving Arbitrary via (GenericArbitrary Rec)

54+

66−#else

67instance Arbitrary Rec where

55instance Arbitrary Rec where

68 arbitrary = genericArbitrary

56 arbitrary = genericArbitrary

69 shrink = genericShrink

57 shrink = genericShrink

70−#endif

71

58

72prop_recTotal :: Rec -> Property

59prop_recTotal :: Rec -> Property

73prop_recTotal = total

60prop_recTotal = total

@@ -77,14 +64,13 @@ data Expr

77 | Add Expr Expr

64 | Add Expr Expr

78 | Mul Expr Expr

65 | Mul Expr Expr

79 deriving (Eq, Show, Generic)

66 deriving (Eq, Show, Generic)

80− deriving anyclass NFData

67+

81−#if MIN_VERSION_QuickCheck(2, 14, 0)

68+-- | Instance with may fall into infinite loop

82− deriving Arbitrary via (GenericArbitrary Expr)

83−#else

84instance Arbitrary Expr where

69instance Arbitrary Expr where

85 arbitrary = genericArbitrary

70 arbitrary = genericArbitrary

86 shrink = genericShrink

71 shrink = genericShrink

87−#endif

72+

73+instance NFData Expr

88

74

89prop_exprTotal :: Expr -> Property

75prop_exprTotal :: Expr -> Property

90prop_exprTotal = total

76prop_exprTotal = total

@@ -97,14 +83,12 @@ data Recursive

97 | R4 Recursive

83 | R4 Recursive

98 | R5 Recursive String

84 | R5 Recursive String

99 deriving (Eq, Show, Generic)

85 deriving (Eq, Show, Generic)

100− deriving anyclass NFData

86+

101−#if MIN_VERSION_QuickCheck(2, 14, 0)

87+instance NFData Recursive

102− deriving Arbitrary via (GenericArbitrary Recursive)

88+

103−#else

104instance Arbitrary Recursive where

89instance Arbitrary Recursive where

105 arbitrary = genericArbitrary

90 arbitrary = genericArbitrary

106 shrink = genericShrink

91 shrink = genericShrink

107−#endif

108

92

109prop_recursiveTotal :: Recursive -> Property

93prop_recursiveTotal :: Recursive -> Property

110prop_recursiveTotal = total

94prop_recursiveTotal = total

@@ -113,23 +97,21 @@ data DeepRecursive

113 = Deep DeepRecursive DeepRecursive DeepRecursive DeepRecursive DeepRecursive

97 = Deep DeepRecursive DeepRecursive DeepRecursive DeepRecursive DeepRecursive

114 | Short

98 | Short

115 deriving (Eq, Show, Generic)

99 deriving (Eq, Show, Generic)

116− deriving anyclass NFData

100+

117−#if MIN_VERSION_QuickCheck(2, 14, 0)

101+instance NFData DeepRecursive

118− deriving Arbitrary via (GenericArbitrary DeepRecursive)

102+

119−#else

120instance Arbitrary DeepRecursive where

103instance Arbitrary DeepRecursive where

121 arbitrary = genericArbitrary

104 arbitrary = genericArbitrary

122 shrink = genericShrink

105 shrink = genericShrink

123−#endif

124

106

125prop_deepRecursiveTotal :: DeepRecursive -> Property

107prop_deepRecursiveTotal :: DeepRecursive -> Property

126prop_deepRecursiveTotal = total

108prop_deepRecursiveTotal = total

127

109

128data P p = NoP | P p

110data P p = NoP | P p

129 deriving (Eq, Show, Generic)

111 deriving (Eq, Show, Generic)

130− deriving anyclass NFData

131

112

132−-- Note that deriving via doesn't work for case with arguments

113+instance (NFData p) => NFData (P p)

114+

133instance (Arg (P p) p, Arbitrary p) => Arbitrary (P p) where

115instance (Arg (P p) p, Arbitrary p) => Arbitrary (P p) where

134 arbitrary = genericArbitrary

116 arbitrary = genericArbitrary

135 shrink = genericShrink

117 shrink = genericShrink