{-# 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Sum a
Sum Gen Integer
genSmallInteger

genSmallInteger :: Gen Integer
genSmallInteger :: Gen Integer
genSmallInteger = forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (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 = forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (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 = forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (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 = forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
2) Gen a
gen

genSmallString :: Gen String
genSmallString :: Gen String
genSmallString = forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m String
Gen.string (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
6) 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 = 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 :: 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 = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x. Gen x -> Gen (f x)
fgen (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 = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
a 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
a <- Gen a
gena
  b
b <- Gen b
genb
  c
c <- Gen c
genc
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c)

genValidRange :: Ix a => Gen a -> Gen (a, a)
genValidRange :: forall a. Ix a => Gen a -> Gen (a, a)
genValidRange Gen a
gen = do
  forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (\(a
l,a
u) -> a
l forall a. Ord a => a -> a -> Bool
<= a
u) (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
  forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (\(a
l,a
u,a
i) -> forall a. Ix a => (a, a) -> a -> Bool
inRange (a
l,a
u) a
i) (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 <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Gen Integer
genSmallInteger) [Integer
1..Integer
10 :: Integer]
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. a -> Set a
S.singleton [Integer]
xs