{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# LANGUAGE TypeOperators, TypeFamilies, ConstraintKinds, DefaultSignatures #-}
{-# LANGUAGE Trustworthy #-}

{- |
    Module      :  SDP.Set
    Copyright   :  (c) Andrey Mulik 2019
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC Extensions)
  
    "SDP.Set" provides 'Set' - class for basic set operations.
-}
module SDP.Set
(
  -- * SetWith
  SetWith (..), SetWith1,
  
  -- * Set
  Set (..), Set1
)
where

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

import Data.Maybe ( isJust  )
import Data.List  ( groupBy )

import GHC.Types

default ()

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

{- |
  'SetWith' is a class of data structures, that can represent sets.
  
  'SetWith' doesn't provide data protection/validation before each first action.
  All functions (except 'setWith') works correctly only with correct sets.
  'SetWith' guarantee only that the returned data is correct. So if you need
  maximum reliability and security, use @containers@. But if you want
  simplicity, openness and a lot of non-set functions without extra conversions,
  then you are at the right place.
  
  Note that function of type @Compare o@ must follow total order laws
  (antisymmetry, transitivity and connexity). If you use the wrong comparator,
  the result may become implementation-dependent.
-}
class (Nullable s) => SetWith s o | s -> o
  where
    {-# MINIMAL intersectionWith, unionWith, differenceWith, lookupLTWith, lookupGTWith #-}
    
    {- Creation functions. -}
    
    -- | Creates ordered set from linear structure.
    default setWith :: (Linear s o) => Compare o -> s -> s
    setWith :: Compare o -> s -> s
    setWith Compare o
f = [o] -> s
forall l e. Linear l e => [e] -> l
fromList ([o] -> s) -> (s -> [o]) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s
setWith Compare o
f ([o] -> [o]) -> (s -> [o]) -> s -> [o]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [o]
forall l e. Linear l e => l -> [e]
listL
    
    {- |
      Creates set from linear structure using additional function for
      choice/merge equal elements.
    -}
    default groupSetWith :: (Linear s o) => Compare o -> (o -> o -> o) -> s -> s
    groupSetWith :: Compare o -> (o -> o -> o) -> s -> s
    groupSetWith Compare o
cmp o -> o -> o
f = [o] -> s
forall l e. Linear l e => [e] -> l
fromList ([o] -> s) -> (s -> [o]) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> (o -> o -> o) -> [o] -> [o]
forall s o. SetWith s o => Compare o -> (o -> o -> o) -> s -> s
groupSetWith Compare o
cmp o -> o -> o
f ([o] -> [o]) -> (s -> [o]) -> s -> [o]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> [o]
forall l e. Linear l e => l -> [e]
listL
    
    -- | Adding element to set.
    default insertWith :: (Linear s o) => Compare o -> o -> s -> s
    insertWith :: Compare o -> o -> s -> s
    insertWith Compare o
f = Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith Compare o
f (s -> s -> s) -> (o -> s) -> o -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> s
forall l e. Linear l e => e -> l
single
    
    -- | Deleting element from set.
    default deleteWith :: (Linear s o) => Compare o -> o -> s -> s
    deleteWith :: Compare o -> o -> s -> s
    deleteWith Compare o
f = (s -> s -> s) -> s -> s -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
differenceWith Compare o
f) (s -> s -> s) -> (o -> s) -> o -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> s
forall l e. Linear l e => e -> l
single
    
    {- Basic operations on sets. -}
    
    -- | Intersection of two sets.
    intersectionWith :: Compare o -> s -> s -> s
    
    -- | Difference (relative complement, aka A / B) of two sets.
    differenceWith :: Compare o -> s -> s -> s
    
    -- | Symmetric difference of two sets.
    symdiffWith :: Compare o -> s -> s -> s
    symdiffWith Compare o
f s
xs s
ys = Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
differenceWith Compare o
f (Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith Compare o
f s
xs s
ys) (Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
intersectionWith Compare o
f s
xs s
ys)
    
    -- | Union of two sets.
    unionWith :: Compare o -> s -> s -> s
    
    {- Generalization of basic set operations on foldable. -}
    
    -- | Fold by 'intersectionWith'.
    intersectionsWith :: (Foldable f) => Compare o -> f s -> s
    intersectionsWith =  ((s -> s -> s) -> s -> f s -> s
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
`foldl` s
forall e. Nullable e => e
Z) ((s -> s -> s) -> f s -> s)
-> (Compare o -> s -> s -> s) -> Compare o -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
intersectionWith
    
    -- | Fold by 'differenceWith'.
    differencesWith :: (Foldable f) => Compare o -> f s -> s
    differencesWith =  ((s -> s -> s) -> s -> f s -> s
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
`foldl` s
forall e. Nullable e => e
Z) ((s -> s -> s) -> f s -> s)
-> (Compare o -> s -> s -> s) -> Compare o -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
differenceWith
    
    -- | Fold by 'unionWith'.
    unionsWith :: (Foldable f) => Compare o -> f s -> s
    unionsWith =  ((s -> s -> s) -> s -> f s -> s
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
`foldl` s
forall e. Nullable e => e
Z) ((s -> s -> s) -> f s -> s)
-> (Compare o -> s -> s -> s) -> Compare o -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith
    
    -- | Fold by 'symdiffWith'.
    symdiffsWith :: (Foldable f) => Compare o -> f s -> s
    symdiffsWith =  ((s -> s -> s) -> s -> f s -> s
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
`foldl` s
forall e. Nullable e => e
Z) ((s -> s -> s) -> f s -> s)
-> (Compare o -> s -> s -> s) -> Compare o -> f s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
symdiffWith
    
    {- Сomparsion operations. -}
    
    -- | Compares sets on intersection.
    isIntersectsWith :: Compare o -> s -> s -> Bool
    isIntersectsWith Compare o
f = Bool -> Bool
not (Bool -> Bool) -> (s -> s -> Bool) -> s -> s -> Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Compare o -> s -> s -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isDisjointWith Compare o
f
    
    -- | Compares sets on disjoint.
    isDisjointWith :: Compare o -> s -> s -> Bool
    isDisjointWith Compare o
f = s -> Bool
forall e. Nullable e => e -> Bool
isNull (s -> Bool) -> (s -> s -> s) -> s -> s -> Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
intersectionWith Compare o
f
    
    -- | Same as 'elem', but can work faster. By default, uses 'find'.
    default memberWith :: (t o ~~ s, Foldable t) => Compare o -> o -> s -> Bool
    memberWith :: Compare o -> o -> s -> Bool
    memberWith Compare o
f o
e = Maybe o -> Bool
forall a. Maybe a -> Bool
isJust (Maybe o -> Bool) -> (t o -> Maybe o) -> t o -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (o -> Bool) -> t o -> Maybe o
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\ o
x -> Compare o
f o
e o
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ)
    
    -- | Сhecks whether a first set is a subset of second.
    default isSubsetWith :: (t o ~~ s, Foldable t) => Compare o -> s -> s -> Bool
    isSubsetWith :: Compare o -> s -> s -> Bool
    isSubsetWith Compare o
f s
xs s
ys = (o -> Bool) -> t o -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ o
x -> Compare o -> o -> s -> Bool
forall s o. SetWith s o => Compare o -> o -> s -> Bool
memberWith Compare o
f o
x s
ys) s
t o
xs
    
    -- | Generates a list of different subsets (including empty and equivalent).
    default subsets :: (Linear s o, Ord o) => s -> [s]
    subsets :: (Ord o) => s -> [s]
    subsets =  s -> [s]
forall l e. Linear l e => l -> [l]
subsequences (s -> [s]) -> (s -> s) -> s -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> s -> s
forall s o. SetWith s o => Compare o -> s -> s
setWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    {- Lookups. -}
    
    -- | 'lookupLTWith' trying to find lesser element in set.
    lookupLTWith :: Compare o -> o -> s -> Maybe o
    
    -- | 'lookupGTWith' trying to find greater element in set.
    lookupGTWith :: Compare o -> o -> s -> Maybe o
    
    -- | 'lookupGEWith' trying to find greater or equal element in set.
    lookupGEWith :: Compare o -> o -> s -> Maybe o
    lookupGEWith Compare o
f o
e s
es = Compare o -> o -> s -> Bool
forall s o. SetWith s o => Compare o -> o -> s -> Bool
memberWith Compare o
f o
e s
es Bool -> Maybe o -> Maybe o -> Maybe o
forall a. Bool -> a -> a -> a
? o -> Maybe o
forall a. a -> Maybe a
Just o
e (Maybe o -> Maybe o) -> Maybe o -> Maybe o
forall a b. (a -> b) -> a -> b
$ Compare o -> o -> s -> Maybe o
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupGTWith Compare o
f o
e s
es
    
    -- | 'lookupLEWith' trying to find lesser or equal element in set.
    lookupLEWith :: Compare o -> o -> s -> Maybe o
    lookupLEWith Compare o
f o
e s
es = Compare o -> o -> s -> Bool
forall s o. SetWith s o => Compare o -> o -> s -> Bool
memberWith Compare o
f o
e s
es Bool -> Maybe o -> Maybe o -> Maybe o
forall a. Bool -> a -> a -> a
? o -> Maybe o
forall a. a -> Maybe a
Just o
e (Maybe o -> Maybe o) -> Maybe o -> Maybe o
forall a b. (a -> b) -> a -> b
$ Compare o -> o -> s -> Maybe o
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupLTWith Compare o
f o
e s
es

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

{- |
  'Set' is a class of data structures, that can represent any sets. 'Set' is
  intended for more specific sets than ordered linear structures. In particular,
  it may not work with an arbitrary comparator, and also (unlike the early
  implementation) does not impose restrictions on the element type.
  
  'Set', as well as 'SetWith', doesn't provide data protection/validation.
-}
class (Nullable s) => Set s o | s -> o
  where
    -- | The same as @'setWith' 'compare'@.
    default set :: (SetWith s o, Ord o) => s -> s
    set :: s -> s
    set =  Compare o -> s -> s
forall s o. SetWith s o => Compare o -> s -> s
setWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'insert' 'compare'@.
    default insert :: (SetWith s o, Ord o) => o -> s -> s
    insert :: o -> s -> s
    insert =  Compare o -> o -> s -> s
forall s o. SetWith s o => Compare o -> o -> s -> s
insertWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'deleteWith' 'compare'@.
    default delete :: (SetWith s o, Ord o) => o -> s -> s
    delete :: o -> s -> s
    delete =  Compare o -> o -> s -> s
forall s o. SetWith s o => Compare o -> o -> s -> s
deleteWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'intersectionWith' 'compare'@.
    default (/\) :: (SetWith s o, Ord o) => s -> s -> s
    (/\) :: s -> s -> s
    (/\) =  Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
intersectionWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'unionWith' 'compare'@.
    default (\/) :: (SetWith s o, Ord o) => s -> s -> s
    (\/) :: s -> s -> s
    (\/) =  Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'differenceWith' 'compare'@.
    default (\\) :: (SetWith s o, Ord o) => s -> s -> s
    (\\) :: s -> s -> s
    (\\) =  Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
differenceWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'symdiffWith' 'compare'@.
    default (\^/) :: (SetWith s o, Ord o) => s -> s -> s
    (\^/) :: s -> s -> s
    (\^/) =  Compare o -> s -> s -> s
forall s o. SetWith s o => Compare o -> s -> s -> s
symdiffWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'isDisjointWith' 'compare'@.
    default (/?\) :: (SetWith s o, Ord o) => s -> s -> Bool
    (/?\) :: s -> s -> Bool
    (/?\) =  Compare o -> s -> s -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isDisjointWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'isIntersectsWith' 'compare'@.
    default (\?/) :: (SetWith s o, Ord o) => s -> s -> Bool
    (\?/) :: s -> s -> Bool
    (\?/) =  Compare o -> s -> s -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isIntersectsWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'isSubsetWith' 'compare'@.
    default (\+/) :: (SetWith s o, Ord o) => s -> s -> Bool
    (\+/) :: s -> s -> Bool
    (\+/) =  Compare o -> s -> s -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isSubsetWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'intersectionsWith' 'compare'@.
    default intersections :: (Foldable f, SetWith s o, Ord o) => f s -> s
    intersections :: (Foldable f) => f s -> s
    intersections =  Compare o -> f s -> s
forall s o (f :: * -> *).
(SetWith s o, Foldable f) =>
Compare o -> f s -> s
intersectionsWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'unionsWith' 'compare'@.
    default unions :: (Foldable f, SetWith s o, Ord o) => f s -> s
    unions :: (Foldable f) => f s -> s
    unions =  Compare o -> f s -> s
forall s o (f :: * -> *).
(SetWith s o, Foldable f) =>
Compare o -> f s -> s
unionsWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'differencesWith' 'compare'@.
    default differences :: (Foldable f, SetWith s o, Ord o) => f s -> s
    differences :: (Foldable f) => f s -> s
    differences =  Compare o -> f s -> s
forall s o (f :: * -> *).
(SetWith s o, Foldable f) =>
Compare o -> f s -> s
differencesWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'symdiffsWith' compare'@.
    default symdiffs :: (Foldable f, SetWith s o, Ord o) => f s -> s
    symdiffs :: (Foldable f) => f s -> s
    symdiffs =  Compare o -> f s -> s
forall s o (f :: * -> *).
(SetWith s o, Foldable f) =>
Compare o -> f s -> s
symdiffsWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'memberWith' 'compare'@.
    default member :: (SetWith s o, Ord o) => o -> s -> Bool
    member :: o -> s -> Bool
    member =  Compare o -> o -> s -> Bool
forall s o. SetWith s o => Compare o -> o -> s -> Bool
memberWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'lookupLTWith' 'compare'@.
    default lookupLT :: (SetWith s o, Ord o) => o -> s -> Maybe o
    lookupLT :: (Ord o) => o -> s -> Maybe o
    lookupLT =  Compare o -> o -> s -> Maybe o
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupLTWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'lookupGTWith' 'compare'@.
    default lookupGT :: (SetWith s o, Ord o) => o -> s -> Maybe o
    lookupGT :: (Ord o) => o -> s -> Maybe o
    lookupGT =  Compare o -> o -> s -> Maybe o
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupGTWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'lookupLEWith' 'compare'@.
    default lookupLE :: (SetWith s o, Ord o) => o -> s -> Maybe o
    lookupLE :: (Ord o) => o -> s -> Maybe o
    lookupLE =  Compare o -> o -> s -> Maybe o
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupLEWith Compare o
forall a. Ord a => a -> a -> Ordering
compare
    
    -- | Same as @'lookupGEWith' 'compare'@.
    default lookupGE :: (SetWith s o, Ord o) => o -> s -> Maybe o
    lookupGE :: (Ord o) => o -> s -> Maybe o
    lookupGE =  Compare o -> o -> s -> Maybe o
forall s o. SetWith s o => Compare o -> o -> s -> Maybe o
lookupGEWith Compare o
forall a. Ord a => a -> a -> Ordering
compare

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

-- | Kind @(* -> *)@ 'Set'.
type Set1 s o = Set (s o) o

-- | Kind @(* -> *)@ 'SetWith'.
type SetWith1 s o = SetWith (s o) o

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

instance (Ord o) => Set [o] o

instance SetWith [o] o
  where
    setWith :: Compare o -> [o] -> [o]
setWith Compare o
f = Compare o -> [o] -> [o]
forall s e. Sort s e => Compare e -> s -> s
sortBy Compare o
f ([o] -> [o]) -> ([o] -> [o]) -> [o] -> [o]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Equal o -> [o] -> [o]
forall l e. Linear l e => Equal e -> l -> l
nubBy ((Ordering
EQ Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==) (Ordering -> Bool) -> Compare o -> Equal o
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Compare o
f)
    
    insertWith :: Compare o -> o -> [o] -> [o]
insertWith Compare o
f o
e es :: [o]
es@(o
x : [o]
xs) = case o
e Compare o
`f` o
x of {Ordering
GT -> o
x o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> o -> [o] -> [o]
forall s o. SetWith s o => Compare o -> o -> s -> s
insertWith Compare o
f o
e [o]
xs; Ordering
LT -> o
e o -> [o] -> [o]
forall a. a -> [a] -> [a]
: [o]
es; Ordering
EQ -> [o]
es}
    insertWith Compare o
_ o
e [o]
_ = [o
e]
    
    deleteWith :: Compare o -> o -> [o] -> [o]
deleteWith Compare o
f o
e es :: [o]
es@(o
x : [o]
xs) = case o
e Compare o
`f` o
x of {Ordering
GT -> o
x o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> o -> [o] -> [o]
forall s o. SetWith s o => Compare o -> o -> s -> s
deleteWith Compare o
f o
e [o]
xs; Ordering
LT -> [o]
es; Ordering
EQ -> [o]
xs}
    deleteWith Compare o
_ o
_ [o]
_ = []
    
    memberWith :: Compare o -> o -> [o] -> Bool
memberWith Compare o
f o
e (o
x : [o]
xs) = case o
e Compare o
`f` o
x of {Ordering
GT -> Compare o -> o -> [o] -> Bool
forall s o. SetWith s o => Compare o -> o -> s -> Bool
memberWith Compare o
f o
e [o]
xs; Ordering
LT -> Bool
False; Ordering
EQ -> Bool
True}
    memberWith Compare o
_ o
_ [o]
_ = Bool
False
    
    intersectionWith :: Compare o -> [o] -> [o] -> [o]
intersectionWith Compare o
f xs' :: [o]
xs'@(o
x : [o]
xs) ys' :: [o]
ys'@(o
y : [o]
ys) = case o
x Compare o
`f` o
y of
      Ordering
LT -> Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
intersectionWith Compare o
f [o]
xs  [o]
ys'
      Ordering
GT -> Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
intersectionWith Compare o
f [o]
xs' [o]
ys
      Ordering
EQ -> o
x o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
intersectionWith Compare o
f [o]
xs [o]
ys
    intersectionWith Compare o
_ [o]
_ [o]
_ = []
    
    unionWith :: Compare o -> [o] -> [o] -> [o]
unionWith Compare o
f xs' :: [o]
xs'@(o
x : [o]
xs) ys' :: [o]
ys'@(o
y : [o]
ys) = case o
x Compare o
`f` o
y of
      Ordering
LT -> o
x o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith Compare o
f [o]
xs  [o]
ys'
      Ordering
EQ -> o
x o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith Compare o
f [o]
xs  [o]
ys
      Ordering
GT -> o
y o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
unionWith Compare o
f [o]
xs' [o]
ys
    unionWith Compare o
_ [o]
xs [o]
ys = [o]
xs [o] -> [o] -> [o]
forall l e. Linear l e => l -> l -> l
++ [o]
ys
    
    differenceWith :: Compare o -> [o] -> [o] -> [o]
differenceWith Compare o
f xs' :: [o]
xs'@(o
x : [o]
xs) ys' :: [o]
ys'@(o
y : [o]
ys) = case Compare o
f o
x o
y of
      Ordering
LT -> o
x o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
differenceWith Compare o
f [o]
xs [o]
ys'
      Ordering
EQ -> Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
differenceWith Compare o
f [o]
xs  [o]
ys
      Ordering
GT -> Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
differenceWith Compare o
f [o]
xs' [o]
ys
    differenceWith Compare o
_ [o]
xs [o]
_ = [o]
xs
    
    symdiffWith :: Compare o -> [o] -> [o] -> [o]
symdiffWith Compare o
f xs' :: [o]
xs'@(o
x : [o]
xs) ys' :: [o]
ys'@(o
y : [o]
ys) = case Compare o
f o
x o
y of
      Ordering
EQ -> Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
symdiffWith Compare o
f [o]
xs [o]
ys
      Ordering
LT -> o
x o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
symdiffWith Compare o
f [o]
xs  [o]
ys'
      Ordering
GT -> o
y o -> [o] -> [o]
forall a. a -> [a] -> [a]
: Compare o -> [o] -> [o] -> [o]
forall s o. SetWith s o => Compare o -> s -> s -> s
symdiffWith Compare o
f [o]
xs' [o]
ys
    symdiffWith Compare o
_ [o]
xs [o]
ys = [o]
xs [o] -> [o] -> [o]
forall l e. Linear l e => l -> l -> l
++ [o]
ys
    
    isIntersectsWith :: Compare o -> [o] -> [o] -> Bool
isIntersectsWith Compare o
f xs' :: [o]
xs'@(o
x : [o]
xs) ys' :: [o]
ys'@(o
y : [o]
ys) = case Compare o
f o
x o
y of
      Ordering
LT -> Compare o -> [o] -> [o] -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isIntersectsWith Compare o
f [o]
xs  [o]
ys'
      Ordering
GT -> Compare o -> [o] -> [o] -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isIntersectsWith Compare o
f [o]
xs' [o]
ys
      Ordering
EQ -> Bool
True
    isIntersectsWith Compare o
_ [o]
_ [o]
_ = Bool
False
    
    isDisjointWith :: Compare o -> [o] -> [o] -> Bool
isDisjointWith Compare o
f xs' :: [o]
xs'@(o
x : [o]
xs) ys' :: [o]
ys'@(o
y : [o]
ys) = case Compare o
f o
x o
y of
      Ordering
LT -> Compare o -> [o] -> [o] -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isDisjointWith Compare o
f [o]
xs  [o]
ys'
      Ordering
GT -> Compare o -> [o] -> [o] -> Bool
forall s o. SetWith s o => Compare o -> s -> s -> Bool
isDisjointWith Compare o
f [o]
xs' [o]
ys
      Ordering
EQ -> Bool
False
    isDisjointWith Compare o
_ [o]
_ [o]
_ = Bool
True
    
    lookupLTWith :: Compare o -> o -> [o] -> Maybe o
lookupLTWith Compare o
f o
o (o
x : [o]
xs) = case o
o Compare o
`f` o
x of {Ordering
GT -> o -> [o] -> Maybe o
look o
x [o]
xs; Ordering
_ -> Maybe o
forall a. Maybe a
Nothing}
      where
        look :: o -> [o] -> Maybe o
look o
r (o
e : [o]
es) = case o
o Compare o
`f` o
e of {Ordering
GT -> o -> [o] -> Maybe o
look o
e [o]
es; Ordering
_ -> o -> Maybe o
forall a. a -> Maybe a
Just o
r}
        look o
r [o]
_ = o -> Maybe o
forall a. a -> Maybe a
Just o
r
    lookupLTWith Compare o
_ o
_ [o]
_ = Maybe o
forall a. Maybe a
Nothing
    
    lookupGTWith :: Compare o -> o -> [o] -> Maybe o
lookupGTWith Compare o
f o
o (o
x : [o]
xs) = case o
o Compare o
`f` o
x of {Ordering
LT -> o -> Maybe o
forall a. a -> Maybe a
Just o
x; Ordering
_ -> [o] -> Maybe o
look [o]
xs}
      where
        look :: [o] -> Maybe o
look (o
e : [o]
es) = case o
o Compare o
`f` o
e of {Ordering
LT -> o -> Maybe o
forall a. a -> Maybe a
Just o
e; Ordering
_ -> [o] -> Maybe o
look [o]
es}
        look [o]
_ = Maybe o
forall a. Maybe a
Nothing
    lookupGTWith Compare o
_ o
_ [o]
_ = Maybe o
forall a. Maybe a
Nothing
    
    lookupLEWith :: Compare o -> o -> [o] -> Maybe o
lookupLEWith Compare o
f o
o (o
x : [o]
xs) = case o
o Compare o
`f` o
x of {Ordering
LT -> Maybe o
forall a. Maybe a
Nothing; Ordering
_ -> o -> [o] -> Maybe o
look o
x [o]
xs}
      where
        look :: o -> [o] -> Maybe o
look o
r (o
e : [o]
es) = case o
o Compare o
`f` o
e of {Ordering
LT -> o -> Maybe o
forall a. a -> Maybe a
Just o
r; Ordering
_ -> o -> [o] -> Maybe o
look o
e [o]
es}
        look o
r [o]
_ = o -> Maybe o
forall a. a -> Maybe a
Just o
r
    lookupLEWith Compare o
_ o
_ [o]
_ = Maybe o
forall a. Maybe a
Nothing
    
    lookupGEWith :: Compare o -> o -> [o] -> Maybe o
lookupGEWith Compare o
f o
o (o
x : [o]
xs) = case o
o Compare o
`f` o
x of {Ordering
GT -> [o] -> Maybe o
look [o]
xs; Ordering
_ -> o -> Maybe o
forall a. a -> Maybe a
Just o
x}
      where
        look :: [o] -> Maybe o
look (o
e : [o]
es) = case o
o Compare o
`f` o
e of {Ordering
GT -> [o] -> Maybe o
look [o]
es; Ordering
_ -> o -> Maybe o
forall a. a -> Maybe a
Just o
e}
        look [o]
_ = Maybe o
forall a. Maybe a
Nothing
    lookupGEWith Compare o
_ o
_ [o]
_ = Maybe o
forall a. Maybe a
Nothing
    
    groupSetWith :: Compare o -> (o -> o -> o) -> [o] -> [o]
groupSetWith Compare o
cmp o -> o -> o
f = ([o] -> o) -> [[o]] -> [o]
forall a b. (a -> b) -> [a] -> [b]
map ((o -> o -> o) -> [o] -> o
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 o -> o -> o
f) ([[o]] -> [o]) -> ([o] -> [[o]]) -> [o] -> [o]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Equal o -> [o] -> [[o]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) (Ordering -> Bool) -> Compare o -> Equal o
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... Compare o
cmp) ([o] -> [[o]]) -> ([o] -> [o]) -> [o] -> [[o]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compare o -> [o] -> [o]
forall s e. Sort s e => Compare e -> s -> s
sortBy Compare o
cmp