    {-# LANGUAGE RankNTypes #-}

    module Hedgehog.Classes.Common.Gen
      ( genSmallList
      , genVerySmallList
      , genSmallNonEmptyList
      , genShowReadPrecedence
      , genSmallString
      , genSmallInteger
      , genSmallSum
      , genCompose
      , genSetInteger

      -- * Used for 'Hedgehog.Classes.ixLaws'
      , genTuple
      , genTuple3
      , genInRange
      , genValidRange
      ) where

    import Data.Ix (Ix(..))
    import Hedgehog
    import Data.Functor.Compose
    import qualified Data.Set as S
    import Data.Semigroup
    import qualified Hedgehog.Gen as Gen
    import qualified Hedgehog.Range as Range

    genSmallSum :: Gen (Sum Integer)
    genSmallSum :: Gen (Sum Integer)
    genSmallSum = (Integer -> Sum Integer)
    -> GenT Identity Integer -> Gen (Sum Integer)
    forall a b. (a -> b) -> GenT Identity a -> GenT Identity b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> Sum Integer
    forall a. a -> Sum a
    Sum GenT Identity Integer
    genSmallInteger

    genSmallInteger :: Gen Integer
    genSmallInteger :: GenT Identity Integer
    genSmallInteger = Range Integer -> GenT Identity Integer
    forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
    Gen.integral (Integer -> Integer -> Range Integer
    forall a. Integral a => a -> a -> Range a
    Range.linear Integer
    0 Integer
    20)

    genSmallNonEmptyList :: Gen a -> Gen [a]
    genSmallNonEmptyList :: forall a. Gen a -> Gen [a]
    genSmallNonEmptyList Gen a
    gen = Range Int -> Gen a -> GenT Identity [a]
    forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
    Gen.list (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    1 Int
    7) Gen a
    gen

    genSmallList :: Gen a -> Gen [a]
    genSmallList :: forall a. Gen a -> Gen [a]
    genSmallList Gen a
    gen = Range Int -> Gen a -> GenT Identity [a]
    forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
    Gen.list (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 Int
    6) Gen a
    gen

    genVerySmallList :: Gen a -> Gen [a]
    genVerySmallList :: forall a. Gen a -> Gen [a]
    genVerySmallList Gen a
    gen = Range Int -> Gen a -> GenT Identity [a]
    forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
    Gen.list (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 Int
    2) Gen a
    gen

    genSmallString :: Gen String
    genSmallString :: Gen String
    genSmallString = Range Int -> GenT Identity Char -> Gen String
    forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
    Gen.string (Int -> Int -> Range Int
    forall a. Integral a => a -> a -> Range a
    Range.linear Int
    0 Int
    6) GenT Identity Char
    forall (m :: * -> *). MonadGen m => m Char
    Gen.ascii

    -- Haskell uses the operator precedences 0..9, the special function application
    -- precedence 10 and the precedence 11 for function arguments. Both show and
    -- read instances have to accept this range. According to the Haskell Language
    -- Report, the output of derived show instances in precedence context 11 has to
    -- be an atomic expression.
    genShowReadPrecedence :: Gen Int
    genShowReadPrecedence :: Gen Int
    genShowReadPrecedence = [Int] -> Gen Int
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, MonadGen m) =>
    f a -> m a
    Gen.element [Int
    0..Int
    11]

    genCompose :: forall f g a. Gen a -> (forall x. Gen x -> Gen (f x)) -> (forall x. Gen x -> Gen (g x)) -> Gen (Compose f g a)
    genCompose :: forall (f :: * -> *) (g :: * -> *) a.
    Gen a
    -> (forall x. Gen x -> Gen (f x))
    -> (forall x. Gen x -> Gen (g x))
    -> Gen (Compose f g a)
    genCompose Gen a
    gen forall x. Gen x -> Gen (f x)
    fgen forall x. Gen x -> Gen (g x)
    ggen = f (g a) -> Compose f g a
    forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
    f (g a) -> Compose f g a
    Compose (f (g a) -> Compose f g a)
    -> GenT Identity (f (g a)) -> GenT Identity (Compose f g a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen (g a) -> GenT Identity (f (g a))
    forall x. Gen x -> Gen (f x)
    fgen (Gen a -> Gen (g a)
    forall x. Gen x -> Gen (g x)
    ggen Gen a
    gen)

    genTuple :: Gen a -> Gen b -> Gen (a,b)
    genTuple :: forall a b. Gen a -> Gen b -> Gen (a, b)
    genTuple Gen a
    a Gen b
    b = (,) (a -> b -> (a, b)) -> Gen a -> GenT Identity (b -> (a, b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen a
    a GenT Identity (b -> (a, b)) -> Gen b -> GenT Identity (a, b)
    forall a b.
    GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Gen b
    b

    genTuple3 :: Gen a -> Gen b -> Gen c -> Gen (a, b, c)
    genTuple3 :: forall a b c. Gen a -> Gen b -> Gen c -> Gen (a, b, c)
    genTuple3 Gen a
    gena Gen b
    genb Gen c
    genc = do
      a <- Gen a
    gena
      b <- genb
      c <- genc
      pure (a, b, c)

    genValidRange :: Ix a => Gen a -> Gen (a, a)
    genValidRange :: forall a. Ix a => Gen a -> Gen (a, a)
    genValidRange Gen a
    gen = do
      ((a, a) -> Bool) -> GenT Identity (a, a) -> GenT Identity (a, a)
    forall (m :: * -> *) a.
    (MonadGen m, GenBase m ~ Identity) =>
    (a -> Bool) -> m a -> m a
    Gen.filter (\(a
    l,a
    u) -> a
    l a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    u) (Gen a -> Gen a -> GenT Identity (a, a)
    forall a b. Gen a -> Gen b -> Gen (a, b)
    genTuple Gen a
    gen Gen a
    gen)

    genInRange :: (Ix a) => Gen a -> Gen (a, a, a)
    genInRange :: forall a. Ix a => Gen a -> Gen (a, a, a)
    genInRange Gen a
    gen = do
      ((a, a, a) -> Bool)
    -> GenT Identity (a, a, a) -> GenT Identity (a, a, a)
    forall (m :: * -> *) a.
    (MonadGen m, GenBase m ~ Identity) =>
    (a -> Bool) -> m a -> m a
    Gen.filter (\(a
    l,a
    u,a
    i) -> (a, a) -> a -> Bool
    forall a. Ix a => (a, a) -> a -> Bool
    inRange (a
    l,a
    u) a
    i) (Gen a -> Gen a -> Gen a -> GenT Identity (a, a, a)
    forall a b c. Gen a -> Gen b -> Gen c -> Gen (a, b, c)
    genTuple3 Gen a
    gen Gen a
    gen Gen a
    gen)

    genSetInteger :: Gen (S.Set Integer)
    genSetInteger :: Gen (Set Integer)
    genSetInteger = do
      xs <- [GenT Identity Integer] -> GenT Identity [Integer]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([GenT Identity Integer] -> GenT Identity [Integer])
    -> [GenT Identity Integer] -> GenT Identity [Integer]
    forall a b. (a -> b) -> a -> b
    $ (Integer -> GenT Identity Integer)
    -> [Integer] -> [GenT Identity Integer]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (GenT Identity Integer -> Integer -> GenT Identity Integer
    forall a b. a -> b -> a
    const GenT Identity Integer
    genSmallInteger) [Integer
    1..Integer
    10 :: Integer]
      pure $ foldMap S.singleton xs