module Data.RedisBloom
(
module Data.RedisBloom.Internal,
Bloom(..),
createBF, createIfNewBF, addBF, queryBF
) where
#if !MIN_VERSION_base(4,8,0)
import Prelude hiding (mapM)
import Data.Traversable (Traversable(..))
import Data.Foldable (foldMap)
#endif
import Data.Monoid (All(..))
import Data.ByteString.Char8 (pack)
import Database.Redis
import Data.RedisBloom.Hash
import Data.RedisBloom.Internal
data Bloom a = Bloom {
key :: !Key,
capacity :: !Capacity,
hf :: HashFamily a
}
createBF :: (RedisCtx m (Either Reply)) => Bloom a -> m (Either Reply Status)
createBF bf = set (key bf) empty
where
empty = pack ""
createIfNewBF :: (RedisCtx m (Either Reply)) => Bloom a -> m (Either Reply Bool)
createIfNewBF bf = setnx (key bf) empty
where
empty = pack ""
addBF :: (RedisCtx m f) => Bloom a -> a -> m ()
addBF bf = mapM_ (flip (setbit (key bf)) one) . fmap (toInteger . (`mod` cap) . fromIntegral) . hf bf
where
(Capacity cap) = capacity bf
one = pack "1"
getBit :: (MonadRedis m, RedisCtx m (Either Reply)) => Bloom a -> Integer -> m Bool
getBit bf i = do
r <- getbit (key bf) i
let l = case r of
Left _ -> False
Right j -> j >= 1
return l
queryBF :: (MonadRedis m, RedisCtx m (Either Reply)) => Bloom a -> a -> m Bool
queryBF bf = query (capacity bf) (getBit bf) (hf bf)
query :: Monad m => Capacity -> (Integer -> m Bool) -> HashFamily a -> a -> m Bool
query (Capacity c) q hashf x = do
let hashes = fmap (toInteger . (`mod` c) . fromIntegral) . hashf $ x
lookupMany q hashes
lookupMany :: (Traversable t, Monad m) => (a -> m Bool) -> t a -> m Bool
lookupMany lookupBit hashes = do
bools <- mapM lookupBit hashes
return . getAll . foldMap All $ bools