radix-tree-1.1.0.0: test/properties/Test/RadixTree/Word8/Strict.hs
{-# LANGUAGE RankNTypes #-}
module Test.RadixTree.Word8.Strict
( test
) where
import qualified Data.Radix1Tree.Word8.Strict as Radix1
import qualified Data.Radix1Tree.Word8.Strict.Zipper as Radix1
import Data.RadixTree.Word8.Strict (RadixTree)
import qualified Data.RadixTree.Word8.Strict as Radix
import Data.RadixTree.Word8.Strict.Debug
import qualified Data.RadixTree.Word8.Strict.Unsafe as Radix
import qualified Data.RadixTree.Word8.Strict.Pointer as Radix
import No.Tree (NoTree)
import qualified No.Tree as No
import Test.Kit
import Test.RadixNTree.Word8.Sample
import Data.Functor.Identity
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty (..))
import Data.Word
import Test.Hspec
radixFromList :: [([Word8], a)] -> RadixTree a
radixFromList = foldr (\(k, a) p -> Radix.insert (Radix.feedBytes k) a p) Radix.empty
radixToList :: RadixTree a -> [([Word8], a)]
radixToList = Radix.foldrWithKey (\k a -> (:) (Radix.buildBytes k, a)) []
unary0 :: [Case () (RadixTree Int) (NoTree [Word8] Int)]
unary0 = foldMap (mkUnary0 radixFromList) [zero, one, tip, bin, tiny, small, medium]
unary1F :: [Case (No.Openness, [Word8], Int) (RadixTree Int) (NoTree [Word8] Int)]
unary1F = foldMap (mkUnary1 radixFromList) [zero, one, tip, bin, tiny, small, medium]
unary1R :: [Case (No.Openness, [Word8]) (RadixTree Int) (NoTree [Word8] Int)]
unary1R = augment (\(o, k, _) -> (o, k)) unary1F
unary1 :: [Case ([Word8], Int) (RadixTree Int) (NoTree [Word8] Int)]
unary1 = augment (\(_, k, i) -> (k, i)) unary1F
unary1_ :: [Case [Word8] (RadixTree Int) (NoTree [Word8] Int)]
unary1_ = augment (\(_, k, _) -> k) unary1F
binary :: [Case (RadixTree Int, NoTree [Word8] Int) (RadixTree Int) (NoTree [Word8] Int)]
binary = foldMap (mkBinary radixFromList) [zero, one, tip, bin, tiny, small, medium]
binaryL :: [Case (RadixTree Int, NoTree [Word8] Int) (RadixTree Int) (NoTree [Word8] Int)]
binaryL = foldMap (mkBinaryL radixFromList) [zero, one, tip, bin, tiny, small, medium]
equal :: [Case (RadixTree Int, NoTree [Word8] Int) (RadixTree Int) (NoTree [Word8] Int)]
equal = foldMap (mkEqual radixFromList) [zero, one, tip, bin, tiny, small, medium]
subset :: [Case (RadixTree Int, NoTree [Word8] Int) (RadixTree Int) (NoTree [Word8] Int)]
subset = foldMap (mkSubset radixFromList) [zero, one, tip, bin, tiny, small, medium]
superset :: [Case (RadixTree Int, NoTree [Word8] Int) (RadixTree Int) (NoTree [Word8] Int)]
superset = foldMap (mkSuperset radixFromList) [zero, one, tip, bin, tiny, small, medium]
type IdT s a b = Test s (RadixTree a) (NoTree [Word8] a) b b
type TreeT s a = Test s (RadixTree a) (NoTree [Word8] a) (RadixTree a) (NoTree [Word8] a)
treeEq :: Eq a => RadixTree a -> NoTree [Word8] a -> Bool
treeEq pat no =
case validate pat of
Valid -> radixToList pat == No.toList no
_ -> False
type SplitT s a =
Test s (RadixTree a) (NoTree [Word8] a)
(Radix.Split a a) (NoTree [Word8] a, NoTree [Word8] a)
splitEq :: Eq a => Radix.Split a a -> (NoTree [Word8] a, NoTree [Word8] a) -> Bool
splitEq (Radix.Split a b) (x, y) = treeEq a x && treeEq b y
type SplitLookupT s a =
Test s (RadixTree a) (NoTree [Word8] a)
(Radix.SplitLookup a a a) (NoTree [Word8] a, Maybe a, NoTree [Word8] a)
splitLookupEq
:: Eq a
=> Radix.SplitLookup a a a -> (NoTree [Word8] a, Maybe a, NoTree [Word8] a) -> Bool
splitLookupEq (Radix.SplitLookup a b c) (x, y, z) = treeEq a x && b == y && treeEq c z
type LookupT s a =
Test s (RadixTree a) (NoTree [Word8] a)
(Maybe (Radix.Lookup a)) (Maybe ([Word8], a))
lookupEq :: Eq a => Maybe (Radix.Lookup a) -> Maybe ([Word8], a) -> Bool
lookupEq (Just (Radix.Lookup k a)) (Just (l, b)) = Radix.buildBytes k == l && a == b
lookupEq Nothing Nothing = True
lookupEq _ _ = False
type MinViewT s a =
Test s (RadixTree a) (NoTree [Word8] a)
(Maybe (Radix.ViewL a)) (Maybe ([Word8], a, NoTree [Word8] a))
minViewEq :: Eq a => Maybe (Radix.ViewL a) -> Maybe ([Word8], a, NoTree [Word8] a) -> Bool
minViewEq (Just (Radix.ViewL k a t)) (Just (l, b, no)) =
Radix.buildBytes k == l && a == b && treeEq t no
minViewEq Nothing Nothing = True
minViewEq _ _ = False
type MaxViewT s a =
Test s (RadixTree a) (NoTree [Word8] a)
(Maybe (Radix.ViewR a)) (Maybe (NoTree [Word8] a, [Word8], a))
maxViewEq :: Eq a => Maybe (Radix.ViewR a) -> Maybe (NoTree [Word8] a, [Word8], a) -> Bool
maxViewEq (Just (Radix.ViewR t k a)) (Just (no, l, b)) =
Radix.buildBytes k == l && a == b && treeEq t no
maxViewEq Nothing Nothing = True
maxViewEq _ _ = False
lookupT :: Eq a => IdT [Word8] a (Maybe a)
lookupT = Test (==) (Radix.lookup . Radix.feedBytes) No.lookup
findT :: Eq a => IdT ([Word8], a) a a
findT = Test (==) (\(k, i) -> Radix.find i $ Radix.feedBytes k) (\(k, i) -> No.find i k)
memberT :: Eq a => IdT [Word8] a Bool
memberT = Test (==) (Radix.member . Radix.feedBytes) No.member
subtreeT :: Eq a => TreeT [Word8] a
subtreeT = Test treeEq (Radix.subtree . Radix.feedBytes) No.subtree
pointerT :: Eq a => IdT ([Word8], a) a (Maybe a)
pointerT = Test (==) (\(k, i) r -> do ptr <- Radix.pointer (Radix.feedBytes k) r
Just $ Radix.follow i ptr r
)
(\(k, _) r -> No.lookup k r)
descendLookup1T :: Eq a => IdT [Word8] a (Maybe a)
descendLookup1T =
Test (==) (\k r -> let Radix.RadixTree mx t = r
in case k of
[] -> mx
l:ls -> do
ctx <- Radix1.descend (Radix1.feedBytes (l :| ls)) (Left t)
(v, _) <- Radix1.focus ctx
Just v
)
No.lookup
descendLookup3T :: Eq a => IdT [Word8] a (Maybe a)
descendLookup3T =
let downward [] mayEi = mayEi
downward (k:ks) mayEi = do
ei <- mayEi
Right <$> Radix1.descend (Radix1.feedBytes (k :| ks)) ei
in Test (==) (\xs r ->
let Radix.RadixTree mx t = r
len = length xs
~(as, ys) = List.splitAt (len `quot` 3) xs
~(bs, cs) = List.splitAt (len `quot` 3) ys
in case downward cs . downward bs $ downward as (Just $ Left t) of
Just (Right ctx) -> fst <$> Radix1.focus ctx
Just (Left _) -> mx
_ -> Nothing
)
No.lookup
descendAdjust3T :: (Eq a, Integral a) => TreeT ([Word8], a) a
descendAdjust3T =
let downward [] mayEi = mayEi
downward (k:ks) mayEi = do
ei <- mayEi
Right <$> Radix1.descend (Radix1.feedBytes (k :| ks)) ei
in Test treeEq (\(xs, a) r ->
let Radix.RadixTree mx t = r
len = length xs
~(as, ys) = List.splitAt (len `quot` 3) xs
~(bs, cs) = List.splitAt (len `quot` 3) ys
in case downward cs . downward bs $ downward as (Just $ Left t) of
Just (Right ctx) -> do
case Radix1.focus ctx of
Nothing -> r
Just (x, reinsert) ->
Radix.RadixTree mx $ reinsert (x + fromIntegral a)
Just (Left _) ->
case mx of
Nothing -> r
Just x -> Radix.RadixTree (Just $ x + fromIntegral a) t
_ -> r
)
(\(k, a) -> No.adjust (+ fromIntegral a) k)
prefixT :: Eq a => TreeT [Word8] a
prefixT = Test treeEq (Radix.prefix . Radix.feedBytes) No.prefix
insertT :: Eq a => TreeT ([Word8], a) a
insertT = Test treeEq (\(k, i) -> Radix.insert (Radix.feedBytes k) i) (uncurry No.insert)
insertWithT, insertWithT' :: (Eq a, Integral a) => TreeT ([Word8], a) a
insertWithT = insertWithT_ Radix.insertWith
insertWithT' = insertWithT_ Radix.insertWith'
insertWithT_
:: (Eq a, Integral a)
=> (forall x. (x -> x) -> Radix.Feed -> x -> RadixTree x -> RadixTree x) -> TreeT ([Word8], a) a
insertWithT_ g =
let f x = (+ fromIntegral x)
in Test treeEq (\(k, a) -> g (f a) (Radix.feedBytes k) a)
(\(k, a) -> No.insertWith (f a) k a)
adjustT, adjustT' :: (Eq a, Integral a) => TreeT ([Word8], a) a
adjustT = adjustT_ Radix.adjust
adjustT' = adjustT_ Radix.adjust'
adjustT_
:: (Eq a, Integral a)
=> (forall x. (x -> x) -> Radix.Feed -> RadixTree x -> RadixTree x) -> TreeT ([Word8], a) a
adjustT_ g =
let f a = (+ fromIntegral a)
in Test treeEq (\(k, a) -> g (f a) (Radix.feedBytes k))
(\(k, a) -> No.adjust (f a) k)
deleteT :: Eq a => TreeT [Word8] a
deleteT = Test treeEq (Radix.delete . Radix.feedBytes) No.delete
pruneT :: Eq a => TreeT (No.Openness, [Word8]) a
pruneT = Test treeEq (\(o, k) -> Radix.prune o $ Radix.feedBytes k) (uncurry No.prune)
updateAdjustT, updateDeleteT :: (Eq a, Integral a) => TreeT ([Word8], a) a
updateAdjustT = updateT_ (\a -> Just . (+ a))
updateDeleteT = updateT_ (\_ _ -> Nothing)
updateT_ :: Eq a => (a -> a -> Maybe a) -> TreeT ([Word8], a) a
updateT_ f = Test treeEq (\(k, a) -> Radix.update (f a) (Radix.feedBytes k))
(\(k, a) -> No.update (f a) k)
alterInsertT
, alterInsertWithT
, alterAdjustT
, alterDeleteT
:: (Eq a, Integral a) => TreeT ([Word8], a) a
alterInsertT = alterT_ (\a _ -> Just a)
alterInsertWithT = alterT_ (\a -> Just . maybe a (+ a))
alterAdjustT = alterT_ (\a -> fmap (+ a))
alterDeleteT = alterT_ (\_ _ -> Nothing)
alterT_ :: Eq a => (a -> Maybe a -> Maybe a) -> TreeT ([Word8], a) a
alterT_ f = Test treeEq (\(k, a) -> Radix.alter (f a) (Radix.feedBytes k))
(\(k, a) -> No.alter (f a) k)
shapeInsertT :: (Eq a, Integral a) => TreeT [Word8] a
shapeInsertT =
Test treeEq
(Radix.shape (Radix.insert (Radix.feedBytes [1, 2, 3]) 10000) . Radix.feedBytes)
(No.shape (No.insert [1, 2, 3] 10000))
shapeAdjustT :: (Eq a, Integral a) => TreeT [Word8] a
shapeAdjustT = Test treeEq (Radix.shape (Radix.map negate) . Radix.feedBytes)
(No.shape (No.map negate))
shapeFilterT :: (Eq a, Integral a) => TreeT [Word8] a
shapeFilterT = Test treeEq (Radix.shape (Radix.filter odd) . Radix.feedBytes)
(No.shape (No.filter odd))
shapeDeleteT :: (Eq a, Integral a) => TreeT [Word8] a
shapeDeleteT = Test treeEq (Radix.shape (\_ -> Radix.empty) . Radix.feedBytes)
(No.shape (\_ -> No.empty))
splitLT :: Eq a => SplitT (No.Openness, [Word8]) a
splitLT = Test splitEq (\(o, k) -> Radix.splitL o $ Radix.feedBytes k) (uncurry No.splitL)
splitLookupT :: Eq a => SplitLookupT [Word8] a
splitLookupT = Test splitLookupEq (Radix.splitLookup . Radix.feedBytes) No.splitLookup
lookupLT :: Eq a => LookupT (No.Openness, [Word8]) a
lookupLT = Test lookupEq (\(o, k) -> Radix.lookupL o $ Radix.feedBytes k)
(uncurry No.lookupL)
adjustLT, adjustLT' :: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
adjustLT = adjustLT_ Radix.adjustL
adjustLT' = adjustLT_ Radix.adjustL'
adjustLT_
:: (Eq a, Integral a)
=> (forall x. (x -> x) -> No.Openness -> Radix.Feed -> RadixTree x -> RadixTree x)
-> TreeT (No.Openness, [Word8], a) a
adjustLT_ g =
let f a = (+ a)
in Test treeEq (\(o, k, a) -> g (f a) o $ Radix.feedBytes k)
(\(o, k, a) -> No.adjustL (f a) o k)
adjustLWithKeyT
, adjustLWithKeyT'
:: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
adjustLWithKeyT = adjustLWithKeyT_ Radix.adjustLWithKey
adjustLWithKeyT' = adjustLWithKeyT_ Radix.adjustLWithKey'
adjustLWithKeyT_
:: (Eq a, Integral a)
=> (forall x. (Radix.Build -> x -> x) -> No.Openness -> Radix.Feed -> RadixTree x -> RadixTree x)
-> TreeT (No.Openness, [Word8], a) a
adjustLWithKeyT_ g =
let f a k = (+ sum (fmap fromIntegral k)) . (+ a)
in Test treeEq (\(o, k, a) -> g (f a . Radix.buildBytes) o $ Radix.feedBytes k)
(\(o, k, a) -> No.adjustLWithKey (f a) o k)
updateLAdjustT
, updateLDeleteT
:: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
updateLAdjustT = updateLT_ (\a -> Just . (+ a))
updateLDeleteT = updateLT_ (\_ _ -> Nothing)
updateLT_
:: (Eq a, Integral a)
=> (a -> a -> Maybe a) -> TreeT (No.Openness, [Word8], a) a
updateLT_ f =
Test treeEq (\(o, k, a) -> Radix.updateL (f a) o $ Radix.feedBytes k)
(\(o, k, a) -> No.updateL (f a) o k)
updateLWithKeyAdjustT
, updateLWithKeyDeleteT
:: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
updateLWithKeyAdjustT = updateLWithKeyT_ (\a k -> Just . (+ sum (fmap fromIntegral k)) . (+ a))
updateLWithKeyDeleteT = updateLWithKeyT_ (\_ _ _ -> Nothing)
updateLWithKeyT_
:: (Eq a, Integral a)
=> (a -> [Word8] -> a -> Maybe a) -> TreeT (No.Openness, [Word8], a) a
updateLWithKeyT_ f =
Test treeEq (\(o, k, a) -> Radix.updateLWithKey (f a . Radix.buildBytes) o $ Radix.feedBytes k)
(\(o, k, a) -> No.updateLWithKey (f a) o k)
takeLT :: Eq a => TreeT (No.Openness, [Word8]) a
takeLT = Test treeEq (\(o, k) -> Radix.takeL o $ Radix.feedBytes k)
(uncurry No.takeL)
lookupRT :: Eq a => LookupT (No.Openness, [Word8]) a
lookupRT = Test lookupEq (\(o, k) -> Radix.lookupR o $ Radix.feedBytes k)
(uncurry No.lookupR)
adjustRT, adjustRT' :: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
adjustRT = adjustRT_ Radix.adjustR
adjustRT' = adjustRT_ Radix.adjustR'
adjustRT_
:: (Eq a, Integral a)
=> (forall x. (x -> x) -> No.Openness -> Radix.Feed -> RadixTree x -> RadixTree x)
-> TreeT (No.Openness, [Word8], a) a
adjustRT_ g =
let f a = (+ a)
in Test treeEq (\(o, k, a) -> g (f a) o $ Radix.feedBytes k)
(\(o, k, a) -> No.adjustR (f a) o k)
adjustRWithKeyT
, adjustRWithKeyT'
:: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
adjustRWithKeyT = adjustRWithKeyT_ Radix.adjustRWithKey
adjustRWithKeyT' = adjustRWithKeyT_ Radix.adjustRWithKey'
adjustRWithKeyT_
:: (Eq a, Integral a)
=> (forall x. (Radix.Build -> x -> x) -> No.Openness -> Radix.Feed -> RadixTree x -> RadixTree x)
-> TreeT (No.Openness, [Word8], a) a
adjustRWithKeyT_ g =
let f a k = (+ sum (fmap fromIntegral k)) . (+ a)
in Test treeEq (\(o, k, a) -> g (f a . Radix.buildBytes) o $ Radix.feedBytes k)
(\(o, k, a) -> No.adjustRWithKey (f a) o k)
updateRAdjustT
, updateRDeleteT
:: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
updateRAdjustT = updateRT_ (\a -> Just . (+ a))
updateRDeleteT = updateRT_ (\_ _ -> Nothing)
updateRT_
:: (Eq a, Integral a)
=> (a -> a -> Maybe a) -> TreeT (No.Openness, [Word8], a) a
updateRT_ f =
Test treeEq (\(o, k, a) -> Radix.updateR (f a) o $ Radix.feedBytes k)
(\(o, k, a) -> No.updateR (f a) o k)
updateRWithKeyAdjustT
, updateRWithKeyDeleteT
:: (Eq a, Integral a) => TreeT (No.Openness, [Word8], a) a
updateRWithKeyAdjustT = updateRWithKeyT_ (\a k -> Just . (+ sum (fmap fromIntegral k)) . (+ a))
updateRWithKeyDeleteT = updateRWithKeyT_ (\_ _ _ -> Nothing)
updateRWithKeyT_
:: (Eq a, Integral a)
=> (a -> [Word8] -> a -> Maybe a) -> TreeT (No.Openness, [Word8], a) a
updateRWithKeyT_ f =
Test treeEq (\(o, k, a) -> Radix.updateRWithKey (f a . Radix.buildBytes) o $ Radix.feedBytes k)
(\(o, k, a) -> No.updateRWithKey (f a) o k)
takeRT :: Eq a => TreeT (No.Openness, [Word8]) a
takeRT = Test treeEq (\(o, k) -> Radix.takeR o $ Radix.feedBytes k)
(uncurry No.takeR)
lookupMinT :: Eq a => IdT () a (Maybe a)
lookupMinT = Test (==) (\_ -> Radix.lookupMin) (\_ -> No.lookupMin)
lookupMinWithKeyT :: Eq a => LookupT () a
lookupMinWithKeyT =
Test lookupEq (\_ -> Radix.lookupMinWithKey) (\_ -> No.lookupMinWithKey)
adjustMinT, adjustMinT' :: (Eq a, Integral a) => TreeT () a
adjustMinT = adjustMinT_ Radix.adjustMin
adjustMinT' = adjustMinT_ Radix.adjustMin'
adjustMinT_
:: (Eq a, Integral a)
=> (forall x. (x -> x) -> RadixTree x -> RadixTree x) -> TreeT () a
adjustMinT_ f = Test treeEq (\_ -> f (+ 10000)) (\_ -> No.adjustMin (+ 10000))
adjustMinWithKeyT, adjustMinWithKeyT' :: (Eq a, Integral a) => TreeT () a
adjustMinWithKeyT = adjustMinWithKeyT_ Radix.adjustMinWithKey
adjustMinWithKeyT' = adjustMinWithKeyT_ Radix.adjustMinWithKey'
adjustMinWithKeyT_
:: (Eq a, Integral a)
=> (forall x. (Radix.Build -> x -> x) -> RadixTree x -> RadixTree x) -> TreeT () a
adjustMinWithKeyT_ g =
let f k = (+ sum (fmap fromIntegral k))
in Test treeEq (\_ -> g (f . Radix.buildBytes)) (\_ -> No.adjustMinWithKey f)
deleteMinT :: (Eq a, Integral a) => TreeT () a
deleteMinT = Test treeEq (\_ -> Radix.deleteMin) (\_ -> No.deleteMin)
updateMinAdjustT, updateMinDeleteT :: (Eq a, Integral a) => TreeT () a
updateMinAdjustT = updateMinT_ (Just . (+ 10000))
updateMinDeleteT = updateMinT_ (\_ -> Nothing)
updateMinT_ :: (Eq a, Integral a) => (a -> Maybe a) -> TreeT () a
updateMinT_ f = Test treeEq (\_ -> Radix.updateMin f) (\_ -> No.updateMin f)
updateMinWithKeyAdjustT, updateMinWithKeyDeleteT :: (Eq a, Integral a) => TreeT () a
updateMinWithKeyAdjustT = updateMinWithKeyT_ (\k -> Just . (+ sum (fmap fromIntegral k)))
updateMinWithKeyDeleteT = updateMinWithKeyT_ (\_ _ -> Nothing)
updateMinWithKeyT_ :: (Eq a, Integral a) => ([Word8] -> a -> Maybe a) -> TreeT () a
updateMinWithKeyT_ f =
Test treeEq (\_ -> Radix.updateMinWithKey (f . Radix.buildBytes))
(\_ -> No.updateMinWithKey f)
minViewT :: Eq a => MinViewT () a
minViewT = Test minViewEq (\_ -> Radix.minView) (\_ -> No.minView)
lookupMaxT :: Eq a => IdT () a (Maybe a)
lookupMaxT = Test (==) (\_ -> Radix.lookupMax) (\_ -> No.lookupMax)
lookupMaxWithKeyT :: Eq a => LookupT () a
lookupMaxWithKeyT =
Test lookupEq (\_ -> Radix.lookupMaxWithKey) (\_ -> No.lookupMaxWithKey)
adjustMaxT, adjustMaxT' :: (Eq a, Integral a) => TreeT () a
adjustMaxT = adjustMaxT_ Radix.adjustMax
adjustMaxT' = adjustMaxT_ Radix.adjustMax'
adjustMaxT_
:: (Eq a, Integral a)
=> (forall x. (x -> x) -> RadixTree x -> RadixTree x) -> TreeT () a
adjustMaxT_ f = Test treeEq (\_ -> f (+ 10000)) (\_ -> No.adjustMax (+ 10000))
adjustMaxWithKeyT, adjustMaxWithKeyT' :: (Eq a, Integral a) => TreeT () a
adjustMaxWithKeyT = adjustMaxWithKeyT_ Radix.adjustMaxWithKey
adjustMaxWithKeyT' = adjustMaxWithKeyT_ Radix.adjustMaxWithKey'
adjustMaxWithKeyT_
:: (Eq a, Integral a)
=> (forall x. (Radix.Build -> x -> x) -> RadixTree x -> RadixTree x) -> TreeT () a
adjustMaxWithKeyT_ g =
let f k = (+ sum (fmap fromIntegral k))
in Test treeEq (\_ -> g (f . Radix.buildBytes)) (\_ -> No.adjustMaxWithKey f)
deleteMaxT :: (Eq a, Integral a) => TreeT () a
deleteMaxT = Test treeEq (\_ -> Radix.deleteMax) (\_ -> No.deleteMax)
updateMaxAdjustT, updateMaxDeleteT :: (Eq a, Integral a) => TreeT () a
updateMaxAdjustT = updateMaxT_ (Just . (+ 10000))
updateMaxDeleteT = updateMaxT_ (\_ -> Nothing)
updateMaxT_ :: (Eq a, Integral a) => (a -> Maybe a) -> TreeT () a
updateMaxT_ f = Test treeEq (\_ -> Radix.updateMax f) (\_ -> No.updateMax f)
updateMaxWithKeyAdjustT, updateMaxWithKeyDeleteT :: (Eq a, Integral a) => TreeT () a
updateMaxWithKeyAdjustT = updateMaxWithKeyT_ (\k -> Just . (+ sum (fmap fromIntegral k)))
updateMaxWithKeyDeleteT = updateMaxWithKeyT_ (\_ _ -> Nothing)
updateMaxWithKeyT_ :: (Eq a, Integral a) => ([Word8] -> a -> Maybe a) -> TreeT () a
updateMaxWithKeyT_ f =
Test treeEq (\_ -> Radix.updateMaxWithKey (f . Radix.buildBytes))
(\_ -> No.updateMaxWithKey f)
maxViewT :: Eq a => MaxViewT () a
maxViewT = Test maxViewEq (\_ -> Radix.maxView) (\_ -> No.maxView)
filterT :: (Eq a, Integral a) => TreeT () a
filterT = Test treeEq (\_ -> Radix.filter odd) (\_ -> No.filter odd)
filterWithKeyT :: (Eq a, Integral a) => TreeT () a
filterWithKeyT =
let f k a = odd $ sum (fmap fromIntegral k) + a
in Test treeEq (\_ -> Radix.filterWithKey (f . Radix.buildBytes))
(\_ -> No.filterWithKey f)
mapMaybeT :: (Eq a, Integral a) => TreeT () a
mapMaybeT =
let f a | odd a = Nothing
| otherwise = Just a
in Test treeEq (\_ -> Radix.mapMaybe f) (\_ -> No.mapMaybe f)
mapMaybeWithKeyT :: (Eq a, Integral a) => TreeT () a
mapMaybeWithKeyT =
let f k a | odd (sum (fmap fromIntegral k) + a) = Nothing
| otherwise = Just a
in Test treeEq (\_ -> Radix.mapMaybeWithKey (f . Radix.buildBytes))
(\_ -> No.mapMaybeWithKey f)
partitionT :: (Eq a, Integral a) => SplitT () a
partitionT = Test splitEq (\_ -> Radix.partition odd) (\_ -> No.partition odd)
partitionWithKeyT :: (Eq a, Integral a) => SplitT () a
partitionWithKeyT =
let f k a = odd $ sum (fmap fromIntegral k) + a
in Test splitEq (\_ -> Radix.partitionWithKey (f . Radix.buildBytes))
(\_ -> No.partitionWithKey f)
mapEitherT :: (Eq a, Integral a) => SplitT () a
mapEitherT =
let f a | odd a = Left a
| otherwise = Right a
in Test splitEq (\_ -> Radix.mapEither f) (\_ -> No.mapEither f)
mapEitherWithKeyT :: (Eq a, Integral a) => SplitT () a
mapEitherWithKeyT =
let f k a | odd (sum (fmap fromIntegral k) + a) = Left a
| otherwise = Right a
in Test splitEq (\_ -> Radix.mapEitherWithKey (f . Radix.buildBytes))
(\_ -> No.mapEitherWithKey f)
mapT, mapT' :: (Eq a, Num a) => TreeT () a
mapT = mapT_ Radix.map
mapT' = mapT_ Radix.map'
mapT_ :: (Eq a, Num a) => (forall x. (x -> x) -> RadixTree x -> RadixTree x) -> TreeT () a
mapT_ g =
let f = (+ 10000)
in Test treeEq (\_ -> g f) (\_ -> No.map f)
mapWithKeyT, mapWithKeyT' :: (Eq a, Num a) => TreeT () a
mapWithKeyT = mapWithKeyT_ Radix.mapWithKey
mapWithKeyT' = mapWithKeyT_ Radix.mapWithKey'
mapWithKeyT_
:: (Eq a, Num a)
=> (forall x. (Radix.Build -> x -> x) -> RadixTree x -> RadixTree x) -> TreeT () a
mapWithKeyT_ g =
let f k = (+ sum (fmap fromIntegral k)) . (+ 10000)
in Test treeEq (\_ -> g (f . Radix.buildBytes)) (\_ -> No.mapWithKey f)
foldlT, foldlT' :: (Eq a, Num a) => IdT () a [a]
foldlT = foldlT_ Radix.foldl
foldlT' = foldlT_ Radix.foldl'
foldlT_ :: Eq a => (forall x. (x -> a -> x) -> x -> RadixTree a -> x) -> IdT () a [a]
foldlT_ g =
Test (==) (\_ -> g (flip (:)) []) (\_ -> No.foldl (flip (:)) [])
foldlWithKeyT, foldlWithKeyT' :: Eq a => IdT () a [([Word8], a)]
foldlWithKeyT = foldlWithKeyT_ Radix.foldlWithKey
foldlWithKeyT' = foldlWithKeyT_ Radix.foldlWithKey'
foldlWithKeyT_
:: Eq a
=> (forall x. (x -> Radix.Build -> a -> x) -> x -> RadixTree a -> x)
-> IdT () a [([Word8], a)]
foldlWithKeyT_ g =
Test (==) (\_ -> g (\z k a -> (Radix.buildBytes k, a) : z) [])
(\_ -> No.foldlWithKey (\z k a -> (k, a) : z) [])
foldrT, foldrT' :: Eq a => IdT () a [a]
foldrT = foldrT_ Radix.foldr
foldrT' = foldrT_ Radix.foldr'
foldrT_ :: Eq a => (forall x. (a -> x -> x) -> x -> RadixTree a -> x) -> IdT () a [a]
foldrT_ g = Test (==) (\_ -> g (:) []) (\_ -> No.foldr (:) [])
foldrWithKeyT, foldrWithKeyT' :: (Eq a, Num a) => IdT () a [([Word8], a)]
foldrWithKeyT = foldrWithKeyT_ Radix.foldrWithKey
foldrWithKeyT' = foldrWithKeyT_ Radix.foldrWithKey'
foldrWithKeyT_
:: (Eq a, Num a)
=> (forall y. (Radix.Build -> a -> y -> y) -> y -> RadixTree a -> y)
-> IdT () a [([Word8], a)]
foldrWithKeyT_ g = Test (==) (\_ -> g (\k a -> (:) (Radix.buildBytes k, a)) [])
(\_ -> No.foldrWithKey (\k a -> (:) (k, a)) [])
foldMapT :: Eq a => IdT () a [a]
foldMapT = Test (==) (\_ -> Radix.foldMap (:[])) (\_ -> No.foldMap (:[]))
foldMapWithKeyT :: Eq a => IdT () a [([Word8], a)]
foldMapWithKeyT =
Test (==) (\_ -> Radix.foldMapWithKey (\k a -> [(Radix.buildBytes k, a)]))
(\_ -> No.foldMapWithKey (\k a -> [(k, a)]))
idTreeEq :: Eq a => Identity (RadixTree a) -> Identity (NoTree [Word8] a) -> Bool
idTreeEq (Identity a) (Identity b) = treeEq a b
traverseT
:: (Eq a, Num a)
=> Test s (RadixTree a) (NoTree [Word8] a)
(Identity (RadixTree a)) (Identity (NoTree [Word8] a))
traverseT =
let f = Identity . (+ 10000)
in Test idTreeEq (\_ -> Radix.traverse f) (\_ -> No.traverse f)
traverseWithKeyT
:: (Eq a, Num a)
=> Test s (RadixTree a) (NoTree [Word8] a)
(Identity (RadixTree a)) (Identity (NoTree [Word8] a))
traverseWithKeyT =
let f k a = Identity $ sum (fmap fromIntegral k) + 10000 + a
in Test idTreeEq (\_ -> Radix.traverseWithKey (f . Radix.buildBytes))
(\_ -> No.traverseWithKey f)
unionT :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
unionT = Test treeEq (Radix.union . fst) (No.unionL . snd)
unionLT :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
unionLT = Test treeEq (Radix.unionL . fst) (No.unionL . snd)
unionWithT' :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
unionWithT' = Test treeEq (Radix.unionWith' (\_ y -> y) . fst)
(No.unionWithKey (\_ _ y -> y) . snd)
unionWithKeyT', mergeUnionT :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
unionWithKeyT' = unionWithKeyT_ Radix.unionWithKey'
mergeUnionT =
unionWithKeyT_ $ \f ->
Radix.merge (\k a b -> Just $! f k a b)
(\_ -> Just) (\_ -> id) (\_ -> Just) (\_ -> id)
unionWithKeyT_
:: Eq a
=> ((Radix.Build -> a -> a -> a) -> RadixTree a -> RadixTree a -> RadixTree a)
-> TreeT (RadixTree a, NoTree [Word8] a) a
unionWithKeyT_ g =
let f k a b | odd $ sum (fmap (fromIntegral :: Word8 -> Int) k) = a
| otherwise = b
in Test treeEq (g (f . Radix.buildBytes) . fst)
(No.unionWithKey f . snd)
differenceT :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
differenceT = Test treeEq (Radix.difference . fst) (No.difference . snd)
differenceWithT :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
differenceWithT = Test treeEq (Radix.differenceWith (\_ -> Just) . fst)
(No.differenceWithKey (\_ _ -> Just) . snd)
differenceWithKeyT
, mergeDifferenceT
:: (Eq a, Integral a) => TreeT (RadixTree a, NoTree [Word8] a) a
differenceWithKeyT = differenceWithKeyT_ Radix.differenceWithKey
mergeDifferenceT =
differenceWithKeyT_ $ \f ->
Radix.merge f (\_ -> Just) (\_ -> id) (\_ _ -> Nothing) (\_ _ -> Radix1.empty)
differenceWithKeyT_
:: (Eq a, Integral a)
=> ((Radix.Build -> a -> a -> Maybe a) -> RadixTree a -> RadixTree a -> RadixTree a)
-> TreeT (RadixTree a, NoTree [Word8] a) a
differenceWithKeyT_ g =
let f k a b | odd $ sum (fmap (fromIntegral :: Word8 -> Int) k) = Just a
| otherwise = if even b
then Just b
else Nothing
in Test treeEq (g (f . Radix.buildBytes) . fst)
(No.differenceWithKey f . snd)
disjointT :: Eq a => IdT (RadixTree a, NoTree [Word8] a) a Bool
disjointT = Test (==) (Radix.disjoint . fst) (\(_, a) -> No.null . No.intersectionL a)
intersectionT :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
intersectionT = Test treeEq (Radix.intersection . fst) (No.intersectionL . snd)
intersectionLT :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
intersectionLT = Test treeEq (Radix.intersectionL . fst) (No.intersectionL . snd)
intersectionWithT' :: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
intersectionWithT' = Test treeEq (Radix.intersectionWith' (\_ y -> y) . fst)
(No.intersectionWithKey (\_ _ y -> y) . snd)
intersectionWithKeyT'
, mergeIntersectionT
:: Eq a => TreeT (RadixTree a, NoTree [Word8] a) a
intersectionWithKeyT' = intersectionWithKeyT_ Radix.intersectionWithKey'
mergeIntersectionT =
intersectionWithKeyT_ $ \f ->
Radix.merge (\k a b -> Just $! f k a b)
(\_ _ -> Nothing) (\_ _ -> Radix1.empty) (\_ _ -> Nothing) (\_ _ -> Radix1.empty)
intersectionWithKeyT_
:: Eq a
=> ((Radix.Build -> a -> a -> a) -> RadixTree a -> RadixTree a -> RadixTree a)
-> TreeT (RadixTree a, NoTree [Word8] a) a
intersectionWithKeyT_ g =
let f k a b | odd $ sum (fmap (fromIntegral :: Word8 -> Int) k) = a
| otherwise = b
in Test treeEq (g (f . Radix.buildBytes) . fst)
(No.intersectionWithKey f . snd)
compareT :: Eq a => IdT (RadixTree a, NoTree [Word8] a) a Radix.PartialOrdering
compareT = Test (==) (Radix.compare (==) . fst) (No.compare . snd)
test :: Spec
test = do
describe "Single-key" $ do
it "lookup" $ run unary1_ lookupT
it "find" $ run unary1 findT
it "member" $ run unary1_ memberT
it "subtree" $ run unary1_ subtreeT
it "pointer1 " $ run unary1 pointerT
it "descend/lookup1" $ run unary1_ descendLookup1T
it "descend/lookup3" $ run unary1_ descendLookup3T
it "descend/adjust3" $ run unary1 descendAdjust3T
it "insert" $ run unary1 insertT
it "insertWith" $ run unary1 insertWithT
it "insertWith'" $ run unary1 insertWithT'
it "adjust" $ run unary1 adjustT
it "adjust'" $ run unary1 adjustT'
it "delete" $ run unary1_ deleteT
it "prune" $ run unary1R pruneT
it "update/adjust" $ run unary1 updateAdjustT
it "update/delete" $ run unary1 updateDeleteT
it "alter/insert" $ run unary1 alterInsertT
it "alter/insertWith" $ run unary1 alterInsertWithT
it "alter/adjust" $ run unary1 alterAdjustT
it "alter/delete" $ run unary1 alterDeleteT
it "shape/insert" $ run unary1_ shapeInsertT
it "shape/adjust" $ run unary1_ shapeAdjustT
it "shape/filter" $ run unary1_ shapeFilterT
it "shape/delete" $ run unary1_ shapeDeleteT
describe "Split" $ do
it "splitL" $ run unary1R splitLT
it "splitLookup" $ run unary1_ splitLookupT
describe "Left" $ do
it "lookupL" $ run unary1R lookupLT
it "adjustL" $ run unary1F adjustLT
it "adjustL'" $ run unary1F adjustLT'
it "adjustLWithKey" $ run unary1F adjustLWithKeyT
it "adjustLWithKey'" $ run unary1F adjustLWithKeyT'
it "updateL/adjust" $ run unary1F updateLAdjustT
it "updateL/delete" $ run unary1F updateLDeleteT
it "updateLWithKey/adjust" $ run unary1F updateLWithKeyAdjustT
it "updateLWithKey/delete" $ run unary1F updateLWithKeyDeleteT
it "takeL" $ run unary1R takeLT
describe "Right" $ do
it "lookupR" $ run unary1R lookupRT
it "adjustR" $ run unary1F adjustRT
it "adjustR'" $ run unary1F adjustRT'
it "adjustRWithKey" $ run unary1F adjustRWithKeyT
it "adjustRWithKey'" $ run unary1F adjustRWithKeyT'
it "updateR/adjust" $ run unary1F updateRAdjustT
it "updateR/delete" $ run unary1F updateRDeleteT
it "updateRWithKey/adjust" $ run unary1F updateRWithKeyAdjustT
it "updateRWithKey/delete" $ run unary1F updateRWithKeyDeleteT
it "takeR" $ run unary1R takeRT
describe "Min" $ do
it "lookupMin" $ run unary0 lookupMinT
it "lookupMinWithKey" $ run unary0 lookupMinWithKeyT
it "adjustMin" $ run unary0 adjustMinT
it "adjustMinWithKey" $ run unary0 adjustMinWithKeyT
it "adjustMin'" $ run unary0 adjustMinT'
it "adjustMinWithKey'" $ run unary0 adjustMinWithKeyT'
it "deleteMin" $ run unary0 deleteMinT
it "updateMin/adjust" $ run unary0 updateMinAdjustT
it "updateMin/delete" $ run unary0 updateMinDeleteT
it "updateMinWithKey/adjust" $ run unary0 updateMinWithKeyAdjustT
it "updateMinWithKey/delete" $ run unary0 updateMinWithKeyDeleteT
it "minView" $ run unary0 minViewT
describe "Max" $ do
it "lookupMax" $ run unary0 lookupMaxT
it "lookupMaxWithKey" $ run unary0 lookupMaxWithKeyT
it "adjustMax" $ run unary0 adjustMaxT
it "adjustMaxWithKey" $ run unary0 adjustMaxWithKeyT
it "adjustMax'" $ run unary0 adjustMaxT'
it "adjustMaxWithKey'" $ run unary0 adjustMaxWithKeyT'
it "deleteMax" $ run unary0 deleteMaxT
it "updateMax/adjust" $ run unary0 updateMaxAdjustT
it "updateMax/delete" $ run unary0 updateMaxDeleteT
it "updateMaxWithKey/adjust" $ run unary0 updateMaxWithKeyAdjustT
it "updateMaxWithKey/delete" $ run unary0 updateMaxWithKeyDeleteT
it "maxView" $ run unary0 maxViewT
describe "Partition" $ do
it "filter" $ run unary0 filterT
it "filterWithKey" $ run unary0 filterWithKeyT
it "mapMaybe" $ run unary0 mapMaybeT
it "mapMaybeWithKey" $ run unary0 mapMaybeWithKeyT
it "partition" $ run unary0 partitionT
it "partitionWithKey" $ run unary0 partitionWithKeyT
it "mapEither" $ run unary0 mapEitherT
it "mapEitherWithKey" $ run unary0 mapEitherWithKeyT
describe "Full-tree" $ do
it "prefix" $ run unary1_ prefixT
it "map" $ run unary0 mapT
it "map'" $ run unary0 mapT'
it "mapWithKey" $ run unary0 mapWithKeyT
it "mapWithKey'" $ run unary0 mapWithKeyT'
it "foldl" $ run unary0 foldlT
it "foldl'" $ run unary0 foldlT'
it "foldlWithKey" $ run unary0 foldlWithKeyT
it "foldlWithKey'" $ run unary0 foldlWithKeyT'
it "foldr" $ run unary0 foldrT
it "foldr'" $ run unary0 foldrT'
it "foldrWithKey" $ run unary0 foldrWithKeyT
it "foldrWithKey'" $ run unary0 foldrWithKeyT'
it "foldMap" $ run unary0 foldMapT
it "foldMapWithKey" $ run unary0 foldMapWithKeyT
it "traverse" $ run unary0 traverseT
it "traverseWithKey" $ run unary0 traverseWithKeyT
describe "Merge" $ do
it "union" $ run binary unionT
it "unionL" $ run binaryL unionLT
it "unionWith'" $ run binaryL unionWithT'
it "unionWithKey'" $ run binaryL unionWithKeyT'
it "difference" $ run binaryL differenceT
it "differenceWith" $ run binaryL differenceWithT
it "differenceWithKey" $ run binaryL differenceWithKeyT
it "disjoint/yes" $ run binary disjointT
it "disjoint/no" $ run binaryL disjointT
it "intersection" $ run binary intersectionT
it "intersectionL" $ run binaryL intersectionLT
it "intersectionWith'" $ run binaryL intersectionWithT'
it "intersectionWithKey'" $ run binaryL intersectionWithKeyT'
it "compare/subset" $ run subset compareT
it "compare/superset" $ run superset compareT
it "compare/equal" $ run equal compareT
it "compare/incomparable" $ run binary compareT
it "merge/union" $ run binaryL mergeUnionT
it "merge/difference" $ run binaryL mergeDifferenceT
it "merge/intersection" $ run binaryL mergeIntersectionT