registry-hedgehog-aeson-0.3.0.0: Hedgehog generators for Aeson
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.Registry.Hedgehog.AesonGenerators

Description

This module provides generators for JSON values

Since the Value data type is an ADT with different alternatives and a recursive data type we need to control how many of each variant (Number, String, Array, etc...) we generate and how deeply we recurse when generating arrays and objects which themselves contain Values.

A registry is used to store all the generators and the current generation configuration

In order to control the recursivity we tag the type of Values we generate:

  • Tag Simple Value is for generating Null, Number, String, Boolean
  • Tag Recurse Value is for generating Array and Object

And we put a Depth parameter in the registry. That parameter is decremented every time we generate values for an Array or an Object

Synopsis

Documentation

genValue :: Gen Value Source #

Generator for a default JSON value

genValueWith :: (Registry _ _ -> Registry _ _) -> Gen Value Source #

Generator for a JSON value with an adjusted set of generators

For example: - change the recursive depth of the generation: genValueWith (setDepth 5) - change the number of elements in an array or an object: genValueWith (setFieldsNb 5) - change the generator used to generate field names in an object: genValueWith (setFieldNames (elements ["a", "b", "c"])) - use a custom text generator: genValueWith (setGen myTextGenerator) - change the range used for generating numbers: genValueWith (setRange (linear @Int 0 20))

genNumberValue :: Gen Value Source #

Specialized generator for a number value

genValueFor :: Registry _ _ -> Gen Value Source #

Generate a JSON value with a given set of generators to be used when recursing

recursiveGens :: Registry _ _ -> Registry _ _ Source #

Set of generators for JSON values including recursive values like arrays and objects In order to control the recursivity of the Value data type we produce several types for JSON values using tags: Recurse Value is a generated value to be used when generating an array or an object Simple Value is a generated value that is either: a string, a number, a bool, a null value

simpleGens :: Registry _ _ Source #

Set of generators for non-recursive JSON values Those value are tagged as Simple but we can also extract a Gen Value from this list

Individual generators

genRecursiveValue :: Tag "Array" Value -> Tag "Object" Value -> Tag "Simple" Value -> Gen Value Source #

Create a generator for a Value which can possibly be recursive if it is an array or an object

untagSimpleValue :: Tag "Simple" Value -> Value Source #

Drop the tag on a Value

genSimpleValue :: Tag "Null" Value -> Tag "Bool" Value -> Tag "Number" Value -> Tag "String" Value -> Gen (Tag "Simple" Value) Source #

Create a generator for a non-recursive Value (i.e. not an array or an object)

genNull :: Gen (Tag "Null" Value) Source #

Generator for the Null value

genBool :: Gen (Tag "Bool" Value) Source #

Generator for a boolean value

genText :: Range Int -> Gen Text Source #

Generator for some Text

genString :: Text -> Tag "String" Value Source #

Generator for a string value

genNumber :: Range Integer -> Gen (Tag "Number" Value) Source #

Generator for a number value

genArray :: [Tag "Recurse" Value] -> Tag "Array" Value Source #

Generator for an array value

genObject :: [FieldName] -> [Tag "Recurse" Value] -> Tag "Object" Value Source #

Generator for an object value

Support functions

gen :: forall a b. (ApplyVariadic Gen a b, Typeable a, Typeable b) => a -> Typed b Source #

Simplification for funTo @Gen when adding a new function to the registry

setGen :: Typeable a => Gen a -> Registry _ _ -> Registry _ _ Source #

set a specific generator on top of the list of generators

setRange :: Typeable a => Range a -> Registry _ _ -> Registry _ _ Source #

set a specific range on top of the list of generators

listOf :: forall a. Int -> Int -> Gen a -> Gen [a] Source #

Generate a list of min' to max' elements

setDepth :: Depth -> Registry _ _ -> Registry _ _ Source #

Simplification for setting a new recursion depth on the registry

decrementDepth :: Registry _ _ -> Registry _ _ Source #

Decrement the depth of generation during recursion

setFieldsNb :: Int -> Registry _ _ -> Registry _ _ Source #

Set the number of fields in an object

setFieldNames :: Gen FieldName -> Registry _ _ -> Registry _ _ Source #

Set a generator for field names

newtype Depth Source #

Depth of generated Values

Constructors

Depth 

Fields

Instances

Instances details
Num Depth Source # 
Instance details

Defined in Data.Registry.Hedgehog.AesonGenerators

Show Depth Source # 
Instance details

Defined in Data.Registry.Hedgehog.AesonGenerators

Methods

showsPrec :: Int -> Depth -> ShowS #

show :: Depth -> String #

showList :: [Depth] -> ShowS #

Eq Depth Source # 
Instance details

Defined in Data.Registry.Hedgehog.AesonGenerators

Methods

(==) :: Depth -> Depth -> Bool #

(/=) :: Depth -> Depth -> Bool #

newtype FieldName Source #

Newtype for the name of fields in an object

Constructors

FieldName 

Fields