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 Control.Monad
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
--
-- See also the 'Fn', 'Fn2', and 'Fn3' patter synonyms.
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