d802f67...master · typeable/generic-arbitrary

.github/workflows/haskell-ci.ymlnew file+29

since splitsnapshots

unifiedsplit

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

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,3 +4,4 @@ dist

4.cabal-sandbox/

5cabal.sandbox.config

6dist-newstyle

7+TAGS

CHANGELOG.md+16

@@ -1,3 +1,19 @@

1+1.0.1.2

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+

11.0.0

171.0.0

2-----

18-----

3

19

README.md+114−12

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

1# generic-arbitrary

2

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

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)

4

5+# What?

6+

5−Deriving `Arbitrary` via `Generic`.

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

6

8

7``` haskell

9``` haskell

8import GHC.Generics (Generic)

10import GHC.Generics (Generic)

9import Test.QuickCheck

11import Test.QuickCheck

10import Test.QuickCheck.Arbitrary.Generic

12import Test.QuickCheck.Arbitrary.Generic

11

13

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

12data Expr

29data Expr

13 = Lit Int

30 = Lit Int

14 | Add Expr Expr

31 | Add Expr Expr

@@ -20,19 +37,104 @@ instance Arbitrary Expr where

20 shrink = genericShrink

37 shrink = genericShrink

21```

38```

22

39

23−if type has an argument then `Arg` is required

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

24

53

25``` haskell

54``` haskell

26−data Expr lit

55+instance Arbitrary R where

27− = Lit lit

56+ arbitrary = genericArbitrary

28− | Add Expr Expr

57+ shrink = genericShrink

29− | Mul Expr Expr

58+```

30− deriving (Eq, Show, Generic)

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.

31

66

32−instance

67+``` haskell

33− ( Arbitrary lit

68+data R = R R | F

34− , Arg (Expr lit) lit

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+

35− ) => Arbitrary (Expr lit) where

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

36 arbitrary = genericArbitrary

105 arbitrary = genericArbitrary

37 shrink = genericShrink

106 shrink = genericShrink

38```

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+24−13

@@ -1,5 +1,5 @@

1name: generic-arbitrary

2−version: 1.0.0

2+version: 1.0.1.2

3synopsis: Generic implementation for QuickCheck's Arbitrary

4description:

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

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

15category: Generic

16build-type: Simple

17extra-source-files: CHANGELOG.md

18+ , README.md

18−cabal-version: 1.22

19+cabal-version: 2.0

19−tested-with: GHC == 8.10.7

20+tested-with: GHC == 8.6.5

21+ , GHC == 8.10.7

20− , GHC == 9.0.2

22+ , GHC == 9.0.2

23+ , GHC == 9.2.4

24+ , GHC == 9.4.3

25+ , GHC == 9.8.1

21

26

22source-repository head

27source-repository head

23 type: git

28 type: git

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

26library

31library

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

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

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

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

29− , QuickCheck >= 2.14

34+ , QuickCheck >=2.8

30 hs-source-dirs: src

35 hs-source-dirs: src

31 default-language: Haskell2010

36 default-language: Haskell2010

32 default-extensions: AllowAmbiguousTypes

37 default-extensions: AllowAmbiguousTypes

@@ -54,21 +59,27 @@ test-suite test

54 hs-source-dirs: test

59 hs-source-dirs: test

55 main-is: Test.hs

60 main-is: Test.hs

56 default-language: Haskell2010

61 default-language: Haskell2010

57− build-depends: base >= 4.8 && <5

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

58− , QuickCheck

63+ , QuickCheck >=2.10

59 , deepseq

64 , deepseq

60 , generic-arbitrary

65 , generic-arbitrary

61− , tasty

66+ , tasty >=1.4.2 || <1.4.0.1

62− , tasty-discover

67+ , tasty-discover >= 2.0.0

63− , tasty-hunit

68+ , tasty-hunit >= 0.9.2

64 , tasty-quickcheck

69 , tasty-quickcheck

70+ other-modules: Auxiliary

71+ , EnumTest

65− other-modules: LimitationDemo

72+ , LimitationDemo

66 , NoTypecheckTest

73 , NoTypecheckTest

74+ , ParametersTest

67 , RecursiveTest

75 , RecursiveTest

68 default-extensions: AllowAmbiguousTypes

76 default-extensions: AllowAmbiguousTypes

69 , CPP

77 , CPP

70 , DataKinds

78 , DataKinds

79+ , DeriveAnyClass

71 , DeriveGeneric

80 , DeriveGeneric

81+ , DerivingStrategies

82+ , DerivingVia

72 , FlexibleContexts

83 , FlexibleContexts

73 , FlexibleInstances

84 , FlexibleInstances

74 , GeneralizedNewtypeDeriving

85 , GeneralizedNewtypeDeriving

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

77 , PolyKinds

88 , PolyKinds

78 , RankNTypes

89 , RankNTypes

79 , ScopedTypeVariables

90 , ScopedTypeVariables

91+ , TypeApplications

80 , TypeFamilies

92 , TypeFamilies

81 , TypeOperators

93 , TypeOperators

82 , TypeSynonymInstances

94 , TypeSynonymInstances

83 , UndecidableInstances

95 , UndecidableInstances

84 , ViewPatterns

96 , ViewPatterns

85− build-tools: tasty-discover

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

86 ghc-options: -Wall

98 ghc-options: -Wall

87 -threaded

99 -threaded

88 -rtsopts

100 -rtsopts

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

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

90− default-extensions: DeriveGeneric

lts-18.18.yaml → ghc-8.10.7.yamlrenamed

The content is the same.

lts-18.18.yaml.lock → ghc-8.10.7.yaml.lockrenamed

The content is the same.

ghc-8.6.5.yamlnew file+1

@@ -0,0 +1 @@

1+resolver: lts-13.21

ghc-8.6.5.yaml.locknew file+12

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

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.yamlnew file+1

@@ -0,0 +1 @@

1+resolver: lts-19.20

ghc-9.0.2.yaml.locknew file+12

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

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.yamlnew file+1

@@ -0,0 +1 @@

1+resolver: nightly-2022-08-24

ghc-9.2.4.yaml.locknew file+12

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

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.yamlnew file+1

@@ -0,0 +1 @@

1+resolver: nightly-2022-12-26

ghc-9.4.3.yaml.locknew file+12

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

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.yamlnew file+1

@@ -0,0 +1 @@

1+resolver: nightly-2024-01-12

ghc-9.8.1.yaml.locknew file+12

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

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+155−10

@@ -1,8 +1,14 @@

1−{-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeOperators, DataKinds, TypeFamilies, ScopedTypeVariables#-}

1+#if __GLASGOW_HASKELL__ >= 806

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

3+#endif

4+#if __GLASGOW_HASKELL__ >= 800

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

6+#endif

2

7

3−{- |

8+{-|

4

9

5−Generic implementation of the 'arbitrary' method. Example usage:

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

11+usage:

6

12

7@

13@

8data Foo = Foo

14data Foo = Foo

@@ -27,27 +33,151 @@ data Foo = Foo

27

33

28The generated 'arbitrary' method is equivalent to

34The generated 'arbitrary' method is equivalent to

29

35

36+@

30−@Foo <$> arbitrary <*> arbitrary@.

37+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.

31

131

32-}

132-}

33

133

34module Test.QuickCheck.Arbitrary.Generic

134module Test.QuickCheck.Arbitrary.Generic

135+ ( -- * Main

136+ genericArbitrary

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

35− ( GenericArbitrary(..)

138+ , GenericArbitrary(..)

36− , Arbitrary(..)

139+#endif

37 , Arg

140 , Arg

38− , genericArbitrary

141+ -- * Internal

142+ , GArbitrary

143+ , FiniteSum

144+ , FiniteSumElem

145+ , Finite

146+ , AllFieldsFinal

147+ , TypesDiffer

148+ , ArgumentsCount

149+ , SumLen

150+ -- * Reexports

151+ , Arbitrary(..)

39 , genericShrink

152 , genericShrink

40 ) where

153 ) where

41

154

42import Control.Applicative

155import Control.Applicative

43−import Data.Coerce (coerce)

44import Data.Proxy

156import Data.Proxy

45import Data.Type.Bool

157import Data.Type.Bool

46import GHC.Generics as G

158import GHC.Generics as G

47import GHC.TypeLits

159import GHC.TypeLits

160+import Prelude

48import Test.QuickCheck as QC

161import Test.QuickCheck as QC

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

163+import Data.Coerce (coerce)

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

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

50

165

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

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

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

52 deriving (Show, Eq)

182 deriving (Show, Eq)

53

183

@@ -59,13 +189,28 @@ instance

59 ) => Arbitrary (GenericArbitrary a) where

189 ) => Arbitrary (GenericArbitrary a) where

60 arbitrary = coerce (genericArbitrary :: Gen a)

190 arbitrary = coerce (genericArbitrary :: Gen a)

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

191 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)

62

209

63type family TypesDiffer a b where

210type family TypesDiffer a b where

64 TypesDiffer a a = 'False

211 TypesDiffer a a = 'False

65 TypesDiffer a b = 'True

212 TypesDiffer a b = 'True

66

213

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

68−

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

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

70 AllFieldsFinal self U1 = 'True

215 AllFieldsFinal self U1 = 'True

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

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

test/Auxiliary.hsnew file+10

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

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.hsnew file+24

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

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.hs+12−5

@@ -1,8 +1,3 @@

1−{-# LANGUAGE NumDecimals #-}

2−{-# LANGUAGE DerivingStrategies #-}

3−{-# LANGUAGE DerivingVia #-}

4−{-# LANGUAGE DeriveAnyClass #-}

5−

6module LimitationDemo where

1module LimitationDemo where

7

2

8import Control.DeepSeq

3import Control.DeepSeq

@@ -16,12 +11,24 @@ import Test.QuickCheck.Arbitrary.Generic

16data R1 = R1 R2

11data R1 = R1 R2

17 deriving (Eq, Ord, Show, Generic)

12 deriving (Eq, Ord, Show, Generic)

18 deriving anyclass NFData

13 deriving anyclass NFData

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

19 deriving Arbitrary via (GenericArbitrary R1)

15 deriving Arbitrary via (GenericArbitrary R1)

16+#else

17+instance Arbitrary R1 where

18+ arbitrary = genericArbitrary

19+ shrink = genericShrink

20+#endif

20

21

21data R2 = R2 R1

22data R2 = R2 R1

22 deriving (Eq, Ord, Show, Generic)

23 deriving (Eq, Ord, Show, Generic)

23 deriving anyclass NFData

24 deriving anyclass NFData

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

24 deriving Arbitrary via (GenericArbitrary R2)

26 deriving Arbitrary via (GenericArbitrary R2)

27+#else

28+instance Arbitrary R2 where

29+ arbitrary = genericArbitrary

30+ shrink = genericShrink

31+#endif

25

32

26-- To force the instance realy be generated

33-- To force the instance realy be generated

27usage :: IO ()

34usage :: IO ()

test/NoTypecheckTest.hs+2−5

@@ -5,7 +5,7 @@

5

6module NoTypecheckTest where

7

8−import Control.Exception

8+import Auxiliary

9import GHC.Generics (Generic)

10import Test.QuickCheck

11import Test.QuickCheck.Arbitrary.Generic

@@ -20,7 +20,4 @@ instance Arbitrary R where

20 shrink = genericShrink

21

22unit_mustFail :: IO ()

23−unit_mustFail = do

23+unit_mustFail = failGeneration @R

24− try (generate (arbitrary :: Gen R) >>= print) >>= \case

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

26− Right _ -> error "Error expected"

test/ParametersTest.hsnew file+34

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

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+45−2

@@ -1,13 +1,14 @@

1{-# LANGUAGE DerivingStrategies #-}

2{-# LANGUAGE DerivingVia #-}

3{-# LANGUAGE DeriveAnyClass #-}

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

4

5

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

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

6-- `size` parameter while generating.

7-- `size` parameter while generating.

7

8

8module RecursiveTest where

9module RecursiveTest where

9

10

10−import Control.DeepSeq

11+import Control.DeepSeq (NFData)

11import GHC.Generics (Generic)

12import GHC.Generics (Generic)

12import Test.QuickCheck

13import Test.QuickCheck

13import Test.QuickCheck.Arbitrary.Generic

14import Test.QuickCheck.Arbitrary.Generic

@@ -15,7 +16,13 @@ import Test.QuickCheck.Arbitrary.Generic

15data Unit = Unit

16data Unit = Unit

16 deriving (Eq, Show, Generic)

17 deriving (Eq, Show, Generic)

17 deriving anyclass NFData

18 deriving anyclass NFData

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

18 deriving Arbitrary via (GenericArbitrary Unit)

20 deriving Arbitrary via (GenericArbitrary Unit)

21+#else

22+instance Arbitrary Unit where

23+ arbitrary = genericArbitrary

24+ shrink = genericShrink

25+#endif

19

26

20prop_unitTotal :: Unit -> Property

27prop_unitTotal :: Unit -> Property

21prop_unitTotal = total

28prop_unitTotal = total

@@ -23,7 +30,13 @@ prop_unitTotal = total

23data Single = Single Int

30data Single = Single Int

24 deriving (Eq, Show, Generic)

31 deriving (Eq, Show, Generic)

25 deriving anyclass NFData

32 deriving anyclass NFData

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

26 deriving Arbitrary via (GenericArbitrary Single)

34 deriving Arbitrary via (GenericArbitrary Single)

35+#else

36+instance Arbitrary Single where

37+ arbitrary = genericArbitrary

38+ shrink = genericShrink

39+#endif

27

40

28prop_singleTotal :: Single -> Property

41prop_singleTotal :: Single -> Property

29prop_singleTotal = total

42prop_singleTotal = total

@@ -31,7 +44,13 @@ prop_singleTotal = total

31data Multiple = M1 | M2 | M3 Int

44data Multiple = M1 | M2 | M3 Int

32 deriving (Eq, Show, Generic)

45 deriving (Eq, Show, Generic)

33 deriving anyclass NFData

46 deriving anyclass NFData

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

34 deriving Arbitrary via (GenericArbitrary Multiple)

48 deriving Arbitrary via (GenericArbitrary Multiple)

49+#else

50+instance Arbitrary Multiple where

51+ arbitrary = genericArbitrary

52+ shrink = genericShrink

53+#endif

35

54

36prop_multipleTotal :: Multiple -> Property

55prop_multipleTotal :: Multiple -> Property

37prop_multipleTotal = total

56prop_multipleTotal = total

@@ -42,7 +61,13 @@ data Rec = Rec

42 , multiple :: Multiple

61 , multiple :: Multiple

43 } deriving (Eq, Show, Generic)

62 } deriving (Eq, Show, Generic)

44 deriving anyclass NFData

63 deriving anyclass NFData

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

45− deriving Arbitrary via (GenericArbitrary Rec)

65+ deriving Arbitrary via (GenericArbitrary Rec)

66+#else

67+instance Arbitrary Rec where

68+ arbitrary = genericArbitrary

69+ shrink = genericShrink

70+#endif

46

71

47prop_recTotal :: Rec -> Property

72prop_recTotal :: Rec -> Property

48prop_recTotal = total

73prop_recTotal = total

@@ -53,7 +78,13 @@ data Expr

53 | Mul Expr Expr

78 | Mul Expr Expr

54 deriving (Eq, Show, Generic)

79 deriving (Eq, Show, Generic)

55 deriving anyclass NFData

80 deriving anyclass NFData

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

56 deriving Arbitrary via (GenericArbitrary Expr)

82 deriving Arbitrary via (GenericArbitrary Expr)

83+#else

84+instance Arbitrary Expr where

85+ arbitrary = genericArbitrary

86+ shrink = genericShrink

87+#endif

57

88

58prop_exprTotal :: Expr -> Property

89prop_exprTotal :: Expr -> Property

59prop_exprTotal = total

90prop_exprTotal = total

@@ -67,7 +98,13 @@ data Recursive

67 | R5 Recursive String

98 | R5 Recursive String

68 deriving (Eq, Show, Generic)

99 deriving (Eq, Show, Generic)

69 deriving anyclass NFData

100 deriving anyclass NFData

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

70 deriving Arbitrary via (GenericArbitrary Recursive)

102 deriving Arbitrary via (GenericArbitrary Recursive)

103+#else

104+instance Arbitrary Recursive where

105+ arbitrary = genericArbitrary

106+ shrink = genericShrink

107+#endif

71

108

72prop_recursiveTotal :: Recursive -> Property

109prop_recursiveTotal :: Recursive -> Property

73prop_recursiveTotal = total

110prop_recursiveTotal = total

@@ -77,7 +114,13 @@ data DeepRecursive

77 | Short

114 | Short

78 deriving (Eq, Show, Generic)

115 deriving (Eq, Show, Generic)

79 deriving anyclass NFData

116 deriving anyclass NFData

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

80 deriving Arbitrary via (GenericArbitrary DeepRecursive)

118 deriving Arbitrary via (GenericArbitrary DeepRecursive)

119+#else

120+instance Arbitrary DeepRecursive where

121+ arbitrary = genericArbitrary

122+ shrink = genericShrink

123+#endif

81

124

82prop_deepRecursiveTotal :: DeepRecursive -> Property

125prop_deepRecursiveTotal :: DeepRecursive -> Property

83prop_deepRecursiveTotal = total

126prop_deepRecursiveTotal = total