{-# LANGUAGE CPP, DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
#endif
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.HashSet
(
HashSet
, empty
, singleton
, union
, unions
, null
, size
, member
, insert
, delete
, map
, difference
, intersection
, foldl'
, foldr
, filter
, toList
, fromList
, toMap
, fromMap
) where
import Control.DeepSeq (NFData(..))
import Data.Data hiding (Typeable)
import Data.HashMap.Base (HashMap, foldrWithKey)
import Data.Hashable (Hashable(hashWithSalt))
#if __GLASGOW_HASKELL__ >= 711
import Data.Semigroup (Semigroup(..), Monoid(..))
#elif __GLASGOW_HASKELL__ < 709
import Data.Monoid (Monoid(..))
#endif
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)
import Text.Read
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as Exts
#endif
newtype HashSet a = HashSet {
asMap :: HashMap a ()
} deriving (Typeable)
#if __GLASGOW_HASKELL__ >= 708
type role HashSet nominal
#endif
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 #-}
#if __GLASGOW_HASKELL__ >= 711
instance (Hashable a, Eq a) => Semigroup (HashSet a) where
(<>) = union
{-# INLINE (<>) #-}
#endif
instance (Hashable a, Eq a) => Monoid (HashSet a) where
mempty = empty
{-# INLINE mempty #-}
#if __GLASGOW_HASKELL__ >= 711
mappend = (<>)
#else
mappend = union
#endif
{-# INLINE mappend #-}
instance (Eq a, Hashable a, Read a) => Read (HashSet a) where
readPrec = parens $ prec 10 $ do
Ident "fromList" <- lexP
xs <- readPrec
return (fromList xs)
readListPrec = readListPrecDefault
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
instance (Hashable a) => Hashable (HashSet a) where
hashWithSalt salt = hashWithSalt salt . asMap
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 ())
{-# INLINABLE singleton #-}
toMap :: HashSet a -> HashMap a ()
toMap = asMap
fromMap :: HashMap a () -> HashSet a
fromMap = HashSet
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
{-# INLINABLE member #-}
insert :: (Eq a, Hashable a) => a -> HashSet a -> HashSet a
insert a = HashSet . H.insert a () . asMap
{-# INLINABLE insert #-}
delete :: (Eq a, Hashable a) => a -> HashSet a -> HashSet a
delete a = HashSet . H.delete a . asMap
{-# INLINABLE delete #-}
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)
{-# INLINABLE difference #-}
intersection :: (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
intersection (HashSet a) (HashSet b) = HashSet (H.intersection a b)
{-# INLINABLE intersection #-}
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 #-}
#if __GLASGOW_HASKELL__ >= 708
instance (Eq a, Hashable a) => Exts.IsList (HashSet a) where
type Item (HashSet a) = a
fromList = fromList
toList = toList
#endif