{-# 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

-- Note: M.fromList <$> genInvalid does not work because of this line in the Data.Set documentation:
-- ' If the list contains more than one value for the same key, the last value for the key is retained.'
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