    {-# OPTIONS_HADDOCK not-home #-}

    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeInType #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}

    -- | Core implementation.
    --
    -- === Warning
    --
    -- This is an internal module: it is not subject to any versioning policy,
    -- breaking changes can happen at any time.
    --
    -- If something here seems useful, please report it or create a pull request to
    -- export it from an external module.

    module Generic.Random.Internal.Generic where

    import Control.Applicative (Alternative(..), liftA2)
    import Data.Coerce (Coercible, coerce)
    import Data.Kind (Type)

    import Data.Proxy (Proxy(..))
    import Data.Type.Bool (type (&&))
    import Data.Type.Equality (type (==))

    import GHC.Generics hiding (S, prec)
    import GHC.TypeLits (KnownNat, Nat, Symbol, type (+), natVal)
    import Test.QuickCheck (Arbitrary(..), Gen, choose, scale, sized, vectorOf)

    -- * Random generators

    -- | 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@.
    genericArbitrary
      :: (GArbitrary UnsizedOpts a)
      => Weights a  -- ^ List of weights for every constructor
      -> Gen a
    genericArbitrary :: forall a. GArbitrary UnsizedOpts a => Weights a -> Gen a
    genericArbitrary = UnsizedOpts -> Weights a -> Gen a
    forall opts a. GArbitrary opts a => opts -> Weights a -> Gen a
    genericArbitraryWith UnsizedOpts
    unsizedOpts

    -- | Pick every constructor with equal probability.
    -- Equivalent to @'genericArbitrary' 'uniform'@.
    --
    -- > genericArbitraryU :: Gen a
    genericArbitraryU
      :: (GArbitrary UnsizedOpts a, GUniformWeight a)
      => Gen a
    genericArbitraryU :: forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
    genericArbitraryU = Weights a -> Gen a
    forall a. GArbitrary UnsizedOpts a => Weights a -> Gen a
    genericArbitrary Weights a
    forall a. UniformWeight_ (Rep a) => Weights a
    uniform

    -- | 'arbitrary' for types with one constructor.
    -- Equivalent to 'genericArbitraryU', with a stricter type.
    --
    -- > genericArbitrarySingle :: Gen a
    genericArbitrarySingle
      :: (GArbitrary UnsizedOpts a, Weights_ (Rep a) ~ L c0)
      => Gen a
    genericArbitrarySingle :: forall a (c0 :: Symbol).
    (GArbitrary UnsizedOpts a, Weights_ (Rep a) ~ L c0) =>
    Gen a
    genericArbitrarySingle = Gen a
    forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
    genericArbitraryU

    -- | Decrease size at every recursive call, but don't do anything different
    -- at size 0.
    --
    -- > genericArbitraryRec (7 % 11 % 13 % ()) :: Gen a
    --
    -- N.B.: This replaces the generator for fields of type @[t]@ with
    -- @'listOf'' arbitrary@ instead of @'Test.QuickCheck.listOf' arbitrary@ (i.e., @arbitrary@ for
    -- lists).
    genericArbitraryRec
      :: (GArbitrary SizedOptsDef a)
      => Weights a  -- ^ List of weights for every constructor
      -> Gen a
    genericArbitraryRec :: forall a. GArbitrary SizedOptsDef a => Weights a -> Gen a
    genericArbitraryRec = SizedOptsDef -> Weights a -> Gen a
    forall opts a. GArbitrary opts a => opts -> Weights a -> Gen a
    genericArbitraryWith SizedOptsDef
    sizedOptsDef

    -- | 'genericArbitrary' with explicit generators.
    --
    -- === Example
    --
    -- > genericArbitraryG customGens (17 % 19 % ())
    --
    -- where, the generators for 'String' and 'Int' fields are overridden as
    -- follows, for example:
    --
    -- @
    -- customGens :: Gen String ':+' Gen Int
    -- customGens =
    --   (filter (/= '\NUL') '<$>' arbitrary) ':+'
    --   (getNonNegative '<$>' arbitrary)
    -- @
    --
    -- === Note on multiple matches
    --
    -- Multiple generators may match a given field: the first will be chosen.
    genericArbitraryG
      :: (GArbitrary (SetGens genList UnsizedOpts) a)
      => genList
      -> Weights a
      -> Gen a
    genericArbitraryG :: forall genList a.
    GArbitrary (SetGens genList UnsizedOpts) a =>
    genList -> Weights a -> Gen a
    genericArbitraryG genList
    gs = Options 'INCOHERENT 'Unsized genList -> Weights a -> Gen a
    forall opts a. GArbitrary opts a => opts -> Weights a -> Gen a
    genericArbitraryWith Options 'INCOHERENT 'Unsized genList
    opts
      where
        opts :: Options 'INCOHERENT 'Unsized genList
    opts = genList -> UnsizedOpts -> Options 'INCOHERENT 'Unsized genList
    forall genList (c :: Coherence) (s :: Sizing) g0.
    genList -> Options c s g0 -> Options c s genList
    setGenerators genList
    gs UnsizedOpts
    unsizedOpts

    -- | 'genericArbitraryU' with explicit generators.
    -- See also 'genericArbitraryG'.
    genericArbitraryUG
      :: (GArbitrary (SetGens genList UnsizedOpts) a, GUniformWeight a)
      => genList
      -> Gen a
    genericArbitraryUG :: forall genList a.
    (GArbitrary (SetGens genList UnsizedOpts) a, GUniformWeight a) =>
    genList -> Gen a
    genericArbitraryUG genList
    gs = genList -> Weights a -> Gen a
    forall genList a.
    GArbitrary (SetGens genList UnsizedOpts) a =>
    genList -> Weights a -> Gen a
    genericArbitraryG genList
    gs Weights a
    forall a. UniformWeight_ (Rep a) => Weights a
    uniform

    -- | 'genericArbitrarySingle' with explicit generators.
    -- See also 'genericArbitraryG'.
    genericArbitrarySingleG
      :: (GArbitrary (SetGens genList UnsizedOpts) a, Weights_ (Rep a) ~ L c0)
      => genList
      -> Gen a
    genericArbitrarySingleG :: forall genList a (c0 :: Symbol).
    (GArbitrary (SetGens genList UnsizedOpts) a,
     Weights_ (Rep a) ~ L c0) =>
    genList -> Gen a
    genericArbitrarySingleG = genList -> Gen a
    forall genList a.
    (GArbitrary (SetGens genList UnsizedOpts) a, GUniformWeight a) =>
    genList -> Gen a
    genericArbitraryUG

    -- | 'genericArbitraryRec' with explicit generators.
    -- See also 'genericArbitraryG'.
    genericArbitraryRecG
      :: (GArbitrary (SetGens genList SizedOpts) a)
      => genList
      -> Weights a  -- ^ List of weights for every constructor
      -> Gen a
    genericArbitraryRecG :: forall genList a.
    GArbitrary (SetGens genList SizedOpts) a =>
    genList -> Weights a -> Gen a
    genericArbitraryRecG genList
    gs = Options 'INCOHERENT 'Sized genList -> Weights a -> Gen a
    forall opts a. GArbitrary opts a => opts -> Weights a -> Gen a
    genericArbitraryWith Options 'INCOHERENT 'Sized genList
    opts
      where
        opts :: Options 'INCOHERENT 'Sized genList
    opts = genList -> SizedOpts -> Options 'INCOHERENT 'Sized genList
    forall genList (c :: Coherence) (s :: Sizing) g0.
    genList -> Options c s g0 -> Options c s genList
    setGenerators genList
    gs SizedOpts
    sizedOpts

    -- | General generic generator with custom options.
    genericArbitraryWith
      :: (GArbitrary opts a)
      => opts -> Weights a -> Gen a
    genericArbitraryWith :: forall opts a. GArbitrary opts a => opts -> Weights a -> Gen a
    genericArbitraryWith opts
    opts (Weights Weights_ (Rep a)
    w Int
    n) =
      (Rep a (ZonkAny 0) -> a) -> Gen (Rep a (ZonkAny 0)) -> Gen a
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Rep a (ZonkAny 0) -> a
    forall a x. Generic a => Rep a x -> a
    forall x. Rep a x -> a
    to (opts -> Weights_ (Rep a) -> Int -> Gen (Rep a (ZonkAny 0))
    forall p. opts -> Weights_ (Rep a) -> Int -> Gen (Rep a p)
    forall opts (f :: * -> *) p.
    GA opts f =>
    opts -> Weights_ f -> Int -> Gen (f p)
    ga opts
    opts Weights_ (Rep a)
    w Int
    n)

    -- * Internal

    type family Weights_ (f :: Type -> Type) :: Type where
      Weights_ (f :+: g) = Weights_ f :| Weights_ g
      Weights_ (M1 D _c f) = Weights_ f
      Weights_ (M1 C ('MetaCons c _i _j) _f) = L c

    data a :| b = N a Int b
    data L (c :: Symbol) = L

    -- | Trees of weights assigned to constructors of type @a@,
    -- rescaled to obtain a probability distribution.
    --
    -- Two ways of constructing them.
    --
    -- @
    -- (x1 '%' x2 '%' ... '%' xn '%' ()) :: 'Weights' a
    -- 'uniform' :: 'Weights' a
    -- @
    --
    -- Using @('%')@, there must be exactly as many weights as
    -- there are constructors.
    --
    -- 'uniform' is equivalent to @(1 '%' ... '%' 1 '%' ())@
    -- (automatically fills out the right number of 1s).
    data Weights a = Weights (Weights_ (Rep a)) Int

    -- | Type of a single weight, tagged with the name of the associated
    -- constructor for additional compile-time checking.
    --
    -- @
    -- ((9 :: 'W' \"Leaf\") '%' (8 :: 'W' \"Node\") '%' ())
    -- @
    newtype W (c :: Symbol) = W Int deriving Integer -> W c
    W c -> W c
    W c -> W c -> W c
    (W c -> W c -> W c)
    -> (W c -> W c -> W c)
    -> (W c -> W c -> W c)
    -> (W c -> W c)
    -> (W c -> W c)
    -> (W c -> W c)
    -> (Integer -> W c)
    -> Num (W c)
    forall a.
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (Integer -> a)
    -> Num a
    forall (c :: Symbol). Integer -> W c
    forall (c :: Symbol). W c -> W c
    forall (c :: Symbol). W c -> W c -> W c
    $c+ :: forall (c :: Symbol). W c -> W c -> W c
    + :: W c -> W c -> W c
    $c- :: forall (c :: Symbol). W c -> W c -> W c
    - :: W c -> W c -> W c
    $c* :: forall (c :: Symbol). W c -> W c -> W c
    * :: W c -> W c -> W c
    $cnegate :: forall (c :: Symbol). W c -> W c
    negate :: W c -> W c
    $cabs :: forall (c :: Symbol). W c -> W c
    abs :: W c -> W c
    $csignum :: forall (c :: Symbol). W c -> W c
    signum :: W c -> W c
    $cfromInteger :: forall (c :: Symbol). Integer -> W c
    fromInteger :: Integer -> W c
    Num

    -- | A smart constructor to specify a custom distribution.
    -- It can be omitted for the '%' operator is overloaded to
    -- insert it.
    weights :: (Weights_ (Rep a), Int, ()) -> Weights a
    weights :: forall a. (Weights_ (Rep a), Int, ()) -> Weights a
    weights (Weights_ (Rep a)
    w, Int
    n, ()) = Weights_ (Rep a) -> Int -> Weights a
    forall a. Weights_ (Rep a) -> Int -> Weights a
    Weights Weights_ (Rep a)
    w Int
    n

    -- | Uniform distribution.
    uniform :: UniformWeight_ (Rep a) => Weights a
    uniform :: forall a. UniformWeight_ (Rep a) => Weights a
    uniform =
      let (Weights_ (Rep a)
    w, Int
    n) = (Weights_ (Rep a), Int)
    forall a. UniformWeight a => (a, Int)
    uniformWeight
      in Weights_ (Rep a) -> Int -> Weights a
    forall a. Weights_ (Rep a) -> Int -> Weights a
    Weights Weights_ (Rep a)
    w Int
    n

    type family First a :: Symbol where
      First (a :| _b) = First a
      First (L c) = c

    type family First' w where
      First' (Weights a) = First (Weights_ (Rep a))
      First' (a, Int, r) = First a

    type family Prec' w where
      Prec' (Weights a) = Prec (Weights_ (Rep a)) ()
      Prec' (a, Int, r) = Prec a r

    class WeightBuilder' w where

      -- | A binary constructor for building up trees of weights.
      (%) :: (c ~ First' w) => W c -> Prec' w -> w

    instance WeightBuilder (Weights_ (Rep a)) => WeightBuilder' (Weights a) where
      W c
    w % :: forall (c :: Symbol).
    (c ~ First' (Weights a)) =>
    W c -> Prec' (Weights a) -> Weights a
    % Prec' (Weights a)
    prec = (Weights_ (Rep a), Int, ()) -> Weights a
    forall a. (Weights_ (Rep a), Int, ()) -> Weights a
    weights (W c
    w W c -> Prec (Weights_ (Rep a)) () -> (Weights_ (Rep a), Int, ())
    forall a (c :: Symbol) r.
    (WeightBuilder a, c ~ First a) =>
    W c -> Prec a r -> (a, Int, r)
    forall (c :: Symbol) r.
    (c ~ First (Weights_ (Rep a))) =>
    W c -> Prec (Weights_ (Rep a)) r -> (Weights_ (Rep a), Int, r)
    %. Prec (Weights_ (Rep a)) ()
    Prec' (Weights a)
    prec)

    instance WeightBuilder a => WeightBuilder' (a, Int, r) where
      % :: forall (c :: Symbol).
    (c ~ First' (a, Int, r)) =>
    W c -> Prec' (a, Int, r) -> (a, Int, r)
    (%) = W c -> Prec a r -> (a, Int, r)
    W c -> Prec' (a, Int, r) -> (a, Int, r)
    forall a (c :: Symbol) r.
    (WeightBuilder a, c ~ First a) =>
    W c -> Prec a r -> (a, Int, r)
    forall (c :: Symbol) r.
    (c ~ First a) =>
    W c -> Prec a r -> (a, Int, r)
    (%.)

    class WeightBuilder a where
      type Prec a r

      (%.) :: (c ~ First a) => W c -> Prec a r -> (a, Int, r)

    infixr 1 %

    instance WeightBuilder a => WeightBuilder (a :| b) where
      type Prec (a :| b) r = Prec a (b, Int, r)
      W c
    m %. :: forall (c :: Symbol) r.
    (c ~ First (a :| b)) =>
    W c -> Prec (a :| b) r -> (a :| b, Int, r)
    %. Prec (a :| b) r
    prec =
        let (a
    a, Int
    n, (b
    b, Int
    p, r
    r)) = W c
    m W c -> Prec' (a, Int, (b, Int, r)) -> (a, Int, (b, Int, r))
    forall w (c :: Symbol).
    (WeightBuilder' w, c ~ First' w) =>
    W c -> Prec' w -> w
    forall (c :: Symbol).
    (c ~ First' (a, Int, (b, Int, r))) =>
    W c -> Prec' (a, Int, (b, Int, r)) -> (a, Int, (b, Int, r))
    % Prec (a :| b) r
    Prec' (a, Int, (b, Int, r))
    prec
        in (a -> Int -> b -> a :| b
    forall a b. a -> Int -> b -> a :| b
    N a
    a Int
    n b
    b, Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    p, r
    r)

    instance WeightBuilder (L c) where
      type Prec (L c) r = r
      W Int
    m %. :: forall (c :: Symbol) r.
    (c ~ First (L c)) =>
    W c -> Prec (L c) r -> (L c, Int, r)
    %. Prec (L c) r
    prec = (L c
    forall (c :: Symbol). L c
    L, Int
    m, r
    Prec (L c) r
    prec)

    instance WeightBuilder () where
      type Prec () r = r
      W Int
    m %. :: forall (c :: Symbol) r.
    (c ~ First ()) =>
    W c -> Prec () r -> ((), Int, r)
    %. Prec () r
    prec = ((), Int
    m, r
    Prec () r
    prec)

    class UniformWeight a where
      uniformWeight :: (a, Int)

    instance (UniformWeight a, UniformWeight b) => UniformWeight (a :| b) where
      uniformWeight :: (a :| b, Int)
    uniformWeight =
        let
          (a
    a, Int
    m) = (a, Int)
    forall a. UniformWeight a => (a, Int)
    uniformWeight
          (b
    b, Int
    n) = (b, Int)
    forall a. UniformWeight a => (a, Int)
    uniformWeight
        in
          (a -> Int -> b -> a :| b
    forall a b. a -> Int -> b -> a :| b
    N a
    a Int
    m b
    b, Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n)

    instance UniformWeight (L c) where
      uniformWeight :: (L c, Int)
    uniformWeight = (L c
    forall (c :: Symbol). L c
    L, Int
    1)

    instance UniformWeight () where
      uniformWeight :: ((), Int)
    uniformWeight = ((), Int
    1)

    class UniformWeight (Weights_ f) => UniformWeight_ f
    instance UniformWeight (Weights_ f) => UniformWeight_ f

    -- | Derived uniform distribution of constructors for @a@.
    class UniformWeight_ (Rep a) => GUniformWeight a
    instance UniformWeight_ (Rep a) => GUniformWeight a

    -- | Type-level options for 'GArbitrary'.
    --
    -- Note: it is recommended to avoid referring to the 'Options' type
    -- explicitly in code, as the set of options may change in the future.
    -- Instead, use the provided synonyms ('UnsizedOpts', 'SizedOpts', 'SizedOptsDef')
    -- and the setter 'SetOptions' (abbreviated as @('<+')@).
    newtype Options (c :: Coherence) (s :: Sizing) (genList :: Type) = Options
      { forall (c :: Coherence) (s :: Sizing) genList.
    Options c s genList -> genList
    _generators :: genList
      }

    -- | Setter for 'Options'.
    --
    -- This subsumes the other setters: 'SetSized', 'SetUnsized', 'SetGens'.
    --
    -- @since 1.4.0.0
    type family SetOptions (x :: k) (o :: Type) :: Type
    type instance SetOptions (s :: Sizing) (Options c _s g) = Options c s g
    type instance SetOptions (c :: Coherence) (Options _c s g) = Options c s g
    type instance SetOptions (g :: Type) (Options c s _g) = Options c s g

    -- | Infix flipped synonym for 'Options'.
    --
    -- @since 1.4.0.0
    type (<+) o x = SetOptions x o
    infixl 1 <+

    type UnsizedOpts = Options 'INCOHERENT 'Unsized ()
    type SizedOpts = Options 'INCOHERENT 'Sized ()
    type SizedOptsDef = Options 'INCOHERENT 'Sized (Gen1 [] :+ ())

    -- | Like 'UnsizedOpts', but using coherent instances by default.
    --
    -- @since 1.4.0.0
    type CohUnsizedOpts = Options 'COHERENT 'Unsized ()

    -- | Like 'SizedOpts', but using coherent instances by default.
    --
    -- @since 1.4.0.0
    type CohSizedOpts = Options 'COHERENT 'Sized ()

    -- | Coerce an 'Options' value between types with the same representation.
    --
    -- @since 1.4.0.0
    setOpts :: forall x o. (Coercible o (SetOptions x o)) => o -> SetOptions x o
    setOpts :: forall {k} (x :: k) o.
    Coercible o (SetOptions x o) =>
    o -> SetOptions x o
    setOpts = o -> SetOptions x o
    forall a b. Coercible a b => a -> b
    coerce

    -- | Default options for unsized generators.
    unsizedOpts :: UnsizedOpts
    unsizedOpts :: UnsizedOpts
    unsizedOpts = () -> UnsizedOpts
    forall (c :: Coherence) (s :: Sizing) genList.
    genList -> Options c s genList
    Options ()

    -- | Default options for sized generators.
    sizedOpts :: SizedOpts
    sizedOpts :: SizedOpts
    sizedOpts = () -> SizedOpts
    forall (c :: Coherence) (s :: Sizing) genList.
    genList -> Options c s genList
    Options ()

    -- | Default options overriding the list generator using 'listOf''.
    sizedOptsDef :: SizedOptsDef
    sizedOptsDef :: SizedOptsDef
    sizedOptsDef = (Gen1 [] :+ ()) -> SizedOptsDef
    forall (c :: Coherence) (s :: Sizing) genList.
    genList -> Options c s genList
    Options ((forall a. Gen a -> Gen [a]) -> Gen1 []
    forall (f :: * -> *). (forall a. Gen a -> Gen (f a)) -> Gen1 f
    Gen1 Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    listOf' Gen1 [] -> () -> Gen1 [] :+ ()
    forall a b. a -> b -> a :+ b
    :+ ())

    -- | Like 'unsizedOpts', but using coherent instances by default.
    cohUnsizedOpts :: CohUnsizedOpts
    cohUnsizedOpts :: CohUnsizedOpts
    cohUnsizedOpts = () -> CohUnsizedOpts
    forall (c :: Coherence) (s :: Sizing) genList.
    genList -> Options c s genList
    Options ()

    -- | Like 'sizedOpts' but using coherent instances by default.
    cohSizedOpts :: CohSizedOpts
    cohSizedOpts :: CohSizedOpts
    cohSizedOpts = () -> CohSizedOpts
    forall (c :: Coherence) (s :: Sizing) genList.
    genList -> Options c s genList
    Options ()

    -- | Whether to decrease the size parameter before generating fields.
    --
    -- The 'Sized' option makes the size parameter decrease in the following way:
    -- - Constructors with one field decrease the size parameter by 1 to generate
    --   that field.
    -- - Constructors with more than one field split the size parameter among all
    --   fields; the size parameter is rounded down to then be divided equally.
    data Sizing
      = Sized     -- ^ Decrease the size parameter when running generators for fields
      | Unsized   -- ^ Don't touch the size parameter

    type family SizingOf opts :: Sizing
    type instance SizingOf (Options _c s _g) = s

    type family SetSized (o :: Type) :: Type
    type instance SetSized (Options c s g) = Options c 'Sized g

    type family SetUnsized (o :: Type) :: Type
    type instance SetUnsized (Options c s g) = Options c 'Unsized g

    setSized :: Options c s g -> Options c 'Sized g
    setSized :: forall (c :: Coherence) (s :: Sizing) g.
    Options c s g -> Options c 'Sized g
    setSized = Options c s g -> Options c 'Sized g
    forall a b. Coercible a b => a -> b
    coerce

    setUnsized :: Options c s g -> Options c 'Unsized g
    setUnsized :: forall (c :: Coherence) (s :: Sizing) g.
    Options c s g -> Options c 'Unsized g
    setUnsized = Options c s g -> Options c 'Unsized g
    forall a b. Coercible a b => a -> b
    coerce

    -- | For custom generators to work with parameterized types, incoherent
    -- instances must be used internally.
    -- In practice, the resulting behavior is what users want 100% of the time,
    -- so you should forget this option even exists.
    --
    -- === __Details__
    --
    -- The default configuration of generic-random does a decent job if
    -- we trust GHC implements precisely the instance resolution algorithm as
    -- described in the GHC manual:
    --
    -- - https://downloads.haskell.org/ghc/latest/docs/html/users_guide/glasgow_exts.html#overlapping-instances
    --
    -- While that assumption holds in practice, it is overly context-dependent
    -- (to know the context leading to a particular choice, we must replay the
    -- whole resolution algorithm).
    -- In particular, this algorithm may find one solution, but it is not
    -- guaranteed to be unique: the behavior of the program is dependent on
    -- implementation details.
    --
    -- An notable property to consider of an implicit type system (such as type
    -- classes) is coherence: the behavior of the program is stable under
    -- specialization.
    --
    -- This sounds nice on paper, but actually leads to surprising behavior for
    -- generic implementations with parameterized types, such as generic-random.
    --
    -- To address that, the coherence property can be relaxd by users, by
    -- explicitly allowing some custom generators to be chosen incoherently. With
    -- appropriate precautions, it is possible to ensure a weaker property which
    -- nevertheless helps keep type inference predictable: when a solution is
    -- found, it is unique.
    -- (This is assuredly weaker, i.e., is not stable under specialization.)
    --
    -- @since 1.4.0.0
    data Coherence
      = INCOHERENT  -- ^ Match custom generators incoherently.
      | COHERENT
        -- ^ Match custom generators coherently by default
        -- (can be manually bypassed with 'Incoherent').

    type family CoherenceOf (o :: Type) :: Coherence
    type instance CoherenceOf (Options c _s _g) = c

    -- | Match this generator incoherently when the 'COHERENT' option is set.
    newtype Incoherent g = Incoherent g

    -- | Heterogeneous list of generators.
    data a :+ b = a :+ b

    infixr 1 :+

    type family GeneratorsOf opts :: Type
    type instance GeneratorsOf (Options _c _s g) = g

    class HasGenerators opts where
      generators :: opts -> GeneratorsOf opts

    instance HasGenerators (Options c s g) where
      generators :: Options c s g -> GeneratorsOf (Options c s g)
    generators = Options c s g -> g
    Options c s g -> GeneratorsOf (Options c s g)
    forall (c :: Coherence) (s :: Sizing) genList.
    Options c s genList -> genList
    _generators

    -- | Define the set of custom generators.
    --
    -- Note: for recursive types which can recursively appear inside lists or other
    -- containers, you may want to include a custom generator to decrease the size
    -- when generating such containers.
    --
    -- See also the Note about lists in "Generic.Random.Tutorial#notelists".
    setGenerators :: genList -> Options c s g0 -> Options c s genList
    setGenerators :: forall genList (c :: Coherence) (s :: Sizing) g0.
    genList -> Options c s g0 -> Options c s genList
    setGenerators genList
    gens (Options g0
    _) = genList -> Options c s genList
    forall (c :: Coherence) (s :: Sizing) genList.
    genList -> Options c s genList
    Options genList
    gens

    type family SetGens (g :: Type) opts
    type instance SetGens g (Options c s _g) = Options c s g

    -- | Custom generator for record fields named @s@.
    --
    -- If there is a field named @s@ with a different type,
    -- this will result in a type error.
    newtype FieldGen (s :: Symbol) a = FieldGen { forall (s :: Symbol) a. FieldGen s a -> Gen a
    unFieldGen :: Gen a }

    -- | 'FieldGen' constructor with the field name given via a proxy.
    fieldGen :: proxy s -> Gen a -> FieldGen s a
    fieldGen :: forall (proxy :: Symbol -> *) (s :: Symbol) a.
    proxy s -> Gen a -> FieldGen s a
    fieldGen proxy s
    _ = Gen a -> FieldGen s a
    forall (s :: Symbol) a. Gen a -> FieldGen s a
    FieldGen

    -- | Custom generator for the @i@-th field of the constructor named @c@.
    -- Fields are 0-indexed.
    newtype ConstrGen (c :: Symbol) (i :: Nat) a = ConstrGen { forall (c :: Symbol) (i :: Nat) a. ConstrGen c i a -> Gen a
    unConstrGen :: Gen a }

    -- | 'ConstrGen' constructor with the constructor name given via a proxy.
    constrGen :: proxy '(c, i) -> Gen a -> ConstrGen c i a
    constrGen :: forall (proxy :: (Symbol, Nat) -> *) (c :: Symbol) (i :: Nat) a.
    proxy '(c, i) -> Gen a -> ConstrGen c i a
    constrGen proxy '(c, i)
    _ = Gen a -> ConstrGen c i a
    forall (c :: Symbol) (i :: Nat) a. Gen a -> ConstrGen c i a
    ConstrGen

    -- | Custom generators for \"containers\" of kind @Type -> Type@, parameterized
    -- by the generator for \"contained elements\".
    --
    -- A custom generator @'Gen1' f@ will be used for any field whose type has the
    -- form @f x@, requiring a generator of @x@. The generator for @x@ will be
    -- constructed using the list of custom generators if possible, otherwise
    -- an instance @Arbitrary x@ will be required.
    newtype Gen1 f = Gen1 { forall (f :: * -> *). Gen1 f -> forall a. Gen a -> Gen (f a)
    unGen1 :: forall a. Gen a -> Gen (f a) }

    -- | 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 @'Gen1_' f@ will be used for any field whose type has the
    -- form @f x@.
    newtype Gen1_ f = Gen1_ { forall {k} (f :: k -> *). Gen1_ f -> forall (a :: k). Gen (f a)
    unGen1_ :: forall a. Gen (f a) }

    -- | An alternative to 'vectorOf' that divides the size parameter by the
    -- length of the list.
    vectorOf' :: Int -> Gen a -> Gen [a]
    vectorOf' :: forall a. Int -> Gen a -> Gen [a]
    vectorOf' Int
    0 = \Gen a
    _ -> [a] -> Gen [a]
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
    vectorOf' Int
    i = (Int -> Int) -> Gen [a] -> Gen [a]
    forall a. (Int -> Int) -> Gen a -> Gen a
    scale (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    i) (Gen [a] -> Gen [a]) -> (Gen a -> Gen [a]) -> Gen a -> Gen [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Gen a -> Gen [a]
    forall a. Int -> Gen a -> Gen [a]
    vectorOf Int
    i

    -- | An alternative to 'Test.QuickCheck.listOf' that divides the size parameter
    -- by the length of the list.
    -- The length follows a geometric distribution of parameter
    -- @1/(sqrt size + 1)@.
    listOf' :: Gen a -> Gen [a]
    listOf' :: forall a. Gen a -> Gen [a]
    listOf' Gen a
    g = (Int -> Gen [a]) -> Gen [a]
    forall a. (Int -> Gen a) -> Gen a
    sized ((Int -> Gen [a]) -> Gen [a]) -> (Int -> Gen [a]) -> Gen [a]
    forall a b. (a -> b) -> a -> b
    $ \Int
    n -> do
      i <- Int -> Gen Int
    geom Int
    n
      vectorOf' i g

    -- | An alternative to 'Test.QuickCheck.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)@.
    listOf1' :: Gen a -> Gen [a]
    listOf1' :: forall a. Gen a -> Gen [a]
    listOf1' Gen a
    g = (a -> [a] -> [a]) -> Gen a -> Gen [a] -> Gen [a]
    forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (:) Gen a
    g (Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    listOf' Gen a
    g)

    -- | Geometric distribution of parameter @1/(sqrt n + 1)@ (@n >= 0@).
    geom :: Int -> Gen Int
    geom :: Int -> Gen Int
    geom Int
    0 = Int -> Gen Int
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    0
    geom Int
    n = Int -> Gen Int
    go Int
    0 where
      n' :: Double
    n' = Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n
      p :: Double
    p = Double
    1 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / (Double -> Double
    forall a. Floating a => a -> a
    sqrt Double
    n' Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    1) :: Double
      go :: Int -> Gen Int
    go Int
    r = do
        x <- (Double, Double) -> Gen Double
    forall a. Random a => (a, a) -> Gen a
    choose (Double
    0, Double
    1)
        if x < p then
          pure r
        else
          go $! (r + 1)

    ---

    -- | Generic Arbitrary
    class GA opts f where
      ga :: opts -> Weights_ f -> Int -> Gen (f p)

    -- | Generic Arbitrary
    class (Generic a, GA opts (Rep a)) => GArbitrary opts a
    instance (Generic a, GA opts (Rep a)) => GArbitrary opts a

    instance GA opts f => GA opts (M1 D c f) where
      ga :: forall p. opts -> Weights_ (M1 D c f) -> Int -> Gen (M1 D c f p)
    ga opts
    z Weights_ (M1 D c f)
    w Int
    n = (f p -> M1 D c f p) -> Gen (f p) -> Gen (M1 D c f p)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f p -> M1 D c f p
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 (opts -> Weights_ f -> Int -> Gen (f p)
    forall p. opts -> Weights_ f -> Int -> Gen (f p)
    forall opts (f :: * -> *) p.
    GA opts f =>
    opts -> Weights_ f -> Int -> Gen (f p)
    ga opts
    z Weights_ f
    Weights_ (M1 D c f)
    w Int
    n)
      {-# INLINE ga #-}

    instance (GASum opts f, GASum opts g) => GA opts (f :+: g) where
      ga :: forall p. opts -> Weights_ (f :+: g) -> Int -> Gen ((:+:) f g p)
    ga = opts -> Weights_ (f :+: g) -> Int -> Gen ((:+:) f g p)
    forall opts (f :: * -> *) p.
    GASum opts f =>
    opts -> Weights_ f -> Int -> Gen (f p)
    gaSum'
      {-# INLINE ga #-}

    instance GAProduct (SizingOf opts) (Name c) opts f => GA opts (M1 C c f) where
      ga :: forall p. opts -> Weights_ (M1 C c f) -> Int -> Gen (M1 C c f p)
    ga opts
    z Weights_ (M1 C c f)
    _ Int
    _ = (f p -> M1 C c f p) -> Gen (f p) -> Gen (M1 C c f p)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f p -> M1 C c f p
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 (Proxy '(SizingOf opts, Name c) -> opts -> Gen (f p)
    forall {k} (s :: Sizing) (c :: Maybe Symbol) opts (f :: k -> *)
           (proxys :: (Sizing, Maybe Symbol) -> *) (p :: k).
    GAProduct s c opts f =>
    proxys '(s, c) -> opts -> Gen (f p)
    forall (proxys :: (Sizing, Maybe Symbol) -> *) p.
    proxys '(SizingOf opts, Name c) -> opts -> Gen (f p)
    gaProduct (Proxy '(SizingOf opts, Name c)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy '(SizingOf opts, Name c)) opts
    z)
      {-# INLINE ga #-}

    gaSum' :: GASum opts f => opts -> Weights_ f -> Int -> Gen (f p)
    gaSum' :: forall opts (f :: * -> *) p.
    GASum opts f =>
    opts -> Weights_ f -> Int -> Gen (f p)
    gaSum' opts
    z Weights_ f
    w Int
    n = do
      i <- (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0, Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
      gaSum z i w
    {-# INLINE gaSum' #-}

    class GASum opts f where
      gaSum :: opts -> Int -> Weights_ f -> Gen (f p)

    instance (GASum opts f, GASum opts g) => GASum opts (f :+: g) where
      gaSum :: forall p. opts -> Int -> Weights_ (f :+: g) -> Gen ((:+:) f g p)
    gaSum opts
    z Int
    i (N Weights_ f
    a Int
    n Weights_ g
    b)
        | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    n = (f p -> (:+:) f g p) -> Gen (f p) -> Gen ((:+:) f g p)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f p -> (:+:) f g p
    forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
    L1 (opts -> Int -> Weights_ f -> Gen (f p)
    forall p. opts -> Int -> Weights_ f -> Gen (f p)
    forall opts (f :: * -> *) p.
    GASum opts f =>
    opts -> Int -> Weights_ f -> Gen (f p)
    gaSum opts
    z Int
    i Weights_ f
    a)
        | Bool
    otherwise = (g p -> (:+:) f g p) -> Gen (g p) -> Gen ((:+:) f g p)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap g p -> (:+:) f g p
    forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
    R1 (opts -> Int -> Weights_ g -> Gen (g p)
    forall p. opts -> Int -> Weights_ g -> Gen (g p)
    forall opts (f :: * -> *) p.
    GASum opts f =>
    opts -> Int -> Weights_ f -> Gen (f p)
    gaSum opts
    z (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n) Weights_ g
    b)
      {-# INLINE gaSum #-}

    instance GAProduct (SizingOf opts) (Name c) opts f => GASum opts (M1 C c f) where
      gaSum :: forall p. opts -> Int -> Weights_ (M1 C c f) -> Gen (M1 C c f p)
    gaSum opts
    z Int
    _ Weights_ (M1 C c f)
    _ = (f p -> M1 C c f p) -> Gen (f p) -> Gen (M1 C c f p)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap f p -> M1 C c f p
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 (Proxy '(SizingOf opts, Name c) -> opts -> Gen (f p)
    forall {k} (s :: Sizing) (c :: Maybe Symbol) opts (f :: k -> *)
           (proxys :: (Sizing, Maybe Symbol) -> *) (p :: k).
    GAProduct s c opts f =>
    proxys '(s, c) -> opts -> Gen (f p)
    forall (proxys :: (Sizing, Maybe Symbol) -> *) p.
    proxys '(SizingOf opts, Name c) -> opts -> Gen (f p)
    gaProduct (Proxy '(SizingOf opts, Name c)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy '(SizingOf opts, Name c)) opts
    z)
      {-# INLINE gaSum #-}

    class GAProduct (s :: Sizing) (c :: Maybe Symbol) opts f where
      gaProduct :: proxys '(s, c) -> opts -> Gen (f p)

    instance GAProduct' c 0 opts f => GAProduct 'Unsized c opts f where
      gaProduct :: forall (proxys :: (Sizing, Maybe Symbol) -> *) (p :: k).
    proxys '( 'Unsized, c) -> opts -> Gen (f p)
    gaProduct proxys '( 'Unsized, c)
    _ = Proxy '(c, 0) -> opts -> Gen (f p)
    forall {k} (c :: Maybe Symbol) (i :: Nat) opts (f :: k -> *)
           (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    GAProduct' c i opts f =>
    proxy '(c, i) -> opts -> Gen (f p)
    forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, 0) -> opts -> Gen (f p)
    gaProduct' (Proxy '(c, 0)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy '(c, 0))
      {-# INLINE gaProduct #-}

    -- Single-field constructors: decrease size by 1.
    instance {-# OVERLAPPING #-} GAProduct' c 0 opts (S1 d f)
      => GAProduct 'Sized c opts (S1 d f) where
      gaProduct :: forall (proxys :: (Sizing, Maybe Symbol) -> *) (p :: k).
    proxys '( 'Sized, c) -> opts -> Gen (S1 d f p)
    gaProduct proxys '( 'Sized, c)
    _ = (Int -> Int) -> Gen (S1 d f p) -> Gen (S1 d f p)
    forall a. (Int -> Int) -> Gen a -> Gen a
    scale (\Int
    n -> Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)) (Gen (S1 d f p) -> Gen (S1 d f p))
    -> (opts -> Gen (S1 d f p)) -> opts -> Gen (S1 d f p)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy '(c, 0) -> opts -> Gen (S1 d f p)
    forall {k} (c :: Maybe Symbol) (i :: Nat) opts (f :: k -> *)
           (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    GAProduct' c i opts f =>
    proxy '(c, i) -> opts -> Gen (f p)
    forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, 0) -> opts -> Gen (M1 S d f p)
    gaProduct' (Proxy '(c, 0)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy '(c, 0))

    instance (GAProduct' c 0 opts f, KnownNat (Arity f)) => GAProduct 'Sized c opts f where
      gaProduct :: forall (proxys :: (Sizing, Maybe Symbol) -> *) (p :: k).
    proxys '( 'Sized, c) -> opts -> Gen (f p)
    gaProduct proxys '( 'Sized, c)
    _ = (Int -> Int) -> Gen (f p) -> Gen (f p)
    forall a. (Int -> Int) -> Gen a -> Gen a
    scale (Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    arity) (Gen (f p) -> Gen (f p))
    -> (opts -> Gen (f p)) -> opts -> Gen (f p)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Proxy '(c, 0) -> opts -> Gen (f p)
    forall {k} (c :: Maybe Symbol) (i :: Nat) opts (f :: k -> *)
           (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    GAProduct' c i opts f =>
    proxy '(c, i) -> opts -> Gen (f p)
    forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, 0) -> opts -> Gen (f p)
    gaProduct' (Proxy '(c, 0)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy '(c, 0))
        where
          arity :: Int
    arity = Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger (Proxy (Arity f) -> Integer
    forall (n :: Nat) (proxy :: Nat -> *).
    KnownNat n =>
    proxy n -> Integer
    natVal (Proxy (Arity f)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy (Arity f)))
      {-# INLINE gaProduct #-}

    instance {-# OVERLAPPING #-} GAProduct 'Sized c opts U1 where
      gaProduct :: forall (proxys :: (Sizing, Maybe Symbol) -> *) (p :: k).
    proxys '( 'Sized, c) -> opts -> Gen (U1 p)
    gaProduct proxys '( 'Sized, c)
    _ opts
    _ = U1 p -> Gen (U1 p)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure U1 p
    forall k (p :: k). U1 p
    U1
      {-# INLINE gaProduct #-}

    class GAProduct' (c :: Maybe Symbol) (i :: Nat) opts f where
      gaProduct' :: proxy '(c, i) -> opts -> Gen (f p)

    instance GAProduct' c i opts U1 where
      gaProduct' :: forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, i) -> opts -> Gen (U1 p)
    gaProduct' proxy '(c, i)
    _ opts
    _ = U1 p -> Gen (U1 p)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure U1 p
    forall k (p :: k). U1 p
    U1
      {-# INLINE gaProduct' #-}

    instance
      ( HasGenerators opts
      , FindGen 'Shift ('S gs coh '(c, i, Name d)) () gs a
      , gs ~ GeneratorsOf opts
      , coh ~ CoherenceOf opts )
      => GAProduct' c i opts (S1 d (K1 _k a)) where
      gaProduct' :: forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, i) -> opts -> Gen (S1 d (K1 _k a) p)
    gaProduct' proxy '(c, i)
    _ opts
    opts = (a -> S1 d (K1 _k a) p) -> Gen a -> Gen (S1 d (K1 _k a) p)
    forall a b. (a -> b) -> Gen a -> Gen b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (K1 _k a p -> S1 d (K1 _k a) p
    forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
    M1 (K1 _k a p -> S1 d (K1 _k a) p)
    -> (a -> K1 _k a p) -> a -> S1 d (K1 _k a) p
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> K1 _k a p
    forall k i c (p :: k). c -> K1 i c p
    K1) ((Proxy 'Shift, Proxy ('S gs coh '(c, i, Name d)),
     FullGenListOf ('S gs coh '(c, i, Name d)))
    -> () -> gs -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift
    is, Proxy ('S gs coh '(c, i, Name d))
    s, FullGenListOf ('S gs coh '(c, i, Name d))
    GeneratorsOf opts
    gs) () gs
    GeneratorsOf opts
    gs)
        where
          is :: Proxy 'Shift
    is = Proxy 'Shift
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy 'Shift
          s :: Proxy ('S gs coh '(c, i, Name d))
    s = Proxy ('S gs coh '(c, i, Name d))
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ('S gs coh '(c, i, Name d))
          gs :: GeneratorsOf opts
    gs = opts -> GeneratorsOf opts
    forall opts. HasGenerators opts => opts -> GeneratorsOf opts
    generators opts
    opts
      {-# INLINE gaProduct' #-}

    instance (GAProduct' c i opts f, GAProduct' c (i + Arity f) opts g) => GAProduct' c i opts (f :*: g) where
      -- TODO: Why does this inline better than eta-reducing? (GHC-8.2)
      gaProduct' :: forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, i) -> opts -> Gen ((:*:) f g p)
    gaProduct' proxy '(c, i)
    px = ((Gen (f p) -> Gen (g p) -> Gen ((:*:) f g p))
    -> (opts -> Gen (f p))
    -> (opts -> Gen (g p))
    -> opts
    -> Gen ((:*:) f g p)
    forall a b c.
    (a -> b -> c) -> (opts -> a) -> (opts -> b) -> opts -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 ((Gen (f p) -> Gen (g p) -> Gen ((:*:) f g p))
     -> (opts -> Gen (f p))
     -> (opts -> Gen (g p))
     -> opts
     -> Gen ((:*:) f g p))
    -> ((f p -> g p -> (:*:) f g p)
        -> Gen (f p) -> Gen (g p) -> Gen ((:*:) f g p))
    -> (f p -> g p -> (:*:) f g p)
    -> (opts -> Gen (f p))
    -> (opts -> Gen (g p))
    -> opts
    -> Gen ((:*:) f g p)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (f p -> g p -> (:*:) f g p)
    -> Gen (f p) -> Gen (g p) -> Gen ((:*:) f g p)
    forall a b c. (a -> b -> c) -> Gen a -> Gen b -> Gen c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2) f p -> g p -> (:*:) f g p
    forall k (f :: k -> *) (g :: k -> *) (p :: k).
    f p -> g p -> (:*:) f g p
    (:*:)
        (proxy '(c, i) -> opts -> Gen (f p)
    forall {k} (c :: Maybe Symbol) (i :: Nat) opts (f :: k -> *)
           (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    GAProduct' c i opts f =>
    proxy '(c, i) -> opts -> Gen (f p)
    forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, i) -> opts -> Gen (f p)
    gaProduct' proxy '(c, i)
    px)
        (Proxy '(c, i + Arity f) -> opts -> Gen (g p)
    forall {k} (c :: Maybe Symbol) (i :: Nat) opts (f :: k -> *)
           (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    GAProduct' c i opts f =>
    proxy '(c, i) -> opts -> Gen (f p)
    forall (proxy :: (Maybe Symbol, Nat) -> *) (p :: k).
    proxy '(c, i + Arity f) -> opts -> Gen (g p)
    gaProduct' (Proxy '(c, i + Arity f)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy '(c, i + Arity f)))
      {-# INLINE gaProduct' #-}

    type family Arity f :: Nat where
      Arity (f :*: g) = Arity f + Arity g
      Arity (M1 _i _c _f) = 1

    -- | Given a list of custom generators @g :+ gs@, find one that applies,
    -- or use @Arbitrary a@ by default.
    --
    -- @g@ and @gs@ follow this little state machine:
    --
    -- >           g,      gs | result
    -- > ---------------------+-----------------------------
    -- >          (),      () | END
    -- >          (), g :+ gs | g, gs
    -- >          (),      g  | g, () when g is not (_ :+ _)
    -- >      g :+ h,      gs | g, h :+ gs
    -- >       Gen a,      gs | END if g matches, else ((), gs)
    -- >  FieldGen a,      gs | idem
    -- > ConstrGen a,      gs | idem
    -- >      Gen1 a,      gs | idem
    -- >     Gen1_ a,      gs | idem
    class FindGen (i :: AInstr) (s :: AStore) (g :: Type) (gs :: Type) (a :: Type) where
      findGen :: (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a

    data AInstr = Shift | Match Coherence | MatchCoh Bool
    data AStore = S Type Coherence ASel

    type ASel = (Maybe Symbol, Nat, Maybe Symbol)

    iShift :: Proxy 'Shift
    iShift :: Proxy 'Shift
    iShift = Proxy 'Shift
    forall {k} (t :: k). Proxy t
    Proxy

    type family FullGenListOf (s :: AStore) :: Type where
      FullGenListOf ('S fg _coh _sel) = fg

    type family ACoherenceOf (s :: AStore) :: Coherence where
      ACoherenceOf ('S _fg coh _sel) = coh

    type family ASelOf (s :: AStore) :: ASel where
      ASelOf ('S _fg _coh sel) = sel

    -- | All candidates have been exhausted
    instance Arbitrary a => FindGen 'Shift s () () a where
      findGen :: (Proxy 'Shift, Proxy s, FullGenListOf s) -> () -> () -> Gen a
    findGen (Proxy 'Shift, Proxy s, FullGenListOf s)
    _ ()
    _ ()
    _ = Gen a
    forall a. Arbitrary a => Gen a
    arbitrary
      {-# INLINEABLE findGen #-}

    -- | Examine the next candidate
    instance FindGen 'Shift s b g a => FindGen 'Shift s () (b :+ g) a where
      findGen :: (Proxy 'Shift, Proxy s, FullGenListOf s) -> () -> (b :+ g) -> Gen a
    findGen (Proxy 'Shift, Proxy s, FullGenListOf s)
    p () (b
    b :+ g
    gens) = (Proxy 'Shift, Proxy s, FullGenListOf s) -> b -> g -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift, Proxy s, FullGenListOf s)
    p b
    b g
    gens
      {-# INLINEABLE findGen #-}

    -- | Examine the last candidate (@g@ is not of the form @_ :+ _@)
    instance {-# OVERLAPS #-} FindGen 'Shift s g () a => FindGen 'Shift s () g a where
      findGen :: (Proxy 'Shift, Proxy s, FullGenListOf s) -> () -> g -> Gen a
    findGen (Proxy 'Shift, Proxy s, FullGenListOf s)
    p () g
    g = (Proxy 'Shift, Proxy s, FullGenListOf s) -> g -> () -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift, Proxy s, FullGenListOf s)
    p g
    g ()

    -- | This can happen if the generators form a tree rather than a list, for whatever reason.
    instance FindGen 'Shift s g (h :+ gs) a => FindGen 'Shift s (g :+ h) gs a where
      findGen :: (Proxy 'Shift, Proxy s, FullGenListOf s) -> (g :+ h) -> gs -> Gen a
    findGen (Proxy 'Shift, Proxy s, FullGenListOf s)
    p (g
    g :+ h
    h) gs
    gs = (Proxy 'Shift, Proxy s, FullGenListOf s) -> g -> (h :+ gs) -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift, Proxy s, FullGenListOf s)
    p g
    g (h
    h h -> gs -> h :+ gs
    forall a b. a -> b -> a :+ b
    :+ gs
    gs)

    instance FindGen ('Match 'INCOHERENT) s g gs a => FindGen 'Shift s (Incoherent g) gs a where
      findGen :: (Proxy 'Shift, Proxy s, FullGenListOf s)
    -> Incoherent g -> gs -> Gen a
    findGen (Proxy 'Shift
    _, Proxy s
    s, FullGenListOf s
    fg) (Incoherent g
    g) = (Proxy ('Match 'INCOHERENT), Proxy s, FullGenListOf s)
    -> g -> gs -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy ('Match 'INCOHERENT)
    im, Proxy s
    s, FullGenListOf s
    fg) g
    g where
        im :: Proxy ('Match 'INCOHERENT)
    im = Proxy ('Match 'INCOHERENT)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ('Match 'INCOHERENT)

    -- | If none of the above matches, then @g@ should be a simple generator,
    -- and we test whether it matches the type @a@.
    instance {-# OVERLAPPABLE #-} FindGen ('Match (ACoherenceOf s)) s g gs a
      => FindGen 'Shift s g gs a where
      findGen :: (Proxy 'Shift, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift
    _, Proxy s
    s, FullGenListOf s
    fg) = (Proxy ('Match (ACoherenceOf s)), Proxy s, FullGenListOf s)
    -> g -> gs -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy ('Match (ACoherenceOf s))
    im, Proxy s
    s, FullGenListOf s
    fg) where
        im :: Proxy ('Match (ACoherenceOf s))
    im = Proxy ('Match (ACoherenceOf s))
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ('Match (ACoherenceOf s))

    -- INCOHERENT

    -- | None of the INCOHERENT instances match, discard the candidate @g@ and look
    -- at the rest of the list @gs@.
    instance FindGen 'Shift s () gs a
      => FindGen ('Match 'INCOHERENT) s _g gs a where
      findGen :: (Proxy ('Match 'INCOHERENT), Proxy s, FullGenListOf s)
    -> _g -> gs -> Gen a
    findGen (Proxy ('Match 'INCOHERENT)
    _, Proxy s
    s, FullGenListOf s
    fg) _g
    _ = (Proxy 'Shift, Proxy s, FullGenListOf s) -> () -> gs -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift
    iShift, Proxy s
    s, FullGenListOf s
    fg) () where

    -- | Matching custom generator for @a@.
    instance {-# INCOHERENT #-} FindGen ('Match 'INCOHERENT) s (Gen a) gs a where
      findGen :: (Proxy ('Match 'INCOHERENT), Proxy s, FullGenListOf s)
    -> Gen a -> gs -> Gen a
    findGen (Proxy ('Match 'INCOHERENT), Proxy s, FullGenListOf s)
    _ Gen a
    gen gs
    _ = Gen a
    gen
      {-# INLINEABLE findGen #-}

    -- | Matching custom generator for non-container @f@.
    instance {-# INCOHERENT #-} FindGen ('Match 'INCOHERENT) s (Gen1_ f) gs (f a) where
      findGen :: (Proxy ('Match 'INCOHERENT), Proxy s, FullGenListOf s)
    -> Gen1_ f -> gs -> Gen (f a)
    findGen (Proxy ('Match 'INCOHERENT), Proxy s, FullGenListOf s)
    _ (Gen1_ forall (a :: k). Gen (f a)
    gen) gs
    _ = Gen (f a)
    forall (a :: k). Gen (f a)
    gen

    -- | Matching custom generator for container @f@. Start the search for containee @a@,
    -- discarding field information.
    instance {-# INCOHERENT #-} FindGen 'Shift ('S fg coh DummySel) () fg a
      => FindGen ('Match 'INCOHERENT) ('S fg coh _sel) (Gen1 f) gs (f a) where
      findGen :: (Proxy ('Match 'INCOHERENT), Proxy ('S fg coh _sel),
     FullGenListOf ('S fg coh _sel))
    -> Gen1 f -> gs -> Gen (f a)
    findGen (Proxy ('Match 'INCOHERENT)
    _, Proxy ('S fg coh _sel)
    _, FullGenListOf ('S fg coh _sel)
    fg) (Gen1 forall a. Gen a -> Gen (f a)
    gen) gs
    _ = Gen a -> Gen (f a)
    forall a. Gen a -> Gen (f a)
    gen ((Proxy 'Shift, Proxy ('S fg coh DummySel),
     FullGenListOf ('S fg coh DummySel))
    -> () -> fg -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift
    iShift, Proxy ('S fg coh DummySel)
    s, FullGenListOf ('S fg coh _sel)
    FullGenListOf ('S fg coh DummySel)
    fg) () fg
    FullGenListOf ('S fg coh _sel)
    fg) where
        s :: Proxy ('S fg coh DummySel)
    s  = Proxy ('S fg coh DummySel)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ('S fg coh DummySel)

    type DummySel = '( 'Nothing, 0, 'Nothing)

    -- | Matching custom generator for field @s@.
    instance {-# INCOHERENT #-} (a ~ a')
      => FindGen ('Match 'INCOHERENT) ('S _fg _coh '(con, i, 'Just s)) (FieldGen s a) gs a' where
      findGen :: (Proxy ('Match 'INCOHERENT),
     Proxy ('S _fg _coh '(con, i, 'Just s)),
     FullGenListOf ('S _fg _coh '(con, i, 'Just s)))
    -> FieldGen s a -> gs -> Gen a'
    findGen (Proxy ('Match 'INCOHERENT),
     Proxy ('S _fg _coh '(con, i, 'Just s)),
     FullGenListOf ('S _fg _coh '(con, i, 'Just s)))
    _ (FieldGen Gen a
    gen) gs
    _ = Gen a
    Gen a'
    gen
      {-# INLINEABLE findGen #-}

    -- | Matching custom generator for @i@-th field of constructor @c@.
    instance {-# INCOHERENT #-} (a ~ a')
      => FindGen ('Match 'INCOHERENT) ('S _fg _coh '( 'Just c, i, s)) (ConstrGen c i a) gs a' where
      findGen :: (Proxy ('Match 'INCOHERENT), Proxy ('S _fg _coh '( 'Just c, i, s)),
     FullGenListOf ('S _fg _coh '( 'Just c, i, s)))
    -> ConstrGen c i a -> gs -> Gen a'
    findGen (Proxy ('Match 'INCOHERENT), Proxy ('S _fg _coh '( 'Just c, i, s)),
     FullGenListOf ('S _fg _coh '( 'Just c, i, s)))
    _ (ConstrGen Gen a
    gen) gs
    _ = Gen a
    Gen a'
    gen
      {-# INLINEABLE findGen #-}

    -- | Get the name contained in a 'Meta' tag.
    type family Name (d :: Meta) :: Maybe Symbol
    type instance Name ('MetaSel mn su ss ds) = mn
    type instance Name ('MetaCons n _f _s) = 'Just n

    -- COHERENT

    -- Use a type famaily to do the matching coherently.
    instance FindGen ('MatchCoh (Matches (ASelOf s) g a)) s g gs a
      => FindGen ('Match 'COHERENT) s g gs a where
      findGen :: (Proxy ('Match 'COHERENT), Proxy s, FullGenListOf s)
    -> g -> gs -> Gen a
    findGen (Proxy ('Match 'COHERENT)
    _, Proxy s
    s, FullGenListOf s
    fg) = (Proxy ('MatchCoh (Matches (ASelOf s) g a)), Proxy s,
     FullGenListOf s)
    -> g -> gs -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy ('MatchCoh (Matches (ASelOf s) g a))
    im, Proxy s
    s, FullGenListOf s
    fg) where
        im :: Proxy ('MatchCoh (Matches (ASelOf s) g a))
    im = Proxy ('MatchCoh (Matches (ASelOf s) g a))
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ('MatchCoh (Matches (ASelOf s) g a))

    type family Matches (s :: ASel) (g :: Type) (a :: Type) :: Bool where
      Matches _sel (Gen b) a = b == a
      Matches _sel (Gen1_ f) (f a) = 'True
      Matches _sel (Gen1_ f) a = 'False
      Matches _sel (Gen1 f) (f a) = 'True
      Matches _sel (Gen1 f) a = 'False
      Matches '(_c, i,  s) (FieldGen s1 b) a = s == 'Just s1 && b == a
      Matches '( c, i, _s) (ConstrGen c1 j b) a = c == 'Just c1 && i == j && b == a

    -- If there is no match, skip and shift.
    instance FindGen 'Shift s () gs a => FindGen ('MatchCoh 'False) s _g gs a where
      findGen :: (Proxy ('MatchCoh 'False), Proxy s, FullGenListOf s)
    -> _g -> gs -> Gen a
    findGen (Proxy ('MatchCoh 'False)
    _, Proxy s
    s, FullGenListOf s
    fg) _g
    _ = (Proxy 'Shift, Proxy s, FullGenListOf s) -> () -> gs -> Gen a
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift
    iShift, Proxy s
    s, FullGenListOf s
    fg) () where

    -- If there is a match, the search terminates

    instance (a ~ a') => FindGen ('MatchCoh 'True) s (Gen a) gs a' where
      findGen :: (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    -> Gen a -> gs -> Gen a'
    findGen (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    _ Gen a
    g gs
    _ = Gen a
    Gen a'
    g

    instance (f x ~ a') => FindGen ('MatchCoh 'True) s (Gen1_ f) gs a' where
      findGen :: (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    -> Gen1_ f -> gs -> Gen a'
    findGen (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    _ (Gen1_ forall (a :: k). Gen (f a)
    g) gs
    _ = Gen a'
    Gen (f x)
    forall (a :: k). Gen (f a)
    g

    instance (f x ~ a', FindGen 'Shift ('S fg coh DummySel) () fg x)
      => FindGen ('MatchCoh 'True) ('S fg coh _sel) (Gen1 f) gs a' where
      findGen :: (Proxy ('MatchCoh 'True), Proxy ('S fg coh _sel),
     FullGenListOf ('S fg coh _sel))
    -> Gen1 f -> gs -> Gen a'
    findGen (Proxy ('MatchCoh 'True)
    _, Proxy ('S fg coh _sel)
    _, FullGenListOf ('S fg coh _sel)
    fg) (Gen1 forall a. Gen a -> Gen (f a)
    gen) gs
    _ = Gen x -> Gen (f x)
    forall a. Gen a -> Gen (f a)
    gen ((Proxy 'Shift, Proxy ('S fg coh DummySel),
     FullGenListOf ('S fg coh DummySel))
    -> () -> fg -> Gen x
    forall (i :: AInstr) (s :: AStore) g gs a.
    FindGen i s g gs a =>
    (Proxy i, Proxy s, FullGenListOf s) -> g -> gs -> Gen a
    findGen (Proxy 'Shift
    iShift, Proxy ('S fg coh DummySel)
    s, FullGenListOf ('S fg coh _sel)
    FullGenListOf ('S fg coh DummySel)
    fg) () fg
    FullGenListOf ('S fg coh _sel)
    fg) where
        s :: Proxy ('S fg coh DummySel)
    s  = Proxy ('S fg coh DummySel)
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy ('S fg coh DummySel)

    -- | Matching custom generator for field @s@.
    instance (a ~ a')
      => FindGen ('MatchCoh 'True) s (FieldGen sn a) gs a' where
      findGen :: (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    -> FieldGen sn a -> gs -> Gen a'
    findGen (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    _ (FieldGen Gen a
    gen) gs
    _ = Gen a
    Gen a'
    gen

    -- | Matching custom generator for @i@-th field of constructor @c@.
    instance (a ~ a')
      => FindGen ('MatchCoh 'True) s (ConstrGen c i a) gs a' where
      findGen :: (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    -> ConstrGen c i a -> gs -> Gen a'
    findGen (Proxy ('MatchCoh 'True), Proxy s, FullGenListOf s)
    _ (ConstrGen Gen a
    gen) gs
    _ = Gen a
    Gen a'
    gen

    --

    newtype Weighted a = Weighted (Maybe (Int -> Gen a, Int))
      deriving (forall a b. (a -> b) -> Weighted a -> Weighted b)
    -> (forall a b. a -> Weighted b -> Weighted a) -> Functor Weighted
    forall a b. a -> Weighted b -> Weighted a
    forall a b. (a -> b) -> Weighted a -> Weighted b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Weighted a -> Weighted b
    fmap :: forall a b. (a -> b) -> Weighted a -> Weighted b
    $c<$ :: forall a b. a -> Weighted b -> Weighted a
    <$ :: forall a b. a -> Weighted b -> Weighted a
    Functor

    instance Applicative Weighted where
      pure :: forall a. a -> Weighted a
    pure a
    a = Maybe (Int -> Gen a, Int) -> Weighted a
    forall a. Maybe (Int -> Gen a, Int) -> Weighted a
    Weighted ((Int -> Gen a, Int) -> Maybe (Int -> Gen a, Int)
    forall a. a -> Maybe a
    Just ((Gen a -> Int -> Gen a
    forall a. a -> Int -> a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Gen a -> Int -> Gen a) -> (a -> Gen a) -> a -> Int -> Gen a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Gen a
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure) a
    a, Int
    1))
      Weighted Maybe (Int -> Gen (a -> b), Int)
    f <*> :: forall a b. Weighted (a -> b) -> Weighted a -> Weighted b
    <*> Weighted Maybe (Int -> Gen a, Int)
    a = Maybe (Int -> Gen b, Int) -> Weighted b
    forall a. Maybe (Int -> Gen a, Int) -> Weighted a
    Weighted (Maybe (Int -> Gen b, Int) -> Weighted b)
    -> Maybe (Int -> Gen b, Int) -> Weighted b
    forall a b. (a -> b) -> a -> b
    $ ((Int -> Gen (a -> b), Int)
     -> (Int -> Gen a, Int) -> (Int -> Gen b, Int))
    -> Maybe (Int -> Gen (a -> b), Int)
    -> Maybe (Int -> Gen a, Int)
    -> Maybe (Int -> Gen b, Int)
    forall a b c. (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (Int -> Gen (a -> b), Int)
    -> (Int -> Gen a, Int) -> (Int -> Gen b, Int)
    forall {b} {f :: * -> *} {a} {b}.
    (Integral b, Applicative f) =>
    (b -> f (a -> b), b) -> (b -> f a, b) -> (b -> f b, b)
    g Maybe (Int -> Gen (a -> b), Int)
    f Maybe (Int -> Gen a, Int)
    a
        where
          g :: (b -> f (a -> b), b) -> (b -> f a, b) -> (b -> f b, b)
    g (b -> f (a -> b)
    f1, b
    m) (b -> f a
    a1, b
    n) =
            ( \b
    i ->
                let (b
    j, b
    k) = b
    i b -> b -> (b, b)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` b
    m
                in b -> f (a -> b)
    f1 b
    j f (a -> b) -> f a -> f b
    forall a b. f (a -> b) -> f a -> f b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> b -> f a
    a1 b
    k
            , b
    m b -> b -> b
    forall a. Num a => a -> a -> a
    * b
    n )

    instance Alternative Weighted where
      empty :: forall a. Weighted a
    empty = Maybe (Int -> Gen a, Int) -> Weighted a
    forall a. Maybe (Int -> Gen a, Int) -> Weighted a
    Weighted Maybe (Int -> Gen a, Int)
    forall a. Maybe a
    Nothing
      Weighted a
    a <|> :: forall a. Weighted a -> Weighted a -> Weighted a
    <|> Weighted Maybe (Int -> Gen a, Int)
    Nothing = Weighted a
    a
      Weighted Maybe (Int -> Gen a, Int)
    Nothing <|> Weighted a
    b = Weighted a
    b
      Weighted (Just (Int -> Gen a
    a, Int
    m)) <|> Weighted (Just (Int -> Gen a
    b, Int
    n)) = Maybe (Int -> Gen a, Int) -> Weighted a
    forall a. Maybe (Int -> Gen a, Int) -> Weighted a
    Weighted (Maybe (Int -> Gen a, Int) -> Weighted a)
    -> ((Int -> Gen a, Int) -> Maybe (Int -> Gen a, Int))
    -> (Int -> Gen a, Int)
    -> Weighted a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Gen a, Int) -> Maybe (Int -> Gen a, Int)
    forall a. a -> Maybe a
    Just ((Int -> Gen a, Int) -> Weighted a)
    -> (Int -> Gen a, Int) -> Weighted a
    forall a b. (a -> b) -> a -> b
    $
        ( \Int
    i ->
            if Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    m then
              Int -> Gen a
    a Int
    i
            else
              Int -> Gen a
    b (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    m)
        , Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n )

    liftGen :: Gen a -> Weighted a
    liftGen :: forall a. Gen a -> Weighted a
    liftGen Gen a
    g = Maybe (Int -> Gen a, Int) -> Weighted a
    forall a. Maybe (Int -> Gen a, Int) -> Weighted a
    Weighted ((Int -> Gen a, Int) -> Maybe (Int -> Gen a, Int)
    forall a. a -> Maybe a
    Just (\Int
    _ -> Gen a
    g, Int
    1))