{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module PlutusCore.Generators.QuickCheck.Builtin where
import PlutusPrelude
import PlutusCore hiding (Constr)
import PlutusCore.Builtin
import PlutusCore.Crypto.BLS12_381.G1 qualified as BLS12_381.G1
import PlutusCore.Crypto.BLS12_381.G2 qualified as BLS12_381.G2
import PlutusCore.Crypto.BLS12_381.Pairing qualified as BLS12_381.Pairing
import PlutusCore.Data
import PlutusCore.Generators.QuickCheck.GenerateKinds ()
import PlutusCore.Generators.QuickCheck.Split (multiSplit0, multiSplit1, multiSplit1In)
import Data.ByteString (ByteString, empty)
import Data.Int
import Data.Kind qualified as GHC
import Data.Maybe
import Data.Proxy
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Test.QuickCheck
import Test.QuickCheck.Instances.ByteString ()
import Universe
class ArbitraryBuiltin a where
arbitraryBuiltin :: Gen a
default arbitraryBuiltin :: Arbitrary a => Gen a
arbitraryBuiltin = Gen a
forall a. Arbitrary a => Gen a
arbitrary
shrinkBuiltin :: a -> [a]
default shrinkBuiltin :: Arbitrary a => a -> [a]
shrinkBuiltin = a -> [a]
forall a. Arbitrary a => a -> [a]
shrink
instance ArbitraryBuiltin ()
instance ArbitraryBuiltin Bool
nextInterestingBound :: Integer -> Integer
nextInterestingBound :: Integer -> Integer
nextInterestingBound Integer
1 = Integer
127
nextInterestingBound Integer
x = (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
highInterestingBound :: Integer
highInterestingBound :: Integer
highInterestingBound = Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
16
magnitudesPositive :: (Integer -> Integer) -> Integer -> [(Integer, Integer)]
magnitudesPositive :: (Integer -> Integer) -> Integer -> [(Integer, Integer)]
magnitudesPositive Integer -> Integer
next Integer
high =
(Integer -> Integer -> (Integer, Integer))
-> [Integer] -> [Integer] -> [(Integer, Integer)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
lo Integer
hi -> (Integer
lo Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer
hi)) [Integer]
borders ([Integer] -> [Integer]
forall a. HasCallStack => [a] -> [a]
tail [Integer]
borders)
where
preborders :: [Integer]
preborders = [Integer] -> [Integer]
forall a. HasCallStack => [a] -> [a]
tail ([Integer] -> [Integer])
-> ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Integer
x -> Integer -> Integer
next Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
high) ([Integer] -> [Integer]) -> [Integer] -> [Integer]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate Integer -> Integer
next Integer
1
borders :: [Integer]
borders = Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
preborders [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer -> Integer
next (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. HasCallStack => [a] -> a
last [Integer]
preborders, Integer
high]
chooseIntegerPreferEnds :: (Integer, Integer) -> Gen Integer
chooseIntegerPreferEnds :: (Integer, Integer) -> Gen Integer
chooseIntegerPreferEnds (Integer
lo, Integer
hi)
| Integer
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
20 = (Integer, Integer) -> Gen Integer
chooseInteger (Integer
lo, Integer
hi)
| Bool
otherwise = [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency ([(Int, Gen Integer)] -> Gen Integer)
-> [(Int, Gen Integer)] -> Gen Integer
forall a b. (a -> b) -> a -> b
$ [[(Int, Gen Integer)]] -> [(Int, Gen Integer)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Int] -> [Gen Integer] -> [(Int, Gen Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int
50 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
9, Int
8.. Int
1]) ([Gen Integer] -> [(Int, Gen Integer)])
-> [Gen Integer] -> [(Int, Gen Integer)]
forall a b. (a -> b) -> a -> b
$ (Integer -> Gen Integer) -> [Integer] -> [Gen Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Integer
lo..]
, [Int] -> [Gen Integer] -> [(Int, Gen Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int
50 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
9, Int
8.. Int
1]) ([Gen Integer] -> [(Int, Gen Integer)])
-> [Gen Integer] -> [(Int, Gen Integer)]
forall a b. (a -> b) -> a -> b
$ (Integer -> Gen Integer) -> [Integer] -> [Gen Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Integer
hi, Integer
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1]
, [(Int
200, (Integer, Integer) -> Gen Integer
chooseInteger (Integer
lo Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
10, Integer
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
10))]
]
arbitraryPositive :: (Integer -> Integer) -> Integer -> Gen Integer
arbitraryPositive :: (Integer -> Integer) -> Integer -> Gen Integer
arbitraryPositive Integer -> Integer
next Integer
high = [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency ([(Int, Gen Integer)] -> Gen Integer)
-> ([Gen Integer] -> [(Int, Gen Integer)])
-> [Gen Integer]
-> Gen Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Gen Integer] -> [(Int, Gen Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
freqs ([Gen Integer] -> Gen Integer) -> [Gen Integer] -> Gen Integer
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Gen Integer)
-> [(Integer, Integer)] -> [Gen Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Integer) -> Gen Integer
chooseIntegerPreferEnds [(Integer, Integer)]
magnitudes where
magnitudes :: [(Integer, Integer)]
magnitudes = (Integer -> Integer) -> Integer -> [(Integer, Integer)]
magnitudesPositive Integer -> Integer
next Integer
high
prefreqs :: [Int]
prefreqs = (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ([Double] -> [Int]) -> [Double] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.1) (Double
100 :: Double)
freqs :: [Int]
freqs = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Int] -> [Int]
forall a. [a] -> [a]
reverse (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take ([(Integer, Integer)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Integer, Integer)]
magnitudes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [Int]
prefreqs)
, (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1.5 :: Double)) (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int]
prefreqs
]
arbitraryNegative :: (Integer -> Integer) -> Integer -> Gen Integer
arbitraryNegative :: (Integer -> Integer) -> Integer -> Gen Integer
arbitraryNegative Integer -> Integer
next Integer
high = Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> Gen Integer -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> Integer) -> Integer -> Gen Integer
arbitraryPositive Integer -> Integer
next Integer
high
arbitrarySigned :: (Integer -> Integer) -> Integer -> Gen Integer
arbitrarySigned :: (Integer -> Integer) -> Integer -> Gen Integer
arbitrarySigned Integer -> Integer
next Integer
high = [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
[ (Int
48, (Integer -> Integer) -> Integer -> Gen Integer
arbitraryNegative Integer -> Integer
next Integer
high)
, (Int
4, Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0)
, (Int
48, (Integer -> Integer) -> Integer -> Gen Integer
arbitraryPositive Integer -> Integer
next Integer
high)
]
shrinkIntegralFast :: Integral a => a -> [a]
shrinkIntegralFast :: forall a. Integral a => a -> [a]
shrinkIntegralFast a
x = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [a
0 | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0]
, [-a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0]
, [a -> a
forall a. Num a => a -> a
signum a
x a -> a -> a
forall a. Num a => a -> a -> a
* Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Floating a => a -> a
sqrt @Double (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
xA) | let xA :: a
xA = a -> a
forall a. Num a => a -> a
abs a
x, a
xA a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
4]
, Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
x a -> a -> a
forall a. Num a => a -> a -> a
-) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2) a
x
]
instance ArbitraryBuiltin Integer where
arbitraryBuiltin :: Gen Integer
arbitraryBuiltin = (Integer -> Integer) -> Integer -> Gen Integer
arbitrarySigned Integer -> Integer
nextInterestingBound Integer
highInterestingBound
shrinkBuiltin :: Integer -> [Integer]
shrinkBuiltin = Integer -> [Integer]
forall a. Integral a => a -> [a]
shrinkIntegralFast
instance ArbitraryBuiltin Text where
arbitraryBuiltin :: Gen Text
arbitraryBuiltin = String -> Text
Text.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
getPrintableString (PrintableString -> Text) -> Gen PrintableString -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PrintableString
forall a. Arbitrary a => Gen a
arbitrary
shrinkBuiltin :: Text -> [Text]
shrinkBuiltin = (PrintableString -> Text) -> [PrintableString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
Text.pack (String -> Text)
-> (PrintableString -> String) -> PrintableString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> String
getPrintableString) ([PrintableString] -> [Text])
-> (Text -> [PrintableString]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintableString -> [PrintableString]
forall a. Arbitrary a => a -> [a]
shrink (PrintableString -> [PrintableString])
-> (Text -> PrintableString) -> Text -> [PrintableString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PrintableString
PrintableString (String -> PrintableString)
-> (Text -> String) -> Text -> PrintableString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
instance ArbitraryBuiltin ByteString where
arbitraryBuiltin :: Gen ByteString
arbitraryBuiltin = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Gen Text -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin
shrinkBuiltin :: ByteString -> [ByteString]
shrinkBuiltin = (Text -> ByteString) -> [Text] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Text -> ByteString
Text.encodeUtf8 ([Text] -> [ByteString])
-> (ByteString -> [Text]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8
genConstrTag :: Gen Integer
genConstrTag :: Gen Integer
genConstrTag = [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
[
(Int
6, (Integer, Integer) -> Gen Integer
chooseInteger (Integer
0, Integer
2))
,
(Int
3, (Integer, Integer) -> Gen Integer
chooseInteger (Integer
3, Integer
5))
,
(Int
1, (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64)) (Integer -> Integer) -> Gen Integer -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin)
]
genDataFromSpine :: [()] -> Gen Data
genDataFromSpine :: [()] -> Gen Data
genDataFromSpine [] =
[Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof
[ Integer -> [Data] -> Data
Constr (Integer -> [Data] -> Data) -> Gen Integer -> Gen ([Data] -> Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
genConstrTag Gen ([Data] -> Data) -> Gen [Data] -> Gen Data
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Data] -> Gen [Data]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
, Data -> Gen Data
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data -> Gen Data) -> Data -> Gen Data
forall a b. (a -> b) -> a -> b
$ [Data] -> Data
List []
, Data -> Gen Data
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data -> Gen Data) -> Data -> Gen Data
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> Data
Map []
]
genDataFromSpine [()] = [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Integer -> Data
I (Integer -> Data) -> Gen Integer -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin, ByteString -> Data
B (ByteString -> Data) -> Gen ByteString -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin]
genDataFromSpine [()]
els = [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof
[ Integer -> [Data] -> Data
Constr (Integer -> [Data] -> Data) -> Gen Integer -> Gen ([Data] -> Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
genConstrTag Gen ([Data] -> Data) -> Gen [Data] -> Gen Data
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> [()] -> Gen [[()]]
forall a. Double -> [a] -> Gen [[a]]
multiSplit0 Double
0.1 [()]
els Gen [[()]] -> ([[()]] -> Gen [Data]) -> Gen [Data]
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([()] -> Gen Data) -> [[()]] -> Gen [Data]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [()] -> Gen Data
genDataFromSpine)
, [Data] -> Data
List ([Data] -> Data) -> Gen [Data] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> [()] -> Gen [[()]]
forall a. Double -> [a] -> Gen [[a]]
multiSplit0 Double
0.1 [()]
els Gen [[()]] -> ([[()]] -> Gen [Data]) -> Gen [Data]
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([()] -> Gen Data) -> [[()]] -> Gen [Data]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [()] -> Gen Data
genDataFromSpine)
, do
[NonEmptyList ()]
elss <- [()] -> Gen [NonEmptyList ()]
forall a. [a] -> Gen [NonEmptyList a]
multiSplit1 [()]
els
[(Data, Data)] -> Data
Map ([(Data, Data)] -> Data) -> Gen [(Data, Data)] -> Gen Data
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen [(Data, Data)])] -> Gen [(Data, Data)]
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
[
(Int
6, [NonEmptyList ()]
-> (NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [NonEmptyList ()]
elss ((NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)])
-> (NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)]
forall a b. (a -> b) -> a -> b
$ \(NonEmpty [()]
els') ->
(,) (Data -> Data -> (Data, Data))
-> (ByteString -> Data) -> ByteString -> Data -> (Data, Data)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Data
B (ByteString -> Data -> (Data, Data))
-> Gen ByteString -> Gen (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [()] -> Gen Data
genDataFromSpine (Int -> [()] -> [()]
forall a. Int -> [a] -> [a]
drop Int
1 [()]
els'))
,
(Int
3, [NonEmptyList ()]
-> (NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [NonEmptyList ()]
elss ((NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)])
-> (NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)]
forall a b. (a -> b) -> a -> b
$ \(NonEmpty [()]
els') ->
(,) (Data -> Data -> (Data, Data))
-> (Integer -> Data) -> Integer -> Data -> (Data, Data)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Data
I (Integer -> Data -> (Data, Data))
-> Gen Integer -> Gen (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [()] -> Gen Data
genDataFromSpine (Int -> [()] -> [()]
forall a. Int -> [a] -> [a]
drop Int
1 [()]
els'))
,
(Int
1, [NonEmptyList ()]
-> (NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [NonEmptyList ()]
elss ((NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)])
-> (NonEmptyList () -> Gen (Data, Data)) -> Gen [(Data, Data)]
forall a b. (a -> b) -> a -> b
$ \(NonEmpty [()]
els') -> do
[NonEmptyList ()]
splitRes <- Int -> [()] -> Gen [NonEmptyList ()]
forall a. Int -> [a] -> Gen [NonEmptyList a]
multiSplit1In Int
2 [()]
els'
case [NonEmptyList ()]
splitRes of
[] ->
(,) (Data -> Data -> (Data, Data))
-> Gen Data -> Gen (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [()] -> Gen Data
genDataFromSpine [] Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [()] -> Gen Data
genDataFromSpine []
[NonEmpty [()]
elsL'] ->
(,) (Data -> Data -> (Data, Data))
-> Gen Data -> Gen (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [()] -> Gen Data
genDataFromSpine [()]
elsL' Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [()] -> Gen Data
genDataFromSpine []
[NonEmpty [()]
elsL', NonEmpty [()]
elsR'] ->
(,) (Data -> Data -> (Data, Data))
-> Gen Data -> Gen (Data -> (Data, Data))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [()] -> Gen Data
genDataFromSpine [()]
elsL' Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [()] -> Gen Data
genDataFromSpine [()]
elsR'
[NonEmptyList ()]
_ -> String -> Gen (Data, Data)
forall a. HasCallStack => String -> a
error String
"Panic: 'multiSplit1In 2' returned a list longer than 2 elements")
]
]
pureIfNull :: (Foldable f, Applicative f) => a -> f a -> f a
pureIfNull :: forall (f :: * -> *) a.
(Foldable f, Applicative f) =>
a -> f a -> f a
pureIfNull a
x f a
xs = if f a -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
xs then a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x else f a
xs
instance ArbitraryBuiltin Data where
arbitraryBuiltin :: Gen Data
arbitraryBuiltin = Gen [()]
forall a. Arbitrary a => Gen a
arbitrary Gen [()] -> ([()] -> Gen Data) -> Gen Data
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [()] -> Gen Data
genDataFromSpine
shrinkBuiltin :: Data -> [Data]
shrinkBuiltin (Constr Integer
i [Data]
ds) = Data -> [Data] -> [Data]
forall (f :: * -> *) a.
(Foldable f, Applicative f) =>
a -> f a -> f a
pureIfNull (Integer -> Data
I Integer
0) ([Data] -> [Data]) -> [Data] -> [Data]
forall a b. (a -> b) -> a -> b
$ [[Data]] -> [Data]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Data]
ds
, ([Data] -> Data) -> [[Data]] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> [Data] -> Data
Constr Integer
i) ([[Data]] -> [Data]) -> [[Data]] -> [Data]
forall a b. (a -> b) -> a -> b
$ [Data] -> [[Data]]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin [Data]
ds
, (Integer -> Data) -> [Integer] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map ((Integer -> [Data] -> Data) -> [Data] -> Integer -> Data
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> [Data] -> Data
Constr [Data]
ds) ([Integer] -> [Data]) -> [Integer] -> [Data]
forall a b. (a -> b) -> a -> b
$ Integer -> [Integer]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin Integer
i
]
shrinkBuiltin (Map [(Data, Data)]
ps) = Data -> [Data] -> [Data]
forall (f :: * -> *) a.
(Foldable f, Applicative f) =>
a -> f a -> f a
pureIfNull (Integer -> Data
I Integer
0) ([Data] -> [Data]) -> [Data] -> [Data]
forall a b. (a -> b) -> a -> b
$ [[Data]] -> [Data]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ ((Data, Data) -> Data) -> [(Data, Data)] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map (Data, Data) -> Data
forall a b. (a, b) -> a
fst [(Data, Data)]
ps
, ((Data, Data) -> Data) -> [(Data, Data)] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map (Data, Data) -> Data
forall a b. (a, b) -> b
snd [(Data, Data)]
ps
, ([(Data, Data)] -> Data) -> [[(Data, Data)]] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map [(Data, Data)] -> Data
Map ([[(Data, Data)]] -> [Data]) -> [[(Data, Data)]] -> [Data]
forall a b. (a -> b) -> a -> b
$ [(Data, Data)] -> [[(Data, Data)]]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin [(Data, Data)]
ps
]
shrinkBuiltin (List [Data]
ds) = Data -> [Data] -> [Data]
forall (f :: * -> *) a.
(Foldable f, Applicative f) =>
a -> f a -> f a
pureIfNull (Integer -> Data
I Integer
0) ([Data] -> [Data]) -> [Data] -> [Data]
forall a b. (a -> b) -> a -> b
$ [[Data]] -> [Data]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Data]
ds
, ([Data] -> Data) -> [[Data]] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map [Data] -> Data
List ([[Data]] -> [Data]) -> [[Data]] -> [Data]
forall a b. (a -> b) -> a -> b
$ [Data] -> [[Data]]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin [Data]
ds
]
shrinkBuiltin (B ByteString
b) = Data -> [Data] -> [Data]
forall (f :: * -> *) a.
(Foldable f, Applicative f) =>
a -> f a -> f a
pureIfNull (Integer -> Data
I Integer
0) ([Data] -> [Data])
-> ([ByteString] -> [Data]) -> [ByteString] -> [Data]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Data) -> [ByteString] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Data
B ([ByteString] -> [Data]) -> [ByteString] -> [Data]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin ByteString
b
shrinkBuiltin (I Integer
i) = (Integer -> Data) -> [Integer] -> [Data]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Data
I ([Integer] -> [Data]) -> [Integer] -> [Data]
forall a b. (a -> b) -> a -> b
$ Integer -> [Integer]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin Integer
i
instance Arbitrary Data where
arbitrary :: Gen Data
arbitrary = Gen Data
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin
shrink :: Data -> [Data]
shrink = Data -> [Data]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin
instance ArbitraryBuiltin BLS12_381.G1.Element where
arbitraryBuiltin :: Gen Element
arbitraryBuiltin =
ByteString -> ByteString -> Either BLS12_381_Error Element
BLS12_381.G1.hashToGroup (ByteString -> ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString
-> Gen (ByteString -> Either BLS12_381_Error Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString -> Gen (Either BLS12_381_Error Element)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Gen ByteString
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
Data.ByteString.empty Gen (Either BLS12_381_Error Element)
-> (Either BLS12_381_Error Element -> Gen Element) -> Gen Element
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left BLS12_381_Error
err -> String -> Gen Element
forall a. HasCallStack => String -> a
error (String -> Gen Element) -> String -> Gen Element
forall a b. (a -> b) -> a -> b
$ BLS12_381_Error -> String
forall a. Show a => a -> String
show BLS12_381_Error
err
Right Element
p -> Element -> Gen Element
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
p
shrinkBuiltin :: Element -> [Element]
shrinkBuiltin Element
_ = []
instance ArbitraryBuiltin BLS12_381.G2.Element where
arbitraryBuiltin :: Gen Element
arbitraryBuiltin =
ByteString -> ByteString -> Either BLS12_381_Error Element
BLS12_381.G2.hashToGroup (ByteString -> ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString
-> Gen (ByteString -> Either BLS12_381_Error Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary Gen (ByteString -> Either BLS12_381_Error Element)
-> Gen ByteString -> Gen (Either BLS12_381_Error Element)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Gen ByteString
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
Data.ByteString.empty Gen (Either BLS12_381_Error Element)
-> (Either BLS12_381_Error Element -> Gen Element) -> Gen Element
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left BLS12_381_Error
err -> String -> Gen Element
forall a. HasCallStack => String -> a
error (String -> Gen Element) -> String -> Gen Element
forall a b. (a -> b) -> a -> b
$ BLS12_381_Error -> String
forall a. Show a => a -> String
show BLS12_381_Error
err
Right Element
p -> Element -> Gen Element
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
p
shrinkBuiltin :: Element -> [Element]
shrinkBuiltin Element
_ = []
instance ArbitraryBuiltin BLS12_381.Pairing.MlResult where
arbitraryBuiltin :: Gen MlResult
arbitraryBuiltin = Element -> Element -> MlResult
BLS12_381.Pairing.millerLoop (Element -> Element -> MlResult)
-> Gen Element -> Gen (Element -> MlResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Element
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin Gen (Element -> MlResult) -> Gen Element -> Gen MlResult
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Element
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin
shrinkBuiltin :: MlResult -> [MlResult]
shrinkBuiltin MlResult
_ = []
newtype AsArbitraryBuiltin a = AsArbitraryBuiltin
{ forall a. AsArbitraryBuiltin a -> a
unAsArbitraryBuiltin :: a
} deriving newtype (Int -> AsArbitraryBuiltin a -> ShowS
[AsArbitraryBuiltin a] -> ShowS
AsArbitraryBuiltin a -> String
(Int -> AsArbitraryBuiltin a -> ShowS)
-> (AsArbitraryBuiltin a -> String)
-> ([AsArbitraryBuiltin a] -> ShowS)
-> Show (AsArbitraryBuiltin a)
forall a. Show a => Int -> AsArbitraryBuiltin a -> ShowS
forall a. Show a => [AsArbitraryBuiltin a] -> ShowS
forall a. Show a => AsArbitraryBuiltin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> AsArbitraryBuiltin a -> ShowS
showsPrec :: Int -> AsArbitraryBuiltin a -> ShowS
$cshow :: forall a. Show a => AsArbitraryBuiltin a -> String
show :: AsArbitraryBuiltin a -> String
$cshowList :: forall a. Show a => [AsArbitraryBuiltin a] -> ShowS
showList :: [AsArbitraryBuiltin a] -> ShowS
Show)
instance ArbitraryBuiltin a => Arbitrary (AsArbitraryBuiltin a) where
arbitrary :: Gen (AsArbitraryBuiltin a)
arbitrary = Gen a -> Gen (AsArbitraryBuiltin a)
forall a b. Coercible a b => a -> b
coerce (Gen a -> Gen (AsArbitraryBuiltin a))
-> Gen a -> Gen (AsArbitraryBuiltin a)
forall a b. (a -> b) -> a -> b
$ forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin @a
shrink :: AsArbitraryBuiltin a -> [AsArbitraryBuiltin a]
shrink = (a -> [a]) -> AsArbitraryBuiltin a -> [AsArbitraryBuiltin a]
forall a b. Coercible a b => a -> b
coerce ((a -> [a]) -> AsArbitraryBuiltin a -> [AsArbitraryBuiltin a])
-> (a -> [a]) -> AsArbitraryBuiltin a -> [AsArbitraryBuiltin a]
forall a b. (a -> b) -> a -> b
$ forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin @a
instance ArbitraryBuiltin a => ArbitraryBuiltin [a] where
arbitraryBuiltin :: Gen [a]
arbitraryBuiltin = do
[()]
spine <- Gen [()]
forall a. Arbitrary a => Gen a
arbitrary
let len :: Int
len = [()] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [()]
spine
[()] -> (() -> Gen a) -> Gen [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [()]
spine ((() -> Gen a) -> Gen [a]) -> (() -> Gen a) -> Gen [a]
forall a b. (a -> b) -> a -> b
$ \() ->
(Int -> Int) -> Gen a -> Gen a
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
len) (Gen a -> Gen a)
-> (Gen (AsArbitraryBuiltin a) -> Gen a)
-> Gen (AsArbitraryBuiltin a)
-> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen (AsArbitraryBuiltin a) -> Gen a
forall a b. Coercible a b => a -> b
coerce (Gen (AsArbitraryBuiltin a) -> Gen a)
-> Gen (AsArbitraryBuiltin a) -> Gen a
forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => Gen a
arbitrary @(AsArbitraryBuiltin a)
shrinkBuiltin :: [a] -> [[a]]
shrinkBuiltin = ([AsArbitraryBuiltin a] -> [[AsArbitraryBuiltin a]])
-> [a] -> [[a]]
forall a b. Coercible a b => a -> b
coerce (([AsArbitraryBuiltin a] -> [[AsArbitraryBuiltin a]])
-> [a] -> [[a]])
-> ([AsArbitraryBuiltin a] -> [[AsArbitraryBuiltin a]])
-> [a]
-> [[a]]
forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
shrink @[AsArbitraryBuiltin a]
instance (ArbitraryBuiltin a, ArbitraryBuiltin b) => ArbitraryBuiltin (a, b) where
arbitraryBuiltin :: Gen (a, b)
arbitraryBuiltin = do
(,)
(a -> b -> (a, b)) -> Gen a -> Gen (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AsArbitraryBuiltin a) -> Gen a
forall a b. Coercible a b => a -> b
coerce ((Int -> Int)
-> Gen (AsArbitraryBuiltin a) -> Gen (AsArbitraryBuiltin a)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Gen (AsArbitraryBuiltin a) -> Gen (AsArbitraryBuiltin a))
-> Gen (AsArbitraryBuiltin a) -> Gen (AsArbitraryBuiltin a)
forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => Gen a
arbitrary @(AsArbitraryBuiltin a))
Gen (b -> (a, b)) -> Gen b -> Gen (a, b)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (AsArbitraryBuiltin b) -> Gen b
forall a b. Coercible a b => a -> b
coerce ((Int -> Int)
-> Gen (AsArbitraryBuiltin b) -> Gen (AsArbitraryBuiltin b)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) (Gen (AsArbitraryBuiltin b) -> Gen (AsArbitraryBuiltin b))
-> Gen (AsArbitraryBuiltin b) -> Gen (AsArbitraryBuiltin b)
forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => Gen a
arbitrary @(AsArbitraryBuiltin b))
shrinkBuiltin :: (a, b) -> [(a, b)]
shrinkBuiltin = ((AsArbitraryBuiltin a, AsArbitraryBuiltin b)
-> [(AsArbitraryBuiltin a, AsArbitraryBuiltin b)])
-> (a, b) -> [(a, b)]
forall a b. Coercible a b => a -> b
coerce (((AsArbitraryBuiltin a, AsArbitraryBuiltin b)
-> [(AsArbitraryBuiltin a, AsArbitraryBuiltin b)])
-> (a, b) -> [(a, b)])
-> ((AsArbitraryBuiltin a, AsArbitraryBuiltin b)
-> [(AsArbitraryBuiltin a, AsArbitraryBuiltin b)])
-> (a, b)
-> [(a, b)]
forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
shrink @(AsArbitraryBuiltin a, AsArbitraryBuiltin b)
data MaybeSomeTypeOf k
= NothingSomeType
| forall (a :: k). JustSomeType (DefaultUni (Esc a))
instance Eq (MaybeSomeTypeOf k) where
MaybeSomeTypeOf k
NothingSomeType == :: MaybeSomeTypeOf k -> MaybeSomeTypeOf k -> Bool
== MaybeSomeTypeOf k
NothingSomeType = Bool
True
JustSomeType DefaultUni (Esc a)
uni1 == JustSomeType DefaultUni (Esc a)
uni2 = DefaultUni (Esc a)
uni1 DefaultUni (Esc a) -> DefaultUni (Esc a) -> Bool
forall {k} (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Bool
`defaultEq` DefaultUni (Esc a)
uni2
MaybeSomeTypeOf k
NothingSomeType == JustSomeType{} = Bool
False
JustSomeType{} == MaybeSomeTypeOf k
NothingSomeType = Bool
False
eraseMaybeSomeTypeOf :: MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
eraseMaybeSomeTypeOf :: forall k. MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
eraseMaybeSomeTypeOf MaybeSomeTypeOf k
NothingSomeType = Maybe (SomeTypeIn DefaultUni)
forall a. Maybe a
Nothing
eraseMaybeSomeTypeOf (JustSomeType DefaultUni (Esc a)
uni) = SomeTypeIn DefaultUni -> Maybe (SomeTypeIn DefaultUni)
forall a. a -> Maybe a
Just (SomeTypeIn DefaultUni -> Maybe (SomeTypeIn DefaultUni))
-> SomeTypeIn DefaultUni -> Maybe (SomeTypeIn DefaultUni)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc a) -> SomeTypeIn DefaultUni
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn DefaultUni (Esc a)
uni
genDefaultUniApply :: KnownKind k => Gen (MaybeSomeTypeOf k)
genDefaultUniApply :: forall k. KnownKind k => Gen (MaybeSomeTypeOf k)
genDefaultUniApply = do
MaybeSomeTypeOf (* -> k)
mayFun <- Gen (MaybeSomeTypeOf (* -> k))
forall a. Arbitrary a => Gen a
arbitrary
MaybeSomeTypeOf (*)
mayArg <- (Int -> Int)
-> Gen (MaybeSomeTypeOf (*)) -> Gen (MaybeSomeTypeOf (*))
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5) Gen (MaybeSomeTypeOf (*))
forall a. Arbitrary a => Gen a
arbitrary :: Gen (MaybeSomeTypeOf GHC.Type)
MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k))
-> MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a b. (a -> b) -> a -> b
$ case (MaybeSomeTypeOf (* -> k)
mayFun, MaybeSomeTypeOf (*)
mayArg) of
(JustSomeType DefaultUni (Esc a)
fun, JustSomeType DefaultUni (Esc a)
arg) -> DefaultUni (Esc (a a)) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType (DefaultUni (Esc (a a)) -> MaybeSomeTypeOf k)
-> DefaultUni (Esc (a a)) -> MaybeSomeTypeOf k
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc a)
fun DefaultUni (Esc a) -> DefaultUni (Esc a) -> DefaultUni (Esc (a a))
forall {k1} {k2} (f :: k1 -> k2) (a1 :: k1).
DefaultUni (Esc f)
-> DefaultUni (Esc a1) -> DefaultUni (Esc (f a1))
`DefaultUniApply` DefaultUni (Esc a)
arg
(MaybeSomeTypeOf (* -> k), MaybeSomeTypeOf (*))
_ -> MaybeSomeTypeOf k
forall k. MaybeSomeTypeOf k
NothingSomeType
shrinkToStarArgs :: DefaultUni (Esc a) -> [MaybeSomeTypeOf GHC.Type]
shrinkToStarArgs :: forall {k} (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf (*)]
shrinkToStarArgs = [MaybeSomeTypeOf (*)]
-> DefaultUni (Esc a) -> [MaybeSomeTypeOf (*)]
forall {k} (b :: k).
[MaybeSomeTypeOf (*)]
-> DefaultUni (Esc b) -> [MaybeSomeTypeOf (*)]
go [] where
go :: [MaybeSomeTypeOf GHC.Type] -> DefaultUni (Esc b) -> [MaybeSomeTypeOf GHC.Type]
go :: forall {k} (b :: k).
[MaybeSomeTypeOf (*)]
-> DefaultUni (Esc b) -> [MaybeSomeTypeOf (*)]
go [MaybeSomeTypeOf (*)]
args (DefaultUni (Esc f)
fun `DefaultUniApply` DefaultUni (Esc a1)
arg) =
[MaybeSomeTypeOf (*)]
-> DefaultUni (Esc f) -> [MaybeSomeTypeOf (*)]
forall {k} (b :: k).
[MaybeSomeTypeOf (*)]
-> DefaultUni (Esc b) -> [MaybeSomeTypeOf (*)]
go ([DefaultUni (Esc a1) -> MaybeSomeTypeOf (*)
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc a1)
DefaultUni (Esc a1)
arg | SingKind k1
SingType <- [DefaultUni (Esc a1) -> SingKind k1
forall k (a :: k). DefaultUni (Esc a) -> SingKind k
forall (uni :: * -> *) k (a :: k).
ToKind uni =>
uni (Esc a) -> SingKind k
toSingKind DefaultUni (Esc a1)
arg]] [MaybeSomeTypeOf (*)]
-> [MaybeSomeTypeOf (*)] -> [MaybeSomeTypeOf (*)]
forall a. [a] -> [a] -> [a]
++ [MaybeSomeTypeOf (*)]
args) DefaultUni (Esc f)
fun
go [MaybeSomeTypeOf (*)]
args DefaultUni (Esc b)
_ = [MaybeSomeTypeOf (*)]
args
shrinkDropBuiltinSameKind :: DefaultUni (Esc (a :: k)) -> [MaybeSomeTypeOf k]
shrinkDropBuiltinSameKind :: forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkDropBuiltinSameKind DefaultUni (Esc a)
uni =
case DefaultUni (Esc a) -> SingKind k
forall k (a :: k). DefaultUni (Esc a) -> SingKind k
forall (uni :: * -> *) k (a :: k).
ToKind uni =>
uni (Esc a) -> SingKind k
toSingKind DefaultUni (Esc a)
uni of
SingKind k
SingType -> case DefaultUni (Esc a)
uni of
DefaultUni (Esc a)
DefaultUniUnit -> []
DefaultUni (Esc a)
_ ->
let ju :: MaybeSomeTypeOf (*)
ju = DefaultUni (Esc ()) -> MaybeSomeTypeOf (*)
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc ())
DefaultUniUnit
in MaybeSomeTypeOf k
MaybeSomeTypeOf (*)
ju MaybeSomeTypeOf k -> [MaybeSomeTypeOf k] -> [MaybeSomeTypeOf k]
forall a. a -> [a] -> [a]
: (MaybeSomeTypeOf k -> Bool)
-> [MaybeSomeTypeOf k] -> [MaybeSomeTypeOf k]
forall a. (a -> Bool) -> [a] -> [a]
filter (MaybeSomeTypeOf (*) -> MaybeSomeTypeOf (*) -> Bool
forall a. Eq a => a -> a -> Bool
/= MaybeSomeTypeOf (*)
ju) (DefaultUni (Esc a) -> [MaybeSomeTypeOf (*)]
forall {k} (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf (*)]
shrinkToStarArgs DefaultUni (Esc a)
uni)
SingKind k1
SingType `SingKindArrow` SingKind l
SingType -> case DefaultUni (Esc a)
uni of
DefaultUni (Esc a)
DefaultUniProtoList -> []
DefaultUni (Esc a)
_ -> [DefaultUni (Esc []) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc [])
DefaultUni (Esc [])
DefaultUniProtoList]
SingKind k
_ -> []
shrinkDefaultUniApply :: DefaultUni (Esc (a :: k)) -> [MaybeSomeTypeOf k]
shrinkDefaultUniApply :: forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkDefaultUniApply (DefaultUni (Esc f)
fun `DefaultUniApply` DefaultUni (Esc a1)
arg) = [[MaybeSomeTypeOf k]] -> [MaybeSomeTypeOf k]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ DefaultUni (Esc (a a1)) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType (DefaultUni (Esc (a a1)) -> MaybeSomeTypeOf k)
-> DefaultUni (Esc (a a1)) -> MaybeSomeTypeOf k
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc a)
DefaultUni (Esc a)
fun' DefaultUni (Esc a)
-> DefaultUni (Esc a1) -> DefaultUni (Esc (a a1))
forall {k1} {k2} (f :: k1 -> k2) (a1 :: k1).
DefaultUni (Esc f)
-> DefaultUni (Esc a1) -> DefaultUni (Esc (f a1))
`DefaultUniApply` DefaultUni (Esc a1)
arg
| JustSomeType DefaultUni (Esc a)
fun' <- DefaultUni (Esc f) -> [MaybeSomeTypeOf (k1 -> k2)]
forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkBuiltinSameKind DefaultUni (Esc f)
fun
]
, [ DefaultUni (Esc (f a)) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType (DefaultUni (Esc (f a)) -> MaybeSomeTypeOf k)
-> DefaultUni (Esc (f a)) -> MaybeSomeTypeOf k
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc f)
DefaultUni (Esc f)
fun DefaultUni (Esc f) -> DefaultUni (Esc a) -> DefaultUni (Esc (f a))
forall {k1} {k2} (f :: k1 -> k2) (a1 :: k1).
DefaultUni (Esc f)
-> DefaultUni (Esc a1) -> DefaultUni (Esc (f a1))
`DefaultUniApply` DefaultUni (Esc a)
arg'
| JustSomeType DefaultUni (Esc a)
arg' <- DefaultUni (Esc a1) -> [MaybeSomeTypeOf k1]
forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkBuiltinSameKind DefaultUni (Esc a1)
arg
]
]
shrinkDefaultUniApply DefaultUni (Esc a)
_ = []
shrinkBuiltinSameKind :: DefaultUni (Esc (a :: k)) -> [MaybeSomeTypeOf k]
shrinkBuiltinSameKind :: forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkBuiltinSameKind DefaultUni (Esc a)
uni = DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkDropBuiltinSameKind DefaultUni (Esc a)
uni [MaybeSomeTypeOf k] -> [MaybeSomeTypeOf k] -> [MaybeSomeTypeOf k]
forall a. [a] -> [a] -> [a]
++ DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkDefaultUniApply DefaultUni (Esc a)
uni
instance KnownKind k => Arbitrary (MaybeSomeTypeOf k) where
arbitrary :: Gen (MaybeSomeTypeOf k)
arbitrary = do
Int
size <- Gen Int
getSize
[Gen (MaybeSomeTypeOf k)] -> Gen (MaybeSomeTypeOf k)
forall a. HasCallStack => [Gen a] -> Gen a
oneof ([Gen (MaybeSomeTypeOf k)] -> Gen (MaybeSomeTypeOf k))
-> [Gen (MaybeSomeTypeOf k)] -> Gen (MaybeSomeTypeOf k)
forall a b. (a -> b) -> a -> b
$ case forall k. KnownKind k => SingKind k
knownKind @k of
SingKind k
SingType ->
[Gen (MaybeSomeTypeOf k)
forall k. KnownKind k => Gen (MaybeSomeTypeOf k)
genDefaultUniApply | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10] [Gen (MaybeSomeTypeOf k)]
-> [Gen (MaybeSomeTypeOf k)] -> [Gen (MaybeSomeTypeOf k)]
forall a. [a] -> [a] -> [a]
++ (MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k))
-> [MaybeSomeTypeOf k] -> [Gen (MaybeSomeTypeOf k)]
forall a b. (a -> b) -> [a] -> [b]
map MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[ DefaultUni (Esc Integer) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc Integer)
DefaultUni (Esc Integer)
DefaultUniInteger
, DefaultUni (Esc ByteString) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc ByteString)
DefaultUni (Esc ByteString)
DefaultUniByteString
, DefaultUni (Esc Text) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc Text)
DefaultUni (Esc Text)
DefaultUniString
, DefaultUni (Esc ()) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc ())
DefaultUni (Esc ())
DefaultUniUnit
, DefaultUni (Esc Bool) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc Bool)
DefaultUni (Esc Bool)
DefaultUniBool
, DefaultUni (Esc Data) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc Data)
DefaultUni (Esc Data)
DefaultUniData
, DefaultUni (Esc Element) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc Element)
DefaultUni (Esc Element)
DefaultUniBLS12_381_G1_Element
, DefaultUni (Esc Element) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc Element)
DefaultUni (Esc Element)
DefaultUniBLS12_381_G2_Element
, DefaultUni (Esc MlResult) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc MlResult)
DefaultUni (Esc MlResult)
DefaultUniBLS12_381_MlResult
]
SingKind k1
SingType `SingKindArrow` SingKind l
SingType ->
[Gen (MaybeSomeTypeOf k)
forall k. KnownKind k => Gen (MaybeSomeTypeOf k)
genDefaultUniApply | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10] [Gen (MaybeSomeTypeOf k)]
-> [Gen (MaybeSomeTypeOf k)] -> [Gen (MaybeSomeTypeOf k)]
forall a. [a] -> [a] -> [a]
++
[MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k))
-> MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc []) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc [])
DefaultUni (Esc [])
DefaultUniProtoList]
SingKind k1
SingType `SingKindArrow` SingKind k1
SingType `SingKindArrow` SingKind l
SingType ->
[MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k))
-> MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc (,)) -> MaybeSomeTypeOf k
forall k (a :: k). DefaultUni (Esc a) -> MaybeSomeTypeOf k
JustSomeType DefaultUni (Esc (,))
DefaultUni (Esc (,))
DefaultUniProtoPair]
SingKind k
_ -> [MaybeSomeTypeOf k -> Gen (MaybeSomeTypeOf k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaybeSomeTypeOf k
forall k. MaybeSomeTypeOf k
NothingSomeType]
shrink :: MaybeSomeTypeOf k -> [MaybeSomeTypeOf k]
shrink MaybeSomeTypeOf k
NothingSomeType = []
shrink (JustSomeType DefaultUni (Esc a)
uni) = DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkBuiltinSameKind DefaultUni (Esc a)
uni
instance Arbitrary (Some (ValueOf DefaultUni)) where
arbitrary :: Gen (Some (ValueOf DefaultUni))
arbitrary = do
MaybeSomeTypeOf (*)
mayUni <- Gen (MaybeSomeTypeOf (*))
forall a. Arbitrary a => Gen a
arbitrary
case MaybeSomeTypeOf (*)
mayUni of
MaybeSomeTypeOf (*)
NothingSomeType -> String -> Gen (Some (ValueOf DefaultUni))
forall a. HasCallStack => String -> a
error String
"Panic: no *-kinded built-in types exist"
JustSomeType DefaultUni (Esc a)
uni ->
Proxy ArbitraryBuiltin
-> DefaultUni (Esc a)
-> (ArbitraryBuiltin a => Gen (Some (ValueOf DefaultUni)))
-> Gen (Some (ValueOf DefaultUni))
forall (uni :: * -> *) (constr :: * -> Constraint)
(proxy :: (* -> Constraint) -> *) a r.
(Closed uni, Everywhere uni constr) =>
proxy constr -> uni (Esc a) -> (constr a => r) -> r
forall (constr :: * -> Constraint)
(proxy :: (* -> Constraint) -> *) a r.
Everywhere DefaultUni constr =>
proxy constr -> DefaultUni (Esc a) -> (constr a => r) -> r
bring (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @ArbitraryBuiltin) DefaultUni (Esc a)
uni ((ArbitraryBuiltin a => Gen (Some (ValueOf DefaultUni)))
-> Gen (Some (ValueOf DefaultUni)))
-> (ArbitraryBuiltin a => Gen (Some (ValueOf DefaultUni)))
-> Gen (Some (ValueOf DefaultUni))
forall a b. (a -> b) -> a -> b
$
ValueOf DefaultUni a -> Some (ValueOf DefaultUni)
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (ValueOf DefaultUni a -> Some (ValueOf DefaultUni))
-> (a -> ValueOf DefaultUni a) -> a -> Some (ValueOf DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultUni (Esc a) -> a -> ValueOf DefaultUni a
forall (uni :: * -> *) a. uni (Esc a) -> a -> ValueOf uni a
ValueOf DefaultUni (Esc a)
uni (a -> Some (ValueOf DefaultUni))
-> Gen a -> Gen (Some (ValueOf DefaultUni))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. ArbitraryBuiltin a => Gen a
arbitraryBuiltin
shrink :: Some (ValueOf DefaultUni) -> [Some (ValueOf DefaultUni)]
shrink (Some (ValueOf DefaultUni (Esc a)
DefaultUniUnit ())) = []
shrink (Some (ValueOf DefaultUni (Esc a)
uni a
x)) = () -> Some (ValueOf DefaultUni)
forall a (uni :: * -> *). Contains uni a => a -> Some (ValueOf uni)
someValue () Some (ValueOf DefaultUni)
-> [Some (ValueOf DefaultUni)] -> [Some (ValueOf DefaultUni)]
forall a. a -> [a] -> [a]
:
Proxy ArbitraryBuiltin
-> DefaultUni (Esc a)
-> (ArbitraryBuiltin a => [Some (ValueOf DefaultUni)])
-> [Some (ValueOf DefaultUni)]
forall (uni :: * -> *) (constr :: * -> Constraint)
(proxy :: (* -> Constraint) -> *) a r.
(Closed uni, Everywhere uni constr) =>
proxy constr -> uni (Esc a) -> (constr a => r) -> r
forall (constr :: * -> Constraint)
(proxy :: (* -> Constraint) -> *) a r.
Everywhere DefaultUni constr =>
proxy constr -> DefaultUni (Esc a) -> (constr a => r) -> r
bring (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @ArbitraryBuiltin) DefaultUni (Esc a)
uni ((a -> Some (ValueOf DefaultUni))
-> [a] -> [Some (ValueOf DefaultUni)]
forall a b. (a -> b) -> [a] -> [b]
map (ValueOf DefaultUni a -> Some (ValueOf DefaultUni)
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some (ValueOf DefaultUni a -> Some (ValueOf DefaultUni))
-> (a -> ValueOf DefaultUni a) -> a -> Some (ValueOf DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultUni (Esc a) -> a -> ValueOf DefaultUni a
forall (uni :: * -> *) a. uni (Esc a) -> a -> ValueOf uni a
ValueOf DefaultUni (Esc a)
uni) ([a] -> [Some (ValueOf DefaultUni)])
-> [a] -> [Some (ValueOf DefaultUni)]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. ArbitraryBuiltin a => a -> [a]
shrinkBuiltin a
x)
genBuiltinTypeOf :: Kind () -> Gen (Maybe (SomeTypeIn DefaultUni))
genBuiltinTypeOf :: Kind () -> Gen (Maybe (SomeTypeIn DefaultUni))
genBuiltinTypeOf Kind ()
kind =
Kind ()
-> (forall {k}.
KnownKind k =>
Proxy k -> Gen (Maybe (SomeTypeIn DefaultUni)))
-> Gen (Maybe (SomeTypeIn DefaultUni))
forall ann r.
Kind ann -> (forall k. KnownKind k => Proxy k -> r) -> r
withKnownKind Kind ()
kind ((forall {k}.
KnownKind k =>
Proxy k -> Gen (Maybe (SomeTypeIn DefaultUni)))
-> Gen (Maybe (SomeTypeIn DefaultUni)))
-> (forall {k}.
KnownKind k =>
Proxy k -> Gen (Maybe (SomeTypeIn DefaultUni)))
-> Gen (Maybe (SomeTypeIn DefaultUni))
forall a b. (a -> b) -> a -> b
$ \(Proxy k
_ :: Proxy kind) ->
MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
forall k. MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
eraseMaybeSomeTypeOf (MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni))
-> Gen (MaybeSomeTypeOf k) -> Gen (Maybe (SomeTypeIn DefaultUni))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @(MaybeSomeTypeOf kind)
shrinkDropBuiltin :: DefaultUni (Esc (a :: k)) -> [SomeTypeIn DefaultUni]
shrinkDropBuiltin :: forall k (a :: k). DefaultUni (Esc a) -> [SomeTypeIn DefaultUni]
shrinkDropBuiltin DefaultUni (Esc a)
uni = [[SomeTypeIn DefaultUni]] -> [SomeTypeIn DefaultUni]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ case DefaultUni (Esc a) -> SingKind k
forall k (a :: k). DefaultUni (Esc a) -> SingKind k
forall (uni :: * -> *) k (a :: k).
ToKind uni =>
uni (Esc a) -> SingKind k
toSingKind DefaultUni (Esc a)
uni of
SingKind k1
SingType `SingKindArrow` SingKind l
_ -> DefaultUni (Esc (a ())) -> [SomeTypeIn DefaultUni]
forall k (a :: k). DefaultUni (Esc a) -> [SomeTypeIn DefaultUni]
shrinkDropBuiltin (DefaultUni (Esc (a ())) -> [SomeTypeIn DefaultUni])
-> DefaultUni (Esc (a ())) -> [SomeTypeIn DefaultUni]
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc a)
DefaultUni (Esc a)
uni DefaultUni (Esc a)
-> DefaultUni (Esc ()) -> DefaultUni (Esc (a ()))
forall {k1} {k2} (f :: k1 -> k2) (a1 :: k1).
DefaultUni (Esc f)
-> DefaultUni (Esc a1) -> DefaultUni (Esc (f a1))
`DefaultUniApply` DefaultUni (Esc ())
DefaultUniUnit
SingKind k
_ -> []
, (MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni))
-> [MaybeSomeTypeOf k] -> [SomeTypeIn DefaultUni]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
forall k. MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
eraseMaybeSomeTypeOf ([MaybeSomeTypeOf k] -> [SomeTypeIn DefaultUni])
-> [MaybeSomeTypeOf k] -> [SomeTypeIn DefaultUni]
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkDropBuiltinSameKind DefaultUni (Esc a)
uni
]
shrinkBuiltinType :: SomeTypeIn DefaultUni -> [SomeTypeIn DefaultUni]
shrinkBuiltinType :: SomeTypeIn DefaultUni -> [SomeTypeIn DefaultUni]
shrinkBuiltinType (SomeTypeIn DefaultUni (Esc a)
uni) = [[SomeTypeIn DefaultUni]] -> [SomeTypeIn DefaultUni]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ DefaultUni (Esc a) -> [SomeTypeIn DefaultUni]
forall k (a :: k). DefaultUni (Esc a) -> [SomeTypeIn DefaultUni]
shrinkDropBuiltin DefaultUni (Esc a)
uni
, (MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni))
-> [MaybeSomeTypeOf k] -> [SomeTypeIn DefaultUni]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
forall k. MaybeSomeTypeOf k -> Maybe (SomeTypeIn DefaultUni)
eraseMaybeSomeTypeOf ([MaybeSomeTypeOf k] -> [SomeTypeIn DefaultUni])
-> [MaybeSomeTypeOf k] -> [SomeTypeIn DefaultUni]
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
forall k (a :: k). DefaultUni (Esc a) -> [MaybeSomeTypeOf k]
shrinkDefaultUniApply DefaultUni (Esc a)
uni
]
instance Arbitrary (SomeTypeIn DefaultUni) where
arbitrary :: Gen (SomeTypeIn DefaultUni)
arbitrary = Gen (Kind ())
genKindOfBuiltin Gen (Kind ())
-> (Kind () -> Gen (SomeTypeIn DefaultUni))
-> Gen (SomeTypeIn DefaultUni)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Gen (Maybe (SomeTypeIn DefaultUni))
-> (Maybe (SomeTypeIn DefaultUni) -> Maybe (SomeTypeIn DefaultUni))
-> Gen (SomeTypeIn DefaultUni)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` Maybe (SomeTypeIn DefaultUni) -> Maybe (SomeTypeIn DefaultUni)
forall a. a -> a
id) (Gen (Maybe (SomeTypeIn DefaultUni))
-> Gen (SomeTypeIn DefaultUni))
-> (Kind () -> Gen (Maybe (SomeTypeIn DefaultUni)))
-> Kind ()
-> Gen (SomeTypeIn DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind () -> Gen (Maybe (SomeTypeIn DefaultUni))
genBuiltinTypeOf where
genKindOfBuiltin :: Gen (Kind ())
genKindOfBuiltin = [(Int, Gen (Kind ()))] -> Gen (Kind ())
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
[ (Int
8, Kind () -> Gen (Kind ())
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Kind () -> Gen (Kind ())) -> Kind () -> Gen (Kind ())
forall a b. (a -> b) -> a -> b
$ () -> Kind ()
forall ann. ann -> Kind ann
Type ())
, (Int
1, Kind () -> Gen (Kind ())
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Kind () -> Gen (Kind ()))
-> (Kind () -> Kind ()) -> Kind () -> Gen (Kind ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Kind () -> Kind () -> Kind ()
forall ann. ann -> Kind ann -> Kind ann -> Kind ann
KindArrow () (() -> Kind ()
forall ann. ann -> Kind ann
Type ()) (Kind () -> Gen (Kind ())) -> Kind () -> Gen (Kind ())
forall a b. (a -> b) -> a -> b
$ () -> Kind ()
forall ann. ann -> Kind ann
Type ())
, (Int
1, Kind () -> Gen (Kind ())
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Kind () -> Gen (Kind ()))
-> (Kind () -> Kind ()) -> Kind () -> Gen (Kind ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Kind () -> Kind () -> Kind ()
forall ann. ann -> Kind ann -> Kind ann -> Kind ann
KindArrow () (() -> Kind ()
forall ann. ann -> Kind ann
Type ()) (Kind () -> Kind ()) -> (Kind () -> Kind ()) -> Kind () -> Kind ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Kind () -> Kind () -> Kind ()
forall ann. ann -> Kind ann -> Kind ann -> Kind ann
KindArrow () (() -> Kind ()
forall ann. ann -> Kind ann
Type ()) (Kind () -> Gen (Kind ())) -> Kind () -> Gen (Kind ())
forall a b. (a -> b) -> a -> b
$ () -> Kind ()
forall ann. ann -> Kind ann
Type ())
]
shrink :: SomeTypeIn DefaultUni -> [SomeTypeIn DefaultUni]
shrink = SomeTypeIn DefaultUni -> [SomeTypeIn DefaultUni]
shrinkBuiltinType