module Data.HashSet ( Set
, HashSet
, (\\)
, null
, size
, member
, notMember
, isSubsetOf
, isProperSubsetOf
, empty
, singleton
, insert
, delete
, union
, unions
, difference
, intersection
, filter
, partition
, map
, fold
, elems
, toList
, fromList
) where
import Prelude hiding (lookup,map,filter,null)
import Control.DeepSeq
import Data.Hashable
import Data.List (foldl')
import Data.Monoid (Monoid(..))
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
#endif
import Data.Typeable
#if __GLASGOW_HASKELL__
import Text.Read
import Data.Data (Data(..), mkNoRepType)
#endif
import qualified Data.IntMap as I
import qualified Data.Set as S
(\\) :: Ord a => Set a -> Set a -> Set a
Set a
s1 \\ :: forall a. Ord a => Set a -> Set a -> Set a
\\ Set a
s2 = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
difference Set a
s1 Set a
s2
data Some a = Only !a | More !(S.Set a) deriving (Some a -> Some a -> Bool
(Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool) -> Eq (Some a)
forall a. Eq a => Some a -> Some a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Some a -> Some a -> Bool
$c/= :: forall a. Eq a => Some a -> Some a -> Bool
== :: Some a -> Some a -> Bool
$c== :: forall a. Eq a => Some a -> Some a -> Bool
Eq, Eq (Some a)
Eq (Some a)
-> (Some a -> Some a -> Ordering)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Some a)
-> (Some a -> Some a -> Some a)
-> Ord (Some a)
Some a -> Some a -> Bool
Some a -> Some a -> Ordering
Some a -> Some a -> Some a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Some a)
forall a. Ord a => Some a -> Some a -> Bool
forall a. Ord a => Some a -> Some a -> Ordering
forall a. Ord a => Some a -> Some a -> Some a
min :: Some a -> Some a -> Some a
$cmin :: forall a. Ord a => Some a -> Some a -> Some a
max :: Some a -> Some a -> Some a
$cmax :: forall a. Ord a => Some a -> Some a -> Some a
>= :: Some a -> Some a -> Bool
$c>= :: forall a. Ord a => Some a -> Some a -> Bool
> :: Some a -> Some a -> Bool
$c> :: forall a. Ord a => Some a -> Some a -> Bool
<= :: Some a -> Some a -> Bool
$c<= :: forall a. Ord a => Some a -> Some a -> Bool
< :: Some a -> Some a -> Bool
$c< :: forall a. Ord a => Some a -> Some a -> Bool
compare :: Some a -> Some a -> Ordering
$ccompare :: forall a. Ord a => Some a -> Some a -> Ordering
Ord)
instance NFData a => NFData (Some a) where
rnf :: Some a -> ()
rnf (Only a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
rnf (More Set a
s) = Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
s
newtype Set a = Set (I.IntMap (Some a)) deriving (Set a -> Set a -> Bool
(Set a -> Set a -> Bool) -> (Set a -> Set a -> Bool) -> Eq (Set a)
forall a. Eq a => Set a -> Set a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Set a -> Set a -> Bool
$c/= :: forall a. Eq a => Set a -> Set a -> Bool
== :: Set a -> Set a -> Bool
$c== :: forall a. Eq a => Set a -> Set a -> Bool
Eq, Eq (Set a)
Eq (Set a)
-> (Set a -> Set a -> Ordering)
-> (Set a -> Set a -> Bool)
-> (Set a -> Set a -> Bool)
-> (Set a -> Set a -> Bool)
-> (Set a -> Set a -> Bool)
-> (Set a -> Set a -> Set a)
-> (Set a -> Set a -> Set a)
-> Ord (Set a)
Set a -> Set a -> Bool
Set a -> Set a -> Ordering
Set a -> Set a -> Set a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Set a)
forall a. Ord a => Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Ordering
forall a. Ord a => Set a -> Set a -> Set a
min :: Set a -> Set a -> Set a
$cmin :: forall a. Ord a => Set a -> Set a -> Set a
max :: Set a -> Set a -> Set a
$cmax :: forall a. Ord a => Set a -> Set a -> Set a
>= :: Set a -> Set a -> Bool
$c>= :: forall a. Ord a => Set a -> Set a -> Bool
> :: Set a -> Set a -> Bool
$c> :: forall a. Ord a => Set a -> Set a -> Bool
<= :: Set a -> Set a -> Bool
$c<= :: forall a. Ord a => Set a -> Set a -> Bool
< :: Set a -> Set a -> Bool
$c< :: forall a. Ord a => Set a -> Set a -> Bool
compare :: Set a -> Set a -> Ordering
$ccompare :: forall a. Ord a => Set a -> Set a -> Ordering
Ord)
{-# DEPRECATED HashSet "HashSet is deprecated. Please use Set instead." #-}
type HashSet a = Set a
instance NFData a => NFData (Set a) where
rnf :: Set a -> ()
rnf (Set IntMap (Some a)
s) = IntMap (Some a) -> ()
forall a. NFData a => a -> ()
rnf IntMap (Some a)
s
instance Ord a => Monoid (Set a) where
mempty :: Set a
mempty = Set a
forall a. Set a
empty
mconcat :: [Set a] -> Set a
mconcat = [Set a] -> Set a
forall a. Ord a => [Set a] -> Set a
unions
#if !(MIN_VERSION_base(4,9,0))
mappend = union
#else
mappend :: Set a -> Set a -> Set a
mappend = Set a -> Set a -> Set a
forall a. Semigroup a => a -> a -> a
(<>)
instance Ord a => Semigroup (Set a) where
<> :: Set a -> Set a -> Set a
(<>) = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
union
stimes :: forall b. Integral b => b -> Set a -> Set a
stimes = b -> Set a -> Set a
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
#endif
instance Show a => Show (Set a) where
showsPrec :: Int -> Set a -> ShowS
showsPrec Int
d Set a
m = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (Set a -> [a]
forall a. Set a -> [a]
toList Set a
m)
instance (Hashable a, Ord a, Read a) => Read (Set a) where
#ifdef __GLASGOW_HASKELL__
readPrec :: ReadPrec (Set a)
readPrec = ReadPrec (Set a) -> ReadPrec (Set a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Set a) -> ReadPrec (Set a))
-> ReadPrec (Set a) -> ReadPrec (Set a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (Set a) -> ReadPrec (Set a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (Set a) -> ReadPrec (Set a))
-> ReadPrec (Set a) -> ReadPrec (Set a)
forall a b. (a -> b) -> a -> b
$ do
Ident String
"fromList" <- ReadPrec Lexeme
lexP
[a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
Set a -> ReadPrec (Set a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> Set a
forall a. (Hashable a, Ord a) => [a] -> Set a
fromList [a]
xs)
readListPrec :: ReadPrec [Set a]
readListPrec = ReadPrec [Set a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
readsPrec p = readParen (p > 10) $ \ r -> do
("fromList",s) <- lex r
(xs,t) <- reads s
return (fromList xs,t)
#endif
#include "hashmap.h"
INSTANCE_TYPEABLE1(Set,setTc,"Set")
#if __GLASGOW_HASKELL__
instance (Hashable a, Ord a, Data a) => Data (Set a) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Set a -> c (Set a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z Set a
m = ([a] -> Set a) -> c ([a] -> Set a)
forall g. g -> c g
z [a] -> Set a
forall a. (Hashable a, Ord a) => [a] -> Set a
fromList c ([a] -> Set a) -> [a] -> c (Set a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` (Set a -> [a]
forall a. Set a -> [a]
toList Set a
m)
toConstr :: Set a -> Constr
toConstr Set a
_ = String -> Constr
forall a. HasCallStack => String -> a
error String
"toConstr"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Set a)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = String -> Constr -> c (Set a)
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: Set a -> DataType
dataTypeOf Set a
_ = String -> DataType
mkNoRepType String
"Data.HashSet.Set"
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Set a))
dataCast1 forall d. Data d => c (t d)
f = c (t a) -> Maybe (c (Set a))
forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
f
#endif
{-# INLINE eq #-}
eq :: Ord a => a -> a -> Bool
eq :: forall a. Ord a => a -> a -> Bool
eq a
x a
y = a
x a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
null :: Set a -> Bool
null :: forall a. Set a -> Bool
null (Set IntMap (Some a)
s) = IntMap (Some a) -> Bool
forall a. IntMap a -> Bool
I.null IntMap (Some a)
s
size :: Set a -> Int
size :: forall a. Set a -> Int
size (Set IntMap (Some a)
s) = (Some a -> Int -> Int) -> Int -> IntMap (Some a) -> Int
forall a b. (a -> b -> b) -> b -> IntMap a -> b
ifoldr (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> Int) -> (Some a -> Int) -> Some a -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some a -> Int
forall {a}. Some a -> Int
some_size) Int
0 IntMap (Some a)
s
where some_size :: Some a -> Int
some_size (Only a
_) = Int
1
some_size (More Set a
t) = Set a -> Int
forall a. Set a -> Int
S.size Set a
t
member :: (Hashable a, Ord a) => a -> Set a -> Bool
member :: forall a. (Hashable a, Ord a) => a -> Set a -> Bool
member a
a (Set IntMap (Some a)
s) =
case Int -> IntMap (Some a) -> Maybe (Some a)
forall a. Int -> IntMap a -> Maybe a
I.lookup (a -> Int
forall a. Hashable a => a -> Int
hash a
a) IntMap (Some a)
s of
Maybe (Some a)
Nothing -> Bool
False
Just (Only a
a') -> a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
a'
Just (More Set a
s') -> a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
a Set a
s'
notMember :: (Hashable a, Ord a) => a -> Set a -> Bool
notMember :: forall a. (Hashable a, Ord a) => a -> Set a -> Bool
notMember a
k Set a
s = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Bool
forall a. (Hashable a, Ord a) => a -> Set a -> Bool
member a
k Set a
s
isSubsetOf :: Ord a => Set a -> Set a -> Bool
isSubsetOf :: forall a. Ord a => Set a -> Set a -> Bool
isSubsetOf (Set IntMap (Some a)
s1) (Set IntMap (Some a)
s2) =
(Some a -> Some a -> Bool)
-> IntMap (Some a) -> IntMap (Some a) -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
I.isSubmapOfBy (Some a -> Some a -> Bool
forall a. Ord a => Some a -> Some a -> Bool
some_isSubsetOf) IntMap (Some a)
s1 IntMap (Some a)
s2
where some_isSubsetOf :: Some a -> Some a -> Bool
some_isSubsetOf (Only a
a) (Only a
b) = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
b
some_isSubsetOf (Only a
a) (More Set a
s) = a
a a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
s
some_isSubsetOf (More Set a
_) (Only a
_) = Bool
False
some_isSubsetOf (More Set a
s) (More Set a
t) = Set a
s Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` Set a
t
isProperSubsetOf :: Ord a => Set a -> Set a -> Bool
isProperSubsetOf :: forall a. Ord a => Set a -> Set a -> Bool
isProperSubsetOf Set a
s1 Set a
s2 = Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOf Set a
s1 Set a
s2 Bool -> Bool -> Bool
&& Set a -> Int
forall a. Set a -> Int
size Set a
s1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Set a -> Int
forall a. Set a -> Int
size Set a
s2
empty :: Set a
empty :: forall a. Set a
empty = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set IntMap (Some a)
forall a. IntMap a
I.empty
singleton :: Hashable a => a -> Set a
singleton :: forall a. Hashable a => a -> Set a
singleton a
a = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set (IntMap (Some a) -> Set a) -> IntMap (Some a) -> Set a
forall a b. (a -> b) -> a -> b
$
Int -> Some a -> IntMap (Some a)
forall a. Int -> a -> IntMap a
I.singleton (a -> Int
forall a. Hashable a => a -> Int
hash a
a) (Some a -> IntMap (Some a)) -> Some a -> IntMap (Some a)
forall a b. (a -> b) -> a -> b
$ a -> Some a
forall a. a -> Some a
Only a
a
insert :: (Hashable a, Ord a) => a -> Set a -> Set a
insert :: forall a. (Hashable a, Ord a) => a -> Set a -> Set a
insert a
a (Set IntMap (Some a)
s) = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set (IntMap (Some a) -> Set a) -> IntMap (Some a) -> Set a
forall a b. (a -> b) -> a -> b
$
(Some a -> Some a -> Some a)
-> Int -> Some a -> IntMap (Some a) -> IntMap (Some a)
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
I.insertWith Some a -> Some a -> Some a
forall {p}. p -> Some a -> Some a
some_insert (a -> Int
forall a. Hashable a => a -> Int
hash a
a) (a -> Some a
forall a. a -> Some a
Only a
a) IntMap (Some a)
s
where some_insert :: p -> Some a -> Some a
some_insert p
_ v :: Some a
v@(Only a
b) | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
b = Some a
v
| Bool
otherwise = Set a -> Some a
forall a. Set a -> Some a
More (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
a (a -> Set a
forall a. a -> Set a
S.singleton a
b)
some_insert p
_ (More Set a
t) = Set a -> Some a
forall a. Set a -> Some a
More (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
a Set a
t
some_norm :: S.Set a -> Maybe (Some a)
some_norm :: forall a. Set a -> Maybe (Some a)
some_norm Set a
s = case Set a -> Int
forall a. Set a -> Int
S.size Set a
s of Int
0 -> Maybe (Some a)
forall a. Maybe a
Nothing
Int
1 -> Some a -> Maybe (Some a)
forall a. a -> Maybe a
Just (Some a -> Maybe (Some a)) -> Some a -> Maybe (Some a)
forall a b. (a -> b) -> a -> b
$ a -> Some a
forall a. a -> Some a
Only (a -> Some a) -> a -> Some a
forall a b. (a -> b) -> a -> b
$ Set a -> a
forall a. Set a -> a
S.findMin Set a
s
Int
_ -> Some a -> Maybe (Some a)
forall a. a -> Maybe a
Just (Some a -> Maybe (Some a)) -> Some a -> Maybe (Some a)
forall a b. (a -> b) -> a -> b
$ Set a -> Some a
forall a. Set a -> Some a
More (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ Set a
s
some_norm' :: S.Set a -> Some a
some_norm' :: forall a. Set a -> Some a
some_norm' Set a
s = case Set a -> Int
forall a. Set a -> Int
S.size Set a
s of Int
1 -> a -> Some a
forall a. a -> Some a
Only (a -> Some a) -> a -> Some a
forall a b. (a -> b) -> a -> b
$ Set a -> a
forall a. Set a -> a
S.findMin Set a
s
Int
_ -> Set a -> Some a
forall a. Set a -> Some a
More (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ Set a
s
delete :: (Hashable a, Ord a) => a -> Set a -> Set a
delete :: forall a. (Hashable a, Ord a) => a -> Set a -> Set a
delete a
a (Set IntMap (Some a)
s) = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set (IntMap (Some a) -> Set a) -> IntMap (Some a) -> Set a
forall a b. (a -> b) -> a -> b
$
(Some a -> Maybe (Some a))
-> Int -> IntMap (Some a) -> IntMap (Some a)
forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a
I.update Some a -> Maybe (Some a)
some_delete (a -> Int
forall a. Hashable a => a -> Int
hash a
a) IntMap (Some a)
s
where some_delete :: Some a -> Maybe (Some a)
some_delete v :: Some a
v@(Only a
b) | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
b = Maybe (Some a)
forall a. Maybe a
Nothing
| Bool
otherwise = Some a -> Maybe (Some a)
forall a. a -> Maybe a
Just Some a
v
some_delete (More Set a
t) = Set a -> Maybe (Some a)
forall a. Set a -> Maybe (Some a)
some_norm (Set a -> Maybe (Some a)) -> Set a -> Maybe (Some a)
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
a Set a
t
union :: Ord a => Set a -> Set a -> Set a
union :: forall a. Ord a => Set a -> Set a -> Set a
union (Set IntMap (Some a)
s1) (Set IntMap (Some a)
s2) = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set (IntMap (Some a) -> Set a) -> IntMap (Some a) -> Set a
forall a b. (a -> b) -> a -> b
$ (Some a -> Some a -> Some a)
-> IntMap (Some a) -> IntMap (Some a) -> IntMap (Some a)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
I.unionWith Some a -> Some a -> Some a
forall a. Ord a => Some a -> Some a -> Some a
some_union IntMap (Some a)
s1 IntMap (Some a)
s2
where some_union :: Some a -> Some a -> Some a
some_union v :: Some a
v@(Only a
a) (Only a
b) | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
b = Some a
v
| Bool
otherwise = Set a -> Some a
forall a. Set a -> Some a
More (a -> Set a
forall a. a -> Set a
S.singleton a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` a -> Set a
forall a. a -> Set a
S.singleton a
b)
some_union (Only a
a) (More Set a
s) = Set a -> Some a
forall a. Set a -> Some a
More (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ a -> Set a
forall a. a -> Set a
S.singleton a
a Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set a
s
some_union (More Set a
s) (Only a
a) = Set a -> Some a
forall a. Set a -> Some a
More (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ Set a
s Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` a -> Set a
forall a. a -> Set a
S.singleton a
a
some_union (More Set a
s) (More Set a
t) = Set a -> Some a
forall a. Set a -> Some a
More (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ Set a
s Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set a
t
unions :: Ord a => [Set a] -> Set a
unions :: forall a. Ord a => [Set a] -> Set a
unions [Set a]
xs = (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
union Set a
forall a. Set a
empty [Set a]
xs
difference :: Ord a => Set a -> Set a -> Set a
difference :: forall a. Ord a => Set a -> Set a -> Set a
difference (Set IntMap (Some a)
s1) (Set IntMap (Some a)
s2) = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set (IntMap (Some a) -> Set a) -> IntMap (Some a) -> Set a
forall a b. (a -> b) -> a -> b
$
(Some a -> Some a -> Maybe (Some a))
-> IntMap (Some a) -> IntMap (Some a) -> IntMap (Some a)
forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
I.differenceWith Some a -> Some a -> Maybe (Some a)
forall {a}. Ord a => Some a -> Some a -> Maybe (Some a)
some_diff IntMap (Some a)
s1 IntMap (Some a)
s2
where some_diff :: Some a -> Some a -> Maybe (Some a)
some_diff v :: Some a
v@(Only a
a) (Only a
b) | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
b = Maybe (Some a)
forall a. Maybe a
Nothing
| Bool
otherwise = Some a -> Maybe (Some a)
forall a. a -> Maybe a
Just Some a
v
some_diff v :: Some a
v@(Only a
a) (More Set a
s) | a
a a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
s = Maybe (Some a)
forall a. Maybe a
Nothing
| Bool
otherwise = Some a -> Maybe (Some a)
forall a. a -> Maybe a
Just Some a
v
some_diff (More Set a
s) (Only a
a) = Set a -> Maybe (Some a)
forall a. Set a -> Maybe (Some a)
some_norm (Set a -> Maybe (Some a)) -> Set a -> Maybe (Some a)
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
a Set a
s
some_diff (More Set a
s) (More Set a
t) = Set a -> Maybe (Some a)
forall a. Set a -> Maybe (Some a)
some_norm (Set a -> Maybe (Some a)) -> Set a -> Maybe (Some a)
forall a b. (a -> b) -> a -> b
$ Set a
s Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set a
t
delete_empty :: I.IntMap (Some a) -> I.IntMap (Some a)
delete_empty :: forall a. IntMap (Some a) -> IntMap (Some a)
delete_empty = (Some a -> Bool) -> IntMap (Some a) -> IntMap (Some a)
forall a. (a -> Bool) -> IntMap a -> IntMap a
I.filter Some a -> Bool
forall {a}. Some a -> Bool
some_empty
where some_empty :: Some a -> Bool
some_empty (Only a
_) = Bool
True
some_empty (More Set a
s) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set a -> Bool
forall a. Set a -> Bool
S.null Set a
s
intersection :: Ord a => Set a -> Set a -> Set a
intersection :: forall a. Ord a => Set a -> Set a -> Set a
intersection (Set IntMap (Some a)
s1) (Set IntMap (Some a)
s2) = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set (IntMap (Some a) -> Set a) -> IntMap (Some a) -> Set a
forall a b. (a -> b) -> a -> b
$ IntMap (Some a) -> IntMap (Some a)
forall a. IntMap (Some a) -> IntMap (Some a)
delete_empty (IntMap (Some a) -> IntMap (Some a))
-> IntMap (Some a) -> IntMap (Some a)
forall a b. (a -> b) -> a -> b
$
(Some a -> Some a -> Some a)
-> IntMap (Some a) -> IntMap (Some a) -> IntMap (Some a)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
I.intersectionWith Some a -> Some a -> Some a
forall a. Ord a => Some a -> Some a -> Some a
some_intersection IntMap (Some a)
s1 IntMap (Some a)
s2
where some_intersection :: Some a -> Some a -> Some a
some_intersection v :: Some a
v@(Only a
a) (Only a
b) | a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
b = Some a
v
| Bool
otherwise = Set a -> Some a
forall a. Set a -> Some a
More (Set a
forall a. Set a
S.empty)
some_intersection v :: Some a
v@(Only a
a) (More Set a
s) | a
a a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
s = Some a
v
| Bool
otherwise = Set a -> Some a
forall a. Set a -> Some a
More (Set a
forall a. Set a
S.empty)
some_intersection (More Set a
s) (Only a
a) | a
a a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
s = a -> Some a
forall a. a -> Some a
Only (Set a -> a
forall a. Set a -> a
S.findMin (Set a -> a) -> Set a -> a
forall a b. (a -> b) -> a -> b
$ Set a
s Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` (a -> Set a
forall a. a -> Set a
S.singleton a
a))
| Bool
otherwise = Set a -> Some a
forall a. Set a -> Some a
More (Set a
forall a. Set a
S.empty)
some_intersection (More Set a
s) (More Set a
t) = Set a -> Some a
forall a. Set a -> Some a
some_norm' (Set a -> Some a) -> Set a -> Some a
forall a b. (a -> b) -> a -> b
$ Set a
s Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`S.intersection` Set a
t
filter :: Ord a => (a -> Bool) -> Set a -> Set a
filter :: forall a. Ord a => (a -> Bool) -> Set a -> Set a
filter a -> Bool
p (Set IntMap (Some a)
s) = IntMap (Some a) -> Set a
forall a. IntMap (Some a) -> Set a
Set (IntMap (Some a) -> Set a) -> IntMap (Some a) -> Set a
forall a b. (a -> b) -> a -> b
$
(Some a -> Maybe (Some a)) -> IntMap (Some a) -> IntMap (Some a)
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
I.mapMaybe Some a -> Maybe (Some a)
some_filter IntMap (Some a)
s
where some_filter :: Some a -> Maybe (Some a)
some_filter v :: Some a
v@(Only a
a) | a -> Bool
p a
a = Some a -> Maybe (Some a)
forall a. a -> Maybe a
Just Some a
v
| Bool
otherwise = Maybe (Some a)
forall a. Maybe a
Nothing
some_filter (More Set a
t) = Set a -> Maybe (Some a)
forall a. Set a -> Maybe (Some a)
some_norm ((a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
S.filter a -> Bool
p Set a
t)
partition :: Ord a => (a -> Bool) -> Set a -> (Set a, Set a)
partition :: forall a. Ord a => (a -> Bool) -> Set a -> (Set a, Set a)
partition a -> Bool
p Set a
s = ((a -> Bool) -> Set a -> Set a
forall a. Ord a => (a -> Bool) -> Set a -> Set a
filter a -> Bool
p Set a
s, (a -> Bool) -> Set a -> Set a
forall a. Ord a => (a -> Bool) -> Set a -> Set a
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) Set a
s)
map :: (Hashable b, Ord b) => (a -> b) -> Set a -> Set b
map :: forall b a. (Hashable b, Ord b) => (a -> b) -> Set a -> Set b
map a -> b
f = [b] -> Set b
forall a. (Hashable a, Ord a) => [a] -> Set a
fromList ([b] -> Set b) -> (Set a -> [b]) -> Set a -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [b] -> [b]) -> [b] -> Set a -> [b]
forall a b. (a -> b -> b) -> b -> Set a -> b
fold ((:) (b -> [b] -> [b]) -> (a -> b) -> a -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) []
fold :: (a -> b -> b) -> b -> Set a -> b
fold :: forall a b. (a -> b -> b) -> b -> Set a -> b
fold a -> b -> b
f b
z (Set IntMap (Some a)
s) = (Some a -> b -> b) -> b -> IntMap (Some a) -> b
forall a b. (a -> b -> b) -> b -> IntMap a -> b
ifoldr Some a -> b -> b
some_fold b
z IntMap (Some a)
s
where some_fold :: Some a -> b -> b
some_fold (Only a
a) b
x = a -> b -> b
f a
a b
x
some_fold (More Set a
t) b
x = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
sfoldr a -> b -> b
f b
x Set a
t
ifoldr :: (a -> b -> b) -> b -> I.IntMap a -> b
sfoldr :: (a -> b -> b) -> b -> S.Set a -> b
#if MIN_VERSION_containers(0,5,0)
ifoldr :: forall a b. (a -> b -> b) -> b -> IntMap a -> b
ifoldr = (a -> b -> b) -> b -> IntMap a -> b
forall a b. (a -> b -> b) -> b -> IntMap a -> b
I.foldr
sfoldr :: forall a b. (a -> b -> b) -> b -> Set a -> b
sfoldr = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr
#else
ifoldr = I.fold
sfoldr = S.fold
#endif
elems :: Set a -> [a]
elems :: forall a. Set a -> [a]
elems = Set a -> [a]
forall a. Set a -> [a]
toList
toList :: Set a -> [a]
toList :: forall a. Set a -> [a]
toList (Set IntMap (Some a)
s) = (Some a -> [a] -> [a]) -> [a] -> IntMap (Some a) -> [a]
forall a b. (a -> b -> b) -> b -> IntMap a -> b
ifoldr Some a -> [a] -> [a]
forall {a}. Some a -> [a] -> [a]
some_append [] IntMap (Some a)
s
where some_append :: Some a -> [a] -> [a]
some_append (Only a
a) [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
some_append (More Set a
t) [a]
acc = Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
t [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc
fromList :: (Hashable a, Ord a) => [a] -> Set a
fromList :: forall a. (Hashable a, Ord a) => [a] -> Set a
fromList [a]
xs = (Set a -> a -> Set a) -> Set a -> [a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> Set a -> Set a) -> Set a -> a -> Set a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Set a -> Set a
forall a. (Hashable a, Ord a) => a -> Set a -> Set a
insert) Set a
forall a. Set a
empty [a]
xs