{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}

module Generic.Random.DerivingVia
  ( GenericArbitrary (..),
    GenericArbitraryU (..),
    GenericArbitrarySingle (..),
    GenericArbitraryRec (..),
    GenericArbitraryG (..),
    GenericArbitraryUG (..),
    GenericArbitrarySingleG (..),
    GenericArbitraryRecG (..),
    GenericArbitraryWith (..),
    AndShrinking (..),
    TypeLevelGenList (..),
    TypeLevelOpts (..),
  )
where

import Data.Coerce (Coercible, coerce)
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic(..))
import GHC.TypeLits (KnownNat, natVal)
import Generic.Random.Internal.Generic
import Test.QuickCheck (Arbitrary (..), Gen, genericShrink)
import Test.QuickCheck.Arbitrary (RecursivelyShrink, GSubterms)

-- * Newtypes for DerivingVia

-- | Pick a constructor with a given distribution, and fill its fields
-- with recursive calls to 'Test.QuickCheck.arbitrary'.
--
-- === Example
--
-- > data X = ...
-- >   deriving Arbitrary via (GenericArbitrary '[2, 3, 5] X)
--
-- Picks the first constructor with probability @2/10@,
-- the second with probability @3/10@, the third with probability @5/10@.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitrary'.
--
-- @since 1.5.0.0
newtype GenericArbitrary weights a = GenericArbitrary {GenericArbitrary weights a -> a
unGenericArbitrary :: a} deriving (GenericArbitrary weights a -> GenericArbitrary weights a -> Bool
(GenericArbitrary weights a -> GenericArbitrary weights a -> Bool)
-> (GenericArbitrary weights a
    -> GenericArbitrary weights a -> Bool)
-> Eq (GenericArbitrary weights a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (weights :: k) a.
Eq a =>
GenericArbitrary weights a -> GenericArbitrary weights a -> Bool
/= :: GenericArbitrary weights a -> GenericArbitrary weights a -> Bool
$c/= :: forall k (weights :: k) a.
Eq a =>
GenericArbitrary weights a -> GenericArbitrary weights a -> Bool
== :: GenericArbitrary weights a -> GenericArbitrary weights a -> Bool
$c== :: forall k (weights :: k) a.
Eq a =>
GenericArbitrary weights a -> GenericArbitrary weights a -> Bool
Eq, Int -> GenericArbitrary weights a -> ShowS
[GenericArbitrary weights a] -> ShowS
GenericArbitrary weights a -> String
(Int -> GenericArbitrary weights a -> ShowS)
-> (GenericArbitrary weights a -> String)
-> ([GenericArbitrary weights a] -> ShowS)
-> Show (GenericArbitrary weights a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (weights :: k) a.
Show a =>
Int -> GenericArbitrary weights a -> ShowS
forall k (weights :: k) a.
Show a =>
[GenericArbitrary weights a] -> ShowS
forall k (weights :: k) a.
Show a =>
GenericArbitrary weights a -> String
showList :: [GenericArbitrary weights a] -> ShowS
$cshowList :: forall k (weights :: k) a.
Show a =>
[GenericArbitrary weights a] -> ShowS
show :: GenericArbitrary weights a -> String
$cshow :: forall k (weights :: k) a.
Show a =>
GenericArbitrary weights a -> String
showsPrec :: Int -> GenericArbitrary weights a -> ShowS
$cshowsPrec :: forall k (weights :: k) a.
Show a =>
Int -> GenericArbitrary weights a -> ShowS
Show)

instance
  ( GArbitrary UnsizedOpts a,
    TypeLevelWeights' weights a
  ) =>
  Arbitrary (GenericArbitrary weights a)
  where
  arbitrary :: Gen (GenericArbitrary weights a)
arbitrary = a -> GenericArbitrary weights a
forall k (weights :: k) a. a -> GenericArbitrary weights a
GenericArbitrary (a -> GenericArbitrary weights a)
-> Gen a -> Gen (GenericArbitrary weights a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Weights a -> Gen a
forall a. GArbitrary UnsizedOpts a => Weights a -> Gen a
genericArbitrary (forall a. TypeLevelWeights weights (Weights_ (Rep a)) => Weights a
forall k (weights :: k) a.
TypeLevelWeights weights (Weights_ (Rep a)) =>
Weights a
typeLevelWeights @weights)

-- | Pick every constructor with equal probability.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitraryU'.
--
-- @since 1.5.0.0
newtype GenericArbitraryU a = GenericArbitraryU {GenericArbitraryU a -> a
unGenericArbitraryU :: a} deriving (GenericArbitraryU a -> GenericArbitraryU a -> Bool
(GenericArbitraryU a -> GenericArbitraryU a -> Bool)
-> (GenericArbitraryU a -> GenericArbitraryU a -> Bool)
-> Eq (GenericArbitraryU a)
forall a.
Eq a =>
GenericArbitraryU a -> GenericArbitraryU a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericArbitraryU a -> GenericArbitraryU a -> Bool
$c/= :: forall a.
Eq a =>
GenericArbitraryU a -> GenericArbitraryU a -> Bool
== :: GenericArbitraryU a -> GenericArbitraryU a -> Bool
$c== :: forall a.
Eq a =>
GenericArbitraryU a -> GenericArbitraryU a -> Bool
Eq, Int -> GenericArbitraryU a -> ShowS
[GenericArbitraryU a] -> ShowS
GenericArbitraryU a -> String
(Int -> GenericArbitraryU a -> ShowS)
-> (GenericArbitraryU a -> String)
-> ([GenericArbitraryU a] -> ShowS)
-> Show (GenericArbitraryU a)
forall a. Show a => Int -> GenericArbitraryU a -> ShowS
forall a. Show a => [GenericArbitraryU a] -> ShowS
forall a. Show a => GenericArbitraryU a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericArbitraryU a] -> ShowS
$cshowList :: forall a. Show a => [GenericArbitraryU a] -> ShowS
show :: GenericArbitraryU a -> String
$cshow :: forall a. Show a => GenericArbitraryU a -> String
showsPrec :: Int -> GenericArbitraryU a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GenericArbitraryU a -> ShowS
Show)

instance
  ( GArbitrary UnsizedOpts a,
    GUniformWeight a
  ) =>
  Arbitrary (GenericArbitraryU a)
  where
  arbitrary :: Gen (GenericArbitraryU a)
arbitrary = a -> GenericArbitraryU a
forall a. a -> GenericArbitraryU a
GenericArbitraryU (a -> GenericArbitraryU a) -> Gen a -> Gen (GenericArbitraryU a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

-- | @arbitrary@ for types with one constructor.
-- Equivalent to 'GenericArbitraryU', with a stricter type.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitrarySingle'.
--
-- @since 1.5.0.0
newtype GenericArbitrarySingle a = GenericArbitrarySingle {GenericArbitrarySingle a -> a
unGenericArbitrarySingle :: a} deriving (GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool
(GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool)
-> (GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool)
-> Eq (GenericArbitrarySingle a)
forall a.
Eq a =>
GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool
$c/= :: forall a.
Eq a =>
GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool
== :: GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool
$c== :: forall a.
Eq a =>
GenericArbitrarySingle a -> GenericArbitrarySingle a -> Bool
Eq, Int -> GenericArbitrarySingle a -> ShowS
[GenericArbitrarySingle a] -> ShowS
GenericArbitrarySingle a -> String
(Int -> GenericArbitrarySingle a -> ShowS)
-> (GenericArbitrarySingle a -> String)
-> ([GenericArbitrarySingle a] -> ShowS)
-> Show (GenericArbitrarySingle a)
forall a. Show a => Int -> GenericArbitrarySingle a -> ShowS
forall a. Show a => [GenericArbitrarySingle a] -> ShowS
forall a. Show a => GenericArbitrarySingle a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericArbitrarySingle a] -> ShowS
$cshowList :: forall a. Show a => [GenericArbitrarySingle a] -> ShowS
show :: GenericArbitrarySingle a -> String
$cshow :: forall a. Show a => GenericArbitrarySingle a -> String
showsPrec :: Int -> GenericArbitrarySingle a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GenericArbitrarySingle a -> ShowS
Show)

instance
  ( GArbitrary UnsizedOpts a,
    Weights_ (Rep a) ~ L c0
  ) =>
  Arbitrary (GenericArbitrarySingle a)
  where
  arbitrary :: Gen (GenericArbitrarySingle a)
arbitrary = a -> GenericArbitrarySingle a
forall a. a -> GenericArbitrarySingle a
GenericArbitrarySingle (a -> GenericArbitrarySingle a)
-> Gen a -> Gen (GenericArbitrarySingle a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a (c0 :: Symbol).
(GArbitrary UnsizedOpts a, Weights_ (Rep a) ~ L c0) =>
Gen a
genericArbitrarySingle

-- | Decrease size at every recursive call, but don't do anything different
-- at size 0.
--
-- > data X = ...
-- >   deriving Arbitrary via (GenericArbitraryRec '[2, 3, 5] X)
--
-- 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).
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitraryRec'.
--
-- @since 1.5.0.0
newtype GenericArbitraryRec weights a = GenericArbitraryRec {GenericArbitraryRec weights a -> a
unGenericArbitraryRec :: a} deriving (GenericArbitraryRec weights a
-> GenericArbitraryRec weights a -> Bool
(GenericArbitraryRec weights a
 -> GenericArbitraryRec weights a -> Bool)
-> (GenericArbitraryRec weights a
    -> GenericArbitraryRec weights a -> Bool)
-> Eq (GenericArbitraryRec weights a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (weights :: k) a.
Eq a =>
GenericArbitraryRec weights a
-> GenericArbitraryRec weights a -> Bool
/= :: GenericArbitraryRec weights a
-> GenericArbitraryRec weights a -> Bool
$c/= :: forall k (weights :: k) a.
Eq a =>
GenericArbitraryRec weights a
-> GenericArbitraryRec weights a -> Bool
== :: GenericArbitraryRec weights a
-> GenericArbitraryRec weights a -> Bool
$c== :: forall k (weights :: k) a.
Eq a =>
GenericArbitraryRec weights a
-> GenericArbitraryRec weights a -> Bool
Eq, Int -> GenericArbitraryRec weights a -> ShowS
[GenericArbitraryRec weights a] -> ShowS
GenericArbitraryRec weights a -> String
(Int -> GenericArbitraryRec weights a -> ShowS)
-> (GenericArbitraryRec weights a -> String)
-> ([GenericArbitraryRec weights a] -> ShowS)
-> Show (GenericArbitraryRec weights a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (weights :: k) a.
Show a =>
Int -> GenericArbitraryRec weights a -> ShowS
forall k (weights :: k) a.
Show a =>
[GenericArbitraryRec weights a] -> ShowS
forall k (weights :: k) a.
Show a =>
GenericArbitraryRec weights a -> String
showList :: [GenericArbitraryRec weights a] -> ShowS
$cshowList :: forall k (weights :: k) a.
Show a =>
[GenericArbitraryRec weights a] -> ShowS
show :: GenericArbitraryRec weights a -> String
$cshow :: forall k (weights :: k) a.
Show a =>
GenericArbitraryRec weights a -> String
showsPrec :: Int -> GenericArbitraryRec weights a -> ShowS
$cshowsPrec :: forall k (weights :: k) a.
Show a =>
Int -> GenericArbitraryRec weights a -> ShowS
Show)

instance
  ( GArbitrary SizedOptsDef a,
    TypeLevelWeights' weights a
  ) =>
  Arbitrary (GenericArbitraryRec weights a)
  where
  arbitrary :: Gen (GenericArbitraryRec weights a)
arbitrary = a -> GenericArbitraryRec weights a
forall k (weights :: k) a. a -> GenericArbitraryRec weights a
GenericArbitraryRec (a -> GenericArbitraryRec weights a)
-> Gen a -> Gen (GenericArbitraryRec weights a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Weights a -> Gen a
forall a. GArbitrary SizedOptsDef a => Weights a -> Gen a
genericArbitraryRec (forall a. TypeLevelWeights weights (Weights_ (Rep a)) => Weights a
forall k (weights :: k) a.
TypeLevelWeights weights (Weights_ (Rep a)) =>
Weights a
typeLevelWeights @weights)

-- | 'GenericArbitrary' with explicit generators.
--
-- === Example
--
-- > data X = ...
-- >   deriving Arbitrary via (GenericArbitraryG CustomGens '[2, 3, 5] X)
--
-- where, for example, custom generators to override 'String' and 'Int' fields
-- might look as follows:
--
-- @
-- type CustomGens = CustomString ':+' CustomInt
-- @
--
-- === Note on multiple matches
--
-- Multiple generators may match a given field: the first will be chosen.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitraryG'.
--
-- @since 1.5.0.0
newtype GenericArbitraryG genList weights a = GenericArbitraryG {GenericArbitraryG genList weights a -> a
unGenericArbitraryG :: a} deriving (GenericArbitraryG genList weights a
-> GenericArbitraryG genList weights a -> Bool
(GenericArbitraryG genList weights a
 -> GenericArbitraryG genList weights a -> Bool)
-> (GenericArbitraryG genList weights a
    -> GenericArbitraryG genList weights a -> Bool)
-> Eq (GenericArbitraryG genList weights a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (genList :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryG genList weights a
-> GenericArbitraryG genList weights a -> Bool
/= :: GenericArbitraryG genList weights a
-> GenericArbitraryG genList weights a -> Bool
$c/= :: forall k (genList :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryG genList weights a
-> GenericArbitraryG genList weights a -> Bool
== :: GenericArbitraryG genList weights a
-> GenericArbitraryG genList weights a -> Bool
$c== :: forall k (genList :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryG genList weights a
-> GenericArbitraryG genList weights a -> Bool
Eq, Int -> GenericArbitraryG genList weights a -> ShowS
[GenericArbitraryG genList weights a] -> ShowS
GenericArbitraryG genList weights a -> String
(Int -> GenericArbitraryG genList weights a -> ShowS)
-> (GenericArbitraryG genList weights a -> String)
-> ([GenericArbitraryG genList weights a] -> ShowS)
-> Show (GenericArbitraryG genList weights a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (genList :: k) k (weights :: k) a.
Show a =>
Int -> GenericArbitraryG genList weights a -> ShowS
forall k (genList :: k) k (weights :: k) a.
Show a =>
[GenericArbitraryG genList weights a] -> ShowS
forall k (genList :: k) k (weights :: k) a.
Show a =>
GenericArbitraryG genList weights a -> String
showList :: [GenericArbitraryG genList weights a] -> ShowS
$cshowList :: forall k (genList :: k) k (weights :: k) a.
Show a =>
[GenericArbitraryG genList weights a] -> ShowS
show :: GenericArbitraryG genList weights a -> String
$cshow :: forall k (genList :: k) k (weights :: k) a.
Show a =>
GenericArbitraryG genList weights a -> String
showsPrec :: Int -> GenericArbitraryG genList weights a -> ShowS
$cshowsPrec :: forall k (genList :: k) k (weights :: k) a.
Show a =>
Int -> GenericArbitraryG genList weights a -> ShowS
Show)

instance
  ( GArbitrary (SetGens genList UnsizedOpts) a,
    GUniformWeight a,
    TypeLevelWeights' weights a,
    TypeLevelGenList genList',
    genList ~ TypeLevelGenList' genList'
  ) =>
  Arbitrary (GenericArbitraryG genList' weights a)
  where
  arbitrary :: Gen (GenericArbitraryG genList' weights a)
arbitrary = a -> GenericArbitraryG genList' weights a
forall k k (genList :: k) (weights :: k) a.
a -> GenericArbitraryG genList weights a
GenericArbitraryG (a -> GenericArbitraryG genList' weights a)
-> Gen a -> Gen (GenericArbitraryG genList' weights a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> genList -> Weights a -> Gen a
forall genList a.
GArbitrary (SetGens genList UnsizedOpts) a =>
genList -> Weights a -> Gen a
genericArbitraryG (Proxy genList' -> TypeLevelGenList' genList'
forall k (a :: k).
TypeLevelGenList a =>
Proxy a -> TypeLevelGenList' a
toGenList (Proxy genList' -> TypeLevelGenList' genList')
-> Proxy genList' -> TypeLevelGenList' genList'
forall a b. (a -> b) -> a -> b
$ Proxy genList'
forall k (t :: k). Proxy t
Proxy @genList') (forall a. TypeLevelWeights weights (Weights_ (Rep a)) => Weights a
forall k (weights :: k) a.
TypeLevelWeights weights (Weights_ (Rep a)) =>
Weights a
typeLevelWeights @weights)

-- | 'GenericArbitraryU' with explicit generators.
-- See also 'GenericArbitraryG'.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitraryUG'.
--
-- @since 1.5.0.0
newtype GenericArbitraryUG genList a = GenericArbitraryUG {GenericArbitraryUG genList a -> a
unGenericArbitraryUG :: a} deriving (GenericArbitraryUG genList a
-> GenericArbitraryUG genList a -> Bool
(GenericArbitraryUG genList a
 -> GenericArbitraryUG genList a -> Bool)
-> (GenericArbitraryUG genList a
    -> GenericArbitraryUG genList a -> Bool)
-> Eq (GenericArbitraryUG genList a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (genList :: k) a.
Eq a =>
GenericArbitraryUG genList a
-> GenericArbitraryUG genList a -> Bool
/= :: GenericArbitraryUG genList a
-> GenericArbitraryUG genList a -> Bool
$c/= :: forall k (genList :: k) a.
Eq a =>
GenericArbitraryUG genList a
-> GenericArbitraryUG genList a -> Bool
== :: GenericArbitraryUG genList a
-> GenericArbitraryUG genList a -> Bool
$c== :: forall k (genList :: k) a.
Eq a =>
GenericArbitraryUG genList a
-> GenericArbitraryUG genList a -> Bool
Eq, Int -> GenericArbitraryUG genList a -> ShowS
[GenericArbitraryUG genList a] -> ShowS
GenericArbitraryUG genList a -> String
(Int -> GenericArbitraryUG genList a -> ShowS)
-> (GenericArbitraryUG genList a -> String)
-> ([GenericArbitraryUG genList a] -> ShowS)
-> Show (GenericArbitraryUG genList a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (genList :: k) a.
Show a =>
Int -> GenericArbitraryUG genList a -> ShowS
forall k (genList :: k) a.
Show a =>
[GenericArbitraryUG genList a] -> ShowS
forall k (genList :: k) a.
Show a =>
GenericArbitraryUG genList a -> String
showList :: [GenericArbitraryUG genList a] -> ShowS
$cshowList :: forall k (genList :: k) a.
Show a =>
[GenericArbitraryUG genList a] -> ShowS
show :: GenericArbitraryUG genList a -> String
$cshow :: forall k (genList :: k) a.
Show a =>
GenericArbitraryUG genList a -> String
showsPrec :: Int -> GenericArbitraryUG genList a -> ShowS
$cshowsPrec :: forall k (genList :: k) a.
Show a =>
Int -> GenericArbitraryUG genList a -> ShowS
Show)

instance
  ( GArbitrary (SetGens genList UnsizedOpts) a,
    GUniformWeight a,
    TypeLevelGenList genList',
    genList ~ TypeLevelGenList' genList'
  ) =>
  Arbitrary (GenericArbitraryUG genList' a)
  where
  arbitrary :: Gen (GenericArbitraryUG genList' a)
arbitrary = a -> GenericArbitraryUG genList' a
forall k (genList :: k) a. a -> GenericArbitraryUG genList a
GenericArbitraryUG (a -> GenericArbitraryUG genList' a)
-> Gen a -> Gen (GenericArbitraryUG genList' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> genList -> Gen a
forall genList a.
(GArbitrary (SetGens genList UnsizedOpts) a, GUniformWeight a) =>
genList -> Gen a
genericArbitraryUG (Proxy genList' -> TypeLevelGenList' genList'
forall k (a :: k).
TypeLevelGenList a =>
Proxy a -> TypeLevelGenList' a
toGenList (Proxy genList' -> TypeLevelGenList' genList')
-> Proxy genList' -> TypeLevelGenList' genList'
forall a b. (a -> b) -> a -> b
$ Proxy genList'
forall k (t :: k). Proxy t
Proxy @genList')

-- | 'genericArbitrarySingle' with explicit generators.
-- See also 'GenericArbitraryG'.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitrarySingleG'.
--
-- @since 1.5.0.0
newtype GenericArbitrarySingleG genList a = GenericArbitrarySingleG {GenericArbitrarySingleG genList a -> a
unGenericArbitrarySingleG :: a} deriving (GenericArbitrarySingleG genList a
-> GenericArbitrarySingleG genList a -> Bool
(GenericArbitrarySingleG genList a
 -> GenericArbitrarySingleG genList a -> Bool)
-> (GenericArbitrarySingleG genList a
    -> GenericArbitrarySingleG genList a -> Bool)
-> Eq (GenericArbitrarySingleG genList a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (genList :: k) a.
Eq a =>
GenericArbitrarySingleG genList a
-> GenericArbitrarySingleG genList a -> Bool
/= :: GenericArbitrarySingleG genList a
-> GenericArbitrarySingleG genList a -> Bool
$c/= :: forall k (genList :: k) a.
Eq a =>
GenericArbitrarySingleG genList a
-> GenericArbitrarySingleG genList a -> Bool
== :: GenericArbitrarySingleG genList a
-> GenericArbitrarySingleG genList a -> Bool
$c== :: forall k (genList :: k) a.
Eq a =>
GenericArbitrarySingleG genList a
-> GenericArbitrarySingleG genList a -> Bool
Eq, Int -> GenericArbitrarySingleG genList a -> ShowS
[GenericArbitrarySingleG genList a] -> ShowS
GenericArbitrarySingleG genList a -> String
(Int -> GenericArbitrarySingleG genList a -> ShowS)
-> (GenericArbitrarySingleG genList a -> String)
-> ([GenericArbitrarySingleG genList a] -> ShowS)
-> Show (GenericArbitrarySingleG genList a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (genList :: k) a.
Show a =>
Int -> GenericArbitrarySingleG genList a -> ShowS
forall k (genList :: k) a.
Show a =>
[GenericArbitrarySingleG genList a] -> ShowS
forall k (genList :: k) a.
Show a =>
GenericArbitrarySingleG genList a -> String
showList :: [GenericArbitrarySingleG genList a] -> ShowS
$cshowList :: forall k (genList :: k) a.
Show a =>
[GenericArbitrarySingleG genList a] -> ShowS
show :: GenericArbitrarySingleG genList a -> String
$cshow :: forall k (genList :: k) a.
Show a =>
GenericArbitrarySingleG genList a -> String
showsPrec :: Int -> GenericArbitrarySingleG genList a -> ShowS
$cshowsPrec :: forall k (genList :: k) a.
Show a =>
Int -> GenericArbitrarySingleG genList a -> ShowS
Show)

instance
  ( GArbitrary (SetGens genList UnsizedOpts) a,
    Weights_ (Rep a) ~ L c0,
    TypeLevelGenList genList',
    genList ~ TypeLevelGenList' genList'
  ) =>
  Arbitrary (GenericArbitrarySingleG genList' a)
  where
  arbitrary :: Gen (GenericArbitrarySingleG genList' a)
arbitrary = a -> GenericArbitrarySingleG genList' a
forall k (genList :: k) a. a -> GenericArbitrarySingleG genList a
GenericArbitrarySingleG (a -> GenericArbitrarySingleG genList' a)
-> Gen a -> Gen (GenericArbitrarySingleG genList' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> genList -> Gen a
forall genList a (c0 :: Symbol).
(GArbitrary (SetGens genList UnsizedOpts) a,
 Weights_ (Rep a) ~ L c0) =>
genList -> Gen a
genericArbitrarySingleG (Proxy genList' -> TypeLevelGenList' genList'
forall k (a :: k).
TypeLevelGenList a =>
Proxy a -> TypeLevelGenList' a
toGenList (Proxy genList' -> TypeLevelGenList' genList')
-> Proxy genList' -> TypeLevelGenList' genList'
forall a b. (a -> b) -> a -> b
$ Proxy genList'
forall k (t :: k). Proxy t
Proxy @genList')

-- | 'genericArbitraryRec' with explicit generators.
-- See also 'genericArbitraryG'.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitraryRecG'.
--
-- @since 1.5.0.0
newtype GenericArbitraryRecG genList weights a = GenericArbitraryRecG {GenericArbitraryRecG genList weights a -> a
unGenericArbitraryRecG :: a} deriving (GenericArbitraryRecG genList weights a
-> GenericArbitraryRecG genList weights a -> Bool
(GenericArbitraryRecG genList weights a
 -> GenericArbitraryRecG genList weights a -> Bool)
-> (GenericArbitraryRecG genList weights a
    -> GenericArbitraryRecG genList weights a -> Bool)
-> Eq (GenericArbitraryRecG genList weights a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (genList :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryRecG genList weights a
-> GenericArbitraryRecG genList weights a -> Bool
/= :: GenericArbitraryRecG genList weights a
-> GenericArbitraryRecG genList weights a -> Bool
$c/= :: forall k (genList :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryRecG genList weights a
-> GenericArbitraryRecG genList weights a -> Bool
== :: GenericArbitraryRecG genList weights a
-> GenericArbitraryRecG genList weights a -> Bool
$c== :: forall k (genList :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryRecG genList weights a
-> GenericArbitraryRecG genList weights a -> Bool
Eq, Int -> GenericArbitraryRecG genList weights a -> ShowS
[GenericArbitraryRecG genList weights a] -> ShowS
GenericArbitraryRecG genList weights a -> String
(Int -> GenericArbitraryRecG genList weights a -> ShowS)
-> (GenericArbitraryRecG genList weights a -> String)
-> ([GenericArbitraryRecG genList weights a] -> ShowS)
-> Show (GenericArbitraryRecG genList weights a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (genList :: k) k (weights :: k) a.
Show a =>
Int -> GenericArbitraryRecG genList weights a -> ShowS
forall k (genList :: k) k (weights :: k) a.
Show a =>
[GenericArbitraryRecG genList weights a] -> ShowS
forall k (genList :: k) k (weights :: k) a.
Show a =>
GenericArbitraryRecG genList weights a -> String
showList :: [GenericArbitraryRecG genList weights a] -> ShowS
$cshowList :: forall k (genList :: k) k (weights :: k) a.
Show a =>
[GenericArbitraryRecG genList weights a] -> ShowS
show :: GenericArbitraryRecG genList weights a -> String
$cshow :: forall k (genList :: k) k (weights :: k) a.
Show a =>
GenericArbitraryRecG genList weights a -> String
showsPrec :: Int -> GenericArbitraryRecG genList weights a -> ShowS
$cshowsPrec :: forall k (genList :: k) k (weights :: k) a.
Show a =>
Int -> GenericArbitraryRecG genList weights a -> ShowS
Show)

instance
  ( GArbitrary (SetGens genList SizedOpts) a,
    TypeLevelWeights' weights a,
    TypeLevelGenList genList',
    genList ~ TypeLevelGenList' genList'
  ) =>
  Arbitrary (GenericArbitraryRecG genList' weights a)
  where
  arbitrary :: Gen (GenericArbitraryRecG genList' weights a)
arbitrary = a -> GenericArbitraryRecG genList' weights a
forall k k (genList :: k) (weights :: k) a.
a -> GenericArbitraryRecG genList weights a
GenericArbitraryRecG (a -> GenericArbitraryRecG genList' weights a)
-> Gen a -> Gen (GenericArbitraryRecG genList' weights a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> genList -> Weights a -> Gen a
forall genList a.
GArbitrary (SetGens genList SizedOpts) a =>
genList -> Weights a -> Gen a
genericArbitraryRecG (Proxy genList' -> TypeLevelGenList' genList'
forall k (a :: k).
TypeLevelGenList a =>
Proxy a -> TypeLevelGenList' a
toGenList (Proxy genList' -> TypeLevelGenList' genList')
-> Proxy genList' -> TypeLevelGenList' genList'
forall a b. (a -> b) -> a -> b
$ Proxy genList'
forall k (t :: k). Proxy t
Proxy @genList') (forall a. TypeLevelWeights weights (Weights_ (Rep a)) => Weights a
forall k (weights :: k) a.
TypeLevelWeights weights (Weights_ (Rep a)) =>
Weights a
typeLevelWeights @weights)

-- | General generic generator with custom options.
--
-- This newtype does no shrinking. To add generic shrinking, use 'AndShrinking'.
--
-- Uses 'genericArbitraryWith'.
--
-- @since 1.5.0.0
newtype GenericArbitraryWith opts weights a = GenericArbitraryWith {GenericArbitraryWith opts weights a -> a
unGenericArbitraryWith :: a} deriving (GenericArbitraryWith opts weights a
-> GenericArbitraryWith opts weights a -> Bool
(GenericArbitraryWith opts weights a
 -> GenericArbitraryWith opts weights a -> Bool)
-> (GenericArbitraryWith opts weights a
    -> GenericArbitraryWith opts weights a -> Bool)
-> Eq (GenericArbitraryWith opts weights a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (opts :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryWith opts weights a
-> GenericArbitraryWith opts weights a -> Bool
/= :: GenericArbitraryWith opts weights a
-> GenericArbitraryWith opts weights a -> Bool
$c/= :: forall k (opts :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryWith opts weights a
-> GenericArbitraryWith opts weights a -> Bool
== :: GenericArbitraryWith opts weights a
-> GenericArbitraryWith opts weights a -> Bool
$c== :: forall k (opts :: k) k (weights :: k) a.
Eq a =>
GenericArbitraryWith opts weights a
-> GenericArbitraryWith opts weights a -> Bool
Eq, Int -> GenericArbitraryWith opts weights a -> ShowS
[GenericArbitraryWith opts weights a] -> ShowS
GenericArbitraryWith opts weights a -> String
(Int -> GenericArbitraryWith opts weights a -> ShowS)
-> (GenericArbitraryWith opts weights a -> String)
-> ([GenericArbitraryWith opts weights a] -> ShowS)
-> Show (GenericArbitraryWith opts weights a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (opts :: k) k (weights :: k) a.
Show a =>
Int -> GenericArbitraryWith opts weights a -> ShowS
forall k (opts :: k) k (weights :: k) a.
Show a =>
[GenericArbitraryWith opts weights a] -> ShowS
forall k (opts :: k) k (weights :: k) a.
Show a =>
GenericArbitraryWith opts weights a -> String
showList :: [GenericArbitraryWith opts weights a] -> ShowS
$cshowList :: forall k (opts :: k) k (weights :: k) a.
Show a =>
[GenericArbitraryWith opts weights a] -> ShowS
show :: GenericArbitraryWith opts weights a -> String
$cshow :: forall k (opts :: k) k (weights :: k) a.
Show a =>
GenericArbitraryWith opts weights a -> String
showsPrec :: Int -> GenericArbitraryWith opts weights a -> ShowS
$cshowsPrec :: forall k (opts :: k) k (weights :: k) a.
Show a =>
Int -> GenericArbitraryWith opts weights a -> ShowS
Show)

instance
  ( GArbitrary opts a,
    TypeLevelWeights' weights a,
    TypeLevelOpts opts',
    opts ~ TypeLevelOpts' opts'
  ) =>
  Arbitrary (GenericArbitraryWith opts' weights a)
  where
  arbitrary :: Gen (GenericArbitraryWith opts' weights a)
arbitrary = a -> GenericArbitraryWith opts' weights a
forall k k (opts :: k) (weights :: k) a.
a -> GenericArbitraryWith opts weights a
GenericArbitraryWith (a -> GenericArbitraryWith opts' weights a)
-> Gen a -> Gen (GenericArbitraryWith opts' weights a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> opts -> Weights a -> Gen a
forall opts a. GArbitrary opts a => opts -> Weights a -> Gen a
genericArbitraryWith (Proxy opts' -> TypeLevelOpts' opts'
forall k (a :: k). TypeLevelOpts a => Proxy a -> TypeLevelOpts' a
toOpts (Proxy opts' -> TypeLevelOpts' opts')
-> Proxy opts' -> TypeLevelOpts' opts'
forall a b. (a -> b) -> a -> b
$ Proxy opts'
forall k (t :: k). Proxy t
Proxy @opts') (forall a. TypeLevelWeights weights (Weights_ (Rep a)) => Weights a
forall k (weights :: k) a.
TypeLevelWeights weights (Weights_ (Rep a)) =>
Weights a
typeLevelWeights @weights)

-- | Add generic shrinking to a newtype wrapper for 'Arbitrary', using 'genericShrink'.
--
-- @
-- data X = ...
--   deriving Arbitrary via ('GenericArbitrary' '[1,2,3] `'AndShrinking'` X)
-- @
--
-- Equivalent to:
--
-- @
-- instance Arbitrary X where
--   arbitrary = 'genericArbitrary' (1 % 2 % 3 % ())
--   shrink = 'Test.QuickCheck.genericShrink'
-- @
--
-- @since 1.5.0.0
newtype AndShrinking f a = AndShrinking a deriving (AndShrinking f a -> AndShrinking f a -> Bool
(AndShrinking f a -> AndShrinking f a -> Bool)
-> (AndShrinking f a -> AndShrinking f a -> Bool)
-> Eq (AndShrinking f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k) a.
Eq a =>
AndShrinking f a -> AndShrinking f a -> Bool
/= :: AndShrinking f a -> AndShrinking f a -> Bool
$c/= :: forall k (f :: k) a.
Eq a =>
AndShrinking f a -> AndShrinking f a -> Bool
== :: AndShrinking f a -> AndShrinking f a -> Bool
$c== :: forall k (f :: k) a.
Eq a =>
AndShrinking f a -> AndShrinking f a -> Bool
Eq, Int -> AndShrinking f a -> ShowS
[AndShrinking f a] -> ShowS
AndShrinking f a -> String
(Int -> AndShrinking f a -> ShowS)
-> (AndShrinking f a -> String)
-> ([AndShrinking f a] -> ShowS)
-> Show (AndShrinking f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k) a. Show a => Int -> AndShrinking f a -> ShowS
forall k (f :: k) a. Show a => [AndShrinking f a] -> ShowS
forall k (f :: k) a. Show a => AndShrinking f a -> String
showList :: [AndShrinking f a] -> ShowS
$cshowList :: forall k (f :: k) a. Show a => [AndShrinking f a] -> ShowS
show :: AndShrinking f a -> String
$cshow :: forall k (f :: k) a. Show a => AndShrinking f a -> String
showsPrec :: Int -> AndShrinking f a -> ShowS
$cshowsPrec :: forall k (f :: k) a. Show a => Int -> AndShrinking f a -> ShowS
Show)

instance
  ( Arbitrary (f a), Coercible (f a) a, Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a
  ) => Arbitrary (AndShrinking f a) where
  arbitrary :: Gen (AndShrinking f a)
arbitrary = Gen (f a) -> Gen (AndShrinking f a)
coerce (Gen (f a)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (f a))
  shrink :: AndShrinking f a -> [AndShrinking f a]
shrink = (a -> [a]) -> AndShrinking f a -> [AndShrinking f a]
coerce (a -> [a]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink :: a -> [a])

-- * Internal

-- |
-- @since 1.5.0.0
type TypeLevelWeights' weights a = TypeLevelWeights weights (Weights_ (Rep a))

typeLevelWeights ::
  forall weights a.
  TypeLevelWeights weights (Weights_ (Rep a)) =>
  Weights a
typeLevelWeights :: Weights a
typeLevelWeights =
  let (Weights_ (Rep a)
w, Int
n) = forall a. TypeLevelWeights weights a => (a, Int)
forall k (weights :: k) a. TypeLevelWeights weights a => (a, Int)
typeLevelWeightsBuilder @weights
   in Weights_ (Rep a) -> Int -> Weights a
forall a. Weights_ (Rep a) -> Int -> Weights a
Weights Weights_ (Rep a)
w Int
n

-- |
-- @since 1.5.0.0
class TypeLevelWeights weights a where
  typeLevelWeightsBuilder :: (a, Int)

instance
  ( KnownNat weight,
    TypeLevelWeights weights a
  ) =>
  TypeLevelWeights (weight ': weights) (L x :| a)
  where
  typeLevelWeightsBuilder :: (L x :| a, Int)
typeLevelWeightsBuilder =
    let (L x
a, Int
m) = (L x
forall (c :: Symbol). L c
L, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy weight -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy weight -> Integer) -> Proxy weight -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy weight
forall k (t :: k). Proxy t
Proxy @weight)
        (a
b, Int
n) = TypeLevelWeights weights a => (a, Int)
forall k (weights :: k) a. TypeLevelWeights weights a => (a, Int)
typeLevelWeightsBuilder @weights @a
     in (L x -> Int -> a -> L x :| a
forall a b. a -> Int -> b -> a :| b
N L x
a Int
m a
b, Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

instance
  ( KnownNat weight
  ) =>
  TypeLevelWeights (weight ': '[]) (L x)
  where
  typeLevelWeightsBuilder :: (L x, Int)
typeLevelWeightsBuilder = (L x
forall (c :: Symbol). L c
L, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy weight -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy weight -> Integer) -> Proxy weight -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy weight
forall k (t :: k). Proxy t
Proxy @weight)

instance
  TypeLevelWeights (w ': ws) (t :| (u :| v)) =>
  TypeLevelWeights (w ': ws) ((t :| u) :| v)
  where
  typeLevelWeightsBuilder :: ((t :| u) :| v, Int)
typeLevelWeightsBuilder =
    let (N t
t Int
nt (N u
u Int
nu v
v), Int
m) = TypeLevelWeights (w : ws) (t :| (u :| v)) => (t :| (u :| v), Int)
forall k (weights :: k) a. TypeLevelWeights weights a => (a, Int)
typeLevelWeightsBuilder @(w ': ws) @(t :| (u :| v))
     in ((t :| u) -> Int -> v -> (t :| u) :| v
forall a b. a -> Int -> b -> a :| b
N (t -> Int -> u -> t :| u
forall a b. a -> Int -> b -> a :| b
N t
t Int
nt u
u) (Int
nt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nu) v
v, Int
m)

instance TypeLevelWeights '[] () where
  typeLevelWeightsBuilder :: ((), Int)
typeLevelWeightsBuilder = ((), Int
1)

-- |
-- @since 1.5.0.0
class TypeLevelGenList a where
  type TypeLevelGenList' a :: Type
  toGenList :: Proxy a -> TypeLevelGenList' a

instance Arbitrary a => TypeLevelGenList (Gen a) where
  type TypeLevelGenList' (Gen a) = Gen a
  toGenList :: Proxy (Gen a) -> TypeLevelGenList' (Gen a)
toGenList Proxy (Gen a)
_ = TypeLevelGenList' (Gen a)
forall a. Arbitrary a => Gen a
arbitrary

instance (TypeLevelGenList a, TypeLevelGenList b) => TypeLevelGenList (a :+ b) where
  type TypeLevelGenList' (a :+ b) = TypeLevelGenList' a :+ TypeLevelGenList' b
  toGenList :: Proxy (a :+ b) -> TypeLevelGenList' (a :+ b)
toGenList Proxy (a :+ b)
_ = Proxy a -> TypeLevelGenList' a
forall k (a :: k).
TypeLevelGenList a =>
Proxy a -> TypeLevelGenList' a
toGenList (Proxy a
forall k (t :: k). Proxy t
Proxy @a) TypeLevelGenList' a
-> TypeLevelGenList' b
-> TypeLevelGenList' a :+ TypeLevelGenList' b
forall a b. a -> b -> a :+ b
:+ Proxy b -> TypeLevelGenList' b
forall k (a :: k).
TypeLevelGenList a =>
Proxy a -> TypeLevelGenList' a
toGenList (Proxy b
forall k (t :: k). Proxy t
Proxy @b)

-- |
-- @since 1.5.0.0
class TypeLevelOpts a where
  type TypeLevelOpts' a :: Type
  toOpts :: Proxy a -> TypeLevelOpts' a