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