Chained hash table implementation

ChainedHash.hs

module ChainedHash
  (
    createHash
  , with
  , without
  , withMany
  , withoutMany
  , at
  ) where


import Data.Array(Array(..), array, bounds, elems, (//), (!))
import Data.List(foldl')


type Chain k v = [(k, v)]


chainWith :: (Eq k) => Chain k v -> (k, v) -> Chain k v
chainWith cs p@(k, v) = if (null after) then p:cs else before ++ p:(tail after)
  where (before, after) = break ((== k) . fst) cs


chainWithout :: (Eq k) => Chain k v -> k -> Chain k v
chainWithout cs k = filter ((/= k) . fst) cs 


data ChainedHash k v = ChainedHash {
    hashFunc   :: (k -> Integer)
  , chainTable :: Array Integer (Chain k v) 
} 


instance (Show k, Show v) => Show (ChainedHash k v) where
    show = show . concat . elems . chainTable


type HashFuncForSize k = Integer -> k -> Integer
 
createHash :: HashFuncForSize k -> Integer -> ChainedHash k v
createHash hs sz = ChainedHash (hs sz) (array (1, sz) [(i, []) | i <- [1..sz]])


withSlot :: ChainedHash k v -> k -> (Chain k v -> Chain k v) -> ChainedHash k v

withSlot h k op
    | rows < hashed = h
    | otherwise     = ChainedHash hf (ht // [(hashed, op (ht!hashed))])
  where hf     = hashFunc h
        ht     = chainTable h
        rows   = snd (bounds ht) 
        hashed = hf k


with :: (Eq k) => ChainedHash k v -> (k, v) -> ChainedHash k v
with h p@(k, v) = withSlot h k (flip chainWith p)


without :: (Eq k) => ChainedHash k v -> k -> ChainedHash k v
without h k = withSlot h k (flip chainWithout k)


withMany :: (Eq k) => ChainedHash k v -> Chain k v -> ChainedHash k v
withMany src pairs = foldl' with src pairs


withoutMany :: (Eq k) => ChainedHash k v -> [k] -> ChainedHash k v
withoutMany src keys = foldl' without src keys


at :: (Eq k) => k -> ChainedHash k v -> Maybe v
at k h
    | rows < hashed = Nothing
    | otherwise     = k `lookup` (ht!hashed) 
  where hf     = hashFunc h
        ht     = chainTable h
        rows   = snd (bounds ht)
        hashed = hf k

HashFunc.hs

{-# LANGUAGE TypeSynonymInstances #-}

module HashFunc where

import Data.Char(ord)
import Data.List(foldl')


class HashTranform a where
    hashPrepare :: a -> Integer

instance HashTranform Integer where
    hashPrepare = id 

instance HashTranform String where
    hashPrepare cs = fromIntegral (foldl' (flip ((+) . ord)) 0 cs)


divHashForSize :: (HashTranform a) => Integer -> a -> Integer
divHashForSize sz k = 1 + (hashPrepare k) `mod` sz

Usage.hs

import ChainedHash (createHash, at, with, withMany, withoutMany)
import HashFunc (divHashForSize)

-- 0. Some basic empty templates
--
intHash = (createHash (divHashForSize :: (Integer -> Integer -> Integer)) 10)
strHash = (createHash (divHashForSize :: (Integer -> String  -> Integer)) 10)


-- 1. U2 80x discography
--
u2'80x = intHash `withMany` [(1980, "Boy"),
                             (1981, "October"),
                             (1983, "War"),
                             (1984, "The Unforgettable Fire"),
                             (1987, "The Joshua Tree")]


-- 2. A sample config
--
conf = strHash `withMany` [("x-axis",    1),
                           ("y-axis",    0),
                           ("longitude", 7),
                           ("tension",   2)]


-- 3. Drop some albums from the disco
--
u2'best = u2'80x `withoutMany` [1980, 1981]


-- 4. Update an entry in the config
--
conf1 = conf `with` ("tension", 1337)


-- 5. Add some albums to the disco
--
u2'best' = u2'best `with` (1993, "Zooropa")


-- 6. Merge some existing and new entries into the config
--
conf2 = conf1 `withMany` [("longitude", 100500),
                          ("pressure",  13)]