Generic.hs

-- | Simple 'GHC.Generics'-based 'arbitrary' generators.
--
-- Here is an example. Define your type.
--
-- @
-- data Tree a = Leaf a | Node (Tree a) (Tree a)
--   deriving Generic
-- @
--
-- Pick an 'arbitrary' implementation.
--
-- @
-- instance Arbitrary a => Arbitrary (Tree a) where
--   arbitrary = 'genericArbitrary' ('weights' (9 '%' 8 '%' ()))
-- @
--
-- @arbitrary :: 'Gen' (Tree a)@ picks a @Leaf@ with probability 9\/17, or a
-- @Node@ with probability 8\/17, and recursively fills their fields with
-- @arbitrary@.
--
-- == Distribution of constructors
--
-- The distribution of constructors can be specified using 'weights' applied to
-- a special list of /weights/ in the same order as the data type definition.
-- This assigns to each constructor a probability proportional to its weight;
-- in other words, @p_C = weight_C / sumOfWeights@.
--
-- The list of weights is built up with the @('%')@ operator as a cons, and using
-- the unit @()@ as the empty list, in the order corresponding to the data type
-- definition. The uniform distribution can be obtained with 'uniform'.
--
-- === Example
--
-- For @Tree@, 'genericArbitrary' produces code equivalent to the following:
--
-- @
-- 'genericArbitrary' :: Arbitrary a => 'Weights' (Tree a) -> Gen (Tree a)
-- 'genericArbitrary' ('weighted' (x '%' y '%' ())) =
--   frequency
--     [ (x, Leaf \<$\> arbitrary)
--     , (y, Node \<$\> arbitrary \<*\> arbitrary)
--     ]
-- @
--
-- === Uniform distribution
--
-- You can specify the uniform distribution (all weights equal) with 'uniform'.
-- 'genericArbitraryU' is available as a shorthand for
-- @'genericArbitrary' 'uniform'@.
--
-- Note that for many types, a uniform distribution tends to produce big
-- values. For instance for @Tree a@, generated values are finite but the
-- __average__ number of @Leaf@ and @Node@ constructors is __infinite__.
--
-- === Checked weights
--
-- /GHC 8.0.1 and above only./
--
-- The weights actually have type @'W' \"ConstructorName\"@ (just a newtype
-- around 'Int'), so that you can annotate a weight with its corresponding
-- constructor, and it will be checked that you got the order right.
--
-- This will type-check.
--
-- @
-- 'weighted' ((x :: 'W' \"Leaf\") '%' (y :: 'W' \"Node\") '%' ()) :: 'Weights' (Tree a)
-- 'weighted' (x '%' (y :: 'W' \"Node\") '%' ()) :: 'Weights' (Tree a)
-- @
--
-- This will not: the first requires an order of constructors different from
-- the definition of the @Tree@ type; the second doesn't have the right number
-- of weights.
--
-- @
-- 'weighted' ((x :: 'W' \"Node\") '%' y '%' ()) :: 'Weights' (Tree a)
-- 'weighted' (x '%' y '%' z '%' ()) :: 'Weights' (Tree a)
-- @
--
-- == Ensuring termination
--
-- As was just mentioned, one must be careful with recursive types
-- to avoid producing extremely large values.
--
-- The alternative 'genericArbitrary'' implements a simple strategy to keep
-- values at reasonable sizes: the size parameter of 'Gen' is divided among the
-- fields of the chosen constructor. When it reaches zero, the generator
-- selects a finite term whenever it can find any of the given type.  This
-- generally ensures that the number of constructors remains close to the
-- initial size parameter passed to 'Gen'.
--
-- A natural number @n@ determines the maximum /depth/ of terms that can be
-- used to end recursion.
-- It is encoded using @'Z' :: 'Z'@ and @'S' :: n -> 'S' n@.
--
-- @
-- 'genericArbitrary'' n ('weights' (...))
-- @
--
-- With @n = 'Z'@, the generator looks for a simple nullary constructor.  If none
-- exist at the current type, as is the case for our @Tree@ type, it carries on
-- as in 'genericArbitrary'.
--
-- @
-- 'genericArbitrary'' 'Z' :: Arbitrary a => 'Weights' (Tree a) -> Gen (Tree a)
-- 'genericArbitrary'' 'Z' ('weights' (x '%' y '%' ())) =
--   frequency
--     [ (x, Leaf \<$\> arbitrary)
--     , (y, scale (\`div\` 2) $ Node \<$\> arbitrary \<*\> arbitrary)
--     -- 2 because Node is 2-ary.
--     ]
-- @
--
-- Here is another example with nullary constructors:
--
-- @
-- data Tree' = Leaf1 | Leaf2 | Node3 Tree' Tree' Tree'
--   deriving Generic
--
-- instance Arbitrary Tree' where
--   arbitrary = 'genericArbitrary'' 'Z' ('weights' (1 '%' 2 '%' 3 '%' ()))
-- @
--
-- Here, @'genericArbitrary'' 'Z'@ is equivalent to:
--
-- @
-- 'genericArbitrary'' 'Z' :: 'Weights' Tree' -> Gen Tree'
-- 'genericArbitrary'' 'Z' ('weights' (x '%' y '%' z '%' ())) =
--   sized $ \n ->
--     if n == 0 then
--       -- If the size parameter is zero, the non-nullary alternative is discarded.
--       frequency $
--         [ (x, return Leaf1)
--         , (y, return Leaf2)
--         ]
--     else
--       frequency $
--         [ (x, return Leaf1)
--         , (y, return Leaf2)
--         , (z, resize (n \`div\` 3) node)  -- 3 because Node3 is 3-ary
--         ]
--   where
--     node = Node3 \<$\> arbitrary \<*\> arbitrary \<*\> arbitrary
-- @
--
-- To increase the chances of termination when no nullary constructor is directly
-- available, such as in @Tree@, we can pass a larger depth @n@. The effectiveness
-- of this parameter depends on the concrete type the generator is used for.
--
-- For instance, if we want to generate a value of type @Tree ()@, there is a
-- value of depth 1 (represented by @'S' 'Z'@) that we can use to end
-- recursion: @Leaf ()@.
--
-- @
-- 'genericArbitrary'' ('S' 'Z') :: 'Weights' (Tree ()) -> Gen (Tree ())
-- 'genericArbitrary'' ('S' 'Z') ('weights' (x '%' y '%' ())) =
--   sized $ \n ->
--     if n == 0 then
--       return (Leaf ())
--     else
--       frequency
--         [ (x, Leaf \<$\> arbitrary)
--         , (y, scale (\`div\` 2) $ Node \<$\> arbitrary \<*\> arbitrary)
--         ]
-- @
--
-- Because the argument of @Tree@ must be inspected in order to discover
-- values of type @Tree ()@, we incur some extra constraints if we want
-- polymorphism.
--
-- @UndecidableInstances@ is also required.
--
-- @
-- instance (Arbitrary a, Generic a, 'ListBaseCases' 'Z' (Rep a))
--   => Arbitrary (Tree a) where
--   arbitrary = 'genericArbitrary'' ('S' 'Z') ('weights' (1 '%' 2 '%' ()))
-- @
--
-- A synonym is provided for brevity.
--
-- @
-- instance (Arbitrary a, 'BaseCases'' Z a) => Arbitrary (Tree a) where
--   arbitrary = 'genericArbitrary'' ('S' 'Z') ('weights' (1 '%' 2 '%' ()))
-- @


module Generic.Random.Generic
  (
    -- * Arbitrary implementations
    genericArbitrary
  , genericArbitraryU
  , genericArbitrary'
  , genericArbitraryU0
  , genericArbitraryU1

    -- * Specifying finite distributions
  , Weights
  , W
  , weights
  , (%)
  , uniform

    -- * Type-level natural numbers
    -- $nat
  , Z (..)
  , S (..)

    -- * Generic classes for finite values
  , BaseCases'
  , BaseCases
  , ListBaseCases
  ) where

import Generic.Random.Internal.Generic