{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# 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
    ( -- ** Helper functions for implementing generators
      upTo
    , genSplit
    , genSplit3
    , genSplit4
    , genSplit5
    , genSplit6
    , genSplit7
    , genSplit8
    , arbPartition
    , shuffle
    , genListLength
    , genListOf
#if MIN_VERSION_base(4,9,0)
    , genNonEmptyOf
#endif
      -- ** Helper functions for implementing shrinking functions
    , shrinkTuple
    , shrinkT2
    , shrinkT3
    , shrinkT4
    , genIntX
    , genWordX
    , genFloat
    , genDouble
    , genFloatX
    , genInteger
    , genUncheckedInt
    , shrinkUncheckedInt
    , genUncheckedWord
    , shrinkUncheckedWord
    ) where

import Test.QuickCheck hiding (Fixed)
import System.Random
import GHC.Float
import GHC.Int (Int(..))
import GHC.Word (Word(..))
import GHC.Exts (Word#, Int#)
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' generates an integer between 0 (inclusive) and 'n'.
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 a' generates a tuple '(b, c)' such that 'b + c' equals 'a'.
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 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 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 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 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 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 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 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 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 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 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 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 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 n' generates a list 'ls' such that 'sum ls' equals 'n', approximately.
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
      -- Rescale the sizes to (approximately) sum to the given size.
      [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

    -- Use an exponential distribution for generating the
    -- sizes in the partition.
    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)
-- | Generates a random permutation of the given list.
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

-- Uses 'genListLengthWithSize' with the size parameter
genListLength :: Gen Int
genListLength :: Gen Int
genListLength = (Int -> Gen Int) -> Gen Int
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 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
    -- 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 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))


-- | 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 :: 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 ]

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

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

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

-- | 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 :: 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)

-- | 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 :: 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)

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

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

-- | 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 :: (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"
        ]
    -- 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 = (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
    -- Not really uniform, but good enough
    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

genUncheckedInt :: (Int# -> a) -> Gen a
genUncheckedInt :: (Int# -> a) -> Gen a
genUncheckedInt func :: Int# -> a
func = do
  (I# i# :: Int#
i#) <- Gen Int
forall a. (Integral a, Bounded a, Random a) => Gen a
genIntX
  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
$ Int# -> a
func Int#
i#

shrinkUncheckedInt :: (Int -> a) -> (a -> Int) -> a -> [a]
shrinkUncheckedInt :: (Int -> a) -> (a -> Int) -> a -> [a]
shrinkUncheckedInt fromInt :: Int -> a
fromInt toInt :: a -> Int
toInt = (Int -> a) -> [Int] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> a
fromInt ([Int] -> [a]) -> (a -> [Int]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int]
forall a. Arbitrary a => a -> [a]
shrink (Int -> [Int]) -> (a -> Int) -> a -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
toInt

genUncheckedWord :: (Word# -> a) -> Gen a
genUncheckedWord :: (Word# -> a) -> Gen a
genUncheckedWord func :: Word# -> a
func = do
  (W# w# :: Word#
w#) <- Gen Word
forall a. (Integral a, Bounded a, Random a) => Gen a
genWordX
  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
$ Word# -> a
func Word#
w#

shrinkUncheckedWord :: (Word -> a) -> (a -> Word) -> a -> [a]
shrinkUncheckedWord :: (Word -> a) -> (a -> Word) -> a -> [a]
shrinkUncheckedWord fromWord :: Word -> a
fromWord toWord :: a -> Word
toWord = (Word -> a) -> [Word] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> a
fromWord ([Word] -> [a]) -> (a -> [Word]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> [Word]
forall a. Arbitrary a => a -> [a]
shrink (Word -> [Word]) -> (a -> Word) -> a -> [Word]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word
toWord