@@ -52,7 +52,7 @@ newtype GenericArbitrary a = GenericArbitrary { unGenericArbitrary :: a }
5252
5353instance
5454 ( Generic a,
55− GArbitrary (Rep a) (Rep a),
55+ GArbitrary a (Rep a),
5656 RecursivelyShrink (Rep a),
5757 GSubterms (Rep a) a
5858 ) => Arbitrary (GenericArbitrary a) where
@@ -64,35 +64,45 @@ class Finite a where
6464 -- | Generates final element, when size = 0.
6565 final :: QC.Gen a
6666
67−class GArbitrary root a where
68− gArbitrary :: Proxy root -> QC.Gen (a x)
67+class GArbitrary self a where
68+ gArbitrary :: Proxy self -> QC.Gen (a x)
6969
7070-- | Unit type instance
71−instance GArbitrary root G.U1 where
71+instance GArbitrary self G.U1 where
7272 gArbitrary _ = pure G.U1
7373
7474-- | Data of the constructor field
75−instance Arbitrary c => GArbitrary root (Rec0 c) where
75+instance Arbitrary c => GArbitrary self (Rec0 c) where
7676 gArbitrary _ = G.K1 <$> arbitrary
7777
78−-- | Data type meta information
79−instance GArbitrary (D1 t f) f => GArbitrary (D1 t f) (D1 t f) where
80− gArbitrary _ = G.M1 <$> gArbitrary (Proxy @(D1 t f))
78+-- | Data type with single constructor
79+instance
80+ ( AllFieldsFinal self f ~ 'True
81+ , GArbitrary self (C1 c f)
82+ ) => GArbitrary self (D1 t (C1 c f)) where
83+ gArbitrary _ = G.M1 <$> gArbitrary (Proxy @self)
84+
85+-- | Data type with multiple constructors
86+instance
87+ ( FinalConstructors self (a :+: b) ~ (x ': y)
88+ , GArbitrary self (a :+: b)
89+ ) => GArbitrary self (D1 t (a :+: b)) where
90+ gArbitrary _ = G.M1 <$> gArbitrary (Proxy @self)
8191
8292-- | The constructor meta information
83−instance GArbitrary root f => GArbitrary root (C1 c f) where
84− gArbitrary _ = G.M1 <$> scale predNat (gArbitrary (Proxy @root))
93+instance GArbitrary self f => GArbitrary self (C1 c f) where
94+ gArbitrary _ = G.M1 <$> scale predNat (gArbitrary (Proxy @self))
8595 where
8696 predNat 0 = 0
8797 predNat n = pred n
8898
8999-- | Constructor field meta information
90−instance GArbitrary root f => GArbitrary root (S1 t f) where
91− gArbitrary _ = G.M1 <$> gArbitrary (Proxy @root)
100+instance GArbitrary self f => GArbitrary self (S1 t f) where
101+ gArbitrary _ = G.M1 <$> gArbitrary (Proxy @self)
92102
93103-- | Product
94−instance (GArbitrary root a, GArbitrary root b) => GArbitrary root (a :*: b) where
95− gArbitrary _ = liftA2 (:*:) (gArbitrary (Proxy @root)) (gArbitrary (Proxy @root))
104+instance (GArbitrary self a, GArbitrary self b) => GArbitrary self (a :*: b) where
105+ gArbitrary _ = liftA2 (:*:) (gArbitrary (Proxy @self)) (gArbitrary (Proxy @self))
96106
97107-- | Calculates count of constructors encoded by particular ':+:'.
98108-- Internal use only.
@@ -100,28 +110,28 @@ type family SumLen a :: Nat where
100110 SumLen (a G.:+: b) = (SumLen a) + (SumLen b)
101111 SumLen a = 1
102112
103−type family FinalConstructors root (a :: * -> *) :: [* -> *] where
104− FinalConstructors root (a :+: b) =
105− FinalConstructors root a :++: FinalConstructors root b
106− FinalConstructors root (M1 C t f) = If (AllFieldsFinal root f) '[M1 C t f] '[]
113+type family FinalConstructors self (a :: * -> *) :: [* -> *] where
114+ FinalConstructors self (a :+: b) =
115+ FinalConstructors self a :++: FinalConstructors self b
116+ FinalConstructors self (M1 C t f) = If (AllFieldsFinal self f) '[M1 C t f] '[]
107117
108−type family AllFieldsFinal root (a :: * -> *) :: Bool where
109− AllFieldsFinal root U1 = 'True
110− AllFieldsFinal root (a :*: b) = AllFieldsFinal root a && AllFieldsFinal root b
111− AllFieldsFinal root (M1 S t (K1 R typ)) = Not (Equal (Rep typ) root)
118+type family AllFieldsFinal self (a :: * -> *) :: Bool where
119+ AllFieldsFinal self U1 = 'True
120+ AllFieldsFinal self (a :*: b) = AllFieldsFinal self a && AllFieldsFinal self b
121+ AllFieldsFinal self (M1 S t (K1 R self)) = 'False
122+ AllFieldsFinal self (M1 S t (K1 R other)) = 'True
112123
113124-- | Sum
114−instance ( (FinalConstructors root (a :+: b) ~ (x ': y))
115− , GArbitrary root a, GArbitrary root b
125+instance ( GArbitrary self a, GArbitrary self b
116126 , KnownNat (SumLen a), KnownNat (SumLen b)
117− ) => GArbitrary root (a :+: b) where
127+ ) => GArbitrary self (a :+: b) where
118128 gArbitrary _ = do
119129 sized $ \s ->
120130 if s > 1 then usual else final
121131 where
122132 usual = frequency
123− [ (lfreq, G.L1 <$> (gArbitrary (Proxy @root)))
124− , (rfreq, G.R1 <$> (gArbitrary (Proxy @root))) ]
133+ [ (lfreq, G.L1 <$> (gArbitrary (Proxy @self)))
134+ , (rfreq, G.R1 <$> (gArbitrary (Proxy @self))) ]
125135 where
126136 lfreq = fromIntegral $ natVal (Proxy :: Proxy (SumLen a))
127137 rfreq = fromIntegral $ natVal (Proxy :: Proxy (SumLen b))
@@ -129,6 +139,6 @@ instance ( (FinalConstructors root (a :+: b) ~ (x ': y))
129139
130140genericArbitrary
131141 :: forall a ga
132− . (Generic a, GArbitrary ga ga, ga ~ G.Rep a)
142+ . (Generic a, GArbitrary a ga, ga ~ G.Rep a)
133143 => Gen a
134−genericArbitrary = G.to <$> gArbitrary (Proxy @ga)
144+genericArbitrary = G.to <$> gArbitrary (Proxy @a)