module Data.Registry.HashTable where
import Control.Monad.IO.Class
import qualified Data.HashTable.IO as H
import Data.Foldable (foldlM)
import Data.Maybe (fromJust)
import Data.Registry.Class
import qualified Data.Text as T
import qualified Data.Vector.Mutable.PushBack as VMP
data HashTableImpl k v = HashTableImpl (H.BasicHashTable k Int) (VMP.IOVector v)
instance IRegistry (HashTableImpl T.Text) where
(!?) (HashTableImpl reg vec) k = liftIO $ do
i <- H.lookup reg k
maybe (return Nothing) (fmap Just . VMP.read vec) i
write (HashTableImpl ht vec) k v = liftIO $ do
i <- fmap fromJust $ liftIO $ H.lookup ht k
liftIO $ VMP.write vec i v
register (HashTableImpl ht vec) k v = liftIO $ do
len <- VMP.safeLength vec
VMP.push vec v
H.insert ht k len
delete (HashTableImpl ht vec) k = liftIO $ do
Just i <- H.lookup ht k
VMP.delete vec i
H.delete ht k
insert (HashTableImpl ht vec) i k v = liftIO $ do
VMP.insert vec i v
H.insert ht k i
asVec (HashTableImpl _ vec) = VMP.asUnsafeIOVector vec
fromListImpl :: MonadIO m => [(T.Text, v)] -> m (HashTableImpl T.Text v)
fromListImpl xs =
liftIO
$ HashTableImpl
<$> ( H.new >>= \h -> foldlM
(\acc (i, k) -> H.insert acc k i >> return acc)
h
(zip [0 ..] $ map fst xs)
)
<*> (VMP.fromList $ map snd xs)