{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
module Data.RedisBloom.Hash.Families
(
Index,
Hash, HashFamily, HashFunction,
RawHash, RawHashFunction,
makeIndexedHash, makeHashFamily
)
where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Data.Bits (shiftR, finiteBitSize, (.&.))
import Data.Word (Word32, Word64)
import Data.Hashable (Hashable)
import Data.RedisBloom.Internal
type Hash = Word32
type Index = Int
type HashFamily a = (a -> [Hash])
type HashFunction a = (Index -> a -> Hash)
type RawHash = Word64
type RawHashFunction a = (a -> RawHash)
makeIndexedHash :: Hashable a => RawHashFunction a -> HashFunction a
makeIndexedHash hh i x = h1 + (h2 `shiftR` i)
where
bs = finiteBitSize (undefined :: Word32)
h = hh x :: Word64
mb = fromIntegral (maxBound :: Word32) - 1 :: Word64
h1 = fromIntegral $ h .&. mb :: Word32
h2 = fromIntegral $ (h `shiftR` bs) .&. mb :: Word32
makeHashFamily :: Hashable a => RawHashFunction a -> HashCount -> HashFamily a
makeHashFamily raw (HashCount n) x = uncurry ih <$> zip [1..n] xs
where
ih = makeIndexedHash raw
xs = replicate (fromIntegral n) x