| Safe Haskell | None | 
|---|---|
| Language | Haskell2010 | 
Generic.Random
Contents
Description
GHC.Generics-based arbitrary generators.
Basic usage
data Foo = A | B | C -- some generic data type deriving Generic Derive instances of Arbitrary.
instance Arbitrary Foo where arbitrary =genericArbitraryuniform-- give a distribution of constructors
Or derive standalone generators (the fields must still be instances of Arbitrary, or use custom generators).
genFoo :: Gen Foo genFoo =genericArbitraryuniform
For more information:
Synopsis
- genericArbitrary :: GArbitrary UnsizedOpts a => Weights a -> Gen a
 - genericArbitraryU :: (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
 - genericArbitrarySingle :: (GArbitrary UnsizedOpts a, Weights_ (Rep a) ~ L c0) => Gen a
 - genericArbitraryRec :: GArbitrary SizedOptsDef a => Weights a -> Gen a
 - genericArbitrary' :: (GArbitrary SizedOptsDef a, BaseCase a) => Weights a -> Gen a
 - genericArbitraryU' :: (GArbitrary SizedOptsDef a, BaseCase a, GUniformWeight a) => Gen a
 - genericArbitraryG :: GArbitrary (SetGens genList UnsizedOpts) a => genList -> Weights a -> Gen a
 - genericArbitraryUG :: (GArbitrary (SetGens genList UnsizedOpts) a, GUniformWeight a) => genList -> Gen a
 - genericArbitrarySingleG :: (GArbitrary (SetGens genList UnsizedOpts) a, Weights_ (Rep a) ~ L c0) => genList -> Gen a
 - genericArbitraryRecG :: GArbitrary (SetGens genList SizedOpts) a => genList -> Weights a -> Gen a
 - data Weights a
 - data W (c :: Symbol)
 - (%) :: (WeightBuilder' w, c ~. First' w) => W c -> Prec' w -> w
 - uniform :: UniformWeight_ (Rep a) => Weights a
 - data a :+ b = a :+ b
 - newtype FieldGen (s :: Symbol) a = FieldGen {
- unFieldGen :: Gen a
 
 - fieldGen :: proxy s -> Gen a -> FieldGen s a
 - newtype ConstrGen (c :: Symbol) (i :: Nat) a = ConstrGen {
- unConstrGen :: Gen a
 
 - constrGen :: proxy '(c, i) -> Gen a -> ConstrGen c i a
 - newtype Gen1 f = Gen1 {}
 - newtype Gen1_ f = Gen1_ {}
 - listOf' :: Gen a -> Gen [a]
 - listOf1' :: Gen a -> Gen [a]
 - vectorOf' :: Int -> Gen a -> Gen [a]
 - withBaseCase :: Gen a -> Gen a -> Gen a
 - class BaseCase a where
 - data Options (s :: Sizing) (genList :: Type)
 - genericArbitraryWith :: GArbitrary opts a => opts -> Weights a -> Gen a
 - data Sizing
 - setSized :: Options s g -> Options Sized g
 - setUnsized :: Options s g -> Options Unsized g
 - type family SetGens (g :: Type) opts
 - setGenerators :: genList -> Options s g0 -> Options s genList
 - type SizedOpts = Options Sized ()
 - sizedOpts :: SizedOpts
 - type SizedOptsDef = Options Sized (Gen1 [] :+ ())
 - sizedOptsDef :: SizedOptsDef
 - type UnsizedOpts = Options Unsized ()
 - unsizedOpts :: UnsizedOpts
 - class (Generic a, GA opts (Rep a)) => GArbitrary opts a
 - class UniformWeight_ (Rep a) => GUniformWeight a
 
Arbitrary implementations
The suffixes for the variants have the following meanings:
U: pick constructors with uniform distribution (equivalent to passinguniformto the non-Uvariant).Single: restricted to types with a single constructor.G: with custom generators.Rec: decrease the size at every recursive call (ensuring termination for (most) recursive types).': automatic discovery of "base cases" when size reaches 0.
Arguments
| :: GArbitrary UnsizedOpts a | |
| => Weights a | List of weights for every constructor  | 
| -> Gen a | 
Pick a constructor with a given distribution, and fill its fields with recursive calls to arbitrary.
Example
genericArbitrary (2 % 3 % 5 % ()) :: Gen a
Picks the first constructor with probability 2/10, the second with probability 3/10, the third with probability 5/10.
genericArbitraryU :: (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a Source #
Pick every constructor with equal probability. Equivalent to .genericArbitrary uniform
genericArbitraryU :: Gen a
genericArbitrarySingle :: (GArbitrary UnsizedOpts a, Weights_ (Rep a) ~ L c0) => Gen a Source #
arbitrary for types with one constructor. Equivalent to genericArbitraryU, with a stricter type.
genericArbitrarySingle :: Gen a
Arguments
| :: GArbitrary SizedOptsDef a | |
| => Weights a | List of weights for every constructor  | 
| -> Gen a | 
Arguments
| :: (GArbitrary SizedOptsDef a, BaseCase a) | |
| => Weights a | List of weights for every constructor  | 
| -> Gen a | 
genericArbitraryU' :: (GArbitrary SizedOptsDef a, BaseCase a, GUniformWeight a) => Gen a Source #
Equivalent to .genericArbitrary' uniform
genericArbitraryU' :: Gen a
N.B.: This replaces the generator for fields of type [t] with  instead of listOf' arbitrary (i.e., listOf arbitraryarbitrary for lists).
With custom generators
Note about incoherence
The custom generator feature relies on incoherent instances, which can lead to surprising behaviors for parameterized types.
Example
For example, here is a pair type and a custom generator of Int (always generating 0).
data Pair a b = Pair a b deriving (Generic, Show) customGen :: Gen Int customGen = pure 0
The following two ways of defining a generator of Pair Int Int are not equivalent.
The first way is to use genericArbitrarySingleG to define a Gen (Pair a b) parameterized by types a and b, and then specialize it to Gen (Pair Int Int).
In this case, the customGen will be ignored.
genPair :: (Arbitrary a, Arbitrary b) => Gen (Pair a b) genPair = genericArbitrarySingleG customGen genPair' :: Gen (Pair Int Int) genPair' = genPair -- Will generate nonzero pairs The second way is to define Gen (Pair Int Int) directly using genericArbitrarySingleG (as if we inlined genPair in genPair' above.
Then the customGen will actually be used.
genPair2 :: Gen (Pair Int Int) genPair2 = genericArbitrarySingleG customGen -- Will only generate (Pair 0 0) In other words, the decision of whether to use a custom generator is done by comparing the type of the custom generator with the type of the field only in the context where genericArbitrarySingleG is being used (or any other variant with a G suffix).
In the first case above, those fields have types a and b, which are not equal to Int (or rather, there is no available evidence that they are equal to Int, even if they could be instantiated as Int later). In the second case, they both actually have type Int.
genericArbitraryG :: GArbitrary (SetGens genList UnsizedOpts) a => genList -> Weights a -> Gen a Source #
genericArbitrary with explicit generators.
Example
genericArbitraryG customGens (17 % 19 % ())
where, for example to override generators for String and Int fields,
customGens :: Gen String:+Gen Int customGens = (filter (/= '\NUL')<$>arbitrary):+(getNonNegative<$>arbitrary)
Note on multiple matches
If the list contains multiple matching types for a field x of type a (i.e., either Gen a or ), the generator for the first match will be picked.FieldGen "x" a
genericArbitraryUG :: (GArbitrary (SetGens genList UnsizedOpts) a, GUniformWeight a) => genList -> Gen a Source #
genericArbitraryU with explicit generators. See also genericArbitraryG.
genericArbitrarySingleG :: (GArbitrary (SetGens genList UnsizedOpts) a, Weights_ (Rep a) ~ L c0) => genList -> Gen a Source #
genericArbitrarySingle with explicit generators. See also genericArbitraryG.
Arguments
| :: GArbitrary (SetGens genList SizedOpts) a | |
| => genList | |
| -> Weights a | List of weights for every constructor  | 
| -> Gen a | 
genericArbitraryRec with explicit generators. See also genericArbitraryG.
Specifying finite distributions
Trees of weights assigned to constructors of type a, rescaled to obtain a probability distribution.
Two ways of constructing them.
(x1%x2%...%xn%()) ::Weightsauniform::Weightsa
Using (, there must be exactly as many weights as there are constructors.%)
uniform is equivalent to (1  (automatically fills out the right number of 1s).% ... % 1 % ())
(%) :: (WeightBuilder' w, c ~. First' w) => W c -> Prec' w -> w infixr 1 Source #
A binary constructor for building up trees of weights.
Custom generators
Heterogeneous list of generators.
Constructors
| a :+ b infixr 1 | 
Instances
| ArbitraryOr fg b g sel a => ArbitraryOr fg () (b :+ g) sel a Source # | Examine the next candidate  | 
Defined in Generic.Random.Internal.Generic Methods arbitraryOr :: proxy sel -> fg -> () -> (b :+ g) -> Gen a Source #  | |
| ArbitraryOr fg g (h :+ gs) sel a => ArbitraryOr fg (g :+ h) gs sel a Source # | This can happen if the generators form a tree rather than a list, for whatever reason.  | 
Defined in Generic.Random.Internal.Generic Methods arbitraryOr :: proxy sel -> fg -> (g :+ h) -> gs -> Gen a Source #  | |
newtype FieldGen (s :: Symbol) a Source #
Custom generator for record fields named s.
Available only for base >= 4.9 (GHC >= 8.0.1).
Constructors
| FieldGen | |
Fields 
  | |
Instances
| a ~ a' => ArbitraryOr fg (FieldGen s a) g ((,,) con i (Just s)) a' Source # | Matching custom generator for field   | 
Defined in Generic.Random.Internal.Generic  | |
fieldGen :: proxy s -> Gen a -> FieldGen s a Source #
FieldGen constructor with the field name given via a proxy.
newtype ConstrGen (c :: Symbol) (i :: Nat) a Source #
Custom generator for the i-th field of the constructor named c.
Available only for base >= 4.9 (GHC >= 8.0.1).
Constructors
| ConstrGen | |
Fields 
  | |
Instances
| a ~ a' => ArbitraryOr fg (ConstrGen c i a) g ((,,) (Just c) i s) a' Source # | Matching custom generator for   | 
Defined in Generic.Random.Internal.Generic  | |
constrGen :: proxy '(c, i) -> Gen a -> ConstrGen c i a Source #
ConstrGen constructor with the constructor name given via a proxy.
Custom generators for "containers" of kind Type -> Type, parameterized by the generator for "contained elements".
A custom generator  will be used for any field whose type has the form Gen1 ff x, requiring a generator of x.
Instances
| ArbitraryOr fg () fg ((,,) (Nothing :: Maybe Symbol) 0 (Nothing :: Maybe Symbol)) a => ArbitraryOr fg (Gen1 f) g sel (f a) Source # | Matching custom generator for container   | 
Defined in Generic.Random.Internal.Generic Methods arbitraryOr :: proxy sel -> fg -> Gen1 f -> g -> Gen (f a) Source #  | |
Custom generators for unary type constructors that are not "containers", i.e., which don't require a generator of a to generate an f a.
A custom generator  will be used for any field whose type has the form Gen1_ ff x.
Instances
| ArbitraryOr fg (Gen1_ f) g sel (f a) Source # | Matching custom generator for non-container   | 
Defined in Generic.Random.Internal.Generic Methods arbitraryOr :: proxy sel -> fg -> Gen1_ f -> g -> Gen (f a) Source #  | |
Helpful combinators
listOf' :: Gen a -> Gen [a] Source #
An alternative to listOf that divides the size parameter by the length of the list. The length follows a geometric distribution of parameter 1/(sqrt size + 1).
listOf1' :: Gen a -> Gen [a] Source #
An alternative to listOf1 (nonempty lists) that divides the size parameter by the length of the list. The length (minus one) follows a geometric distribution of parameter 1/(sqrt size + 1).
vectorOf' :: Int -> Gen a -> Gen [a] Source #
An alternative to vectorOf that divides the size parameter by the length of the list.
Base cases for recursive types
withBaseCase :: Gen a -> Gen a -> Gen a Source #
Run the first generator if the size is positive. Run the second if the size is zero.
defaultGen `withBaseCase` baseCaseGen
class BaseCase a where Source #
Custom instances can override the default behavior.
Instances
| BaseCaseSearching a 0 => BaseCase a Source # | Overlappable  | 
Defined in Generic.Random.Internal.BaseCase  | |
Full options
data Options (s :: Sizing) (genList :: Type) Source #
Type-level options for GArbitrary.
Instances
| HasGenerators (Options s g) Source # | |
Defined in Generic.Random.Internal.Generic Methods generators :: Options s g -> GeneratorsOf (Options s g) Source #  | |
| type SetGens g (Options s _g) Source # | |
Defined in Generic.Random.Internal.Generic  | |
| type GeneratorsOf (Options _s g) Source # | |
Defined in Generic.Random.Internal.Generic  | |
| type SizingOf (Options s _g) Source # | |
Defined in Generic.Random.Internal.Generic  | |
genericArbitraryWith :: GArbitrary opts a => opts -> Weights a -> Gen a Source #
General generic generator with custom options.
Size modifiers
Whether to decrease the size parameter before generating fields.
Custom generators
setGenerators :: genList -> Options s g0 -> Options s genList Source #
Common options
sizedOptsDef :: SizedOptsDef Source #
Default options overriding the list generator using listOf'.
type UnsizedOpts = Options Unsized () Source #
unsizedOpts :: UnsizedOpts Source #
Default options for unsized generators.
Generic classes
class (Generic a, GA opts (Rep a)) => GArbitrary opts a Source #
Generic Arbitrary
Instances
| (Generic a, GA opts (Rep a)) => GArbitrary opts a Source # | |
Defined in Generic.Random.Internal.Generic  | |
class UniformWeight_ (Rep a) => GUniformWeight a Source #
Derived uniform distribution of constructors for a.
Instances
| UniformWeight_ (Rep a) => GUniformWeight a Source # | |
Defined in Generic.Random.Internal.Generic  | |