module Test.Falsify.Internal.Generator.Function (
    fun
  , Function(..)
  , GFunction -- opaque
  ) where

import Prelude hiding (sum)

import Data.Char
import Data.Int
import Data.Maybe (fromMaybe)
import Data.Ratio (Ratio)
import Data.Void (Void)
import Data.Word
import GHC.Generics
import Numeric.Natural

import qualified Data.Ratio as Ratio

import Data.Falsify.ConcreteFun ((:->)(..))
import Test.Falsify.Internal.Fun
import Test.Falsify.Internal.Generator (Gen)
import Test.Falsify.Internal.Generator.Compound
import Test.Falsify.Internal.Generator.Shrinking

import qualified Data.Falsify.ConcreteFun as ConcreteFun

{-------------------------------------------------------------------------------
  Functions that can be shrunk and shown
-------------------------------------------------------------------------------}

-- | Generate function @a -> b@ given a generator for @b@
fun :: Function a => Gen b -> Gen (Fun a b)
fun :: forall a b. Function a => Gen b -> Gen (Fun a b)
fun Gen b
gen = do
    -- Generate value first, so that we try to shrink that first
    b
defaultValue  <- Gen b
gen
    a :-> b
concrete      <- Gen b -> Gen (a :-> b)
forall b. Gen b -> Gen (a :-> b)
forall a b. Function a => Gen b -> Gen (a :-> b)
function Gen b
gen
    Bool
isFullyShrunk <- Bool -> Bool -> Gen Bool
forall a. a -> a -> Gen a
firstThen Bool
False Bool
True
    Fun a b -> Gen (Fun a b)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Fun{a :-> b
concrete :: a :-> b
concrete :: a :-> b
concrete, b
defaultValue :: b
defaultValue :: b
defaultValue, Bool
isFullyShrunk :: Bool
isFullyShrunk :: Bool
isFullyShrunk}

{-------------------------------------------------------------------------------
  Constructing concrete functions
-------------------------------------------------------------------------------}

shrinkToNil :: Gen (a :-> b) -> Gen (a :-> b)
shrinkToNil :: forall a b. Gen (a :-> b) -> Gen (a :-> b)
shrinkToNil Gen (a :-> b)
gen = (a :-> b) -> Maybe (a :-> b) -> a :-> b
forall a. a -> Maybe a -> a
fromMaybe a :-> b
forall a b. a :-> b
Nil (Maybe (a :-> b) -> a :-> b)
-> Gen (Maybe (a :-> b)) -> Gen (a :-> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a :-> b) -> Gen (Maybe (a :-> b))
forall a. Gen a -> Gen (Maybe a)
shrinkToNothing Gen (a :-> b)
gen

table :: forall a b. (Integral a, Bounded a) => Gen b -> Gen (a :-> b)
table :: forall a b. (Integral a, Bounded a) => Gen b -> Gen (a :-> b)
table Gen b
gen = Tree (a, Maybe b) -> a :-> b
forall a b. Ord a => Tree (a, Maybe b) -> a :-> b
Table (Tree (a, Maybe b) -> a :-> b)
-> Gen (Tree (a, Maybe b)) -> Gen (a :-> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Gen (Maybe b)) -> (a, a) -> Gen (Tree (a, Maybe b))
forall a b.
Integral a =>
(a -> Gen b) -> (a, a) -> Gen (Tree (a, b))
bst (\a
_a -> Gen b -> Gen (Maybe b)
forall a. Gen a -> Gen (Maybe a)
shrinkToNothing Gen b
gen) (a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
maxBound)

unit :: Gen c -> Gen (() :-> c)
unit :: forall c. Gen c -> Gen (() :-> c)
unit Gen c
gen = Gen (() :-> c) -> Gen (() :-> c)
forall a b. Gen (a :-> b) -> Gen (a :-> b)
shrinkToNil (c -> () :-> c
forall b. b -> () :-> b
Unit (c -> () :-> c) -> Gen c -> Gen (() :-> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen c
gen)

sum ::
     (Gen c -> Gen (       a   :-> c))
  -> (Gen c -> Gen (         b :-> c))
  -> (Gen c -> Gen (Either a b :-> c))
sum :: forall c a b.
(Gen c -> Gen (a :-> c))
-> (Gen c -> Gen (b :-> c)) -> Gen c -> Gen (Either a b :-> c)
sum Gen c -> Gen (a :-> c)
f Gen c -> Gen (b :-> c)
g Gen c
gen = (a :-> c) -> (b :-> c) -> Either a b :-> c
forall a1 b b1. (a1 :-> b) -> (b1 :-> b) -> Either a1 b1 :-> b
Sum ((a :-> c) -> (b :-> c) -> Either a b :-> c)
-> Gen (a :-> c) -> Gen ((b :-> c) -> Either a b :-> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (a :-> c) -> Gen (a :-> c)
forall a b. Gen (a :-> b) -> Gen (a :-> b)
shrinkToNil (Gen c -> Gen (a :-> c)
f Gen c
gen) Gen ((b :-> c) -> Either a b :-> c)
-> Gen (b :-> c) -> Gen (Either a b :-> c)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (b :-> c) -> Gen (b :-> c)
forall a b. Gen (a :-> b) -> Gen (a :-> b)
shrinkToNil (Gen c -> Gen (b :-> c)
g Gen c
gen)

prod ::
     (forall c. Gen c -> Gen ( a     :-> c))
  -> (forall c. Gen c -> Gen (    b  :-> c))
  -> (forall c. Gen c -> Gen ((a, b) :-> c))
prod :: forall a b.
(forall c. Gen c -> Gen (a :-> c))
-> (forall c. Gen c -> Gen (b :-> c))
-> forall c. Gen c -> Gen ((a, b) :-> c)
prod forall c. Gen c -> Gen (a :-> c)
f forall c. Gen c -> Gen (b :-> c)
g = ((a :-> (b :-> c)) -> (a, b) :-> c)
-> Gen (a :-> (b :-> c)) -> Gen ((a, b) :-> c)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a :-> (b :-> c)) -> (a, b) :-> c
forall a1 b1 b. (a1 :-> (b1 :-> b)) -> (a1, b1) :-> b
Prod (Gen (a :-> (b :-> c)) -> Gen ((a, b) :-> c))
-> (Gen c -> Gen (a :-> (b :-> c))) -> Gen c -> Gen ((a, b) :-> c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (b :-> c) -> Gen (a :-> (b :-> c))
forall c. Gen c -> Gen (a :-> c)
f (Gen (b :-> c) -> Gen (a :-> (b :-> c)))
-> (Gen c -> Gen (b :-> c)) -> Gen c -> Gen (a :-> (b :-> c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen c -> Gen (b :-> c)
forall c. Gen c -> Gen (b :-> c)
g

{-------------------------------------------------------------------------------
  Class to construct functions
-------------------------------------------------------------------------------}

-- | Generating functions
class Function a where
  -- | Build reified function
  --
  -- If you need to add additional 'Function' instances, you will typically
  -- define them using 'Data.Falsify.Concrete.map', or rely on the default
  -- implementation in terms of generics.
  function :: Gen b -> Gen (a :-> b)

  default function :: (Generic a, GFunction (Rep a)) => Gen b -> Gen (a :-> b)
  function Gen b
gen = (a -> Rep a Any)
-> (Rep a Any -> a) -> (Rep a Any :-> b) -> a :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to ((Rep a Any :-> b) -> a :-> b)
-> Gen (Rep a Any :-> b) -> Gen (a :-> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen b -> Gen (Rep a Any :-> b)
forall b p. Gen b -> Gen (Rep a p :-> b)
forall (f :: * -> *) b p. GFunction f => Gen b -> Gen (f p :-> b)
gFunction Gen b
gen

instance Function Word8 where function :: forall b. Gen b -> Gen (Word8 :-> b)
function = Gen b -> Gen (Word8 :-> b)
forall a b. (Integral a, Bounded a) => Gen b -> Gen (a :-> b)
table
instance Function Int8  where function :: forall b. Gen b -> Gen (Int8 :-> b)
function = Gen b -> Gen (Int8 :-> b)
forall a b. (Integral a, Bounded a) => Gen b -> Gen (a :-> b)
table

instance Function Int     where function :: forall b. Gen b -> Gen (Int :-> b)
function = Gen b -> Gen (Int :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Int16   where function :: forall b. Gen b -> Gen (Int16 :-> b)
function = Gen b -> Gen (Int16 :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Int32   where function :: forall b. Gen b -> Gen (Int32 :-> b)
function = Gen b -> Gen (Int32 :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Int64   where function :: forall b. Gen b -> Gen (Int64 :-> b)
function = Gen b -> Gen (Int64 :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word    where function :: forall b. Gen b -> Gen (Word :-> b)
function = Gen b -> Gen (Word :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word16  where function :: forall b. Gen b -> Gen (Word16 :-> b)
function = Gen b -> Gen (Word16 :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word32  where function :: forall b. Gen b -> Gen (Word32 :-> b)
function = Gen b -> Gen (Word32 :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word64  where function :: forall b. Gen b -> Gen (Word64 :-> b)
function = Gen b -> Gen (Word64 :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Integer where function :: forall b. Gen b -> Gen (Integer :-> b)
function = Gen b -> Gen (Integer :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Natural where function :: forall b. Gen b -> Gen (Natural :-> b)
function = Gen b -> Gen (Natural :-> b)
forall a b. Integral a => Gen b -> Gen (a :-> b)
integral

instance Function Float  where function :: forall b. Gen b -> Gen (Float :-> b)
function = Gen b -> Gen (Float :-> b)
forall a b. RealFrac a => Gen b -> Gen (a :-> b)
realFrac
instance Function Double where function :: forall b. Gen b -> Gen (Double :-> b)
function = Gen b -> Gen (Double :-> b)
forall a b. RealFrac a => Gen b -> Gen (a :-> b)
realFrac

instance (Integral a, Function a) => Function (Ratio a) where
  function :: forall b. Gen b -> Gen (Ratio a :-> b)
function = (((a, a) :-> b) -> Ratio a :-> b)
-> Gen ((a, a) :-> b) -> Gen (Ratio a :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ratio a -> (a, a))
-> ((a, a) -> Ratio a) -> ((a, a) :-> b) -> Ratio a :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map Ratio a -> (a, a)
toPair (a, a) -> Ratio a
fromPair) (Gen ((a, a) :-> b) -> Gen (Ratio a :-> b))
-> (Gen b -> Gen ((a, a) :-> b)) -> Gen b -> Gen (Ratio a :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen b -> Gen ((a, a) :-> b)
forall b. Gen b -> Gen ((a, a) :-> b)
forall a b. Function a => Gen b -> Gen (a :-> b)
function
    where
      toPair :: Ratio a -> (a, a)
      toPair :: Ratio a -> (a, a)
toPair Ratio a
r = (Ratio a -> a
forall a. Ratio a -> a
Ratio.numerator Ratio a
r, Ratio a -> a
forall a. Ratio a -> a
Ratio.denominator Ratio a
r)

      fromPair :: (a, a) -> Ratio a
      fromPair :: (a, a) -> Ratio a
fromPair (a
n, a
d) = a
n a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
Ratio.% a
d

instance Function Char where
  function :: forall b. Gen b -> Gen (Char :-> b)
function = ((Int :-> b) -> Char :-> b) -> Gen (Int :-> b) -> Gen (Char :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Int) -> (Int -> Char) -> (Int :-> b) -> Char :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map Char -> Int
ord Int -> Char
chr) (Gen (Int :-> b) -> Gen (Char :-> b))
-> (Gen b -> Gen (Int :-> b)) -> Gen b -> Gen (Char :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen b -> Gen (Int :-> b)
forall b. Gen b -> Gen (Int :-> b)
forall a b. Function a => Gen b -> Gen (a :-> b)
function

-- instances that depend on generics

instance Function ()
instance Function Bool
instance Function Void

instance (Function a, Function b) => Function (Either a b)

instance Function a => Function [a]
instance Function a => Function (Maybe a)

-- Tuples (these are also using generics)

-- 2
instance
     ( Function a
     , Function b
     )
  => Function (a, b)

-- 3
instance
     ( Function a
     , Function b
     , Function c
     )
  => Function (a, b, c)

-- 4
instance
     ( Function a
     , Function b
     , Function c
     , Function d
     )
  => Function (a, b, c, d)

-- 5
instance
     ( Function a
     , Function b
     , Function c
     , Function d
     , Function e
     )
  => Function (a, b, c, d, e)

-- 6
instance
     ( Function a
     , Function b
     , Function c
     , Function d
     , Function e
     , Function f
     )
  => Function (a, b, c, d, e, f)

-- 7
instance
     ( Function a
     , Function b
     , Function c
     , Function d
     , Function e
     , Function f
     , Function g
     )
  => Function (a, b, c, d, e, f, g)

{-------------------------------------------------------------------------------
  Support for numbers
-------------------------------------------------------------------------------}

integral :: Integral a => Gen b -> Gen (a :-> b)
integral :: forall a b. Integral a => Gen b -> Gen (a :-> b)
integral =
      ((Signed [Word8] :-> b) -> a :-> b)
-> Gen (Signed [Word8] :-> b) -> Gen (a :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Signed [Word8])
-> (Signed [Word8] -> a) -> (Signed [Word8] :-> b) -> a :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map
             ((Natural -> [Word8]) -> Signed Natural -> Signed [Word8]
forall a b. (a -> b) -> Signed a -> Signed b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> [Word8]
bytes  (Signed Natural -> Signed [Word8])
-> (a -> Signed Natural) -> a -> Signed [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Signed Natural
toSignedNatural   (Integer -> Signed Natural)
-> (a -> Integer) -> a -> Signed Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger)
             (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a)
-> (Signed [Word8] -> Integer) -> Signed [Word8] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signed Natural -> Integer
fromSignedNatural (Signed Natural -> Integer)
-> (Signed [Word8] -> Signed Natural) -> Signed [Word8] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8] -> Natural) -> Signed [Word8] -> Signed Natural
forall a b. (a -> b) -> Signed a -> Signed b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> Natural
unbytes)
           )
    (Gen (Signed [Word8] :-> b) -> Gen (a :-> b))
-> (Gen b -> Gen (Signed [Word8] :-> b)) -> Gen b -> Gen (a :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen b -> Gen (Signed [Word8] :-> b)
forall b. Gen b -> Gen (Signed [Word8] :-> b)
forall a b. Function a => Gen b -> Gen (a :-> b)
function
  where
    bytes :: Natural -> [Word8]
    bytes :: Natural -> [Word8]
bytes Natural
0 = []
    bytes Natural
n = Natural -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural
n Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`mod` Natural
256) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Natural -> [Word8]
bytes (Natural
n Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`div` Natural
256)

    unbytes :: [Word8] -> Natural
    unbytes :: [Word8] -> Natural
unbytes []     = Natural
0
    unbytes (Word8
w:[Word8]
ws) = Word8 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
256 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* [Word8] -> Natural
unbytes [Word8]
ws

realFrac :: RealFrac a => Gen b -> Gen (a :-> b)
realFrac :: forall a b. RealFrac a => Gen b -> Gen (a :-> b)
realFrac = ((Rational :-> b) -> a :-> b)
-> Gen (Rational :-> b) -> Gen (a :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Rational) -> (Rational -> a) -> (Rational :-> b) -> a :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map a -> Rational
forall a. Real a => a -> Rational
toRational Rational -> a
forall a. Fractional a => Rational -> a
fromRational) (Gen (Rational :-> b) -> Gen (a :-> b))
-> (Gen b -> Gen (Rational :-> b)) -> Gen b -> Gen (a :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen b -> Gen (Rational :-> b)
forall b. Gen b -> Gen (Rational :-> b)
forall a b. Function a => Gen b -> Gen (a :-> b)
function

data Signed a = Pos a | Neg a
  deriving stock (Int -> Signed a -> ShowS
[Signed a] -> ShowS
Signed a -> String
(Int -> Signed a -> ShowS)
-> (Signed a -> String) -> ([Signed a] -> ShowS) -> Show (Signed a)
forall a. Show a => Int -> Signed a -> ShowS
forall a. Show a => [Signed a] -> ShowS
forall a. Show a => Signed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Signed a -> ShowS
showsPrec :: Int -> Signed a -> ShowS
$cshow :: forall a. Show a => Signed a -> String
show :: Signed a -> String
$cshowList :: forall a. Show a => [Signed a] -> ShowS
showList :: [Signed a] -> ShowS
Show, (forall a b. (a -> b) -> Signed a -> Signed b)
-> (forall a b. a -> Signed b -> Signed a) -> Functor Signed
forall a b. a -> Signed b -> Signed a
forall a b. (a -> b) -> Signed a -> Signed 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) -> Signed a -> Signed b
fmap :: forall a b. (a -> b) -> Signed a -> Signed b
$c<$ :: forall a b. a -> Signed b -> Signed a
<$ :: forall a b. a -> Signed b -> Signed a
Functor, (forall x. Signed a -> Rep (Signed a) x)
-> (forall x. Rep (Signed a) x -> Signed a) -> Generic (Signed a)
forall x. Rep (Signed a) x -> Signed a
forall x. Signed a -> Rep (Signed a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Signed a) x -> Signed a
forall a x. Signed a -> Rep (Signed a) x
$cfrom :: forall a x. Signed a -> Rep (Signed a) x
from :: forall x. Signed a -> Rep (Signed a) x
$cto :: forall a x. Rep (Signed a) x -> Signed a
to :: forall x. Rep (Signed a) x -> Signed a
Generic)
  deriving anyclass ((forall b. Gen b -> Gen (Signed a :-> b)) -> Function (Signed a)
forall b. Gen b -> Gen (Signed a :-> b)
forall a b. Function a => Gen b -> Gen (Signed a :-> b)
forall a. (forall b. Gen b -> Gen (a :-> b)) -> Function a
$cfunction :: forall a b. Function a => Gen b -> Gen (Signed a :-> b)
function :: forall b. Gen b -> Gen (Signed a :-> b)
Function)

toSignedNatural :: Integer -> Signed Natural
toSignedNatural :: Integer -> Signed Natural
toSignedNatural Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     = Natural -> Signed Natural
forall a. a -> Signed a
Neg (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
forall a. Num a => a -> a
abs Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
  | Bool
otherwise = Natural -> Signed Natural
forall a. a -> Signed a
Pos (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
n)

fromSignedNatural :: Signed Natural -> Integer
fromSignedNatural :: Signed Natural -> Integer
fromSignedNatural (Neg Natural
n) = Integer -> Integer
forall a. Num a => a -> a
negate (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
fromSignedNatural (Pos Natural
n) = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n

{-------------------------------------------------------------------------------
  Generic support for 'Function'
-------------------------------------------------------------------------------}

-- | Generic construction of concrete functions
--
-- See 'Function' for discussion.
class GFunction f where
  {-# MINIMAL #-}
  gFunction :: Gen b -> Gen (f p :-> b)
  gFunction = String -> Gen b -> Gen (f p :-> b)
forall a. HasCallStack => String -> a
error String
"gFunction not implemented"

instance GFunction f => GFunction (M1 i c f) where
  gFunction :: forall b p. Gen b -> Gen (M1 i c f p :-> b)
gFunction = ((f p :-> b) -> M1 i c f p :-> b)
-> Gen (f p :-> b) -> Gen (M1 i c f p :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((M1 i c f p -> f p)
-> (f p -> M1 i c f p) -> (f p :-> b) -> M1 i c f p :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map M1 i c f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 f p -> M1 i c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) (Gen (f p :-> b) -> Gen (M1 i c f p :-> b))
-> (Gen b -> Gen (f p :-> b)) -> Gen b -> Gen (M1 i c f p :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b p. GFunction f => Gen b -> Gen (f p :-> b)
gFunction @f

instance GFunction V1 where
  gFunction :: forall b p. Gen b -> Gen (V1 p :-> b)
gFunction Gen b
_ = (V1 p :-> b) -> Gen (V1 p :-> b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure V1 p :-> b
forall a b. a :-> b
Nil

instance GFunction U1 where
  gFunction :: forall b p. Gen b -> Gen (U1 p :-> b)
gFunction = ((() :-> b) -> U1 p :-> b) -> Gen (() :-> b) -> Gen (U1 p :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((U1 p -> ()) -> (() -> U1 p) -> (() :-> b) -> U1 p :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map U1 p -> ()
forall p. U1 p -> ()
unwrap () -> U1 p
forall p. () -> U1 p
wrap) (Gen (() :-> b) -> Gen (U1 p :-> b))
-> (Gen b -> Gen (() :-> b)) -> Gen b -> Gen (U1 p :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen b -> Gen (() :-> b)
forall c. Gen c -> Gen (() :-> c)
unit
    where
      unwrap :: U1 p -> ()
      unwrap :: forall p. U1 p -> ()
unwrap U1 p
_ = ()

      wrap :: () -> U1 p
      wrap :: forall p. () -> U1 p
wrap ()
_ = U1 p
forall k (p :: k). U1 p
U1

instance (GFunction f, GFunction g) => GFunction (f :*: g) where
  gFunction :: forall b p. Gen b -> Gen ((:*:) f g p :-> b)
gFunction = (((f p, g p) :-> b) -> (:*:) f g p :-> b)
-> Gen ((f p, g p) :-> b) -> Gen ((:*:) f g p :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((:*:) f g p -> (f p, g p))
-> ((f p, g p) -> (:*:) f g p)
-> ((f p, g p) :-> b)
-> (:*:) f g p :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map (:*:) f g p -> (f p, g p)
forall p. (:*:) f g p -> (f p, g p)
unwrap (f p, g p) -> (:*:) f g p
forall p. (f p, g p) -> (:*:) f g p
wrap) (Gen ((f p, g p) :-> b) -> Gen ((:*:) f g p :-> b))
-> (Gen b -> Gen ((f p, g p) :-> b))
-> Gen b
-> Gen ((:*:) f g p :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall c. Gen c -> Gen (f p :-> c))
-> (forall c. Gen c -> Gen (g p :-> c))
-> forall c. Gen c -> Gen ((f p, g p) :-> c)
forall a b.
(forall c. Gen c -> Gen (a :-> c))
-> (forall c. Gen c -> Gen (b :-> c))
-> forall c. Gen c -> Gen ((a, b) :-> c)
prod (forall (f :: * -> *) b p. GFunction f => Gen b -> Gen (f p :-> b)
gFunction @f) (forall (f :: * -> *) b p. GFunction f => Gen b -> Gen (f p :-> b)
gFunction @g)
    where
      unwrap :: (f :*: g) p -> (f p, g p)
      unwrap :: forall p. (:*:) f g p -> (f p, g p)
unwrap (f p
x :*: g p
y) = (f p
x, g p
y)

      wrap :: (f p, g p) -> (f :*: g) p
      wrap :: forall p. (f p, g p) -> (:*:) f g p
wrap (f p
x, g p
y) = f p
x f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
y

instance (GFunction f, GFunction g) => GFunction (f :+: g) where
  gFunction :: forall b p. Gen b -> Gen ((:+:) f g p :-> b)
gFunction =
      ((Either (f p) (g p) :-> b) -> (:+:) f g p :-> b)
-> Gen (Either (f p) (g p) :-> b) -> Gen ((:+:) f g p :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((:+:) f g p -> Either (f p) (g p))
-> (Either (f p) (g p) -> (:+:) f g p)
-> (Either (f p) (g p) :-> b)
-> (:+:) f g p :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map (:+:) f g p -> Either (f p) (g p)
forall p. (:+:) f g p -> Either (f p) (g p)
unwrap Either (f p) (g p) -> (:+:) f g p
forall p. Either (f p) (g p) -> (:+:) f g p
wrap) (Gen (Either (f p) (g p) :-> b) -> Gen ((:+:) f g p :-> b))
-> (Gen b -> Gen (Either (f p) (g p) :-> b))
-> Gen b
-> Gen ((:+:) f g p :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gen b -> Gen (f p :-> b))
-> (Gen b -> Gen (g p :-> b))
-> Gen b
-> Gen (Either (f p) (g p) :-> b)
forall c a b.
(Gen c -> Gen (a :-> c))
-> (Gen c -> Gen (b :-> c)) -> Gen c -> Gen (Either a b :-> c)
sum (forall (f :: * -> *) b p. GFunction f => Gen b -> Gen (f p :-> b)
gFunction @f) (forall (f :: * -> *) b p. GFunction f => Gen b -> Gen (f p :-> b)
gFunction @g)
    where
      unwrap :: (f :+: g) p -> Either (f p) (g p)
      unwrap :: forall p. (:+:) f g p -> Either (f p) (g p)
unwrap (L1 f p
x) = f p -> Either (f p) (g p)
forall a b. a -> Either a b
Left  f p
x
      unwrap (R1 g p
y) = g p -> Either (f p) (g p)
forall a b. b -> Either a b
Right g p
y

      wrap :: Either (f p) (g p) -> (f :+: g) p
      wrap :: forall p. Either (f p) (g p) -> (:+:) f g p
wrap (Left  f p
x) = f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x
      wrap (Right g p
y) = g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
y

instance Function a => GFunction (K1 i a) where
  gFunction :: forall b p. Gen b -> Gen (K1 i a p :-> b)
gFunction = ((a :-> b) -> K1 i a p :-> b)
-> Gen (a :-> b) -> Gen (K1 i a p :-> b)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((K1 i a p -> a) -> (a -> K1 i a p) -> (a :-> b) -> K1 i a p :-> b
forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
ConcreteFun.map K1 i a p -> a
forall k i c (p :: k). K1 i c p -> c
unK1 a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1) (Gen (a :-> b) -> Gen (K1 i a p :-> b))
-> (Gen b -> Gen (a :-> b)) -> Gen b -> Gen (K1 i a p :-> b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Function a => Gen b -> Gen (a :-> b)
function @a