{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 710
#define OVERLAPPING_ {-# OVERLAPPING #-}
#else
{-# LANGUAGE OverlappingInstances #-}
#define OVERLAPPING_
#endif
#if MIN_VERSION_base(4,9,0)
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
module Data.GenValidity.Utils
(
upTo
, genSplit
, genSplit3
, genSplit4
, genSplit5
, genSplit6
, genSplit7
, genSplit8
, arbPartition
, shuffle
, genListLength
, genListOf
#if MIN_VERSION_base(4,9,0)
, genNonEmptyOf
#endif
, shrinkTuple
, shrinkT2
, shrinkT3
, shrinkT4
, genIntX
, genWordX
, genFloat
, genDouble
, genFloatX
, genInteger
) where
import Test.QuickCheck hiding (Fixed)
import System.Random
import GHC.Float
import Data.Ratio
#if !MIN_VERSION_QuickCheck(2,8,0)
import Data.List (sortBy)
import Data.Ord (comparing)
#endif
#if MIN_VERSION_base(4,9,0)
import Data.List.NonEmpty(NonEmpty(..))
import qualified Data.List.NonEmpty as NE
#endif
#if MIN_VERSION_base(4,8,0)
import Control.Monad (forM, replicateM)
#else
import Control.Applicative ((<$>), (<*>), pure)
import Control.Monad (forM, replicateM)
#endif
upTo :: Int -> Gen Int
upTo :: Int -> Gen Int
upTo n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = Int -> Gen Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure 0
| Bool
otherwise = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (0, Int
n)
genSplit :: Int -> Gen (Int, Int)
genSplit :: Int -> Gen (Int, Int)
genSplit n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Int, Int) -> Gen (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0, 0)
| Bool
otherwise = do
Int
i <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (0, Int
n)
let j :: Int
j = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
(Int, Int) -> Gen (Int, Int)
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 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Int, Int, Int) -> Gen (Int, Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0, 0, 0)
| Bool
otherwise = do
(a :: Int
a, z :: Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(b :: Int
b, c :: Int
c) <- Int -> Gen (Int, Int)
genSplit Int
z
(Int, Int, Int) -> Gen (Int, Int, Int)
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 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Int, Int, Int, Int) -> Gen (Int, Int, Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0, 0, 0, 0)
| Bool
otherwise = do
(y :: Int
y, z :: Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(a :: Int
a, b :: Int
b) <- Int -> Gen (Int, Int)
genSplit Int
y
(c :: Int
c, d :: Int
d) <- Int -> Gen (Int, Int)
genSplit Int
z
(Int, Int, Int, Int) -> Gen (Int, Int, Int, Int)
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 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Int, Int, Int, Int, Int) -> Gen (Int, Int, Int, Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0, 0, 0, 0, 0)
| Bool
otherwise = do
(y :: Int
y, z :: Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(a :: Int
a, b :: Int
b, c :: Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
y
(d :: Int
d, e :: Int
e) <- Int -> Gen (Int, Int)
genSplit Int
z
(Int, Int, Int, Int, Int) -> Gen (Int, Int, Int, Int, Int)
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 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Int, Int, Int, Int, Int, Int)
-> Gen (Int, Int, Int, Int, Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0, 0, 0, 0, 0, 0)
| Bool
otherwise = do
(y :: Int
y, z :: Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(a :: Int
a, b :: Int
b, c :: Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
y
(d :: Int
d, e :: Int
e, f :: Int
f) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
z
(Int, Int, Int, Int, Int, Int)
-> Gen (Int, Int, Int, Int, Int, Int)
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 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Int, Int, Int, Int, Int, Int, Int)
-> Gen (Int, Int, Int, Int, Int, Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0, 0, 0, 0, 0, 0, 0)
| Bool
otherwise = do
(y :: Int
y, z :: Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(a :: Int
a, b :: Int
b, c :: Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
y
(d :: Int
d, e :: Int
e, f :: Int
f, g :: Int
g) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
z
(Int, Int, Int, Int, Int, Int, Int)
-> Gen (Int, Int, Int, Int, Int, Int, Int)
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 n :: Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Int, Int, Int, Int, Int, Int, Int, Int)
-> Gen (Int, Int, Int, Int, Int, Int, Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (0, 0, 0, 0, 0, 0, 0, 0)
| Bool
otherwise = do
(y :: Int
y, z :: Int
z) <- Int -> Gen (Int, Int)
genSplit Int
n
(a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
y
(e :: Int
e, f :: Int
f, g :: Int
g, h :: Int
h) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
z
(Int, Int, Int, Int, Int, Int, Int, Int)
-> Gen (Int, Int, Int, Int, Int, Int, Int, Int)
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 0 = [Int] -> Gen [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
arbPartition i :: Int
i = Int -> Gen Int
genListLengthWithSize Int
i Gen Int -> (Int -> Gen [Int]) -> Gen [Int]
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 size :: Int
size len :: Int
len = do
[Double]
us <- Int -> Gen Double -> Gen [Double]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len (Gen Double -> Gen [Double]) -> Gen Double -> Gen [Double]
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (0, 1)
let invs :: [Double]
invs = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
invE 0.25) [Double]
us
[Int] -> Gen [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int] -> Gen [Int]) -> [Int] -> Gen [Int]
forall a b. (a -> b) -> a -> b
$ (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
invs))) [Double]
invs
invE :: Double -> Double -> Double
invE :: Double -> Double -> Double
invE lambda :: Double
lambda u :: Double
u = - Double -> Double
forall a. Floating a => a -> a
log (1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
u) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
lambda
#if !MIN_VERSION_QuickCheck(2,8,0)
shuffle :: [a] -> Gen [a]
shuffle xs = do
ns <- vectorOf (length xs) (choose (minBound :: Int, maxBound))
return (map snd (sortBy (comparing fst) (zip ns xs)))
#endif
#if MIN_VERSION_base(4,9,0)
genNonEmptyOf :: Gen a -> Gen (NonEmpty a)
genNonEmptyOf :: Gen a -> Gen (NonEmpty a)
genNonEmptyOf gen :: Gen a
gen = do
[a]
l <- Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
gen
case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
l of
Nothing -> (Int -> Int) -> Gen (NonEmpty a) -> Gen (NonEmpty a)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) (Gen (NonEmpty a) -> Gen (NonEmpty a))
-> Gen (NonEmpty a) -> Gen (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ Gen a -> Gen (NonEmpty a)
forall a. Gen a -> Gen (NonEmpty a)
genNonEmptyOf Gen a
gen
Just ne :: NonEmpty a
ne -> NonEmpty a -> Gen (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
ne
#endif
genListLength :: Gen Int
genListLength :: Gen Int
genListLength = (Int -> Gen Int) -> Gen Int
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Int
genListLengthWithSize
genListLengthWithSize :: Int -> Gen Int
genListLengthWithSize :: Int -> Gen Int
genListLengthWithSize maxLen :: Int
maxLen = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
invT (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxLen) (Double -> Int) -> Gen Double -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (0, 1)
where
invT :: Double -> Double -> Double
invT :: Double -> Double -> Double
invT m :: Double
m u :: Double
u =
let a :: Double
a = 0
b :: Double
b = Double
m
c :: Double
c = 2
fc :: Double
fc = (Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a)
in if Double
u Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
fc
then Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt (Double
u Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) )
else Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
sqrt ((1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
u) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c))
genListOf :: Gen a -> Gen [a]
genListOf :: Gen a -> Gen [a]
genListOf func :: Gen a
func =
(Int -> Gen [a]) -> Gen [a]
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen [a]) -> Gen [a]) -> (Int -> Gen [a]) -> Gen [a]
forall a b. (a -> b) -> a -> b
$ \n :: Int
n -> do
[Int]
pars <- Int -> Gen [Int]
arbPartition Int
n
[Int] -> (Int -> Gen a) -> Gen [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
pars ((Int -> Gen a) -> Gen [a]) -> (Int -> Gen a) -> Gen [a]
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
i Gen a
func
shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple :: (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
shrinkTuple sa :: a -> [a]
sa sb :: b -> [b]
sb (a :: a
a, b :: b
b) =
((,) (a -> b -> (a, b)) -> [a] -> [b -> (a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
sa a
a [b -> (a, b)] -> [b] -> [(a, b)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> [b]
sb b
b)
[(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [ (a
a', b
b) | a
a' <- a -> [a]
sa a
a ]
[(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ [ (a
a, b
b') | b
b' <- b -> [b]
sb b
b ]
shrinkT2 :: (a -> [a]) -> (a, a) -> [(a, a)]
shrinkT2 :: (a -> [a]) -> (a, a) -> [(a, a)]
shrinkT2 s :: a -> [a]
s (a :: a
a, b :: a
b) = (,) (a -> a -> (a, a)) -> [a] -> [a -> (a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
s a
a [a -> (a, a)] -> [a] -> [(a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
b
shrinkT3 :: (a -> [a]) -> (a, a, a) -> [(a, a, a)]
shrinkT3 :: (a -> [a]) -> (a, a, a) -> [(a, a, a)]
shrinkT3 s :: a -> [a]
s (a :: a
a, b :: a
b, c :: a
c) = (,,) (a -> a -> a -> (a, a, a)) -> [a] -> [a -> a -> (a, a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
s a
a [a -> a -> (a, a, a)] -> [a] -> [a -> (a, a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
b [a -> (a, a, a)] -> [a] -> [(a, a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
c
shrinkT4 :: (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)]
shrinkT4 :: (a -> [a]) -> (a, a, a, a) -> [(a, a, a, a)]
shrinkT4 s :: a -> [a]
s (a :: a
a, b :: a
b, c :: a
c, d :: a
d) = (,,,) (a -> a -> a -> a -> (a, a, a, a))
-> [a] -> [a -> a -> a -> (a, a, a, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
s a
a [a -> a -> a -> (a, a, a, a)] -> [a] -> [a -> a -> (a, a, a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
b [a -> a -> (a, a, a, a)] -> [a] -> [a -> (a, a, a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
c [a -> (a, a, a, a)] -> [a] -> [(a, a, a, a)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> [a]
s a
d
genIntX :: forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX :: Gen a
genIntX =
[(Int, Gen a)] -> Gen a
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (1, Gen a
extreme)
, (1, Gen a
small)
, (8, Gen a
uniform)
]
where
extreme :: Gen a
extreme :: Gen a
extreme = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen a) -> Gen a) -> (Int -> Gen a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \s :: Int
s -> [Gen a] -> Gen a
forall a. [Gen a] -> Gen a
oneof
[ (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. Num a => a -> a -> a
- Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, a
forall a. Bounded a => a
maxBound)
, (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
minBound a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
]
small :: Gen a
small :: Gen a
small = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen a) -> Gen a) -> (Int -> Gen a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \s :: Int
s -> (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (- Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
uniform :: Gen a
uniform :: Gen a
uniform = (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
maxBound)
genWordX :: forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX :: Gen a
genWordX =
[(Int, Gen a)] -> Gen a
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (1, Gen a
extreme)
, (1, Gen a
small)
, (8, Gen a
uniform)
]
where
extreme :: Gen a
extreme :: Gen a
extreme = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen a) -> Gen a) -> (Int -> Gen a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \s :: Int
s ->
(a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. Num a => a -> a -> a
- Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s, a
forall a. Bounded a => a
maxBound)
small :: Gen a
small :: Gen a
small = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen a) -> Gen a) -> (Int -> Gen a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \s :: Int
s -> (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (0, Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
uniform :: Gen a
uniform :: Gen a
uniform = (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
maxBound)
genFloat :: Gen Float
genFloat :: Gen Float
genFloat = (Word32 -> Float) -> Gen Float
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 = (Word64 -> Double) -> Gen Double
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 :: (w -> a) -> Gen a
genFloatX func :: w -> a
func =
[(Int, Gen a)] -> Gen a
forall a. [(Int, Gen a)] -> Gen a
frequency
[ (1, Gen a
denormalised)
, (1, Gen a
small)
, (1, Gen a
aroundBounds)
, (1, Gen a
viaEncoding)
, (1, Gen a
uniformViaEncoding)
, (5, Gen a
reallyUniform)
]
where
denormalised :: Gen a
denormalised :: Gen a
denormalised =
[a] -> Gen a
forall a. [a] -> Gen a
elements
[ String -> a
forall a. Read a => String -> a
read "NaN"
, String -> a
forall a. Read a => String -> a
read "Infinity"
, String -> a
forall a. Read a => String -> a
read "-Infinity"
, String -> a
forall a. Read a => String -> a
read "-0"
]
small :: Gen a
small :: Gen a
small = (Int -> Gen a) -> Gen a
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen a) -> Gen a) -> (Int -> Gen a) -> Gen a
forall a b. (a -> b) -> a -> b
$ \n :: Int
n -> do
let n' :: Integer
n' = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n
let precision :: Integer
precision = 9999999999999 :: Integer
Integer
b <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (1, Integer
precision)
Integer
a <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose ((-Integer
n') Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b, Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b)
a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> a
forall a. Fractional a => Rational -> a
fromRational (Integer
a Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
b))
upperSignificand :: Integer
upperSignificand :: Integer
upperSignificand = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix (0.0 :: a) Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ a -> Int
forall a. RealFloat a => a -> Int
floatDigits (0.0 :: a)
lowerSignificand :: Integer
lowerSignificand :: Integer
lowerSignificand = - Integer
upperSignificand
(lowerExponent :: Int
lowerExponent, upperExponent :: Int
upperExponent) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange (0.0 :: a)
aroundBounds :: Gen a
aroundBounds :: Gen a
aroundBounds = do
Integer
s <- (Int -> Gen Integer) -> Gen Integer
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Integer) -> Gen Integer)
-> (Int -> Gen Integer) -> Gen Integer
forall a b. (a -> b) -> a -> b
$ \n :: Int
n -> [Gen Integer] -> Gen Integer
forall a. [Gen a] -> Gen a
oneof
[ (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
lowerSignificand, Integer
lowerSignificand Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
upperSignificand Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Integer
upperSignificand)
]
Int
e <- (Int -> Gen Int) -> Gen Int
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Int) -> Gen Int) -> (Int -> Gen Int) -> Gen Int
forall a b. (a -> b) -> a -> b
$ \n :: Int
n -> [Gen Int] -> Gen Int
forall a. [Gen a] -> Gen a
oneof
[ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
lowerExponent, Int
lowerExponent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
, (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
upperExponent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n, Int
upperExponent)
]
a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Gen a) -> a -> Gen a
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
s Int
e
viaEncoding :: Gen a
viaEncoding :: Gen a
viaEncoding = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer -> Int -> a) -> Gen Integer -> Gen (Int -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen (Int -> a) -> Gen Int -> Gen a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX
uniformViaEncoding :: Gen a
uniformViaEncoding :: Gen a
uniformViaEncoding = do
Integer
s <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
lowerSignificand, Integer
upperSignificand)
Int
e <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose ((Int, Int) -> Gen Int) -> (Int, Int) -> Gen Int
forall a b. (a -> b) -> a -> b
$ a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange (0.0 :: a)
a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Gen a) -> a -> Gen a
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
s Int
e
reallyUniform :: Gen a
reallyUniform :: Gen a
reallyUniform = w -> a
func (w -> a) -> Gen w -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (w, w) -> Gen w
forall a. Random a => (a, a) -> Gen a
choose (w
forall a. Bounded a => a
minBound, w
forall a. Bounded a => a
maxBound)
genInteger :: Gen Integer
genInteger :: Gen Integer
genInteger = (Int -> Gen Integer) -> Gen Integer
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Integer) -> Gen Integer)
-> (Int -> Gen Integer) -> Gen Integer
forall a b. (a -> b) -> a -> b
$ \s :: Int
s -> [Gen Integer] -> Gen Integer
forall a. [Gen a] -> Gen a
oneof ([Gen Integer] -> Gen Integer) -> [Gen Integer] -> Gen Integer
forall a b. (a -> b) -> a -> b
$
(if Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10 then (Gen Integer
genBiggerInteger Gen Integer -> [Gen Integer] -> [Gen Integer]
forall a. a -> [a] -> [a]
:) else [Gen Integer] -> [Gen Integer]
forall a. a -> a
id)
[ Gen Integer
genIntSizedInteger
, Gen Integer
small
]
where
small :: Gen Integer
small = (Int -> Gen Integer) -> Gen Integer
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Integer) -> Gen Integer)
-> (Int -> Gen Integer) -> Gen Integer
forall a b. (a -> b) -> a -> b
$ \s :: Int
s -> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (- Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
s, Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
s)
genIntSizedInteger :: Gen Integer
genIntSizedInteger = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Gen Int -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen Int
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX :: Gen Int)
genBiggerInteger :: Gen Integer
genBiggerInteger = (Int -> Gen Integer) -> Gen Integer
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Integer) -> Gen Integer)
-> (Int -> Gen Integer) -> Gen Integer
forall a b. (a -> b) -> a -> b
$ \s :: Int
s ->do
(a :: Int
a, b :: Int
b, c :: Int
c) <- Int -> Gen (Int, Int, Int)
genSplit3 Int
s
Integer
ai <- Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
resize Int
a Gen Integer
genIntSizedInteger
Integer
bi <- Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
resize Int
b Gen Integer
genInteger
Integer
ci <- Int -> Gen Integer -> Gen Integer
forall a. Int -> Gen a -> Gen a
resize Int
c Gen Integer
genIntSizedInteger
Integer -> Gen Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Gen Integer) -> Integer -> Gen Integer
forall a b. (a -> b) -> a -> b
$ Integer
ai Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
ci