    {-# 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = Int -> Gen Int
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    0
      | Bool
    otherwise = (Int, Int) -> Gen Int
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (Int, Int) -> Gen (Int, Int)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    0, Int
    0)
      | Bool
    otherwise = do
          i <- (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (Int
    0, Int
    n)
          let j = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i
          pure (i, 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (Int, Int, Int) -> Gen (Int, Int, Int)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    0, Int
    0, Int
    0)
      | Bool
    otherwise = do
          (a, z) <- Int -> Gen (Int, Int)
    genSplit Int
    n
          (b, c) <- genSplit z
          return (a, b, 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (Int, Int, Int, Int) -> Gen (Int, Int, Int, Int)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    0, Int
    0, Int
    0, Int
    0)
      | Bool
    otherwise = do
          (y, z) <- Int -> Gen (Int, Int)
    genSplit Int
    n
          (a, b) <- genSplit y
          (c, d) <- genSplit z
          return (a, b, c, 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (Int, Int, Int, Int, Int) -> Gen (Int, Int, Int, Int, Int)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    0, Int
    0, Int
    0, Int
    0, Int
    0)
      | Bool
    otherwise = do
          (y, z) <- Int -> Gen (Int, Int)
    genSplit Int
    n
          (a, b, c) <- genSplit3 y
          (d, e) <- genSplit z
          return (a, b, c, d, 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (Int, Int, Int, Int, Int, Int)
    -> Gen (Int, Int, Int, Int, Int, Int)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    0, Int
    0, Int
    0, Int
    0, Int
    0, Int
    0)
      | Bool
    otherwise = do
          (y, z) <- Int -> Gen (Int, Int)
    genSplit Int
    n
          (a, b, c) <- genSplit3 y
          (d, e, f) <- genSplit3 z
          return (a, b, c, d, e, 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (Int, Int, Int, Int, Int, Int, Int)
    -> Gen (Int, Int, Int, Int, Int, Int, Int)
    forall a. a -> Gen a
    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
          (y, z) <- Int -> Gen (Int, Int)
    genSplit Int
    n
          (a, b, c) <- genSplit3 y
          (d, e, f, g) <- genSplit4 z
          return (a, b, c, d, e, f, 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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 = (Int, Int, Int, Int, Int, Int, Int, Int)
    -> Gen (Int, Int, Int, Int, Int, Int, Int, Int)
    forall a. a -> Gen a
    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
          (y, z) <- Int -> Gen (Int, Int)
    genSplit Int
    n
          (a, b, c, d) <- genSplit4 y
          (e, f, g, h) <- genSplit4 z
          return (a, b, c, d, e, f, g, 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 = [Int] -> Gen [Int]
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
    arbPartition Int
    i = Int -> Gen Int
    genListLengthWithSize Int
    i Gen Int -> (Int -> Gen [Int]) -> Gen [Int]
    forall a b. Gen a -> (a -> Gen b) -> Gen b
    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
          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 (Double
    0, Double
    1)
          let invs = (Double -> Double) -> [Double] -> [Double]
    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.
          pure $ map (round . (* (fromIntegral size / sum invs))) 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 = (-Double -> Double
    forall a. Floating a => a -> a
    log (Double
    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

    genMaybe :: Gen a -> Gen (Maybe a)
    genMaybe :: forall a. Gen a -> Gen (Maybe a)
    genMaybe Gen a
    gen = [Gen (Maybe a)] -> Gen (Maybe a)
    forall a. HasCallStack => [Gen a] -> Gen a
    oneof [Maybe a -> Gen (Maybe a)
    forall a. a -> Gen a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe a
    forall a. Maybe a
    Nothing, a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
    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
      l <- Gen a -> Gen [a]
    forall a. Gen a -> Gen [a]
    genListOf Gen a
    gen
      case NE.nonEmpty l of
        Maybe (NonEmpty a)
    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
    + Int
    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 NonEmpty a
    ne -> NonEmpty a -> Gen (NonEmpty a)
    forall a. a -> Gen a
    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 = (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 Int
    maxLen = Double -> Int
    forall b. Integral b => Double -> b
    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 (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 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 ((Double
    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))

    -- Generate a String using a generator of 'Char's
    genStringBy :: Gen Char -> Gen String
    genStringBy :: Gen Char -> Gen String
    genStringBy = Gen Char -> Gen String
    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 = Gen Char -> Gen String
    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 =
      (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
    $ \Int
    n -> do
        pars <- Int -> Gen [Int]
    arbPartition Int
    n
        forM pars $ \Int
    i -> Int -> Gen a -> Gen a
    forall a. HasCallStack => 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 = NonEmpty a -> [a]
    forall a. NonEmpty a -> [a]
    NE.toList (NonEmpty a -> [a]) -> Gen (NonEmpty a) -> Gen [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen a -> Gen (NonEmpty a)
    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 -> Maybe a
    forall a. Maybe a
    Nothing Maybe a -> [Maybe a] -> [Maybe a]
    forall a. a -> [a] -> [a]
    : (a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> [a] -> [Maybe a]
    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) =
      ((,) (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 a b. [a -> 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]

    -- | 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', (b', c')) <- (a -> [a]) -> ((b, c) -> [(b, c)]) -> (a, (b, c)) -> [(a, (b, c))]
    forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
    shrinkTuple a -> [a]
    sa ((b -> [b]) -> (c -> [c]) -> (b, c) -> [(b, c)]
    forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
    shrinkTuple b -> [b]
    sb c -> [c]
    sc) (a
    a, (b
    b, c
    c))
      pure (a', b', 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', b'), (c', d')) <- ((a, b) -> [(a, b)])
    -> ((c, d) -> [(c, d)]) -> ((a, b), (c, d)) -> [((a, b), (c, d))]
    forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
    shrinkTuple ((a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
    forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
    shrinkTuple a -> [a]
    sa b -> [b]
    sb) ((c -> [c]) -> (d -> [d]) -> (c, d) -> [(c, d)]
    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))
      pure (a', b', c', 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 = (a -> [a]) -> (a -> [a]) -> (a, a) -> [(a, a)]
    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 = (a -> [a]) -> (a -> [a]) -> (a -> [a]) -> (a, a, a) -> [(a, a, a)]
    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 = (a -> [a])
    -> (a -> [a])
    -> (a -> [a])
    -> (a -> [a])
    -> (a, a, a, a)
    -> [(a, a, a, a)]
    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 = ([a] -> Maybe (NonEmpty a)) -> [[a]] -> [NonEmpty a]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [a] -> Maybe (NonEmpty a)
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty ([[a]] -> [NonEmpty a])
    -> (NonEmpty a -> [[a]]) -> NonEmpty a -> [NonEmpty a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> [a]) -> [a] -> [[a]]
    forall a. (a -> [a]) -> [a] -> [[a]]
    shrinkList a -> [a]
    shrinker ([a] -> [[a]]) -> (NonEmpty a -> [a]) -> NonEmpty a -> [[a]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty a -> [a]
    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 =
      [(Int, Gen a)] -> Gen a
    forall a. HasCallStack => [(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 = (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
    $ \Int
    s ->
          [Gen a] -> Gen a
    forall a. HasCallStack => [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
    $ \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)
        uniformInt :: Gen a
        uniformInt :: Gen a
    uniformInt = (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 :: forall a. (Integral a, Bounded a, Random a) => Gen a
    genWordX =
      [(Int, Gen a)] -> Gen a
    forall a. HasCallStack => [(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 = (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
    $ \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
    $ \Int
    s -> (a, a) -> Gen a
    forall a. Random a => (a, a) -> Gen a
    choose (a
    0, Int -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    s)
        uniformWord :: Gen a
        uniformWord :: Gen a
    uniformWord = (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 :: forall a w.
    (Read a, RealFloat a, Bounded w, Random w) =>
    (w -> a) -> Gen a
    genFloatX w -> a
    func =
      [(Int, Gen a)] -> Gen a
    forall a. HasCallStack => [(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 =
          [a] -> Gen a
    forall a. HasCallStack => [a] -> Gen a
    elements
            [ String -> a
    forall a. Read a => String -> a
    read String
    "NaN",
              String -> a
    forall a. Read a => String -> a
    read String
    "Infinity",
              String -> a
    forall a. Read a => String -> a
    read String
    "-Infinity",
              String -> a
    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 = (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
    $ \Int
    n -> do
          let n' :: Integer
    n' = Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    n
          let precision :: Integer
    precision = Integer
    9999999999999 :: Integer
          b <- (Integer, Integer) -> Gen Integer
    forall a. Random a => (a, a) -> Gen a
    choose (Integer
    1, Integer
    precision)
          a <- choose ((-n') * b, n' * b)
          pure (fromRational (a % b))
        upperSignificand :: Integer
        upperSignificand :: Integer
    upperSignificand = a -> Integer
    forall a. RealFloat a => a -> Integer
    floatRadix (a
    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 (a
    0.0 :: a)
        lowerSignificand :: Integer
        lowerSignificand :: Integer
    lowerSignificand = (-Integer
    upperSignificand)
        (Int
    lowerExponent, Int
    upperExponent) = a -> (Int, Int)
    forall a. RealFloat a => a -> (Int, Int)
    floatRange (a
    0.0 :: a)
        aroundBounds :: Gen a
        aroundBounds :: Gen a
    aroundBounds = do
          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
    $ \Int
    n ->
            [Gen Integer] -> Gen Integer
    forall a. HasCallStack => [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)
              ]
          e <- sized $ \Int
    n ->
            [Gen Int] -> Gen Int
    forall a. HasCallStack => [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)
              ]
          pure $ encodeFloat s e
        uniformViaEncoding :: Gen a
        uniformViaEncoding :: Gen a
    uniformViaEncoding = do
          s <- (Integer, Integer) -> Gen Integer
    forall a. Random a => (a, a) -> Gen a
    choose (Integer
    lowerSignificand, Integer
    upperSignificand)
          e <- choose $ floatRange (0.0 :: a)
          pure $ encodeFloat s 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
    $ \Int
    s ->
      [Gen Integer] -> Gen Integer
    forall a. HasCallStack => [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
    >= Int
    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
    $ \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
    $ \Int
    s -> do
          (a, b, c) <- Int -> Gen (Int, Int, Int)
    genSplit3 Int
    s
          ai <- resize a genIntSizedInteger
          bi <- resize b genInteger
          ci <- resize c genIntSizedInteger
          pure $ ai * bi + ci