```module Test.Falsify.Reexported.Generator.Function (
Fun -- opaque
, applyFun
, pattern Fn
, pattern Fn2
, pattern Fn3
-- * Generation
, fun
-- * Construction
, Function(..)
, (:->) -- opaque
, functionMap
) where

import Prelude hiding (sum)

import Data.Bifunctor
import Data.Char
import Data.Foldable (toList)
import Data.Int
import Data.Kind
import Data.List (intercalate)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ratio (Ratio)
import Data.Word
import GHC.Generics
import Numeric.Natural

import qualified Data.Ratio as Ratio

import Data.Falsify.Tree (Tree, Interval(..), Endpoint(..))
import Test.Falsify.Internal.Generator (Gen)
import Test.Falsify.Reexported.Generator.Shrinking
import Test.Falsify.Reexported.Generator.Compound

import qualified Data.Falsify.Tree as Tree

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

-- | Function @a -> b@ which can be shown, generated, and shrunk
data Fun a b = Fun {
forall a b. Fun a b -> a :-> b
concrete      :: a :-> b
, forall a b. Fun a b -> b
defaultValue  :: b

-- Since functions are typically infinite, they can only safely be shown
-- once they are fully shrunk: after all, once a function has been fully
-- shrunk, we /know/ it must be finite, because in any given property, a
-- function will only ever be applied a finite number of times.
, forall a b. Fun a b -> Bool
isFullyShrunk :: Bool
}
deriving (forall a b. a -> Fun a b -> Fun a a
forall a b. (a -> b) -> Fun a a -> Fun a b
forall a a b. a -> Fun a b -> Fun a a
forall a a b. (a -> b) -> Fun a a -> Fun a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<\$ :: forall a b. a -> Fun a b -> Fun a a
\$c<\$ :: forall a a b. a -> Fun a b -> Fun a a
fmap :: forall a b. (a -> b) -> Fun a a -> Fun a b
\$cfmap :: forall a a b. (a -> b) -> Fun a a -> Fun a b
Functor)

-- | 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      <- forall a b. Function a => Gen b -> Gen (a :-> b)
function Gen b
gen
Bool
isFullyShrunk <- forall a. a -> a -> Gen a
firstThen Bool
False Bool
True
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}

{-------------------------------------------------------------------------------
Concrete functions

NOTE: @Nil@ is useful as a separate constructor, since it does not have an
@Eq@ constraint.
-------------------------------------------------------------------------------}

data (:->) :: Type -> Type -> Type where
Nil   :: a :-> b
Unit  :: a -> () :-> a
Table :: Ord a => Tree (a, Maybe b) -> a :-> b
Sum   :: (a :-> c) -> (b :-> c) -> (Either a b :-> c)
Prod  :: (a :-> (b :-> c)) -> (a, b) :-> c
Map   :: (b -> a) -> (a -> b) -> (a :-> c) -> (b :-> c)

instance Functor ((:->) a) where
fmap :: forall a b. (a -> b) -> (a :-> a) -> a :-> b
fmap a -> b
_ a :-> a
Nil           = forall a b. a :-> b
Nil
fmap a -> b
f (Unit a
x)      = forall a. a -> () :-> a
Unit (a -> b
f a
x)
fmap a -> b
f (Table Tree (a, Maybe a)
xs)    = forall a b. Ord a => Tree (a, Maybe b) -> a :-> b
Table (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) Tree (a, Maybe a)
xs)
fmap a -> b
f (Sum a :-> a
x b :-> a
y)     = forall a c b. (a :-> c) -> (b :-> c) -> Either a b :-> c
Sum (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a :-> a
x) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f b :-> a
y)
fmap a -> b
f (Prod a :-> (b :-> a)
x)      = forall a b c. (a :-> (b :-> c)) -> (a, b) :-> c
Prod (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) a :-> (b :-> a)
x)
fmap a -> b
f (Map a -> a
ab a -> a
ba a :-> a
x) = forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
Map a -> a
ab a -> a
ba (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f a :-> a
x)

-- | The basic building block for 'Function' instances
--
-- Provides a 'Function' instance by mapping to and from a type that
-- already has a 'Function' instance.
functionMap :: (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap :: forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap = forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
Map

-- | Apply concrete function
abstract :: (a :-> b) -> b -> (a -> b)
abstract :: forall a b. (a :-> b) -> b -> a -> b
abstract a :-> b
Nil         b
d a
_     = b
d
abstract (Unit b
x)    b
_ a
_     = b
x
abstract (Prod a :-> (b :-> b)
p)    b
d (a
x,b
y) = forall a b. (a :-> b) -> b -> a -> b
abstract (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b :-> b
q -> forall a b. (a :-> b) -> b -> a -> b
abstract b :-> b
q b
d b
y) a :-> (b :-> b)
p) b
d a
x
abstract (Sum a :-> b
p b :-> b
q)   b
d a
exy   = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. (a :-> b) -> b -> a -> b
abstract a :-> b
p b
d) (forall a b. (a :-> b) -> b -> a -> b
abstract b :-> b
q b
d) a
exy
abstract (Table Tree (a, Maybe b)
xys) b
d a
x     = forall a. a -> Maybe a -> a
fromMaybe b
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
\$ forall a b. Ord a => a -> Tree (a, b) -> Maybe b
Tree.lookup a
x Tree (a, Maybe b)
xys
abstract (Map a -> a
g a -> a
_ a :-> b
p) b
d a
x     = forall a b. (a :-> b) -> b -> a -> b
abstract a :-> b
p b
d (a -> a
g a
x)

{-------------------------------------------------------------------------------
Patterns

These are analogue to their counterparts in QuickCheck.
-------------------------------------------------------------------------------}

-- | Pattern synonym useful when generating functions of one argument
pattern Fn :: (a -> b) -> Fun a b
pattern \$mFn :: forall {r} {a} {b}. Fun a b -> ((a -> b) -> r) -> ((# #) -> r) -> r
Fn f <- (applyFun -> f)

-- | Pattern synonym useful when generating functions of two arguments
pattern Fn2 :: (a -> b -> c) -> Fun (a, b) c
pattern \$mFn2 :: forall {r} {a} {b} {c}.
Fun (a, b) c -> ((a -> b -> c) -> r) -> ((# #) -> r) -> r
Fn2 f <- (applyFun2 -> f)

-- | Pattern synonym useful when generating functions of three arguments
pattern Fn3 :: (a -> b -> c -> d) -> Fun (a, b, c) d
pattern \$mFn3 :: forall {r} {a} {b} {c} {d}.
Fun (a, b, c) d -> ((a -> b -> c -> d) -> r) -> ((# #) -> r) -> r
Fn3 f <- (applyFun3 -> f)

-- | Apply function to argument
--
applyFun :: Fun a b -> a -> b
applyFun :: forall a b. Fun a b -> a -> b
applyFun Fun{a :-> b
concrete :: a :-> b
concrete :: forall a b. Fun a b -> a :-> b
concrete, b
defaultValue :: b
defaultValue :: forall a b. Fun a b -> b
defaultValue} = forall a b. (a :-> b) -> b -> a -> b
abstract a :-> b
concrete b
defaultValue

applyFun2 :: Fun (a, b) c -> (a -> b -> c)
applyFun2 :: forall a b c. Fun (a, b) c -> a -> b -> c
applyFun2 Fun (a, b) c
f a
a b
b = forall a b. Fun a b -> a -> b
applyFun Fun (a, b) c
f (a
a, b
b)

applyFun3 :: Fun (a, b, c) d -> (a -> b -> c -> d)
applyFun3 :: forall a b c d. Fun (a, b, c) d -> a -> b -> c -> d
applyFun3 Fun (a, b, c) d
f a
a b
b c
c = forall a b. Fun a b -> a -> b
applyFun Fun (a, b, c) d
f (a
a, b
b, c
c)

{-# COMPLETE Fn  #-}
{-# COMPLETE Fn2 #-}
{-# COMPLETE Fn3 #-}

{-------------------------------------------------------------------------------
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 = forall a. a -> Maybe a -> a
fromMaybe forall a b. a :-> b
Nil forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 = forall a b. Ord a => Tree (a, Maybe b) -> a :-> b
Table forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> forall a b.
Integral a =>
(a -> Gen b) -> Interval a -> Gen (Tree (a, b))
bst (\a
_a -> forall a. Gen a -> Gen (Maybe a)
shrinkToNothing Gen b
gen) Interval a
i
where
i :: Interval a
i :: Interval a
i = forall a. Endpoint a -> Endpoint a -> Interval a
Interval (forall a. a -> Endpoint a
Inclusive forall a. Bounded a => a
minBound) (forall a. a -> Endpoint a
Inclusive forall a. Bounded a => a
maxBound)

unit :: Gen c -> Gen (() :-> c)
unit :: forall c. Gen c -> Gen (() :-> c)
unit Gen c
gen = forall a b. Gen (a :-> b) -> Gen (a :-> b)
shrinkToNil (forall a. a -> () :-> a
Unit 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 = forall a c b. (a :-> c) -> (b :-> c) -> Either a b :-> c
Sum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> forall a b. Gen (a :-> b) -> Gen (a :-> b)
shrinkToNil (Gen c -> Gen (a :-> c)
f Gen c
gen) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a :-> (b :-> c)) -> (a, b) :-> c
Prod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Gen c -> Gen (a :-> c)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Gen c -> Gen (b :-> c)
g

{-------------------------------------------------------------------------------
Show functions
-------------------------------------------------------------------------------}

instance (Show a, Show b) => Show (Fun a b) where
show :: Fun a b -> String
show Fun{a :-> b
concrete :: a :-> b
concrete :: forall a b. Fun a b -> a :-> b
concrete, b
defaultValue :: b
defaultValue :: forall a b. Fun a b -> b
defaultValue, Bool
isFullyShrunk :: Bool
isFullyShrunk :: forall a b. Fun a b -> Bool
isFullyShrunk}
| Bool
isFullyShrunk = forall a b. (Show a, Show b) => (a :-> b) -> b -> String
showFunction a :-> b
concrete b
defaultValue
| Bool
otherwise     = String
"<fun>"

-- | Show concrete function
--
-- Only use this on finite functions.
showFunction :: (Show a, Show b) => (a :-> b) -> b -> String
showFunction :: forall a b. (Show a, Show b) => (a :-> b) -> b -> String
showFunction a :-> b
p b
d = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
String
"{"
, forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
\$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[ forall a. Show a => a -> String
show a
x forall a. [a] -> [a] -> [a]
++ String
"->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
c
| (a
x,b
c) <- forall a b. (a :-> b) -> [(a, b)]
toTable a :-> b
p
]
, [String
"_->" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
d]
]
, String
"}"
]

-- | Generating a table from a concrete function
--
-- This is only used in the 'Show' instance.
toTable :: (a :-> b) -> [(a, b)]
toTable :: forall a b. (a :-> b) -> [(a, b)]
toTable a :-> b
Nil         = []
toTable (Unit b
x)    = [((), b
x)]
toTable (Prod a :-> (b :-> b)
p)    = [ ((a
x,b
y),b
c) | (a
x,b :-> b
q) <- forall a b. (a :-> b) -> [(a, b)]
toTable a :-> (b :-> b)
p, (b
y,b
c) <- forall a b. (a :-> b) -> [(a, b)]
toTable b :-> b
q ]
toTable (Sum a :-> b
p b :-> b
q)   = [ (forall a b. a -> Either a b
Left a
x, b
c) | (a
x,b
c) <- forall a b. (a :-> b) -> [(a, b)]
toTable a :-> b
p ]
forall a. [a] -> [a] -> [a]
++ [ (forall a b. b -> Either a b
Right b
y,b
c) | (b
y,b
c) <- forall a b. (a :-> b) -> [(a, b)]
toTable b :-> b
q ]
toTable (Table Tree (a, Maybe b)
xys) = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(a
a, Maybe b
b) -> (a
a,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<\$> Maybe b
b) forall a b. (a -> b) -> a -> b
\$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Tree (a, Maybe b)
xys
toTable (Map a -> a
_ a -> a
h a :-> b
p) = [ (a -> a
h a
x, b
c) | (a
x,b
c) <- forall a b. (a :-> b) -> [(a, b)]
toTable a :-> b
p ]

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

-- | Generating functions
class Function a where
-- | Build reified function
--
-- '(:->)' is an abstract type; if you need to add additional 'Function'
-- instances, you need to use 'functionMap', 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 = forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap forall a x. Generic a => a -> Rep a x
from forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 = 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 = 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 = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Int16   where function :: forall b. Gen b -> Gen (Int16 :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Int32   where function :: forall b. Gen b -> Gen (Int32 :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Int64   where function :: forall b. Gen b -> Gen (Int64 :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word    where function :: forall b. Gen b -> Gen (Word :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word16  where function :: forall b. Gen b -> Gen (Word16 :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word32  where function :: forall b. Gen b -> Gen (Word32 :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Word64  where function :: forall b. Gen b -> Gen (Word64 :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Integer where function :: forall b. Gen b -> Gen (Integer :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral
instance Function Natural where function :: forall b. Gen b -> Gen (Natural :-> b)
function = forall a b. Integral a => Gen b -> Gen (a :-> b)
integral

instance Function Float  where function :: forall b. Gen b -> Gen (Float :-> b)
function = forall a b. RealFrac a => Gen b -> Gen (a :-> b)
realFrac
instance Function Double where function :: forall b. Gen b -> Gen (Double :-> b)
function = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap Ratio a -> (a, a)
toPair (a, a) -> Ratio a
fromPair) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = (forall a. Ratio a -> a
Ratio.numerator Ratio a
r, 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 forall a. Integral a => a -> a -> Ratio a
Ratio.% a
d

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

-- instances that depend on generics

instance Function ()
instance Function Bool

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

unbytes :: [Word8] -> Natural
unbytes :: [Word8] -> Natural
unbytes []     = Natural
0
unbytes (Word8
w:[Word8]
ws) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w forall a. Num a => a -> a -> a
+ Natural
256 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap forall a. Real a => a -> Rational
toRational forall a. Fractional a => Rational -> a
fromRational) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Function a => Gen b -> Gen (a :-> b)
function

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

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

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

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

class GFunction f where
gFunction :: Gen b -> Gen (f p :-> b)

instance GFunction f => GFunction (M1 i c f) where
gFunction :: forall b p. Gen b -> Gen (M1 i c f p :-> b)
gFunction = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) 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 U1 where
gFunction :: forall b p. Gen b -> Gen (U1 p :-> b)
gFunction = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap forall p. U1 p -> ()
unwrap forall p. () -> U1 p
wrap) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ()
_ = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap forall p. (:*:) f g p -> (f p, g p)
unwrap forall p. (f p, g p) -> (:*:) f g p
wrap) forall b c a. (b -> c) -> (a -> b) -> a -> 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 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 =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap forall p. (:+:) f g p -> Either (f p) (g p)
unwrap forall p. Either (f p) (g p) -> (:+:) f g p
wrap) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall a b. a -> Either a b
Left  f p
x
unwrap (R1 g p
y) = 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) = forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
x
wrap (Right g p
y) = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a c. (b -> a) -> (a -> b) -> (a :-> c) -> b :-> c
functionMap forall k i c (p :: k). K1 i c p -> c
unK1 forall k i c (p :: k). c -> K1 i c p
K1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Function a => Gen b -> Gen (a :-> b)
function @a
```