module Test.Falsify.Reexported.Generator.Function (
Fun
, applyFun
, pattern Fn
, pattern Fn2
, pattern Fn3
, fun
, Function(..)
, (:->)
, 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
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
, 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)
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
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}
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)
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
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)
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 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 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)
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 #-}
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
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>"
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
"}"
]
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 Function a where
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
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)
instance
( Function a
, Function b
)
=> Function (a, b)
instance
( Function a
, Function b
, Function c
)
=> Function (a, b, c)
instance
( Function a
, Function b
, Function c
, Function d
)
=> Function (a, b, c, d)
instance
( Function a
, Function b
, Function c
, Function d
, Function e
)
=> Function (a, b, c, d, e)
instance
( Function a
, Function b
, Function c
, Function d
, Function e
, Function f
)
=> Function (a, b, c, d, e, f)
instance
( Function a
, Function b
, Function c
, Function d
, Function e
, Function f
, Function g
)
=> Function (a, b, c, d, e, f, g)
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
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