{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.GenValidity.Utils
(
upTo,
genSplit,
genSplit3,
genSplit4,
genSplit5,
genSplit6,
genSplit7,
genSplit8,
arbPartition,
shuffle,
genListLength,
genStringBy,
genStringBy1,
genListOf,
genListOf1,
genMaybe,
genNonEmptyOf,
genIntX,
genWordX,
genFloat,
genDouble,
genFloatX,
genInteger,
shrinkMaybe,
shrinkTuple,
shrinkTriple,
shrinkQuadruple,
shrinkT2,
shrinkT3,
shrinkT4,
shrinkList,
shrinkNonEmpty,
)
where
import Control.Monad (forM, replicateM)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Ratio
import GHC.Float (castWord32ToFloat, castWord64ToDouble)
import System.Random
import Test.QuickCheck hiding (Fixed)
upTo :: Int -> Gen Int
upTo :: Int -> Gen Int
upTo Int
n
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
| Bool
otherwise = forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
n)
genSplit :: Int -> Gen (Int, Int)
genSplit :: Int -> Gen (Int, Int)
genSplit Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0)
| Bool
otherwise = do
Int
i <- forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
n)
let j :: Int
j = Int
n forall a. Num a => a -> a -> a
- Int
i
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, Int
j)
genSplit3 :: Int -> Gen (Int, Int, Int)
genSplit3 :: Int -> Gen (Int, Int, Int)
genSplit3 Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0, Int
0)
| Bool
otherwise = do
(Int
a, Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(Int
b, Int
c) <- Int -> Gen (Int, Int)
genSplit Int
z
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c)
genSplit4 :: Int -> Gen (Int, Int, Int, Int)
genSplit4 :: Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0, Int
0, Int
0)
| Bool
otherwise = do
(Int
y, Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(Int
a, Int
b) <- Int -> Gen (Int, Int)
genSplit Int
y
(Int
c, Int
d) <- Int -> Gen (Int, Int)
genSplit Int
z
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c, Int
d)
genSplit5 :: Int -> Gen (Int, Int, Int, Int, Int)
genSplit5 :: Int -> Gen (Int, Int, Int, Int, Int)
genSplit5 Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0, Int
0, Int
0, Int
0)
| Bool
otherwise = do
(Int
y, Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(Int
a, Int
b, Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
y
(Int
d, Int
e) <- Int -> Gen (Int, Int)
genSplit Int
z
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c, Int
d, Int
e)
genSplit6 :: Int -> Gen (Int, Int, Int, Int, Int, Int)
genSplit6 :: Int -> Gen (Int, Int, Int, Int, Int, Int)
genSplit6 Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0, Int
0, Int
0, Int
0, Int
0)
| Bool
otherwise = do
(Int
y, Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(Int
a, Int
b, Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
y
(Int
d, Int
e, Int
f) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
z
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c, Int
d, Int
e, Int
f)
genSplit7 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int)
genSplit7 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int)
genSplit7 Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0)
| Bool
otherwise = do
(Int
y, Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(Int
a, Int
b, Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
y
(Int
d, Int
e, Int
f, Int
g) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
z
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c, Int
d, Int
e, Int
f, Int
g)
genSplit8 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int, Int)
genSplit8 :: Int -> Gen (Int, Int, Int, Int, Int, Int, Int, Int)
genSplit8 Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0, Int
0)
| Bool
otherwise = do
(Int
y, Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(Int
a, Int
b, Int
c, Int
d) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
y
(Int
e, Int
f, Int
g, Int
h) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
z
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
a, Int
b, Int
c, Int
d, Int
e, Int
f, Int
g, Int
h)
arbPartition :: Int -> Gen [Int]
arbPartition :: Int -> Gen [Int]
arbPartition Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
arbPartition Int
i = Int -> Gen Int
genListLengthWithSize Int
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Int -> Gen [Int]
go Int
i
where
go :: Int -> Int -> Gen [Int]
go :: Int -> Int -> Gen [Int]
go Int
size Int
len = do
[Double]
us <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len forall a b. (a -> b) -> a -> b
$ forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
1)
let invs :: [Double]
invs = forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
invE Double
0.25) [Double]
us
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size forall a. Fractional a => a -> a -> a
/ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
invs))) [Double]
invs
invE :: Double -> Double -> Double
invE :: Double -> Double -> Double
invE Double
lambda Double
u = (-forall a. Floating a => a -> a
log (Double
1 forall a. Num a => a -> a -> a
- Double
u)) forall a. Fractional a => a -> a -> a
/ Double
lambda
genMaybe :: Gen a -> Gen (Maybe a)
genMaybe :: forall a. Gen a -> Gen (Maybe a)
genMaybe Gen a
gen = forall a. [Gen a] -> Gen a
oneof [forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen]
genNonEmptyOf :: Gen a -> Gen (NonEmpty a)
genNonEmptyOf :: forall a. Gen a -> Gen (NonEmpty a)
genNonEmptyOf Gen a
gen = do
[a]
l <- forall a. Gen a -> Gen [a]
genListOf Gen a
gen
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
l of
Maybe (NonEmpty a)
Nothing -> forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> Gen (NonEmpty a)
genNonEmptyOf Gen a
gen
Just NonEmpty a
ne -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
ne
genListLength :: Gen Int
genListLength :: Gen Int
genListLength = forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Int
genListLengthWithSize
genListLengthWithSize :: Int -> Gen Int
genListLengthWithSize :: Int -> Gen Int
genListLengthWithSize Int
maxLen = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
invT (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxLen) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
1)
where
invT :: Double -> Double -> Double
invT :: Double -> Double -> Double
invT Double
m Double
u =
let a :: Double
a = Double
0
b :: Double
b = Double
m
c :: Double
c = Double
2
fc :: Double
fc = (Double
c forall a. Num a => a -> a -> a
- Double
a) forall a. Fractional a => a -> a -> a
/ (Double
b forall a. Num a => a -> a -> a
- Double
a)
in if Double
u forall a. Ord a => a -> a -> Bool
< Double
fc
then Double
a forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sqrt (Double
u forall a. Num a => a -> a -> a
* (Double
b forall a. Num a => a -> a -> a
- Double
a) forall a. Num a => a -> a -> a
* (Double
c forall a. Num a => a -> a -> a
- Double
a))
else Double
b forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
sqrt ((Double
1 forall a. Num a => a -> a -> a
- Double
u) forall a. Num a => a -> a -> a
* (Double
b forall a. Num a => a -> a -> a
- Double
a) forall a. Num a => a -> a -> a
* (Double
b forall a. Num a => a -> a -> a
- Double
c))
genStringBy :: Gen Char -> Gen String
genStringBy :: Gen Char -> Gen String
genStringBy = forall a. Gen a -> Gen [a]
genListOf
genStringBy1 :: Gen Char -> Gen String
genStringBy1 :: Gen Char -> Gen String
genStringBy1 = forall a. Gen a -> Gen [a]
genListOf1
genListOf :: Gen a -> Gen [a]
genListOf :: forall a. Gen a -> Gen [a]
genListOf Gen a
func =
forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
n -> do
[Int]
pars <- Int -> Gen [Int]
arbPartition Int
n
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
pars forall a b. (a -> b) -> a -> b
$ \Int
i -> forall a. Int -> Gen a -> Gen a
resize Int
i Gen a
func
genListOf1 :: Gen a -> Gen [a]
genListOf1 :: forall a. Gen a -> Gen [a]
genListOf1 Gen a
gen = forall a. NonEmpty a -> [a]
NE.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen (NonEmpty a)
genNonEmptyOf Gen a
gen
shrinkMaybe :: (a -> [a]) -> Maybe a -> [Maybe a]
shrinkMaybe :: forall a. (a -> [a]) -> Maybe a -> [Maybe a]
shrinkMaybe a -> [a]
shrinker = \case
Maybe a
Nothing -> []
Just a
a -> forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
shrinker a
a)
shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple :: forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple a -> [a]
sa b -> [b]
sb (a
a, b
b) =
((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
sa a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> [b]
sb b
b)
forall a. [a] -> [a] -> [a]
++ [(a
a', b
b) | a
a' <- a -> [a]
sa a
a]
forall a. [a] -> [a] -> [a]
++ [(a
a, b
b') | b
b' <- b -> [b]
sb b
b]
shrinkTriple ::
(a -> [a]) ->
(b -> [b]) ->
(c -> [c]) ->
(a, b, c) ->
[(a, b, c)]
shrinkTriple :: forall a b c.
(a -> [a]) -> (b -> [b]) -> (c -> [c]) -> (a, b, c) -> [(a, b, c)]
shrinkTriple a -> [a]
sa b -> [b]
sb c -> [c]
sc (a
a, b
b, c
c) = do
(a
a', (b
b', c
c')) <- forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple a -> [a]
sa (forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple b -> [b]
sb c -> [c]
sc) (a
a, (b
b, c
c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a', b
b', c
c')
shrinkQuadruple ::
(a -> [a]) ->
(b -> [b]) ->
(c -> [c]) ->
(d -> [d]) ->
(a, b, c, d) ->
[(a, b, c, d)]
shrinkQuadruple :: forall a b c d.
(a -> [a])
-> (b -> [b])
-> (c -> [c])
-> (d -> [d])
-> (a, b, c, d)
-> [(a, b, c, d)]
shrinkQuadruple a -> [a]
sa b -> [b]
sb c -> [c]
sc d -> [d]
sd (a
a, b
b, c
c, d
d) = do
((a
a', b
b'), (c
c', d
d')) <- forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple (forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple a -> [a]
sa b -> [b]
sb) (forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple c -> [c]
sc d -> [d]
sd) ((a
a, b
b), (c
c, d
d))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a', b
b', c
c', d
d')
shrinkT2 :: (a -> [a]) -> (a, a) -> [(a, a)]
shrinkT2 :: forall a. (a -> [a]) -> (a, a) -> [(a, a)]
shrinkT2 a -> [a]
s = forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple a -> [a]
s a -> [a]
s
shrinkT3 :: (a -> [a]) -> (a, a, a) -> [(a, a, a)]
shrinkT3 :: forall a. (a -> [a]) -> (a, a, a) -> [(a, a, a)]
shrinkT3 a -> [a]
s = forall a b c.
(a -> [a]) -> (b -> [b]) -> (c -> [c]) -> (a, b, c) -> [(a, b, c)]
shrinkTriple a -> [a]
s a -> [a]
s a -> [a]
s
shrinkT4 :: (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)]
shrinkT4 :: forall a. (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)]
shrinkT4 a -> [a]
s = forall a b c d.
(a -> [a])
-> (b -> [b])
-> (c -> [c])
-> (d -> [d])
-> (a, b, c, d)
-> [(a, b, c, d)]
shrinkQuadruple a -> [a]
s a -> [a]
s a -> [a]
s a -> [a]
s
shrinkNonEmpty :: (a -> [a]) -> NonEmpty a -> [NonEmpty a]
shrinkNonEmpty :: forall a. (a -> [a]) -> NonEmpty a -> [NonEmpty a]
shrinkNonEmpty a -> [a]
shrinker = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList a -> [a]
shrinker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
genIntX :: forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX :: forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX =
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Int
1, Gen a
extreme),
(Int
1, Gen a
small),
(Int
8, Gen a
uniformInt)
]
where
extreme :: Gen a
extreme :: Gen a
extreme = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
s ->
forall a. [Gen a] -> Gen a
oneof
[ forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, forall a. Bounded a => a
maxBound),
forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
minBound forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
]
small :: Gen a
small :: Gen a
small = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
s -> forall a. Random a => (a, a) -> Gen a
choose (-forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
uniformInt :: Gen a
uniformInt :: Gen a
uniformInt = forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
genWordX :: forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX :: forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX =
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Int
1, Gen a
extreme),
(Int
1, Gen a
small),
(Int
8, Gen a
uniformWord)
]
where
extreme :: Gen a
extreme :: Gen a
extreme = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
s ->
forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
maxBound forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, forall a. Bounded a => a
maxBound)
small :: Gen a
small :: Gen a
small = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
s -> forall a. Random a => (a, a) -> Gen a
choose (a
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
uniformWord :: Gen a
uniformWord :: Gen a
uniformWord = forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
genFloat :: Gen Float
genFloat :: Gen Float
genFloat = forall a w.
(Read a, RealFloat a, Bounded w, Random w) =>
(w -> a) -> Gen a
genFloatX Word32 -> Float
castWord32ToFloat
genDouble :: Gen Double
genDouble :: Gen Double
genDouble = forall a w.
(Read a, RealFloat a, Bounded w, Random w) =>
(w -> a) -> Gen a
genFloatX Word64 -> Double
castWord64ToDouble
genFloatX ::
forall a w.
(Read a, RealFloat a, Bounded w, Random w) =>
(w -> a) ->
Gen a
genFloatX :: forall a w.
(Read a, RealFloat a, Bounded w, Random w) =>
(w -> a) -> Gen a
genFloatX w -> a
func =
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (Int
1, Gen a
denormalised),
(Int
1, Gen a
small),
(Int
1, Gen a
aroundBounds),
(Int
1, Gen a
uniformViaEncoding),
(Int
6, Gen a
reallyUniform)
]
where
denormalised :: Gen a
denormalised :: Gen a
denormalised =
forall a. [a] -> Gen a
elements
[ forall a. Read a => String -> a
read String
"NaN",
forall a. Read a => String -> a
read String
"Infinity",
forall a. Read a => String -> a
read String
"-Infinity",
forall a. Read a => String -> a
read String
"-0"
]
small :: Gen a
small :: Gen a
small = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
n -> do
let n' :: Integer
n' = forall a. Integral a => a -> Integer
toInteger Int
n
let precision :: Integer
precision = Integer
9999999999999 :: Integer
Integer
b <- forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
precision)
Integer
a <- forall a. Random a => (a, a) -> Gen a
choose ((-Integer
n') forall a. Num a => a -> a -> a
* Integer
b, Integer
n' forall a. Num a => a -> a -> a
* Integer
b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Fractional a => Rational -> a
fromRational (Integer
a forall a. Integral a => a -> a -> Ratio a
% Integer
b))
upperSignificand :: Integer
upperSignificand :: Integer
upperSignificand = forall a. RealFloat a => a -> Integer
floatRadix (a
0.0 :: a) forall a b. (Num a, Integral b) => a -> b -> a
^ forall a. RealFloat a => a -> Int
floatDigits (a
0.0 :: a)
lowerSignificand :: Integer
lowerSignificand :: Integer
lowerSignificand = (-Integer
upperSignificand)
(Int
lowerExponent, Int
upperExponent) = forall a. RealFloat a => a -> (Int, Int)
floatRange (a
0.0 :: a)
aroundBounds :: Gen a
aroundBounds :: Gen a
aroundBounds = do
Integer
s <- forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
n ->
forall a. [Gen a] -> Gen a
oneof
[ forall a. Random a => (a, a) -> Gen a
choose (Integer
lowerSignificand, Integer
lowerSignificand forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n),
forall a. Random a => (a, a) -> Gen a
choose (Integer
upperSignificand forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Integer
upperSignificand)
]
Int
e <- forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
n ->
forall a. [Gen a] -> Gen a
oneof
[ forall a. Random a => (a, a) -> Gen a
choose (Int
lowerExponent, Int
lowerExponent forall a. Num a => a -> a -> a
+ Int
n),
forall a. Random a => (a, a) -> Gen a
choose (Int
upperExponent forall a. Num a => a -> a -> a
- Int
n, Int
upperExponent)
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
s Int
e
uniformViaEncoding :: Gen a
uniformViaEncoding :: Gen a
uniformViaEncoding = do
Integer
s <- forall a. Random a => (a, a) -> Gen a
choose (Integer
lowerSignificand, Integer
upperSignificand)
Int
e <- forall a. Random a => (a, a) -> Gen a
choose forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> (Int, Int)
floatRange (a
0.0 :: a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
s Int
e
reallyUniform :: Gen a
reallyUniform :: Gen a
reallyUniform = w -> a
func forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
genInteger :: Gen Integer
genInteger :: Gen Integer
genInteger = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
s ->
forall a. [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$
(if Int
s forall a. Ord a => a -> a -> Bool
>= Int
10 then (Gen Integer
genBiggerInteger forall a. a -> [a] -> [a]
:) else forall a. a -> a
id)
[ Gen Integer
genIntSizedInteger,
Gen Integer
small
]
where
small :: Gen Integer
small = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
s -> forall a. Random a => (a, a) -> Gen a
choose (-forall a. Integral a => a -> Integer
toInteger Int
s, forall a. Integral a => a -> Integer
toInteger Int
s)
genIntSizedInteger :: Gen Integer
genIntSizedInteger = forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX :: Gen Int)
genBiggerInteger :: Gen Integer
genBiggerInteger = forall a. (Int -> Gen a) -> Gen a
sized forall a b. (a -> b) -> a -> b
$ \Int
s -> do
(Int
a, Int
b, Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
s
Integer
ai <- forall a. Int -> Gen a -> Gen a
resize Int
a Gen Integer
genIntSizedInteger
Integer
bi <- forall a. Int -> Gen a -> Gen a
resize Int
b Gen Integer
genInteger
Integer
ci <- forall a. Int -> Gen a -> Gen a
resize Int
c Gen Integer
genIntSizedInteger
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer
ai forall a. Num a => a -> a -> a
* Integer
bi forall a. Num a => a -> a -> a
+ Integer
ci