git.iko.soy/typeable/generic-arbitrary
on master help sign in
wip
commit3bc62d366bb6a68f9f565aed20ffc4d27a445b13 authorAleksey Uymanov <s9gf4ult@gmail.com> dateTue 9 Aug 2022, 11:11 (4 years ago) parent9a2cdf8
2 files changed+53−4
.github/workflows/haskell-ci.yml+1−3 src/Test/QuickCheck/Arbitrary/Generic.hs+52−1
.github/workflows/haskell-ci.yml+1−3
@@ -1,7 +1,5 @@
11name: Haskell-CI
2−on:
3− - push
4− - pull_request
2+on: [push]
53jobs:
64 linux:
75 name: ${{ matrix.stack-yaml }}
src/Test/QuickCheck/Arbitrary/Generic.hs+52−1
@@ -25,7 +25,57 @@ data Foo = Foo
2525
2626The generated 'arbitrary' method is equivalent to
2727
28−@Foo <$> arbitrary <*> arbitrary@.
28+@
29+Foo <$> arbitrary <*> arbitrary
30+@.
31+
32+It can also handle a recursive types problem. Assuming a type
33+
34+@
35+data R = R R
36+ deriving Generic
37+@
38+
39+there is no instance
40+
41+@
42+instance Arbitrary R where
43+ arbitrary = genericArbitrary
44+ shrink = genericShrink
45+@
46+
47+If you try to compile this you will get a type level error
48+
49+> • R refers to itself in all constructors
50+
51+Which means that there is no finite term for @R@ because it is recursive. But,
52+if you correct the definition of @R@ like this.
53+
54+@
55+data R = R R | F
56+ deriving Generic
57+@
58+
59+Then it will compile. And the @arbitrary@ generated will not hang forever, because
60+it respects the @size@ parameter.
61+
62+There is a limitation of recursion detection:
63+
64+@
65+data R1 = R1 R2
66+ deriving (Eq, Ord, Show, Generic)
67+ deriving anyclass NFData
68+ deriving Arbitrary via (GenericArbitrary R1)
69+
70+data R2 = R2 R1
71+ deriving (Eq, Ord, Show, Generic)
72+ deriving anyclass NFData
73+ deriving Arbitrary via (GenericArbitrary R2)
74+@
75+
76+This code will compile and the @arbitrary@ generated will always hand. Yes,
77+there is a problem with mutually recursive types
78+
2979
3080-}
3181
@@ -49,6 +99,7 @@ import Test.QuickCheck as QC
4999#if MIN_VERSION_QuickCheck(2, 14, 0)
50100import Test.QuickCheck.Arbitrary (GSubterms, RecursivelyShrink)
51101
102+-- | Newtype for @DerivingVia@
52103newtype GenericArbitrary a = GenericArbitrary { unGenericArbitrary :: a }
53104 deriving (Show, Eq)
54105