module Data.HSet.Mutable ( HKey , HSet , new , insert , lookup , delete ) where import Data.HSet.Types import Prelude hiding (lookup, length) import Data.Maybe (fromMaybe) import Data.Typeable (typeOf, typeRepFingerprint) import GHC.Fingerprint import Data.Dynamic import Data.HashTable.ST.Basic (HashTable) import qualified Data.HashTable.ST.Basic as HT import Control.Monad.ST data HSet s = HSet { forall s. HSet s -> HashTable s HKey' Dynamic hSetValues :: {-# UNPACK #-} !(HashTable s HKey' Dynamic) , forall s. HSet s -> HashTable s Fingerprint Int hSetCount :: {-# UNPACK #-} !(HashTable s Fingerprint Int) } new :: ST s (HSet s) new :: forall s. ST s (HSet s) new = forall s. HashTable s HKey' Dynamic -> HashTable s Fingerprint Int -> HSet s HSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s k v. ST s (HashTable s k v) HT.new forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall s k v. ST s (HashTable s k v) HT.new insert :: Typeable a => a -> HSet s -> ST s (HKey a) insert :: forall a s. Typeable a => a -> HSet s -> ST s (HKey a) insert a x (HSet HashTable s HKey' Dynamic xs HashTable s Fingerprint Int count) = do let f :: Fingerprint f = TypeRep -> Fingerprint typeRepFingerprint forall a b. (a -> b) -> a -> b $ forall a. Typeable a => a -> TypeRep typeOf a x Int c <- forall a. a -> Maybe a -> a fromMaybe Int 0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall k s v. (Eq k, Hashable k) => HashTable s k v -> k -> ST s (Maybe v) HT.lookup HashTable s Fingerprint Int count Fingerprint f forall k s v. (Eq k, Hashable k) => HashTable s k v -> k -> v -> ST s () HT.insert HashTable s Fingerprint Int count Fingerprint f (Int cforall a. Num a => a -> a -> a +Int 1) let k :: HKey' k = Fingerprint -> Int -> HKey' HKey' Fingerprint f Int c forall k s v. (Eq k, Hashable k) => HashTable s k v -> k -> v -> ST s () HT.insert HashTable s HKey' Dynamic xs HKey' k (forall a. Typeable a => a -> Dynamic toDyn a x) forall (f :: * -> *) a. Applicative f => a -> f a pure (forall a. HKey' -> HKey a HKey HKey' k) lookup :: Typeable a => HKey a -> HSet s -> ST s (Maybe a) lookup :: forall a s. Typeable a => HKey a -> HSet s -> ST s (Maybe a) lookup (HKey HKey' k) (HSet HashTable s HKey' Dynamic xs HashTable s Fingerprint Int _) = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a. Typeable a => Dynamic -> Maybe a fromDynamic) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall k s v. (Eq k, Hashable k) => HashTable s k v -> k -> ST s (Maybe v) HT.lookup HashTable s HKey' Dynamic xs HKey' k delete :: HKey a -> HSet s -> ST s () delete :: forall a s. HKey a -> HSet s -> ST s () delete (HKey k :: HKey' k@(HKey' Fingerprint f Int _)) (HSet HashTable s HKey' Dynamic xs HashTable s Fingerprint Int count) = do forall k s v. (Hashable k, Eq k) => HashTable s k v -> k -> ST s () HT.delete HashTable s Fingerprint Int count Fingerprint f forall k s v. (Hashable k, Eq k) => HashTable s k v -> k -> ST s () HT.delete HashTable s HKey' Dynamic xs HKey' k