-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HashSet
-- Copyright   :  (c) Milan Straka 2011
-- License     :  BSD-style
-- Maintainer  :  fox@ucw.cz
-- Stability   :  provisional
-- Portability :  portable
--
-- Persistent 'Set' based on hashing, which is defined as
--
-- @
--   data 'Set' e = 'Data.IntMap.IntMap' (Some e)
-- @
--
-- is an 'Data.IntMap.IntMap' indexed by hash values of elements,
-- containing a value of @Some e@. That contains either one 'e'
-- or a @'Data.Set.Set' e@ with elements of the same hash values.
--
-- The interface of a 'Set' is a suitable subset of 'Data.IntSet.IntSet'
-- and can be used as a drop-in replacement of 'Data.Set.Set'.
--
-- The complexity of operations is determined by the complexities of
-- 'Data.IntMap.IntMap' and 'Data.Set.Set' operations. See the sources of
-- 'Set' to see which operations from @containers@ package are used.
-----------------------------------------------------------------------------

module Data.HashSet ( Set
                    , HashSet

                    -- * Operators
                    , (\\)

                    -- * Query
                    , null
                    , size
                    , member
                    , notMember
                    , isSubsetOf
                    , isProperSubsetOf

                    -- * Construction
                    , empty
                    , singleton
                    , insert
                    , delete

                    -- * Combine
                    , union
                    , unions
                    , difference
                    , intersection

                    -- * Filter
                    , filter
                    , partition

                    -- * Map
                    , map

                    -- * Fold
                    , fold

                    -- * Conversion
                    , 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


{--------------------------------------------------------------------
  Operators
--------------------------------------------------------------------}

-- | Same as 'difference'.
(\\) :: Ord a => Set a -> Set a -> Set a
s1 :: Set a
s1 \\ :: Set a -> Set a -> Set a
\\ s2 :: 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


{--------------------------------------------------------------------
  Types
--------------------------------------------------------------------}

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
$cp1Ord :: forall a. Ord a => Eq (Some a)
Ord)

instance NFData a => NFData (Some a) where
  rnf :: Some a -> ()
rnf (Only a :: a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a
  rnf (More s :: Set a
s) = Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
s

-- | The abstract type of a @Set@. Its interface is a suitable
-- subset of 'Data.IntSet.IntSet'.
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
$cp1Ord :: forall a. Ord a => Eq (Set a)
Ord)

-- | The @HashSet@ is a type synonym for @Set@ for backward compatibility.
-- It is deprecated and will be removed in furture releases.
{-# 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 s :: 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 :: 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 d :: Int
d m :: Set a
m   = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString "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 10 (ReadPrec (Set a) -> ReadPrec (Set a))
-> ReadPrec (Set a) -> ReadPrec (Set a)
forall a b. (a -> b) -> a -> b
$ do
    Ident "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__
{--------------------------------------------------------------------
  A Data instance
--------------------------------------------------------------------}

-- This instance preserves data abstraction at the cost of inefficiency.
-- We omit reflection services for the sake of data abstraction.

instance (Hashable a, Ord a, Data a) => Data (Set a) where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Set a -> c (Set a)
gfoldl f :: forall d b. Data d => c (d -> b) -> d -> c b
f z :: forall g. g -> c g
z m :: 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 _   = String -> Constr
forall a. HasCallStack => String -> a
error "toConstr"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Set a)
gunfold _ _  = String -> Constr -> c (Set a)
forall a. HasCallStack => String -> a
error "gunfold"
  dataTypeOf :: Set a -> DataType
dataTypeOf _ = String -> DataType
mkNoRepType "Data.HashSet.Set"
  dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Set a))
dataCast1 f :: 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

{--------------------------------------------------------------------
  Comparing elements
--------------------------------------------------------------------}

-- For ByteStrings, doing compare is usually faster than doing (==),
-- according to benchmarks. A Set is using compare naturally. We therefore
-- define eq :: Ord a => a -> a -> Bool, which serves as (==).

{-# INLINE eq #-}
eq :: Ord a => a -> a -> Bool
eq :: a -> a -> Bool
eq x :: a
x y :: 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

{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}
-- | Is the set empty?
null :: Set a -> Bool
null :: Set a -> Bool
null (Set s :: IntMap (Some a)
s) = IntMap (Some a) -> Bool
forall a. IntMap a -> Bool
I.null IntMap (Some a)
s

-- | Number of elements in the set.
size :: Set a -> Int
size :: Set a -> Int
size (Set s :: 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) 0 IntMap (Some a)
s
  where some_size :: Some a -> Int
some_size (Only _) = 1
        some_size (More t :: Set a
t) = Set a -> Int
forall a. Set a -> Int
S.size Set a
t

-- | Is the element a member of the set?
member :: (Hashable a, Ord a) => a -> Set a -> Bool
member :: a -> Set a -> Bool
member a :: a
a (Set s :: 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
    Nothing -> Bool
False
    Just (Only a' :: a
a') -> a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
a'
    Just (More s' :: Set a
s') -> a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member a
a Set a
s'

-- | Is the element not a member of the set?
notMember :: (Hashable a, Ord a) => a -> Set a -> Bool
notMember :: a -> Set a -> Bool
notMember k :: a
k s :: 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

-- | Is this a subset?
isSubsetOf :: Ord a => Set a -> Set a -> Bool
isSubsetOf :: Set a -> Set a -> Bool
isSubsetOf (Set s1 :: IntMap (Some a)
s1) (Set s2 :: 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
a) (Only b :: a
b) = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
`eq` a
b
        some_isSubsetOf (Only a :: a
a) (More s :: 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 _) (Only _) = Bool
False
        some_isSubsetOf (More s :: Set a
s) (More t :: 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

-- | Is this a proper subset? (ie. a subset but not equal).
isProperSubsetOf :: Ord a => Set a -> Set a -> Bool
isProperSubsetOf :: Set a -> Set a -> Bool
isProperSubsetOf s1 :: Set a
s1 s2 :: 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


{--------------------------------------------------------------------
  Construction
--------------------------------------------------------------------}
-- | The empty set.
empty :: Set a
empty :: 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

-- | A set of one element.
singleton :: Hashable a => a -> Set a
singleton :: a -> Set a
singleton a :: 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

-- | Add a value to the set. When the value is already an element of the set,
-- it is replaced by the new one, ie. 'insert' is left-biased.
insert :: (Hashable a, Ord a) => a -> Set a -> Set a
insert :: a -> Set a -> Set a
insert a :: a
a (Set s :: 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 _ v :: Some a
v@(Only b :: 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 _ (More t :: 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 :: Set a -> Maybe (Some a)
some_norm s :: Set a
s = case Set a -> Int
forall a. Set a -> Int
S.size Set a
s of 0 -> Maybe (Some a)
forall a. Maybe a
Nothing
                               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
                               _ -> 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' :: Set a -> Some a
some_norm' s :: Set a
s = case Set a -> Int
forall a. Set a -> Int
S.size Set a
s of 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
                                _ -> 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 a value in the set. Returns the original set when the value was not
-- present.
delete :: (Hashable a, Ord a) => a -> Set a -> Set a
delete :: a -> Set a -> Set a
delete a :: a
a (Set s :: 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 b :: 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 t :: 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


{--------------------------------------------------------------------
  Combine
--------------------------------------------------------------------}

-- | The union of two sets.
union :: Ord a => Set a -> Set a -> Set a
union :: Set a -> Set a -> Set a
union (Set s1 :: IntMap (Some a)
s1) (Set s2 :: 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
a) (Only b :: 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
a) (More s :: 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 s :: Set a
s) (Only a :: 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 s :: Set a
s) (More t :: 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

-- | The union of a list of sets.
unions :: Ord a => [Set a] -> Set a
unions :: [Set a] -> Set a
unions xs :: [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 between two sets.
difference :: Ord a => Set a -> Set a -> Set a
difference :: Set a -> Set a -> Set a
difference (Set s1 :: IntMap (Some a)
s1) (Set s2 :: 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
a) (Only b :: 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
a) (More s :: 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 s :: Set a
s) (Only a :: 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 s :: Set a
s) (More t :: 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

-- The I.intersectionWith does not have type general enough. We need the function
-- given to I.intersectionWith to have type a -> b -> Maybe c, so the elements could
-- be deleted from the IntMap. As it is only a -> b -> c, we allow empty sets to be
-- in the resulting intersection and delete them with a filter afterwards. This is
-- the function performing the deletions.
delete_empty :: I.IntMap (Some a) -> I.IntMap (Some a)
delete_empty :: 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 _) = Bool
True
        some_empty (More s :: 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

-- | The intersection of two sets.
intersection :: Ord a => Set a -> Set a -> Set a
intersection :: Set a -> Set a -> Set a
intersection (Set s1 :: IntMap (Some a)
s1) (Set s2 :: 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
a) (Only b :: 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
a) (More s :: 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 s :: Set a
s) (Only a :: 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 s :: Set a
s) (More t :: 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
--------------------------------------------------------------------}
-- | Filter all elements that satisfy some predicate.
filter :: Ord a => (a -> Bool) -> Set a -> Set a
filter :: (a -> Bool) -> Set a -> Set a
filter p :: a -> Bool
p (Set s :: 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) | 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 t :: 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 the set according to some predicate. The first set contains all
-- elements that satisfy the predicate, the second all elements that fail the
-- predicate.
partition :: Ord a => (a -> Bool) -> Set a -> (Set a, Set a)
partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition p :: a -> Bool
p s :: 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
--------------------------------------------------------------------}
-- | @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
--
-- It's worth noting that the size of the result may be smaller if, for some
-- @(x,y)@, @x /= y && f x == f y@
map :: (Hashable b, Ord b) => (a -> b) -> Set a -> Set b
map :: (a -> b) -> Set a -> Set b
map f :: 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
--------------------------------------------------------------------}
-- | Fold over the elements of a set in an unspecified order.
fold :: (a -> b -> b) -> b -> Set a -> b
fold :: (a -> b -> b) -> b -> Set a -> b
fold f :: a -> b -> b
f z :: b
z (Set s :: 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
a) x :: b
x = a -> b -> b
f a
a b
x
        some_fold (More t :: Set a
t) x :: 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 :: (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 :: (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


{--------------------------------------------------------------------
  Conversions
--------------------------------------------------------------------}
-- | The elements of a set. (For sets, this is equivalent to toList).
elems :: Set a -> [a]
elems :: Set a -> [a]
elems = Set a -> [a]
forall a. Set a -> [a]
toList

-- | Convert the set to a list of elements.
toList :: Set a -> [a]
toList :: Set a -> [a]
toList (Set s :: 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]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
        some_append (More t :: Set a
t) acc :: [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

-- | Create a set from a list of elements.
fromList :: (Hashable a, Ord a) => [a] -> Set a
fromList :: [a] -> Set a
fromList xs :: [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