{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.GenValidity.Set
( genStructurallyValidSetOf
, genStructurallyValidSetOfInvalidValues
#if MIN_VERSION_containers(0,5,9)
, genStructurallyInvalidSet
#endif
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), pure)
#endif
import Data.GenValidity
import Data.Validity.Set ()
import Test.QuickCheck
import Data.Set (Set)
import qualified Data.Set as S
#if MIN_VERSION_containers(0,5,9)
import qualified Data.Set.Internal as Internal
#endif
#if MIN_VERSION_containers(0,5,9)
instance (Ord v, GenUnchecked v) => GenUnchecked (Set v) where
genUnchecked :: Gen (Set v)
genUnchecked =
(Int -> Gen (Set v)) -> Gen (Set v)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (Set v)) -> Gen (Set v))
-> (Int -> Gen (Set v)) -> Gen (Set v)
forall a b. (a -> b) -> a -> b
$ \n :: Int
n ->
case Int
n of
0 -> Set v -> Gen (Set v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set v
forall a. Set a
Internal.Tip
_ -> do
(a :: Int
a, b :: Int
b, c :: Int
c, d :: Int
d) <- Int -> Gen (Int, Int, Int, Int)
genSplit4 Int
n
Int -> v -> Set v -> Set v -> Set v
forall a. Int -> a -> Set a -> Set a -> Set a
Internal.Bin (Int -> v -> Set v -> Set v -> Set v)
-> Gen Int -> Gen (v -> Set v -> Set v -> Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Int -> Gen Int
forall a. Int -> Gen a -> Gen a
resize Int
a Gen Int
forall a. GenUnchecked a => Gen a
genUnchecked Gen (v -> Set v -> Set v -> Set v)
-> Gen v -> Gen (Set v -> Set v -> Set v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Int -> Gen v -> Gen v
forall a. Int -> Gen a -> Gen a
resize Int
b Gen v
forall a. GenUnchecked a => Gen a
genUnchecked Gen (Set v -> Set v -> Set v)
-> Gen (Set v) -> Gen (Set v -> Set v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Int -> Gen (Set v) -> Gen (Set v)
forall a. Int -> Gen a -> Gen a
resize Int
c Gen (Set v)
forall a. GenUnchecked a => Gen a
genUnchecked Gen (Set v -> Set v) -> Gen (Set v) -> Gen (Set v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Int -> Gen (Set v) -> Gen (Set v)
forall a. Int -> Gen a -> Gen a
resize Int
d Gen (Set v)
forall a. GenUnchecked a => Gen a
genUnchecked
shrinkUnchecked :: Set v -> [Set v]
shrinkUnchecked Internal.Tip = []
shrinkUnchecked (Internal.Bin s :: Int
s a :: v
a s1 :: Set v
s1 s2 :: Set v
s2) =
Set v
forall a. Set a
Internal.Tip Set v -> [Set v] -> [Set v]
forall a. a -> [a] -> [a]
:
[Set v
s1, Set v
s2] [Set v] -> [Set v] -> [Set v]
forall a. [a] -> [a] -> [a]
++
[ Int -> v -> Set v -> Set v -> Set v
forall a. Int -> a -> Set a -> Set a -> Set a
Internal.Bin Int
s' v
a' Set v
s1' Set v
s2'
| (s' :: Int
s', a' :: v
a', s1' :: Set v
s1', s2' :: Set v
s2') <- (Int, v, Set v, Set v) -> [(Int, v, Set v, Set v)]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked (Int
s, v
a, Set v
s1, Set v
s2)
]
#else
instance (Ord v, GenUnchecked v) => GenUnchecked (Set v) where
genUnchecked = S.fromList <$> genUnchecked
shrinkUnchecked = fmap S.fromList . shrinkUnchecked . S.toList
#endif
instance (Ord v, GenValid v) => GenValid (Set v) where
genValid :: Gen (Set v)
genValid = [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList ([v] -> Set v) -> Gen [v] -> Gen (Set v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [v]
forall a. GenValid a => Gen a
genValid
shrinkValid :: Set v -> [Set v]
shrinkValid = ([v] -> Set v) -> [[v]] -> [Set v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [v] -> Set v
forall a. Ord a => [a] -> Set a
S.fromList ([[v]] -> [Set v]) -> (Set v -> [[v]]) -> Set v -> [Set v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> [[v]]
forall a. GenValid a => a -> [a]
shrinkValid ([v] -> [[v]]) -> (Set v -> [v]) -> Set v -> [[v]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> [v]
forall a. Set a -> [a]
S.toList
#if MIN_VERSION_containers(0,5,9)
instance (Ord v, GenUnchecked v, GenInvalid v) => GenInvalid (Set v) where
genInvalid :: Gen (Set v)
genInvalid =
[Gen (Set v)] -> Gen (Set v)
forall a. [Gen a] -> Gen a
oneof
[Gen (Set v)
forall v. (Ord v, GenUnchecked v, GenInvalid v) => Gen (Set v)
genStructurallyValidSetOfInvalidValues, Gen (Set v)
forall v. (Ord v, GenUnchecked v) => Gen (Set v)
genStructurallyInvalidSet]
#else
instance (Ord v, GenUnchecked v, GenInvalid v) => GenInvalid (Set v) where
genInvalid = genStructurallyValidSetOfInvalidValues
#endif
genStructurallyValidSetOf :: Ord v => Gen v -> Gen (Set v)
genStructurallyValidSetOf :: Gen v -> Gen (Set v)
genStructurallyValidSetOf g :: Gen v
g =
(Int -> Gen (Set v)) -> Gen (Set v)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (Set v)) -> Gen (Set v))
-> (Int -> Gen (Set v)) -> Gen (Set v)
forall a b. (a -> b) -> a -> b
$ \n :: Int
n ->
case Int
n of
0 -> Set v -> Gen (Set v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set v
forall a. Set a
S.empty
_ -> do
(v :: Int
v, m :: Int
m) <- Int -> Gen (Int, Int)
genSplit Int
n
v
val <- Int -> Gen v -> Gen v
forall a. Int -> Gen a -> Gen a
resize Int
v Gen v
g
Set v
rest <- Int -> Gen (Set v) -> Gen (Set v)
forall a. Int -> Gen a -> Gen a
resize Int
m (Gen (Set v) -> Gen (Set v)) -> Gen (Set v) -> Gen (Set v)
forall a b. (a -> b) -> a -> b
$ Gen v -> Gen (Set v)
forall v. Ord v => Gen v -> Gen (Set v)
genStructurallyValidSetOf Gen v
g
Set v -> Gen (Set v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set v -> Gen (Set v)) -> Set v -> Gen (Set v)
forall a b. (a -> b) -> a -> b
$ v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
S.insert v
val Set v
rest
genStructurallyValidSetOfInvalidValues :: (Ord v, GenUnchecked v, GenInvalid v) => Gen (Set v)
genStructurallyValidSetOfInvalidValues :: Gen (Set v)
genStructurallyValidSetOfInvalidValues =
(Int -> Gen (Set v)) -> Gen (Set v)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (Set v)) -> Gen (Set v))
-> (Int -> Gen (Set v)) -> Gen (Set v)
forall a b. (a -> b) -> a -> b
$ \n :: Int
n -> do
(v :: Int
v, m :: Int
m) <- Int -> Gen (Int, Int)
genSplit Int
n
v
val <- Int -> Gen v -> Gen v
forall a. Int -> Gen a -> Gen a
resize Int
v Gen v
forall a. GenInvalid a => Gen a
genInvalid
Set v
rest <- Int -> Gen (Set v) -> Gen (Set v)
forall a. Int -> Gen a -> Gen a
resize Int
m (Gen (Set v) -> Gen (Set v)) -> Gen (Set v) -> Gen (Set v)
forall a b. (a -> b) -> a -> b
$ Gen v -> Gen (Set v)
forall v. Ord v => Gen v -> Gen (Set v)
genStructurallyValidSetOf Gen v
forall a. GenUnchecked a => Gen a
genUnchecked
Set v -> Gen (Set v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set v -> Gen (Set v)) -> Set v -> Gen (Set v)
forall a b. (a -> b) -> a -> b
$ v -> Set v -> Set v
forall a. Ord a => a -> Set a -> Set a
S.insert v
val Set v
rest
#if MIN_VERSION_containers(0,5,9)
genStructurallyInvalidSet :: (Ord v, GenUnchecked v) => Gen (Set v)
genStructurallyInvalidSet :: Gen (Set v)
genStructurallyInvalidSet = do
Set v
v <- Gen (Set v)
forall a. GenUnchecked a => Gen a
genUnchecked
if Set v -> Bool
forall a. Ord a => Set a -> Bool
S.valid Set v
v
then (Int -> Int) -> Gen (Set v) -> Gen (Set v)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Gen (Set v)
forall v. (Ord v, GenUnchecked v) => Gen (Set v)
genStructurallyInvalidSet
else Set v -> Gen (Set v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set v
v
#endif