module Test.QuickCheck.Instances.List
       (anyList,nonEmpty
       ,infiniteList
       ,setLength
       ,increasing,nondecreasing
       ,increasingInf,nondecreasingInf
       ,decreasing,nonincreasing
       ,decreasingInf,nonincreasingInf
       ) where

import Test.QuickCheck hiding (infiniteList)
import Test.QuickCheck.Instances.Num
import Control.Applicative

{- | Generates a non-empty list with the contents generated using its
     argument.
-}
nonEmpty :: Gen a -> Gen [a]
nonEmpty :: Gen a -> Gen [a]
nonEmpty Gen a
x = (a -> [a] -> [a]) -> Gen a -> Gen [a] -> Gen [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) Gen a
x (Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
anyList Gen a
x)

{- | Generates any list (possibly empty) with the contents generated using
     its argument.
-}
anyList :: Gen a -> Gen [a]
anyList :: Gen a -> Gen [a]
anyList Gen a
x = [(Int, Gen [a])] -> Gen [a]
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
1, [a] -> Gen [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []), (Int
4, Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
nonEmpty Gen a
x)]

{- | Generates an infinite list with contents generated using its argument
-}
infiniteList :: Gen a -> Gen [a]
infiniteList :: Gen a -> Gen [a]
infiniteList Gen a
x = (a -> [a] -> [a]) -> Gen a -> Gen [a] -> Gen [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) Gen a
x (Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
infiniteList Gen a
x)

{- | Generates a list with a set length
-}
setLength :: Int -> Gen a -> Gen [a]
setLength :: Int -> Gen a -> Gen [a]
setLength Int
0 Gen a
_ = [a] -> Gen [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
setLength Int
n Gen a
g = (:) (a -> [a] -> [a]) -> Gen a -> Gen ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g Gen ([a] -> [a]) -> Gen [a] -> Gen [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen a -> Gen [a]
forall a. Int -> Gen a -> Gen [a]
setLength (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Gen a
g

sumA :: (Applicative f, Num a) => f a -> f [a] -> f [a]
sumA :: f a -> f [a] -> f [a]
sumA = (a -> [a] -> [a]) -> f a -> f [a] -> f [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((a -> a -> a) -> a -> [a] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl a -> a -> a
forall a. Num a => a -> a -> a
(+))

monotonic_ :: (Arbitrary a, Num a) => (Gen a -> Gen [a]) -> Gen a -> Gen [a]
monotonic_ :: (Gen a -> Gen [a]) -> Gen a -> Gen [a]
monotonic_ Gen a -> Gen [a]
listGen Gen a
gen = Gen a -> Gen [a] -> Gen [a]
forall (f :: * -> *) a.
(Applicative f, Num a) =>
f a -> f [a] -> f [a]
sumA Gen a
forall a. Arbitrary a => Gen a
arbitrary (Gen a -> Gen [a]
listGen Gen a
gen)

-- TODO: Generalise this to Ord a.
monotonic :: (Arbitrary a, Num a) => Gen a -> Gen [a]
monotonic :: Gen a -> Gen [a]
monotonic Gen a
gen = (Gen a -> Gen [a]) -> Gen a -> Gen [a]
forall a.
(Arbitrary a, Num a) =>
(Gen a -> Gen [a]) -> Gen a -> Gen [a]
monotonic_ Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
anyList Gen a
gen

-- | Generate increasing towards infinity
increasing :: (Arbitrary a, Eq a, Num a) => Gen [a]
increasing :: Gen [a]
increasing = Gen a -> Gen [a]
forall a. (Arbitrary a, Num a) => Gen a -> Gen [a]
monotonic Gen a
forall a. (Eq a, Num a, Arbitrary a) => Gen a
positive

-- | Generate an infinite list of increasing values
increasingInf :: (Arbitrary a, Eq a, Num a) => Gen [a]
increasingInf :: Gen [a]
increasingInf = (Gen a -> Gen [a]) -> Gen a -> Gen [a]
forall a.
(Arbitrary a, Num a) =>
(Gen a -> Gen [a]) -> Gen a -> Gen [a]
monotonic_ Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
infiniteList Gen a
forall a. (Eq a, Num a, Arbitrary a) => Gen a
positive

-- | Generate nondecreasing values
nondecreasing :: (Arbitrary a, Num a) => Gen [a]
nondecreasing :: Gen [a]
nondecreasing = Gen a -> Gen [a]
forall a. (Arbitrary a, Num a) => Gen a -> Gen [a]
monotonic Gen a
forall a. (Num a, Arbitrary a) => Gen a
nonNegative

-- | Generate an infinite list of nondecreasing values
nondecreasingInf :: (Arbitrary a, Num a) => Gen [a]
nondecreasingInf :: Gen [a]
nondecreasingInf = (Gen a -> Gen [a]) -> Gen a -> Gen [a]
forall a.
(Arbitrary a, Num a) =>
(Gen a -> Gen [a]) -> Gen a -> Gen [a]
monotonic_ Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
infiniteList Gen a
forall a. (Num a, Arbitrary a) => Gen a
nonNegative

-- | Generate increasing towards infinity
decreasing :: (Arbitrary a, Eq a, Num a) => Gen [a]
decreasing :: Gen [a]
decreasing = Gen a -> Gen [a]
forall a. (Arbitrary a, Num a) => Gen a -> Gen [a]
monotonic Gen a
forall a. (Eq a, Num a, Arbitrary a) => Gen a
negative

-- | Generate an infinite list of increasing values
decreasingInf :: (Arbitrary a, Eq a, Num a) => Gen [a]
decreasingInf :: Gen [a]
decreasingInf = (Gen a -> Gen [a]) -> Gen a -> Gen [a]
forall a.
(Arbitrary a, Num a) =>
(Gen a -> Gen [a]) -> Gen a -> Gen [a]
monotonic_ Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
infiniteList Gen a
forall a. (Eq a, Num a, Arbitrary a) => Gen a
negative

-- | Generate nondecreasing values
nonincreasing :: (Arbitrary a, Num a) => Gen [a]
nonincreasing :: Gen [a]
nonincreasing = Gen a -> Gen [a]
forall a. (Arbitrary a, Num a) => Gen a -> Gen [a]
monotonic Gen a
forall a. (Num a, Arbitrary a) => Gen a
nonPositive

-- | Generate an infinite list of nondecreasing values
nonincreasingInf :: (Arbitrary a, Num a) => Gen [a]
nonincreasingInf :: Gen [a]
nonincreasingInf = (Gen a -> Gen [a]) -> Gen a -> Gen [a]
forall a.
(Arbitrary a, Num a) =>
(Gen a -> Gen [a]) -> Gen a -> Gen [a]
monotonic_ Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
infiniteList Gen a
forall a. (Num a, Arbitrary a) => Gen a
nonPositive