{-# 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 (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 :: Gen a -> Gen [a]
genSmallNonEmptyList Gen a
gen = Range Int -> Gen a -> Gen [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 :: Gen a -> Gen [a]
genSmallList Gen a
gen = Range Int -> Gen a -> Gen [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 :: Gen a -> Gen [a]
genVerySmallList Gen a
gen = Range Int -> Gen a -> Gen [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 (m :: * -> *) a. MonadGen m => [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 :: 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)) -> Gen (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 :: 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 -> Gen (a, 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 :: Gen a -> Gen b -> Gen c -> Gen (a, b, c)
genTuple3 Gen a
gena Gen b
genb Gen c
genc = do
  a
a <- Gen a
gena
  b
b <- Gen b
genb
  c
c <- Gen c
genc
  (a, b, c) -> Gen (a, b, c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c)

genValidRange :: Ix a => Gen a -> Gen (a, a)
genValidRange :: Gen a -> Gen (a, a)
genValidRange Gen a
gen = do
  ((a, a) -> Bool) -> Gen (a, a) -> Gen (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 -> Gen (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 :: Gen a -> Gen (a, a, a)
genInRange Gen a
gen = do
  ((a, a, a) -> Bool) -> Gen (a, a, a) -> Gen (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 -> Gen (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
  [Integer]
xs <- [GenT Identity Integer] -> GenT Identity [Integer]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t 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 (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]
  Set Integer -> Gen (Set Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set Integer -> Gen (Set Integer))
-> Set Integer -> Gen (Set Integer)
forall a b. (a -> b) -> a -> b
$ (Integer -> Set Integer) -> [Integer] -> Set Integer
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Integer -> Set Integer
forall a. a -> Set a
S.singleton [Integer]
xs