{-# LANGUAGE CPP, DeriveDataTypeable #-}
module Data.HashSet
(
HashSet
, empty
, singleton
, union
, unions
, null
, size
, member
, insert
, delete
, map
, difference
, intersection
, foldl'
, foldr
, filter
, toList
, fromList
) where
import Control.DeepSeq (NFData(..))
import Data.Data hiding (Typeable)
import Data.HashMap.Base (HashMap, foldrWithKey)
import Data.Hashable (Hashable)
import Data.Monoid (Monoid(..))
import GHC.Exts (build)
import Prelude hiding (filter, foldr, map, null)
import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Lazy as H
import qualified Data.List as List
import Data.Typeable (Typeable)
newtype HashSet a = HashSet {
asMap :: HashMap a ()
} deriving (Typeable)
instance (NFData a) => NFData (HashSet a) where
rnf = rnf . asMap
{-# INLINE rnf #-}
instance (Hashable a, Eq a) => Eq (HashSet a) where
a == b = foldr f True b && size a == size b
where f i = (&& i `member` a)
{-# INLINE (==) #-}
instance Foldable.Foldable HashSet where
foldr = Data.HashSet.foldr
{-# INLINE foldr #-}
instance (Hashable a, Eq a) => Monoid (HashSet a) where
mempty = empty
{-# INLINE mempty #-}
mappend = union
{-# INLINE mappend #-}
instance (Show a) => Show (HashSet a) where
showsPrec d m = showParen (d > 10) $
showString "fromList " . shows (toList m)
instance (Data a, Eq a, Hashable a) => Data (HashSet a) where
gfoldl f z m = z fromList `f` toList m
toConstr _ = fromListConstr
gunfold k z c = case constrIndex c of
1 -> k (z fromList)
_ -> error "gunfold"
dataTypeOf _ = hashSetDataType
dataCast1 f = gcast1 f
fromListConstr :: Constr
fromListConstr = mkConstr hashSetDataType "fromList" [] Prefix
hashSetDataType :: DataType
hashSetDataType = mkDataType "Data.HashSet" [fromListConstr]
empty :: HashSet a
empty = HashSet H.empty
singleton :: Hashable a => a -> HashSet a
singleton a = HashSet (H.singleton a ())
union :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
union s1 s2 = HashSet $ H.union (asMap s1) (asMap s2)
{-# INLINE union #-}
unions :: (Eq a, Hashable a) => [HashSet a] -> HashSet a
unions = List.foldl' union empty
{-# INLINE unions #-}
null :: HashSet a -> Bool
null = H.null . asMap
{-# INLINE null #-}
size :: HashSet a -> Int
size = H.size . asMap
{-# INLINE size #-}
member :: (Eq a, Hashable a) => a -> HashSet a -> Bool
member a s = case H.lookup a (asMap s) of
Just _ -> True
_ -> False
insert :: (Eq a, Hashable a) => a -> HashSet a -> HashSet a
insert a = HashSet . H.insert a () . asMap
delete :: (Eq a, Hashable a) => a -> HashSet a -> HashSet a
delete a = HashSet . H.delete a . asMap
map :: (Hashable b, Eq b) => (a -> b) -> HashSet a -> HashSet b
map f = fromList . List.map f . toList
{-# INLINE map #-}
difference :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
difference (HashSet a) (HashSet b) = HashSet (H.difference a b)
intersection :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
intersection (HashSet a) (HashSet b) = HashSet (H.intersection a b)
foldl' :: (a -> b -> a) -> a -> HashSet b -> a
foldl' f z0 = H.foldlWithKey' g z0 . asMap
where g z k _ = f z k
{-# INLINE foldl' #-}
foldr :: (b -> a -> a) -> a -> HashSet b -> a
foldr f z0 = foldrWithKey g z0 . asMap
where g k _ z = f k z
{-# INLINE foldr #-}
filter :: (a -> Bool) -> HashSet a -> HashSet a
filter p = HashSet . H.filterWithKey q . asMap
where q k _ = p k
{-# INLINE filter #-}
toList :: HashSet a -> [a]
toList t = build (\ c z -> foldrWithKey ((const .) c) z (asMap t))
{-# INLINE toList #-}
fromList :: (Eq a, Hashable a) => [a] -> HashSet a
fromList = HashSet . List.foldl' (\ m k -> H.insert k () m) H.empty
{-# INLINE fromList #-}