module Data.CuckooFilter
(
Size,
makeSize,
Filter,
MFilter,
initialize,
insert,
member,
delete
) where
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
import Data.CuckooFilter.Internal
import Data.CuckooFilter.Pure
import Data.CuckooFilter.Mutable
insert :: (Hashable a, Monad m, CuckooFilter filt m) =>
filt a
-> a
-> m (Maybe (filt a))
insert cfilt val = do
numBuckets <- bucketCount cfilt
let idxA = primaryIndex val numBuckets
fp = makeFingerprint val
bucketA <- readBucket (toIndex numBuckets idxA) cfilt
case insertBucket fp bucketA of
Just bucketA' ->
Just <$> writeBucket (toIndex numBuckets idxA) bucketA' cfilt
Nothing -> let
idxB = secondaryIndex fp numBuckets idxA
in bumpHash numBuckets maxNumKicks cfilt idxB fp
where
maxNumKicks = 1200
bumpHash numBuckets 0 _ _ _ = pure Nothing
bumpHash numBuckets remaingKicks cfilt' idxB fp = do
bucketB <- readBucket (toIndex numBuckets idxB) cfilt'
case insertBucket fp bucketB of
Just bb' ->
Just <$> writeBucket (toIndex numBuckets idxB) bb' cfilt
Nothing -> do
let (bumpedFP, bucketB') = replaceInBucket fp isBucketMinimum bucketB
kickedIndex = kickedSecondaryIndex bumpedFP numBuckets idxB
nextStepFilter <- writeBucket (toIndex numBuckets idxB) bucketB' cfilt'
bumpHash numBuckets (remaingKicks - 1) nextStepFilter kickedIndex bumpedFP
isBucketMinimum _ bkt = let
a = getCell bkt 0
b = getCell bkt 1
c = getCell bkt 2
d = getCell bkt 3
m = min a . min b $ min c d
in (a == m, b == m, c == m, d == m)
member :: (Hashable a, Monad m, CuckooFilter filt m) =>
a
-> filt a
-> m Bool
member a cFilter = do
numBuckets <- bucketCount cFilter
let idxA = primaryIndex a numBuckets
idxB = secondaryIndex fp numBuckets idxA
bA <- readBucket ( toIndex numBuckets idxA ) cFilter
bB <- readBucket ( toIndex numBuckets idxB ) cFilter
pure $ inBucket fp bA || inBucket fp bB
where
fp = makeFingerprint a
inBucket fp bucket =
fp == getCell bucket 0 ||
fp == getCell bucket 1 ||
fp == getCell bucket 2 ||
fp == getCell bucket 3
delete :: (Hashable a, Monad m, CuckooFilter filt m) =>
filt a
-> a
-> m (filt a)
delete cFilt a = do
isMember <- member a cFilt
if isMember
then do
numBuckets <- bucketCount cFilt
let idxA = primaryIndex a numBuckets
idxB = secondaryIndex fp numBuckets idxA
bucketA <- readBucket ( toIndex numBuckets idxA ) cFilt
bucketB <- readBucket ( toIndex numBuckets idxB ) cFilt
let (removedFromA, bucketA') = removeFromBucket bucketA
(_, bucketB') = removeFromBucket bucketB
if removedFromA
then writeBucket (toIndex numBuckets idxA) bucketA' cFilt
else writeBucket (toIndex numBuckets idxB) bucketB' cFilt
else pure cFilt
where
fp = makeFingerprint a
matchesFP _ bucket = (fp == getCell bucket 0,
fp == getCell bucket 1,
fp == getCell bucket 2,
fp == getCell bucket 3)
removeFromBucket bucket = let
(_, bucket') = replaceInBucket (FP 0) matchesFP bucket
in (bucket /= bucket', bucket')