@@ -73,6 +73,11 @@ type family Finite self (a :: * -> *) :: Bool where
7373 Finite self (M1 C c f) = AllFieldsFinal self f
7474 Finite self (M1 S s f) = Finite self f
7575
76+type family ArgumentsCount (a :: * -> *) :: Nat where
77+ ArgumentsCount U1 = 1
78+ ArgumentsCount (M1 S s f) = 1
79+ ArgumentsCount (a :*: b) = (ArgumentsCount a) + (ArgumentsCount b)
80+
7681-- | Calculates count of constructors encoded by particular ':+:'.
7782-- Internal use only.
7883type family SumLen a :: Nat where
@@ -96,12 +101,15 @@ instance
96101-- | The constructor meta information
97102instance
98103 ( GArbitrary self f some
104+ , KnownNat (ArgumentsCount f)
99105 , AllFieldsFinal self f ~ some
100106 ) => GArbitrary self (C1 c f) some where
101107 gArbitrary = M1 <$> scale predNat (gArbitrary @self)
102108 where
103− predNat 0 = 0
104− predNat n = pred n
109+ argumentsCount = fromIntegral $ natVal (Proxy @(ArgumentsCount f))
110+ predNat n = max 0 $ if argumentsCount > 1
111+ then n `div` argumentsCount
112+ else pred n
105113
106114-- | Unit type instance
107115instance GArbitrary self U1 'True where