@@ -59,12 +59,6 @@ instance
59 arbitrary = coerce (genericArbitrary :: Gen a)
59 arbitrary = coerce (genericArbitrary :: Gen a)
60 shrink = coerce (genericShrink :: a -> [a])
60 shrink = coerce (genericShrink :: a -> [a])
63−-- type family FinalConstructors self (a :: * -> *) :: [* -> *] where
64−-- FinalConstructors self (a :+: b) =
65−-- FinalConstructors self a :++: FinalConstructors self b
66−-- FinalConstructors self (M1 C t f) = If (AllFieldsFinal self f) '[M1 C t f] '[]
68type family AllFieldsFinal self (a :: * -> *) :: Bool where
62type family AllFieldsFinal self (a :: * -> *) :: Bool where
69 AllFieldsFinal self U1 = 'True
63 AllFieldsFinal self U1 = 'True
70 AllFieldsFinal self (a :*: b) = AllFieldsFinal self a && AllFieldsFinal self b
64 AllFieldsFinal self (a :*: b) = AllFieldsFinal self a && AllFieldsFinal self b
@@ -147,7 +141,7 @@ instance
147 , GArbitrary self (a :+: b) 'True
141 , GArbitrary self (a :+: b) 'True
148 ) => GArbitrary self (D1 t (a :+: b)) 'True where
142 ) => GArbitrary self (D1 t (a :+: b)) 'True where
149 gArbitrary = sized $ \s -> M1 <$>
143 gArbitrary = sized $ \s -> M1 <$>
150− if s > 1 then gArbitrary @self else finiteSum @self
144+ if s > 1 then gArbitrary @self else oneof (finiteSum @self @a @b)
152-- | Any sum inside of declaration
146-- | Any sum inside of declaration
@@ -165,33 +159,33 @@ instance
166 ( Finite self a ~ af, Finite self b ~ bf
160 ( Finite self a ~ af, Finite self b ~ bf
167 ) => FiniteSum self (a :: * -> *) (b :: * -> *) af bf where
161 ) => FiniteSum self (a :: * -> *) (b :: * -> *) af bf where
168− finiteSum :: Gen ((a :+: b) p)
162+ finiteSum :: [Gen ((a :+: b) p)]
171 ( FiniteSumElem self a, FiniteSumElem self b
165 ( FiniteSumElem self a, FiniteSumElem self b
172 , Finite self a ~ 'True
166 , Finite self a ~ 'True
173 , Finite self b ~ 'True
167 , Finite self b ~ 'True
174 ) => FiniteSum self a b 'True 'True where
168 ) => FiniteSum self a b 'True 'True where
175− finiteSum = oneof
169+ finiteSum = concat
176− [ L1 <$> finiteElem @self
170+ [ fmap L1 <$> finiteElem @self @a
177− , R1 <$> finiteElem @self ]
171+ , fmap R1 <$> finiteElem @self @b]
180 ( FiniteSumElem self a
174 ( FiniteSumElem self a
181 , Finite self a ~ 'True
175 , Finite self a ~ 'True
182 , Finite self b ~ 'False
176 , Finite self b ~ 'False
183 ) => FiniteSum self a b 'True 'False where
177 ) => FiniteSum self a b 'True 'False where
184− finiteSum = L1 <$> finiteElem @self
178+ finiteSum = fmap L1 <$> finiteElem @self @a
187 ( FiniteSumElem self b
181 ( FiniteSumElem self b
188 , Finite self a ~ 'False
182 , Finite self a ~ 'False
189 , Finite self b ~ 'True
183 , Finite self b ~ 'True
190 ) => FiniteSum self a b 'False 'True where
184 ) => FiniteSum self a b 'False 'True where
191− finiteSum = R1 <$> finiteElem @self
185+ finiteSum = fmap R1 <$> finiteElem @self @b
193class FiniteSumElem self a where
187class FiniteSumElem self a where
194− finiteElem :: Gen (a p)
188+ finiteElem :: [Gen (a p)]
197 ( FiniteSum self a b af bf
191 ( FiniteSum self a b af bf
@@ -201,7 +195,7 @@ instance
202 ( GArbitrary self (C1 c f) 'True
196 ( GArbitrary self (C1 c f) 'True
203 ) => FiniteSumElem self (C1 c f) where
197 ) => FiniteSumElem self (C1 c f) where
204− finiteElem = gArbitrary @self
198+ finiteElem = [gArbitrary @self]
207 ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")
201 ( TypeError (ShowType self :<>: Text " refers to itself in all constructors")