{-# LANGUAGE CPP, DeriveDataTypeable #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.HashSet.Internal
(
HashSet
, empty
, singleton
, null
, size
, member
, insert
, delete
, isSubsetOf
, map
, union
, unions
, difference
, intersection
, foldr
, foldr'
, foldl
, foldl'
, filter
, toList
, fromList
, toMap
, fromMap
, keysSet
) where
import Control.DeepSeq (NFData(..))
import Data.Data hiding (Typeable)
import Data.Functor.Classes
import Data.HashMap.Internal
( HashMap, foldMapWithKey, foldlWithKey, foldrWithKey
, equalKeys, equalKeys1)
import Data.Hashable (Hashable(hashWithSalt))
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import GHC.Exts (build)
import qualified GHC.Exts as Exts
import Prelude hiding (filter, foldr, foldl, map, null)
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Internal as H
import qualified Data.List as List
import Data.Typeable (Typeable)
import Text.Read
#if MIN_VERSION_hashable(1,2,5)
import qualified Data.Hashable.Lifted as H
#endif
#if MIN_VERSION_deepseq(1,4,3)
import qualified Control.DeepSeq as NF
#endif
newtype HashSet a = HashSet {
HashSet a -> HashMap a ()
asMap :: HashMap a ()
} deriving (Typeable)
type role HashSet nominal
instance (NFData a) => NFData (HashSet a) where
rnf :: HashSet a -> ()
rnf = HashMap a () -> ()
forall a. NFData a => a -> ()
rnf (HashMap a () -> ())
-> (HashSet a -> HashMap a ()) -> HashSet a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
{-# INLINE rnf #-}
#if MIN_VERSION_deepseq(1,4,3)
instance NF.NFData1 HashSet where
liftRnf :: (a -> ()) -> HashSet a -> ()
liftRnf a -> ()
rnf1 = (a -> ()) -> (() -> ()) -> HashMap a () -> ()
forall (p :: * -> * -> *) a b.
NFData2 p =>
(a -> ()) -> (b -> ()) -> p a b -> ()
NF.liftRnf2 a -> ()
rnf1 () -> ()
forall a. NFData a => a -> ()
rnf (HashMap a () -> ())
-> (HashSet a -> HashMap a ()) -> HashSet a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
#endif
instance (Eq a) => Eq (HashSet a) where
HashSet HashMap a ()
a == :: HashSet a -> HashSet a -> Bool
== HashSet HashMap a ()
b = HashMap a () -> HashMap a () -> Bool
forall k v v'. Eq k => HashMap k v -> HashMap k v' -> Bool
equalKeys HashMap a ()
a HashMap a ()
b
{-# INLINE (==) #-}
instance Eq1 HashSet where
liftEq :: (a -> b -> Bool) -> HashSet a -> HashSet b -> Bool
liftEq a -> b -> Bool
eq (HashSet HashMap a ()
a) (HashSet HashMap b ()
b) = (a -> b -> Bool) -> HashMap a () -> HashMap b () -> Bool
forall k k' v v'.
(k -> k' -> Bool) -> HashMap k v -> HashMap k' v' -> Bool
equalKeys1 a -> b -> Bool
eq HashMap a ()
a HashMap b ()
b
instance (Ord a) => Ord (HashSet a) where
compare :: HashSet a -> HashSet a -> Ordering
compare (HashSet HashMap a ()
a) (HashSet HashMap a ()
b) = HashMap a () -> HashMap a () -> Ordering
forall a. Ord a => a -> a -> Ordering
compare HashMap a ()
a HashMap a ()
b
{-# INLINE compare #-}
instance Ord1 HashSet where
liftCompare :: (a -> b -> Ordering) -> HashSet a -> HashSet b -> Ordering
liftCompare a -> b -> Ordering
c (HashSet HashMap a ()
a) (HashSet HashMap b ()
b) = (a -> b -> Ordering)
-> (() -> () -> Ordering)
-> HashMap a ()
-> HashMap b ()
-> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
c () -> () -> Ordering
forall a. Ord a => a -> a -> Ordering
compare HashMap a ()
a HashMap b ()
b
instance Foldable.Foldable HashSet where
foldMap :: (a -> m) -> HashSet a -> m
foldMap a -> m
f = (a -> () -> m) -> HashMap a () -> m
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
foldMapWithKey (\a
a ()
_ -> a -> m
f a
a) (HashMap a () -> m)
-> (HashSet a -> HashMap a ()) -> HashSet a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
foldr :: (a -> b -> b) -> b -> HashSet a -> b
foldr = (a -> b -> b) -> b -> HashSet a -> b
forall a b. (a -> b -> b) -> b -> HashSet a -> b
foldr
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> HashSet a -> b
foldl = (b -> a -> b) -> b -> HashSet a -> b
forall b a. (b -> a -> b) -> b -> HashSet a -> b
foldl
{-# INLINE foldl #-}
foldl' :: (b -> a -> b) -> b -> HashSet a -> b
foldl' = (b -> a -> b) -> b -> HashSet a -> b
forall b a. (b -> a -> b) -> b -> HashSet a -> b
foldl'
{-# INLINE foldl' #-}
foldr' :: (a -> b -> b) -> b -> HashSet a -> b
foldr' = (a -> b -> b) -> b -> HashSet a -> b
forall a b. (a -> b -> b) -> b -> HashSet a -> b
foldr'
{-# INLINE foldr' #-}
toList :: HashSet a -> [a]
toList = HashSet a -> [a]
forall a. HashSet a -> [a]
toList
{-# INLINE toList #-}
null :: HashSet a -> Bool
null = HashSet a -> Bool
forall a. HashSet a -> Bool
null
{-# INLINE null #-}
length :: HashSet a -> Int
length = HashSet a -> Int
forall a. HashSet a -> Int
size
{-# INLINE length #-}
instance (Hashable a, Eq a) => Semigroup (HashSet a) where
<> :: HashSet a -> HashSet a -> HashSet a
(<>) = HashSet a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
union
{-# INLINE (<>) #-}
instance (Hashable a, Eq a) => Monoid (HashSet a) where
mempty :: HashSet a
mempty = HashSet a
forall a. HashSet a
empty
{-# INLINE mempty #-}
mappend :: HashSet a -> HashSet a -> HashSet a
mappend = HashSet a -> HashSet a -> HashSet a
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
instance (Eq a, Hashable a, Read a) => Read (HashSet a) where
readPrec :: ReadPrec (HashSet a)
readPrec = ReadPrec (HashSet a) -> ReadPrec (HashSet a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (HashSet a) -> ReadPrec (HashSet a))
-> ReadPrec (HashSet a) -> ReadPrec (HashSet a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (HashSet a) -> ReadPrec (HashSet a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (HashSet a) -> ReadPrec (HashSet a))
-> ReadPrec (HashSet a) -> ReadPrec (HashSet a)
forall a b. (a -> b) -> a -> b
$ do
Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
[a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
HashSet a -> ReadPrec (HashSet a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList [a]
xs)
readListPrec :: ReadPrec [HashSet a]
readListPrec = ReadPrec [HashSet a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
instance Show1 HashSet where
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> HashSet a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d HashSet a
m =
(Int -> [a] -> ShowS) -> [Char] -> Int -> [a] -> ShowS
forall a. (Int -> a -> ShowS) -> [Char] -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) [Char]
"fromList" Int
d (HashSet a -> [a]
forall a. HashSet a -> [a]
toList HashSet a
m)
instance (Show a) => Show (HashSet a) where
showsPrec :: Int -> HashSet a -> ShowS
showsPrec Int
d HashSet 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
$
[Char] -> ShowS
showString [Char]
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (HashSet a -> [a]
forall a. HashSet a -> [a]
toList HashSet a
m)
instance (Data a, Eq a, Hashable a) => Data (HashSet a) where
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HashSet a -> c (HashSet a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z HashSet a
m = ([a] -> HashSet a) -> c ([a] -> HashSet a)
forall g. g -> c g
z [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList c ([a] -> HashSet a) -> [a] -> c (HashSet a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` HashSet a -> [a]
forall a. HashSet a -> [a]
toList HashSet a
m
toConstr :: HashSet a -> Constr
toConstr HashSet a
_ = Constr
fromListConstr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (HashSet a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> c ([a] -> HashSet a) -> c (HashSet a)
forall b r. Data b => c (b -> r) -> c r
k (([a] -> HashSet a) -> c ([a] -> HashSet a)
forall r. r -> c r
z [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList)
Int
_ -> [Char] -> c (HashSet a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
dataTypeOf :: HashSet a -> DataType
dataTypeOf HashSet a
_ = DataType
hashSetDataType
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (HashSet a))
dataCast1 forall d. Data d => c (t d)
f = c (t a) -> Maybe (c (HashSet 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
#if MIN_VERSION_hashable(1,2,6)
instance H.Hashable1 HashSet where
liftHashWithSalt :: (Int -> a -> Int) -> Int -> HashSet a -> Int
liftHashWithSalt Int -> a -> Int
h Int
s = (Int -> a -> Int)
-> (Int -> () -> Int) -> Int -> HashMap a () -> Int
forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
H.liftHashWithSalt2 Int -> a -> Int
h Int -> () -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (HashMap a () -> Int)
-> (HashSet a -> HashMap a ()) -> HashSet a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
#endif
instance (Hashable a) => Hashable (HashSet a) where
hashWithSalt :: Int -> HashSet a -> Int
hashWithSalt Int
salt = Int -> HashMap a () -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (HashMap a () -> Int)
-> (HashSet a -> HashMap a ()) -> HashSet a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
hashSetDataType [Char]
"fromList" [] Fixity
Prefix
hashSetDataType :: DataType
hashSetDataType :: DataType
hashSetDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.HashSet.Internal.HashSet" [Constr
fromListConstr]
empty :: HashSet a
empty :: HashSet a
empty = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet HashMap a ()
forall k v. HashMap k v
H.empty
singleton :: Hashable a => a -> HashSet a
singleton :: a -> HashSet a
singleton a
a = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (a -> () -> HashMap a ()
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton a
a ())
{-# INLINABLE singleton #-}
toMap :: HashSet a -> HashMap a ()
toMap :: HashSet a -> HashMap a ()
toMap = HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
fromMap :: HashMap a () -> HashSet a
fromMap :: HashMap a () -> HashSet a
fromMap = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet
keysSet :: HashMap k a -> HashSet k
keysSet :: HashMap k a -> HashSet k
keysSet HashMap k a
m = HashMap k () -> HashSet k
forall a. HashMap a () -> HashSet a
fromMap (() () -> HashMap k a -> HashMap k ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ HashMap k a
m)
isSubsetOf :: (Eq a, Hashable a) => HashSet a -> HashSet a -> Bool
isSubsetOf :: HashSet a -> HashSet a -> Bool
isSubsetOf HashSet a
s1 HashSet a
s2 = (() -> () -> Bool) -> HashMap a () -> HashMap a () -> Bool
forall k v1 v2.
(Eq k, Hashable k) =>
(v1 -> v2 -> Bool) -> HashMap k v1 -> HashMap k v2 -> Bool
H.isSubmapOfBy (\()
_ ()
_ -> Bool
True) (HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap HashSet a
s1) (HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap HashSet a
s2)
union :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
union :: HashSet a -> HashSet a -> HashSet a
union HashSet a
s1 HashSet a
s2 = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (HashMap a () -> HashSet a) -> HashMap a () -> HashSet a
forall a b. (a -> b) -> a -> b
$ HashMap a () -> HashMap a () -> HashMap a ()
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
H.union (HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap HashSet a
s1) (HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap HashSet a
s2)
{-# INLINE union #-}
unions :: (Eq a, Hashable a) => [HashSet a] -> HashSet a
unions :: [HashSet a] -> HashSet a
unions = (HashSet a -> HashSet a -> HashSet a)
-> HashSet a -> [HashSet a] -> HashSet a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' HashSet a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
union HashSet a
forall a. HashSet a
empty
{-# INLINE unions #-}
null :: HashSet a -> Bool
null :: HashSet a -> Bool
null = HashMap a () -> Bool
forall k v. HashMap k v -> Bool
H.null (HashMap a () -> Bool)
-> (HashSet a -> HashMap a ()) -> HashSet a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
{-# INLINE null #-}
size :: HashSet a -> Int
size :: HashSet a -> Int
size = HashMap a () -> Int
forall k v. HashMap k v -> Int
H.size (HashMap a () -> Int)
-> (HashSet a -> HashMap a ()) -> HashSet a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
{-# INLINE size #-}
member :: (Eq a, Hashable a) => a -> HashSet a -> Bool
member :: a -> HashSet a -> Bool
member a
a HashSet a
s = case a -> HashMap a () -> Maybe ()
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup a
a (HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap HashSet a
s) of
Just ()
_ -> Bool
True
Maybe ()
_ -> Bool
False
{-# INLINABLE member #-}
insert :: (Eq a, Hashable a) => a -> HashSet a -> HashSet a
insert :: a -> HashSet a -> HashSet a
insert a
a = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (HashMap a () -> HashSet a)
-> (HashSet a -> HashMap a ()) -> HashSet a -> HashSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> () -> HashMap a () -> HashMap a ()
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert a
a () (HashMap a () -> HashMap a ())
-> (HashSet a -> HashMap a ()) -> HashSet a -> HashMap a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
{-# INLINABLE insert #-}
delete :: (Eq a, Hashable a) => a -> HashSet a -> HashSet a
delete :: a -> HashSet a -> HashSet a
delete a
a = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (HashMap a () -> HashSet a)
-> (HashSet a -> HashMap a ()) -> HashSet a -> HashSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HashMap a () -> HashMap a ()
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete a
a (HashMap a () -> HashMap a ())
-> (HashSet a -> HashMap a ()) -> HashSet a -> HashMap a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
{-# INLINABLE delete #-}
map :: (Hashable b, Eq b) => (a -> b) -> HashSet a -> HashSet b
map :: (a -> b) -> HashSet a -> HashSet b
map a -> b
f = [b] -> HashSet b
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList ([b] -> HashSet b) -> (HashSet a -> [b]) -> HashSet a -> HashSet b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> b
f ([a] -> [b]) -> (HashSet a -> [a]) -> HashSet a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> [a]
forall a. HashSet a -> [a]
toList
{-# INLINE map #-}
difference :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
difference :: HashSet a -> HashSet a -> HashSet a
difference (HashSet HashMap a ()
a) (HashSet HashMap a ()
b) = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (HashMap a () -> HashMap a () -> HashMap a ()
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
H.difference HashMap a ()
a HashMap a ()
b)
{-# INLINABLE difference #-}
intersection :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
intersection :: HashSet a -> HashSet a -> HashSet a
intersection (HashSet HashMap a ()
a) (HashSet HashMap a ()
b) = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (HashMap a () -> HashMap a () -> HashMap a ()
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
H.intersection HashMap a ()
a HashMap a ()
b)
{-# INLINABLE intersection #-}
foldl' :: (a -> b -> a) -> a -> HashSet b -> a
foldl' :: (a -> b -> a) -> a -> HashSet b -> a
foldl' a -> b -> a
f a
z0 = (a -> b -> () -> a) -> a -> HashMap b () -> a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
H.foldlWithKey' a -> b -> () -> a
g a
z0 (HashMap b () -> a)
-> (HashSet b -> HashMap b ()) -> HashSet b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet b -> HashMap b ()
forall a. HashSet a -> HashMap a ()
asMap
where g :: a -> b -> () -> a
g a
z b
k ()
_ = a -> b -> a
f a
z b
k
{-# INLINE foldl' #-}
foldr' :: (b -> a -> a) -> a -> HashSet b -> a
foldr' :: (b -> a -> a) -> a -> HashSet b -> a
foldr' b -> a -> a
f a
z0 = (b -> () -> a -> a) -> a -> HashMap b () -> a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
H.foldrWithKey' b -> () -> a -> a
g a
z0 (HashMap b () -> a)
-> (HashSet b -> HashMap b ()) -> HashSet b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet b -> HashMap b ()
forall a. HashSet a -> HashMap a ()
asMap
where g :: b -> () -> a -> a
g b
k ()
_ a
z = b -> a -> a
f b
k a
z
{-# INLINE foldr' #-}
foldr :: (b -> a -> a) -> a -> HashSet b -> a
foldr :: (b -> a -> a) -> a -> HashSet b -> a
foldr b -> a -> a
f a
z0 = (b -> () -> a -> a) -> a -> HashMap b () -> a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey b -> () -> a -> a
g a
z0 (HashMap b () -> a)
-> (HashSet b -> HashMap b ()) -> HashSet b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet b -> HashMap b ()
forall a. HashSet a -> HashMap a ()
asMap
where g :: b -> () -> a -> a
g b
k ()
_ a
z = b -> a -> a
f b
k a
z
{-# INLINE foldr #-}
foldl :: (a -> b -> a) -> a -> HashSet b -> a
foldl :: (a -> b -> a) -> a -> HashSet b -> a
foldl a -> b -> a
f a
z0 = (a -> b -> () -> a) -> a -> HashMap b () -> a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
foldlWithKey a -> b -> () -> a
g a
z0 (HashMap b () -> a)
-> (HashSet b -> HashMap b ()) -> HashSet b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet b -> HashMap b ()
forall a. HashSet a -> HashMap a ()
asMap
where g :: a -> b -> () -> a
g a
z b
k ()
_ = a -> b -> a
f a
z b
k
{-# INLINE foldl #-}
filter :: (a -> Bool) -> HashSet a -> HashSet a
filter :: (a -> Bool) -> HashSet a -> HashSet a
filter a -> Bool
p = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (HashMap a () -> HashSet a)
-> (HashSet a -> HashMap a ()) -> HashSet a -> HashSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> () -> Bool) -> HashMap a () -> HashMap a ()
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
H.filterWithKey a -> () -> Bool
q (HashMap a () -> HashMap a ())
-> (HashSet a -> HashMap a ()) -> HashSet a -> HashMap a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap
where q :: a -> () -> Bool
q a
k ()
_ = a -> Bool
p a
k
{-# INLINE filter #-}
toList :: HashSet a -> [a]
toList :: HashSet a -> [a]
toList HashSet a
t = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\ a -> b -> b
c b
z -> (a -> () -> b -> b) -> b -> HashMap a () -> b
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (((b -> b) -> () -> b -> b
forall a b. a -> b -> a
const ((b -> b) -> () -> b -> b) -> (a -> b -> b) -> a -> () -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) a -> b -> b
c) b
z (HashSet a -> HashMap a ()
forall a. HashSet a -> HashMap a ()
asMap HashSet a
t))
{-# INLINE toList #-}
fromList :: (Eq a, Hashable a) => [a] -> HashSet a
fromList :: [a] -> HashSet a
fromList = HashMap a () -> HashSet a
forall a. HashMap a () -> HashSet a
HashSet (HashMap a () -> HashSet a)
-> ([a] -> HashMap a ()) -> [a] -> HashSet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap a () -> a -> HashMap a ())
-> HashMap a () -> [a] -> HashMap a ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\ HashMap a ()
m a
k -> a -> () -> HashMap a () -> HashMap a ()
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert a
k () HashMap a ()
m) HashMap a ()
forall k v. HashMap k v
H.empty
{-# INLINE fromList #-}
instance (Eq a, Hashable a) => Exts.IsList (HashSet a) where
type Item (HashSet a) = a
fromList :: [Item (HashSet a)] -> HashSet a
fromList = [Item (HashSet a)] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
fromList
toList :: HashSet a -> [Item (HashSet a)]
toList = HashSet a -> [Item (HashSet a)]
forall a. HashSet a -> [a]
toList