module Data.Generics.Fixplate.Hash.Table
( HashTable
, getHashValue , unHashTable
, empty , singleton
, fromList , toList
, bag
, lookup , member
, insert , insertWith
)
where
import Prelude hiding ( lookup )
import Data.List ( foldl' )
import qualified Data.Map as Map ; import Data.Map (Map)
mapInsertWith :: Ord k => (a -> v) -> (a -> v -> v) -> k -> a -> Map k v -> Map k v
mapInsertWith f g k x = x `seq` Map.alter worker k where
worker Nothing = Just $! (f x)
worker (Just y) = y `seq` (Just $! (g x y))
mapIsSingleton :: Map k v -> Maybe (k,v)
mapIsSingleton table = if Map.size table == 1
then let [(k,v)] = Map.toList table in Just (k,v)
else Nothing
mapIsSingleton_ :: Map k v -> Maybe v
mapIsSingleton_ table = if Map.size table == 1
then let [(_,v)] = Map.toList table in Just v
else Nothing
data HashTable hash k v = HashTable
{ getHashValue :: k -> hash
, unHashTable :: Map hash (Map k v)
}
empty :: (Ord hash, Ord k) => (k -> hash) -> HashTable hash k v
empty gethash = HashTable gethash (Map.empty)
singleton :: (Ord hash, Ord k) => (k -> hash) -> k -> v -> HashTable hash k v
singleton gethash k v = HashTable gethash $ Map.singleton h (Map.singleton k v) where
h = gethash k
fromList :: (Ord hash, Ord k) => (k -> hash) -> [(k,v)] -> HashTable hash k v
fromList gethash = foldl' (\old (k,v) -> insert k v old) (empty gethash)
toList :: Ord k => HashTable hash k v -> [(k,v)]
toList (HashTable _ table) = concat [ Map.toList sub | sub <- Map.elems table ]
lookup :: (Ord hash, Ord k) => k -> HashTable hash k v -> Maybe v
lookup key (HashTable gethash table) =
case Map.lookup h table of
Just sub -> case mapIsSingleton_ sub of
Just v -> Just v
Nothing -> Map.lookup key sub
Nothing -> Nothing
where
h = gethash key
member :: (Ord hash, Ord k) => k -> HashTable hash k v -> Bool
member key table = case lookup key table of
Just _ -> True
Nothing -> False
insert :: (Ord hash, Ord k) => k -> v -> HashTable hash k v -> HashTable hash k v
insert k v (HashTable gethash table) = HashTable gethash $ mapInsertWith f g h v table where
h = gethash k
f v = Map.singleton k v
g v sub = Map.insert k v sub
insertWith :: (Ord hash, Ord k) => (a -> v) -> (a -> v -> v) -> k -> a -> HashTable hash k v -> HashTable hash k v
insertWith ff gg k x (HashTable gethash table) = HashTable gethash $ mapInsertWith f g h x table where
h = gethash k
f x = Map.singleton k (ff x)
g x sub = mapInsertWith ff gg k x sub
bag :: (Ord hash, Ord k) => (k -> hash) -> [k] -> HashTable hash k Int
bag gethash = foldl' (\old k -> insertWith id (+) k 1 old) (empty gethash)