{- |
    Module      :  Test.SDP.Set
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (requires non-portable modules)
    
    @Test.SDP.Set@ provides basic test quite for 'Set' class.
-}
module Test.SDP.Set
(
  -- * Set test
  TestSet, TestSet1, setTest,
  
  -- * Particular tests
  basicSetTest, insdelSetTest, lookupSetTest, unintSetTest, diffSetTest,
  elemSetTest
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Linear
import SDP.Set

default ()

--------------------------------------------------------------------------------

-- | TestSet  is service type synonym for more comfortable quickCheck using.
type TestSet  s o = o -> s -> s -> Bool

-- | TestSet1 is service type synonym for more comfortable quickCheck using.
type TestSet1 s o = o -> s o -> s o -> Bool

--------------------------------------------------------------------------------

{- |
  'basicSetTest' checks relations of 'set', ('/?\') and ('\?/').
  Note that basicSetTest requires any @('Set' s o) => s@, not necessarily a set
  (may contain any data).
-}
basicSetTest :: (Set s o, Nullable s, Eq s, Ord o) => s -> Bool
basicSetTest :: s -> Bool
basicSetTest s
sx = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [
      s -> Bool
forall e. Nullable e => e -> Bool
isNull s
sx Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Bool
forall e. Nullable e => e -> Bool
isNull s
sx',
      
      s -> s
forall s o. Set s o => s -> s
set s
sx' s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
sx',
      
      (s
sx' s -> s -> Bool
forall s o. Set s o => s -> s -> Bool
\?/ s
sx') Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= (s
sx' s -> s -> Bool
forall s o. Set s o => s -> s -> Bool
/?\ s
sx')
    ]
  where
    sx' :: s
sx' = s -> s
forall s o. Set s o => s -> s
set s
sx

{- |
  'insdelSetTest' checks rules of 'insert' and 'delete'.
  Note that 'insdelSetTest' requires a set, not any @('Set' s o) => s@.
-}
insdelSetTest :: (Set s o, Eq s, Ord o) => o -> s -> Bool
insdelSetTest :: o -> s -> Bool
insdelSetTest o
e s
sx' = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [
    (o -> s -> s
forall s o. Set s o => o -> s -> s
insert o
e s
sx' s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
sx') Bool -> Bool -> Bool
|| Bool -> Bool
not (o -> s -> Bool
forall s o. Set s o => o -> s -> Bool
member o
e s
sx'),
    (o -> s -> s
forall s o. Set s o => o -> s -> s
delete o
e s
sx' s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
sx') Bool -> Bool -> Bool
||     (o -> s -> Bool
forall s o. Set s o => o -> s -> Bool
member o
e s
sx')
  ]

{- |
  'unintSetTest' checks the laws of union ('\/') and intersection ('/\').
  Note that unintSetTest requires any @('Set' s o) => s@, not necessarily a set
  (may contain any data).
-}
unintSetTest :: (Set s o, Linear s o, Ord o) => s -> s -> Bool
unintSetTest :: s -> s -> Bool
unintSetTest s
sx' s
sy' = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [
      (s
is s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
sx') Bool -> Bool -> Bool
&& (s
is  s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
sy') Bool -> Bool -> Bool
&& (s
is s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
un),
      (s
sx' s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
un) Bool -> Bool -> Bool
&& (s
sy' s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
un)
    ]
  where
    is :: s
is = s
sx' s -> s -> s
forall s o. Set s o => s -> s -> s
/\  s
sy'
    un :: s
un = s
sx' s -> s -> s
forall s o. Set s o => s -> s -> s
\/  s
sy'

{- |
  'diffSetTest' checks laws of difference ('\\') and symmetric difference
  ('\^/'). Note that diffSetTest requires a set, not any @('Set' s o) => s@
-}
diffSetTest :: (Set s o, Linear s o, Ord o) => s -> s -> Bool
diffSetTest :: s -> s -> Bool
diffSetTest s
sx' s
sy' = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [
      (s
cp s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
sx') Bool -> Bool -> Bool
&& (s -> Bool
forall e. Nullable e => e -> Bool
isNull s
cp Bool -> Bool -> Bool
|| Bool -> Bool
not (s
cp s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
sy')) Bool -> Bool -> Bool
&& (s
cp s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
un),
      (s -> Bool
forall e. Nullable e => e -> Bool
isNull s
sd Bool -> Bool -> Bool
&& s -> Bool
forall e. Nullable e => e -> Bool
isNull s
is Bool -> Bool -> Bool
|| s
sd s -> s -> Bool
forall s o. Set s o => s -> s -> Bool
/?\ s
is) Bool -> Bool -> Bool
&& (s
sd s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
un)
    ]
  where
    is :: s
is = s
sx' s -> s -> s
forall s o. Set s o => s -> s -> s
/\  s
sy'
    un :: s
un = s
sx' s -> s -> s
forall s o. Set s o => s -> s -> s
\/  s
sy'
    cp :: s
cp = s
sx' s -> s -> s
forall s o. Set s o => s -> s -> s
\\  s
sy'
    sd :: s
sd = s
sx' s -> s -> s
forall s o. Set s o => s -> s -> s
\^/ s
sy'

{- |
  'elemSetTest' checks relations of 'member' and 'isSubseqOf'.
  Note that elemSetTest requires any @('Set' s o) => s@, not necessarily a set
  (may contain any data).
-}
elemSetTest :: (Set s o, Linear s o, Ord o) => o -> s -> Bool
elemSetTest :: o -> s -> Bool
elemSetTest o
e s
sx = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [
      (s
e' s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
sx) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== o -> s -> Bool
forall s o. Set s o => o -> s -> Bool
member o
e s
sx',
      (s
e' s -> s -> Bool
forall l e. (Linear l e, Eq e) => l -> l -> Bool
`isSubseqOf` s
sx) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== o -> s -> Bool
forall s o. Set s o => o -> s -> Bool
member o
e s
sx'
    ]
  where
    sx' :: s
sx' = s -> s
forall s o. Set s o => s -> s
set s
sx; e' :: s
e' = o -> s
forall l e. Linear l e => e -> l
single o
e

{- |
  'lookupSetTest' checks relations of 'lookupLT', 'lookupGT', 'lookupLE' and
  'lookupGE'. Note that lookupSetTest requires a set, not any @('Set' s o) => s@.
-}
lookupSetTest :: (Set s o, Linear s o, Ord o) => o -> s -> Bool
lookupSetTest :: o -> s -> Bool
lookupSetTest o
e s
sx = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [
      o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLT o
e s
sx Maybe o -> Maybe o -> Bool
forall a. Eq a => a -> a -> Bool
== o -> [o] -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLT o
e (s -> [o]
forall l e. Linear l e => l -> [e]
listL s
sx),
      o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGT o
e s
sx Maybe o -> Maybe o -> Bool
forall a. Eq a => a -> a -> Bool
== o -> [o] -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGT o
e (s -> [o]
forall l e. Linear l e => l -> [e]
listL s
sx),
      o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLE o
e s
sx Maybe o -> Maybe o -> Bool
forall a. Eq a => a -> a -> Bool
== o -> [o] -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLE o
e (s -> [o]
forall l e. Linear l e => l -> [e]
listL s
sx),
      o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGE o
e s
sx Maybe o -> Maybe o -> Bool
forall a. Eq a => a -> a -> Bool
== o -> [o] -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGE o
e (s -> [o]
forall l e. Linear l e => l -> [e]
listL s
sx),
      
      case o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLT o
e s
sx of {Maybe o
Nothing -> Bool
True; Just o
x -> o
x o -> o -> Bool
forall a. Ord a => a -> a -> Bool
<  o
e},
      case o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGT o
e s
sx of {Maybe o
Nothing -> Bool
True; Just o
x -> o
x o -> o -> Bool
forall a. Ord a => a -> a -> Bool
>  o
e},
      case o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLE o
e s
sx of {Maybe o
Nothing -> Bool
True; Just o
x -> o
x o -> o -> Bool
forall a. Ord a => a -> a -> Bool
<= o
e},
      case o -> s -> Maybe o
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGE o
e s
sx of {Maybe o
Nothing -> Bool
True; Just o
x -> o
x o -> o -> Bool
forall a. Ord a => a -> a -> Bool
>= o
e}
    ]

{- |
  'setTest' is complex test, that includes all other tests.
  Note that setTest requires any @('Set' s o) => s@, not necessarily a set (may
  contain any data).
-}
setTest :: (Set s o, Linear s o, Ord s, Ord o) => o -> s -> s -> Bool
setTest :: o -> s -> s -> Bool
setTest o
e s
xs s
ys = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [
      s -> s -> Bool
forall s o. (Set s o, Linear s o, Ord o) => s -> s -> Bool
unintSetTest  s
sx s
sy,
      s -> s -> Bool
forall s o. (Set s o, Linear s o, Ord o) => s -> s -> Bool
diffSetTest   s
sx s
sy,
      s -> Bool
forall s o. (Set s o, Nullable s, Eq s, Ord o) => s -> Bool
basicSetTest     s
xs,
      o -> s -> Bool
forall s o. (Set s o, Eq s, Ord o) => o -> s -> Bool
insdelSetTest o
e  s
sx,
      o -> s -> Bool
forall s o. (Set s o, Linear s o, Ord o) => o -> s -> Bool
lookupSetTest o
e  s
sx,
      o -> s -> Bool
forall s o. (Set s o, Linear s o, Ord o) => o -> s -> Bool
elemSetTest   o
e  s
xs
    ]
  where
    sx :: s
sx = s -> s
forall s o. Set s o => s -> s
set s
xs
    sy :: s
sy = s -> s
forall s o. Set s o => s -> s
set s
ys