module HashtablesPlus
(
Map,
Set,
HashRefSet,
Multimap,
Sized,
Algorithm,
Basic,
Cuckoo,
Linear,
Key,
Row,
UniqueKey,
MultiKey,
Value,
Collection(..),
toList,
Lookup(..),
TraverseMulti(..),
lookupMulti,
Elem(..),
Insert(..),
Delete(..),
Size(..),
Null(..),
)
where
import HashtablesPlus.Prelude hiding (traverse, elem, toList, null, insert, delete, lookup, foldM, forM_)
import qualified HashtablesPlus.HashRef as HR
import qualified Data.HashTable.IO as T
import qualified Data.HashTable.ST.Basic
import qualified Data.HashTable.ST.Cuckoo
import qualified Data.HashTable.ST.Linear
import qualified Data.HashTable.Class
type family Row c
type family UniqueKey c
type family MultiKey c
type family Value c
class Collection c where
new :: IO c
traverse :: c -> (Row c -> IO ()) -> IO ()
toList :: (Collection c) => c -> IO [Row c]
toList c = do
ref <- newIORef []
traverse c $ \r -> modifyIORef ref (r:)
readIORef ref
class Collection c => Lookup c where
lookup :: c -> UniqueKey c -> IO (Maybe (Value c))
class Collection c => TraverseMulti c where
traverseMulti :: c -> MultiKey c -> (Value c -> IO ()) -> IO ()
lookupMulti :: (TraverseMulti c) => c -> MultiKey c -> IO [Value c]
lookupMulti c k = do
ref <- newIORef []
traverseMulti c k $ \v -> modifyIORef ref (v:)
readIORef ref
class Collection c => Elem c where
elem :: c -> UniqueKey c -> IO Bool
default elem :: Lookup c => c -> UniqueKey c -> IO Bool
elem = ((fmap isJust) .) . lookup
class Collection c => Insert c where
insert :: c -> Row c -> IO Bool
insertFast :: c -> Row c -> IO ()
insertFast = (void .) . insert
class Collection c => Delete c where
delete :: c -> UniqueKey c -> IO Bool
deleteFast :: c -> UniqueKey c -> IO ()
deleteFast = (void .) . delete
class Collection c => Size c where
size :: c -> IO Int
class Collection c => Null c where
null :: c -> IO Bool
default null :: (Size c) => c -> IO Bool
null = fmap (<= 0) . size
type Key k = (Hashable k, Eq k)
type Algorithm = Data.HashTable.Class.HashTable
type Basic = Data.HashTable.ST.Basic.HashTable
type Cuckoo = Data.HashTable.ST.Cuckoo.HashTable
type Linear = Data.HashTable.ST.Linear.HashTable
type Map a k v = a RealWorld k v
type instance Row (Map a k v) = (k, v)
type instance UniqueKey (Map a k v) = k
type instance Value (Map a k v) = v
instance (Algorithm a, Key k) => Collection (Map a k v) where
new = T.new
traverse = flip T.mapM_
instance (Algorithm a, Key k) => Lookup (Map a k v) where
lookup t = T.lookup t
instance (Algorithm a, Key k) => Elem (Map a k v)
instance (Algorithm a, Key k) => Insert (Map a k v) where
insert t (k, v) = do
T.lookup t k >>= \case
Just v' -> return False
Nothing -> T.insert t k v >> return True
insertFast t (k, v) = T.insert t k v
instance (Algorithm a, Key k) => Delete (Map a k v) where
delete t k = do
T.lookup t k >>= \case
Just v' -> return False
Nothing -> T.delete t k >> return True
deleteFast t k = T.delete t k
newtype Set a v = Set (T.IOHashTable a v ())
type instance Row (Set a v) = v
type instance UniqueKey (Set a v) = v
type instance Value (Set a v) = v
instance (Algorithm a, Key v) => Collection (Set a v) where
new = Set <$> T.new
traverse (Set table) f = traverse table $ f . fst
instance (Algorithm a, Key v) => Elem (Set a v) where
elem (Set table) a = T.lookup table a >>= return . isJust
instance (Algorithm a, Key v) => Insert (Set a v) where
insert (Set table) a = do
T.lookup table a >>= \case
Just _ -> return False
Nothing -> do
T.insert table a ()
return True
insertFast (Set table) a = T.insert table a ()
instance (Algorithm a, Key v) => Delete (Set a v) where
delete (Set table) a = do
T.lookup table a >>= \case
Just _ -> do
T.delete table a
return True
Nothing -> return False
deleteFast (Set table) a = T.delete table a
newtype HashRefSet a v = HashRefSet (T.IOHashTable a (StableName v) v)
type instance Row (HashRefSet a v) = HR.HashRef v
type instance UniqueKey (HashRefSet a v) = HR.HashRef v
type instance Value (HashRefSet a v) = HR.HashRef v
instance (Algorithm a) => Collection (HashRefSet a v) where
new = HashRefSet <$> T.new
traverse (HashRefSet table) f = traverse table $ f . \(sn, a) -> HR.HashRef sn a
instance (Algorithm a) => Elem (HashRefSet a v) where
elem (HashRefSet table) (HR.HashRef sn a) = T.lookup table sn >>= return . isJust
instance (Algorithm a) => Insert (HashRefSet a v) where
insert (HashRefSet table) (HR.HashRef sn a) = do
T.lookup table sn >>= \case
Just _ -> return False
Nothing -> do
T.insert table sn a
return True
insertFast (HashRefSet table) (HR.HashRef sn a) = T.insert table sn a
instance (Algorithm a) => Delete (HashRefSet a v) where
delete (HashRefSet table) (HR.HashRef sn a) = do
T.lookup table sn >>= \case
Just _ -> do
T.delete table sn
return True
Nothing -> return False
deleteFast (HashRefSet table) (HR.HashRef sn a) = T.delete table sn
newtype Multimap a k s = Multimap (T.IOHashTable a k s)
type instance Row (Multimap a k s) = (k, Row s)
type instance UniqueKey (Multimap a k s) = (k, UniqueKey s)
type instance MultiKey (Multimap a k s) = k
type instance Value (Multimap a k s) = Value s
instance (Algorithm a, Key k, Collection s) =>
Collection (Multimap a k s) where
new = Multimap <$> T.new
traverse (Multimap t) f =
traverse t $ \(k, set) -> traverse set $ \v -> f (k, v)
instance (Algorithm a, Key k, Collection s, Value s ~ Row s) =>
TraverseMulti (Multimap a k s) where
traverseMulti (Multimap t) k f =
T.lookup t k >>= maybe (return ()) (flip traverse f)
instance (Algorithm a, Key k, Elem s) =>
Elem (Multimap a k s) where
elem (Multimap t) (k, v) = do
T.lookup t k >>= \case
Nothing -> return False
Just s -> elem s v
instance (Algorithm a, Key k, Insert s) =>
Insert (Multimap a k s) where
insert (Multimap t) (k, v) = do
T.lookup t k >>= \case
Nothing -> do
s <- new
insertFast s v
T.insert t k s
return True
Just s -> do
insert s v
insertFast (Multimap t) (k, v) = do
T.lookup t k >>= \case
Nothing -> do
s <- new
insertFast s v
T.insert t k s
Just s -> do
insertFast s v
instance (Algorithm a, Key k, Delete s) => Delete (Multimap a k s) where
delete (Multimap t) (k, v) = do
T.lookup t k >>= \case
Nothing -> return False
Just s -> delete s v
deleteFast (Multimap t) (k, v) = do
T.lookup t k >>= \case
Nothing -> return ()
Just s -> deleteFast s v
instance (Algorithm a, Key k, Delete s) => Delete (Multimap a k (Sized s)) where
delete (Multimap t) (k, v) = do
T.lookup t k >>= \case
Nothing -> return False
Just s -> do
delete s v >>= \case
False -> return False
True -> do
null s >>= \case
False -> return ()
True -> T.delete t k
return True
deleteFast (Multimap t) (k, v) = do
T.lookup t k >>= \case
Nothing -> return ()
Just s -> do
deleteFast s v
null s >>= \case
False -> return ()
True -> T.delete t k
data Sized c = Sized !c !(IORef Int)
type instance Row (Sized c) = Row c
type instance UniqueKey (Sized c) = UniqueKey c
type instance MultiKey (Sized c) = MultiKey c
type instance Value (Sized c) = Value c
instance (Collection c) => Collection (Sized c) where
new = Sized <$> new <*> newIORef 0
traverse (Sized c _) = traverse c
instance (Lookup c) => Lookup (Sized c) where
lookup (Sized c _) a = lookup c a
instance (TraverseMulti c) => TraverseMulti (Sized c) where
traverseMulti (Sized c _) = traverseMulti c
instance (Elem c) => Elem (Sized c) where
elem (Sized c _) a = elem c a
instance (Insert c) => Insert (Sized c) where
insert (Sized c size) a = do
ok <- insert c a
when ok $ modifyIORef size succ
return ok
instance (Delete c) => Delete (Sized c) where
delete (Sized c size) a = do
ok <- delete c a
when ok $ modifyIORef size pred
return ok
instance (Collection c) => Size (Sized c) where
size (Sized _ s) = readIORef s
instance (Collection c) => Null (Sized c)