{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Data.GenValidity.Utils
  ( -- ** Helper functions for implementing generators
    upTo,
    genSplit,
    genSplit3,
    genSplit4,
    genSplit5,
    genSplit6,
    genSplit7,
    genSplit8,
    arbPartition,
    shuffle,
    genListLength,
    genStringBy,
    genStringBy1,
    genListOf,
    genListOf1,
    genMaybe,
    genNonEmptyOf,
    genIntX,
    genWordX,
    genFloat,
    genDouble,
    genFloatX,
    genInteger,

    -- ** Helper functions for implementing shrinking functions
    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' generates an integer between 0 (inclusive) and 'n'.
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 a' generates a tuple '(b, c)' such that 'b + c' equals 'a'.
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 a' generates a triple '(b, c, d)' such that 'b + c + d' equals 'a'.
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 a' generates a quadruple '(b, c, d, e)' such that 'b + c + d + e' equals 'a'.
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 a' generates a quintuple '(b, c, d, e, f)' such that 'b + c + d + e + f' equals 'a'.
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 a' generates a sextuple '(b, c, d, e, f, g)' such that 'b + c + d + e + f + g' equals 'a'.
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 a' generates a septtuple '(b, c, d, e, f, g)' such that 'b + c + d + e + f + g' equals 'a'.
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 a' generates a octtuple '(b, c, d, e, f, g, h)' such that 'b + c + d + e + f + g + h' equals 'a'.
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 n' generates a list 'ls' such that 'sum ls' equals 'n', approximately.
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
      -- Rescale the sizes to (approximately) sum to the given size.
      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

    -- Use an exponential distribution for generating the
    -- sizes in the partition.
    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

-- Uses 'genListLengthWithSize' with the size parameter
genListLength :: Gen Int
genListLength :: Gen Int
genListLength = forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen Int
genListLengthWithSize

-- Generate a list length with the given size
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
    -- Use a triangle distribution for generating the
    -- length of the list
    -- with minimum length '0', mode length '2'
    -- and given max length.
    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))

-- Generate a String using a generator of 'Char's
genStringBy :: Gen Char -> Gen String
genStringBy :: Gen Char -> Gen String
genStringBy = forall a. Gen a -> Gen [a]
genListOf

-- Generate a String using a generator of 'Char's
genStringBy1 :: Gen Char -> Gen String
genStringBy1 :: Gen Char -> Gen String
genStringBy1 = forall a. Gen a -> Gen [a]
genListOf1

-- | A version of @listOf@ that takes size into account more accurately.
--
-- This generator distributes the size that is is given among the values
-- in the list that it generates.
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

-- | A version of 'genNonEmptyOf' that returns a list instead of a 'NonEmpty'.
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

-- | Lift a shrinker function into a maybe
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)

-- | Combine two shrinking functions to shrink a tuple.
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]

-- | Like 'shrinkTuple', but for triples
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')

-- | Like 'shrinkTuple', but for quadruples
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')

-- | Turn a shrinking function into a function that shrinks tuples.
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

-- | Turn a shrinking function into a function that shrinks triples.
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

-- | Turn a shrinking function into a function that shrinks quadruples.
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

-- Shrink a nonempty list given a shrinker for values.
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

-- | Generate Int, Int8, Int16, Int32 and Int64 values smartly.
--
-- * Some at the border
-- * Some around zero
-- * Mostly uniformly
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)

-- | Generate Word, Word8, Word16, Word32 and Word64 values smartly.
--
-- * Some at the border
-- * Some around zero
-- * Mostly uniformly
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)

-- | See 'genFloatX'
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

-- | See 'genFloatX'
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

-- | Generate floating point numbers smartly:
--
-- * Some denormalised
-- * Some around zero
-- * Some around the bounds
-- * Some by encoding an Integer and an Int to a floating point number.
-- * Some accross the entire range
-- * Mostly uniformly via the bitrepresentation
--
-- The function parameter is to go from the bitrepresentation to the floating point value.
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"
        ]
    -- This is what Quickcheck does,
    -- but inlined so QuickCheck cannot change
    -- it behind the scenes in the future.
    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
    -- Not really uniform, but good enough
    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