radix-tree-1.0.0.0: test/properties/Test/Patricia/Word/Lazy.hs
{-# LANGUAGE RankNTypes #-}
module Test.Patricia.Word.Lazy
( test
) where
import Data.Patricia.Word.Lazy (Patricia)
import qualified Data.Patricia.Word.Lazy as Pat
import Data.Patricia.Word.Lazy.Debug (validate, Validity (..))
import qualified Data.Patricia.Word.Lazy.Unsafe as Pat
import No.Tree (NoTree)
import qualified No.Tree as No
import Test.Patricia.Word.Sample
import Test.Kit
import Data.Functor.Identity
import Test.Hspec
patFromList :: [(Word, a)] -> Patricia a
patFromList = foldr (\(k, a) p -> Pat.insert k a p) Pat.empty
patToList :: Patricia a -> [(Word, a)]
patToList = Pat.foldrWithKey (\k a -> (:) (k, a)) []
patRange :: (Pat.Range -> a -> b) -> (Word, Word, a) -> b
patRange f (k1, k2, a) = f (Pat.Range k1 k2) a
patRange_ :: (Pat.Range -> b) -> (Word, Word) -> b
patRange_ f (k1, k2) = f (Pat.Range k1 k2)
noRange :: (No.Range Word -> a -> b) -> (Word, Word, a) -> b
noRange f (k1, k2, a) = f (No.WordRange No.Closed k1 No.Closed k2) a
noRange_ :: (No.Range Word -> b) -> (Word, Word) -> b
noRange_ f (k1, k2) = f (No.WordRange No.Closed k1 No.Closed k2)
unary0 :: [Case () (Patricia Int) (NoTree Word Int)]
unary0 = foldMap (mkUnary0 patFromList) [zero, one, tiny, small, medium] -- , large]
unary1 :: [Case (Word, Int) (Patricia Int) (NoTree Word Int)]
unary1 = foldMap (mkUnary1 patFromList) [zero, one, tiny, small, medium] -- , large]
unary1_ :: [Case Word (Patricia Int) (NoTree Word Int)]
unary1_ = augment fst unary1
unary2 :: [Case (Word, Word, Int) (Patricia Int) (NoTree Word Int)]
unary2 = foldMap (mkUnary2 patFromList) [zero, one, tiny, small, medium] -- , large]
unary2_ :: [Case (Word, Word) (Patricia Int) (NoTree Word Int)]
unary2_ = augment (\(k1, k2, _) -> (k1, k2)) unary2
binary
, binaryL
, subset
, superset
, equal
:: [Case (Patricia Int, NoTree Word Int) (Patricia Int) (NoTree Word Int)]
binary = foldMap (mkBinary patFromList) [zero, one, tiny, small, medium] -- , large]
binaryL = foldMap (mkBinaryL patFromList) [zero, one, tiny, small, medium] -- , large]
subset = foldMap (mkSubset patFromList) [zero, one, tiny, small, medium] -- , large]
superset = foldMap (mkSuperset patFromList) [zero, one, tiny, small, medium] -- , large]
equal = foldMap (mkEqual patFromList) [zero, one, tiny, small, medium] -- , large]
type IdT s a b = Test s (Patricia a) (NoTree Word a) b b
type TreeT s a = Test s (Patricia a) (NoTree Word a) (Patricia a) (NoTree Word a)
treeEq :: Eq a => Patricia a -> NoTree Word a -> Bool
treeEq pat no =
case validate pat of
Valid -> patToList pat == No.toList no
_ -> False
type SplitT s a =
Test s (Patricia a) (NoTree Word a)
(Patricia a, Patricia a) (NoTree Word a, NoTree Word a)
splitEq
:: Eq a => (Patricia a, Patricia a) -> (NoTree Word a, NoTree Word a) -> Bool
splitEq (a, b) (x, y) = treeEq a x && treeEq b y
type SplitLookupT s a =
Test s (Patricia a) (NoTree Word a)
(Patricia a, Maybe a, Patricia a) (NoTree Word a, Maybe a, NoTree Word a)
splitLookupEq
:: Eq a
=> (Patricia a, Maybe a, Patricia a) -> (NoTree Word a, Maybe a, NoTree Word a) -> Bool
splitLookupEq (a, b, c) (x, y, z) = treeEq a x && b == y && treeEq c z
type LookupT s a =
Test s (Patricia a) (NoTree Word a) (Maybe (Pat.Lookup a)) (Maybe (Word, a))
lookupEq :: Eq a => Maybe (Pat.Lookup a) -> Maybe (Word, a) -> Bool
lookupEq (Just (Pat.Lookup k a)) (Just (l, b)) = k == l && a == b
lookupEq Nothing Nothing = True
lookupEq _ _ = False
type MinViewT s a =
Test s (Patricia a) (NoTree Word a)
(Maybe (Pat.ViewL a)) (Maybe (Word, a, NoTree Word a))
minViewEq :: Eq a => Maybe (Pat.ViewL a) -> Maybe (Word, a, NoTree Word a) -> Bool
minViewEq (Just (Pat.ViewL (Pat.Lookup k a) pat)) (Just (l, b, no)) =
k == l && a == b && treeEq pat no
minViewEq Nothing Nothing = True
minViewEq _ _ = False
type MaxViewT s a =
Test s (Patricia a) (NoTree Word a)
(Maybe (Pat.ViewR a)) (Maybe (NoTree Word a, Word, a))
maxViewEq :: Eq a => Maybe (Pat.ViewR a) -> Maybe (NoTree Word a, Word, a) -> Bool
maxViewEq (Just (Pat.ViewR pat (Pat.Lookup k a))) (Just (no, l, b)) =
k == l && a == b && treeEq pat no
maxViewEq Nothing Nothing = True
maxViewEq _ _ = False
lookupT :: Eq a => IdT Word a (Maybe a)
lookupT = Test (==) Pat.lookup No.lookup
findT :: Eq a => IdT (Word, a) a a
findT = Test (==) (\(k, a) -> Pat.find a k) (\(k, a) -> No.find a k)
memberT :: IdT Word a Bool
memberT = Test (==) Pat.member No.member
insertT :: Eq a => TreeT (Word, a) a
insertT = Test treeEq (uncurry Pat.insert) (uncurry No.insert)
insertWithT :: (Eq a, Integral a) => TreeT (Word, a) a
insertWithT =
let f x = (+ fromIntegral x)
in Test treeEq
(\(k, a) -> Pat.insertWith (f a) k a)
(\(k, a) -> No.insertWith (f a) k a)
adjustT :: (Eq a, Integral a) => TreeT (Word, a) a
adjustT =
let f a = (+ fromIntegral a)
in Test treeEq (\(k, a) -> Pat.adjust (f a) k) (\(k, a) -> No.adjust (f a) k)
deleteT :: Eq a => TreeT Word a
deleteT = Test treeEq Pat.delete No.delete
updateAdjustT, updateDeleteT :: (Eq a, Integral a) => TreeT (Word, a) a
updateAdjustT = updateT_ (\a -> Just . (+ a))
updateDeleteT = updateT_ (\_ _ -> Nothing)
updateT_ :: Eq a => (a -> a -> Maybe a) -> TreeT (Word, a) a
updateT_ f = Test treeEq (\(k, a) -> Pat.update (f a) k) (\(k, a) -> No.update (f a) k)
alterInsertT
, alterInsertWithT
, alterAdjustT
, alterDeleteT
:: (Eq a, Integral a) => TreeT (Word, 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 (Word, a) a
alterT_ f = Test treeEq (\(k, a) -> Pat.alter (f a) k) (\(k, a) -> No.alter (f a) k)
splitLT :: Eq a => SplitT Word a
splitLT = Test splitEq Pat.splitL (No.splitL No.Closed)
splitRT :: Eq a => SplitT Word a
splitRT = Test splitEq Pat.splitR No.splitR
splitLookupT :: Eq a => SplitLookupT Word a
splitLookupT = Test splitLookupEq Pat.splitLookup No.splitLookup
lookupLT :: Eq a => LookupT Word a
lookupLT = Test lookupEq Pat.lookupL (No.lookupL No.Closed)
adjustLT :: (Eq a, Integral a) => TreeT (Word, a) a
adjustLT =
let f a = (+ a)
in Test treeEq
(\(k, a) -> Pat.adjustL (f a) k)
(\(k, a) -> No.adjustL (f a) No.Closed k)
adjustLWithKeyT :: (Eq a, Integral a) => TreeT (Word, a) a
adjustLWithKeyT =
let f a k = (+ fromIntegral k) . (+ a)
in Test treeEq
(\(k, a) -> Pat.adjustLWithKey (f a) k)
(\(k, a) -> No.adjustLWithKey (f a) No.Closed k)
deleteLT :: Eq a => TreeT (Word) a
deleteLT = Test treeEq Pat.deleteL (No.deleteL No.Closed)
updateLAdjustT
, updateLDeleteT
:: (Eq a, Integral a) => TreeT (Word, a) a
updateLAdjustT = updateLT_ (\a -> Just . (+ a))
updateLDeleteT = updateLT_ (\_ _ -> Nothing)
updateLT_
:: (Eq a, Integral a)
=> (a -> a -> Maybe a) -> TreeT (Word, a) a
updateLT_ f =
Test treeEq (\(k, a) -> Pat.updateL (f a) k) (\(k, a) -> No.updateL (f a) No.Closed k)
updateLWithKeyAdjustT
, updateLWithKeyDeleteT
:: (Eq a, Integral a) => TreeT (Word, a) a
updateLWithKeyAdjustT = updateLWithKeyT_ (\a k -> Just . (+ fromIntegral k) . (+ a))
updateLWithKeyDeleteT = updateLWithKeyT_ (\_ _ _ -> Nothing)
updateLWithKeyT_
:: (Eq a, Integral a)
=> (a -> Word -> a -> Maybe a) -> TreeT (Word, a) a
updateLWithKeyT_ f =
Test treeEq (\(k, a) -> Pat.updateLWithKey (f a) k)
(\(k, a) -> No.updateLWithKey (f a) No.Closed k)
takeLT :: Eq a => TreeT (Word) a
takeLT = Test treeEq Pat.takeL (No.takeL No.Closed)
lookupRT :: Eq a => LookupT (Word) a
lookupRT = Test lookupEq Pat.lookupR (No.lookupR No.Closed)
adjustRT :: (Eq a, Integral a) => TreeT (Word, a) a
adjustRT =
let f a = (+ a)
in Test treeEq
(\(k, a) -> Pat.adjustR (f a) k)
(\(k, a) -> No.adjustR (f a) No.Closed k)
adjustRWithKeyT :: (Eq a, Integral a) => TreeT (Word, a) a
adjustRWithKeyT =
let f a k = (+ fromIntegral k) . (+ a)
in Test treeEq
(\(k, a) -> Pat.adjustRWithKey (f a) k)
(\(k, a) -> No.adjustRWithKey (f a) No.Closed k)
deleteRT :: Eq a => TreeT (Word) a
deleteRT = Test treeEq Pat.deleteR (No.deleteR No.Closed)
updateRAdjustT
, updateRDeleteT
:: (Eq a, Integral a) => TreeT (Word, a) a
updateRAdjustT = updateRT_ (\a -> Just . (+ a))
updateRDeleteT = updateRT_ (\_ _ -> Nothing)
updateRT_
:: (Eq a, Integral a)
=> (a -> a -> Maybe a) -> TreeT (Word, a) a
updateRT_ f =
Test treeEq (\(k, a) -> Pat.updateR (f a) k) (\(k, a) -> No.updateR (f a) No.Closed k)
updateRWithKeyAdjustT
, updateRWithKeyDeleteT
:: (Eq a, Integral a) => TreeT (Word, a) a
updateRWithKeyAdjustT = updateRWithKeyT_ (\a k -> Just . (+ fromIntegral k) . (+ a))
updateRWithKeyDeleteT = updateRWithKeyT_ (\_ _ _ -> Nothing)
updateRWithKeyT_
:: (Eq a, Integral a)
=> (a -> Word -> a -> Maybe a) -> TreeT (Word, a) a
updateRWithKeyT_ f =
Test treeEq (\(k, a) -> Pat.updateRWithKey (f a) k)
(\(k, a) -> No.updateRWithKey (f a) No.Closed k)
takeRT :: Eq a => TreeT (Word) a
takeRT = Test treeEq Pat.takeR (No.takeR No.Closed)
adjustRangeT :: (Eq a, Integral a) => TreeT (Word, Word, a) a
adjustRangeT =
let f a = (+ a)
in Test treeEq
(patRange $ \r a -> Pat.adjustRange (f a) r)
(noRange $ \r a -> No.adjustRange (f a) r)
adjustRangeWithKeyT :: (Eq a, Integral a) => TreeT (Word, Word, a) a
adjustRangeWithKeyT =
let f a k = (+ fromIntegral k) . (+ a)
in Test treeEq
(patRange $ \r a -> Pat.adjustRangeWithKey (f a) r)
(noRange $ \r a -> No.adjustRangeWithKey (f a) r)
deleteRangeT :: Eq a => TreeT (Word, Word) a
deleteRangeT = Test treeEq (patRange_ Pat.deleteRange) (noRange_ No.deleteRange)
updateRangeAdjustT
, updateRangeDeleteT
:: (Eq a, Integral a) => TreeT (Word, Word, a) a
updateRangeAdjustT = updateRangeT_ (\a -> Just . (+ a))
updateRangeDeleteT = updateRangeT_ (\_ _ -> Nothing)
updateRangeT_
:: (Eq a, Integral a)
=> (a -> a -> Maybe a) -> TreeT (Word, Word, a) a
updateRangeT_ f =
Test treeEq
(patRange $ \r a -> Pat.updateRange (f a) r) (noRange $ \r a -> No.updateRange (f a) r)
updateRangeWithKeyAdjustT
, updateRangeWithKeyDeleteT
:: (Eq a, Integral a) => TreeT (Word, Word, a) a
updateRangeWithKeyAdjustT = updateRangeWithKeyT_ (\a k -> Just . (+ fromIntegral k) . (+ a))
updateRangeWithKeyDeleteT = updateRangeWithKeyT_ (\_ _ _ -> Nothing)
updateRangeWithKeyT_
:: (Eq a, Integral a)
=> (a -> Word -> a -> Maybe a) -> TreeT (Word, Word, a) a
updateRangeWithKeyT_ f =
Test treeEq (patRange $ \r a -> Pat.updateRangeWithKey (f a) r)
(noRange $ \r a -> No.updateRangeWithKey (f a) r)
takeRangeT :: Eq a => TreeT (Word, Word) a
takeRangeT = Test treeEq (patRange_ Pat.takeRange) (noRange_ No.takeRange)
lookupMinT :: Eq a => IdT () a (Maybe a)
lookupMinT = Test (==) (\_ -> Pat.lookupMin) (\_ -> No.lookupMin)
lookupMinWithKeyT :: Eq a => LookupT () a
lookupMinWithKeyT = Test lookupEq (\_ -> Pat.lookupMinWithKey) (\_ -> No.lookupMinWithKey)
adjustMinT :: (Eq a, Integral a) => TreeT () a
adjustMinT = Test treeEq (\_ -> Pat.adjustMin (+ 10000)) (\_ -> No.adjustMin (+ 10000))
adjustMinWithKeyT :: (Eq a, Integral a) => TreeT () a
adjustMinWithKeyT =
let f k = (+ fromIntegral k)
in Test treeEq (\_ -> Pat.adjustMinWithKey f) (\_ -> No.adjustMinWithKey f)
deleteMinT :: (Eq a, Integral a) => TreeT () a
deleteMinT = Test treeEq (\_ -> Pat.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 (\_ -> Pat.updateMin f) (\_ -> No.updateMin f)
updateMinWithKeyAdjustT, updateMinWithKeyDeleteT :: (Eq a, Integral a) => TreeT () a
updateMinWithKeyAdjustT = updateMinWithKeyT_ (\k -> Just . (+ fromIntegral k))
updateMinWithKeyDeleteT = updateMinWithKeyT_ (\_ _ -> Nothing)
updateMinWithKeyT_ :: (Eq a, Integral a) => (Word -> a -> Maybe a) -> TreeT () a
updateMinWithKeyT_ f =
Test treeEq (\_ -> Pat.updateMinWithKey f) (\_ -> No.updateMinWithKey f)
minViewT :: Eq a => MinViewT () a
minViewT = Test minViewEq (\_ -> Pat.minView) (\_ -> No.minView)
lookupMaxT :: Eq a => IdT () a (Maybe a)
lookupMaxT = Test (==) (\_ -> Pat.lookupMax) (\_ -> No.lookupMax)
lookupMaxWithKeyT :: Eq a => LookupT () a
lookupMaxWithKeyT = Test lookupEq (\_ -> Pat.lookupMaxWithKey) (\_ -> No.lookupMaxWithKey)
adjustMaxT :: (Eq a, Integral a) => TreeT () a
adjustMaxT = Test treeEq (\_ -> Pat.adjustMax (+ 10000)) (\_ -> No.adjustMax (+ 10000))
adjustMaxWithKeyT :: (Eq a, Integral a) => TreeT () a
adjustMaxWithKeyT =
let f k = (+ fromIntegral k)
in Test treeEq (\_ -> Pat.adjustMaxWithKey f) (\_ -> No.adjustMaxWithKey f)
deleteMaxT :: (Eq a, Integral a) => TreeT () a
deleteMaxT = Test treeEq (\_ -> Pat.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 (\_ -> Pat.updateMax f) (\_ -> No.updateMax f)
updateMaxWithKeyAdjustT, updateMaxWithKeyDeleteT :: (Eq a, Integral a) => TreeT () a
updateMaxWithKeyAdjustT = updateMaxWithKeyT_ (\k -> Just . (+ fromIntegral k))
updateMaxWithKeyDeleteT = updateMaxWithKeyT_ (\_ _ -> Nothing)
updateMaxWithKeyT_ :: (Eq a, Integral a) => (Word -> a -> Maybe a) -> TreeT () a
updateMaxWithKeyT_ f =
Test treeEq (\_ -> Pat.updateMaxWithKey f) (\_ -> No.updateMaxWithKey f)
maxViewT :: Eq a => MaxViewT () a
maxViewT = Test maxViewEq (\_ -> Pat.maxView) (\_ -> No.maxView)
eqT :: (Eq a, Integral a) => IdT (Pat.Patricia a, NoTree Word a) a Bool
eqT = Test (==) (\(a, _) b -> a == b) (\(_, a) b -> a == b)
filterT :: (Eq a, Integral a) => TreeT () a
filterT = Test treeEq (\_ -> Pat.filter odd) (\_ -> No.filter odd)
filterWithKeyT :: (Eq a, Integral a) => TreeT () a
filterWithKeyT =
let f k a = odd $ fromIntegral k + a
in Test treeEq (\_ -> Pat.filterWithKey f) (\_ -> No.filterWithKey f)
mapMaybeT :: (Eq a, Integral a) => TreeT () a
mapMaybeT =
let f a | odd a = Nothing
| otherwise = Just a
in Test treeEq (\_ -> Pat.mapMaybe f) (\_ -> No.mapMaybe f)
mapMaybeWithKeyT :: (Eq a, Integral a) => TreeT () a
mapMaybeWithKeyT =
let f k a | odd (fromIntegral k + a) = Nothing
| otherwise = Just a
in Test treeEq (\_ -> Pat.mapMaybeWithKey f) (\_ -> No.mapMaybeWithKey f)
partitionT :: (Eq a, Integral a) => SplitT () a
partitionT = Test splitEq (\_ -> Pat.partition odd) (\_ -> No.partition odd)
partitionWithKeyT :: (Eq a, Integral a) => SplitT () a
partitionWithKeyT =
let f k a = odd $ fromIntegral k + a
in Test splitEq (\_ -> Pat.partitionWithKey f) (\_ -> No.partitionWithKey f)
mapEitherT :: (Eq a, Integral a) => SplitT () a
mapEitherT =
let f a | odd a = Left a
| otherwise = Right a
in Test splitEq (\_ -> Pat.mapEither f) (\_ -> No.mapEither f)
mapEitherWithKeyT :: (Eq a, Integral a) => SplitT () a
mapEitherWithKeyT =
let f k a | odd (fromIntegral k + a) = Left a
| otherwise = Right a
in Test splitEq (\_ -> Pat.mapEitherWithKey f) (\_ -> No.mapEitherWithKey f)
mapT :: (Eq a, Num a) => TreeT () a
mapT =
let f = (+ 10000)
in Test treeEq (\_ -> Pat.map f) (\_ -> No.map f)
mapWithKeyT :: (Eq a, Num a) => TreeT () a
mapWithKeyT =
let f k = (+ fromIntegral k) . (+ 10000)
in Test treeEq (\_ -> Pat.mapWithKey f) (\_ -> No.mapWithKey f)
sizeT :: IdT () a Int
sizeT = Test (==) (\_ -> Pat.size) (\_ -> No.size)
foldlT, foldlT' :: Eq a => IdT () a [a]
foldlT = foldlT_ Pat.foldl
foldlT' = foldlT_ Pat.foldl'
foldlT_ :: Eq a => (forall x. (x -> a -> x) -> x -> Patricia a -> x) -> IdT () a [a]
foldlT_ g = Test (==) (\_ -> g (flip (:)) []) (\_ -> No.foldl (flip (:)) [])
foldlWithKeyT, foldlWithKeyT' :: Eq a => IdT () a [(Word, a)]
foldlWithKeyT = foldlWithKeyT_ Pat.foldlWithKey
foldlWithKeyT' = foldlWithKeyT_ Pat.foldlWithKey'
foldlWithKeyT_
:: Eq a
=> (forall x. (x -> Word -> a -> x) -> x -> Patricia a -> x) -> IdT () a [(Word, a)]
foldlWithKeyT_ g =
let f z k a = (k, a) : z
in Test (==) (\_ -> g f []) (\_ -> No.foldlWithKey f [])
foldrT, foldrT' :: Eq a => IdT () a [a]
foldrT = foldrT_ Pat.foldr
foldrT' = foldrT_ Pat.foldr'
foldrT_
:: Eq a => (forall x. (a -> x -> x) -> x -> Patricia a -> x) -> IdT () a [a]
foldrT_ g = Test (==) (\_ -> g (:) []) (\_ -> No.foldr (:) [])
foldrWithKeyT, foldrWithKeyT' :: Eq a => IdT () a [(Word, a)]
foldrWithKeyT = foldrWithKeyT_ Pat.foldrWithKey
foldrWithKeyT' = foldrWithKeyT_ Pat.foldrWithKey'
foldrWithKeyT_
:: Eq a
=> (forall x. (Word -> a -> x -> x) -> x -> Patricia a -> x) -> IdT () a [(Word, a)]
foldrWithKeyT_ g =
let f k a = (:) (k, a)
in Test (==) (\_ -> g f []) (\_ -> No.foldrWithKey f [])
foldMapT :: Eq a => IdT () a [a]
foldMapT = Test (==) (\_ -> Pat.foldMap pure) (\_ -> No.foldMap pure)
foldMapWithKeyT :: Eq a => IdT () a [(Word, a)]
foldMapWithKeyT =
let f k a = [(k, a)]
in Test (==) (\_ -> Pat.foldMapWithKey f) (\_ -> No.foldMapWithKey f)
idTreeEq :: Eq a => Identity (Patricia a) -> Identity (NoTree Word a) -> Bool
idTreeEq (Identity a) (Identity b) = treeEq a b
traverseT
:: (Eq a, Num a)
=> Test s (Patricia a) (NoTree Word a) (Identity (Patricia a)) (Identity (NoTree Word a))
traverseT =
let f = Identity . (+ 10000)
in Test idTreeEq (\_ -> Pat.traverse f) (\_ -> No.traverse f)
traverseWithKeyT
:: (Eq a, Num a)
=> Test s (Patricia a) (NoTree Word a) (Identity (Patricia a)) (Identity (NoTree Word a))
traverseWithKeyT =
let f k a = Identity $ fromIntegral k + 10000 + a
in Test idTreeEq (\_ -> Pat.traverseWithKey f) (\_ -> No.traverseWithKey f)
unionT :: Eq a => TreeT (Patricia a, NoTree Word a) a
unionT = Test treeEq (\(a, _) b -> Pat.union a b) (\(_, a) b -> No.unionL a b)
unionLT :: Eq a => TreeT (Patricia a, NoTree Word a) a
unionLT = Test treeEq (\(a, _) b -> Pat.unionL a b) (\(_, a) b -> No.unionL a b)
unionWithT :: (Eq a, Num a) => TreeT (Patricia a, NoTree Word a) a
unionWithT = Test treeEq (\(a, _) b -> Pat.unionWith (+) a b)
(\(_, a) b -> No.unionWithKey (\_ -> (+)) a b)
unionWithKeyT
, mergeUnionT
:: (Eq a, Num a) => TreeT (Patricia a, NoTree Word a) a
unionWithKeyT = unionWithKeyT_ Pat.unionWithKey
mergeUnionT =
unionWithKeyT_ $ \f ->
Pat.merge
(\k a b -> Pat.Tip k $ f k a b)
Pat.Tip Pat.Bin Pat.Tip Pat.Bin
unionWithKeyT_
:: (Eq a, Num a)
=> (forall x. (Word -> x -> x -> x) -> Patricia x -> Patricia x -> Patricia x)
-> TreeT (Patricia a, NoTree Word a) a
unionWithKeyT_ g =
let f k a b = fromIntegral k + a + b
in Test treeEq (\(a, _) b -> g f a b)
(\(_, a) b -> No.unionWithKey f a b)
differenceT :: Eq a => TreeT (Patricia a, NoTree Word a) a
differenceT = Test treeEq (\(a, _) b -> Pat.difference a b)
(\(_, a) b -> No.difference a b)
differenceWithT :: (Eq a, Integral a) => TreeT (Patricia a, NoTree Word a) a
differenceWithT =
let f a b = let c = a + b
in if odd c
then Nothing
else Just c
in Test treeEq (\(a, _) b -> Pat.differenceWith f a b)
(\(_, a) b -> No.differenceWithKey (\_ -> f) a b)
differenceWithKeyT
, mergeDifferenceT
:: (Eq a, Integral a) => TreeT (Patricia a, NoTree Word a) a
differenceWithKeyT = differenceWithKeyT_ Pat.differenceWithKey
mergeDifferenceT =
differenceWithKeyT_ $ \f ->
Pat.merge
(\k a b -> case f k a b of
Just c -> Pat.Tip k c
Nothing -> Pat.Nil
)
Pat.Tip Pat.Bin
(\_ _ -> Pat.Nil) (\_ _ _ -> Pat.Nil)
differenceWithKeyT_
:: (Eq a, Integral a)
=> (forall x y. (Word -> x -> y -> Maybe x) -> Patricia x -> Patricia y -> Patricia x)
-> TreeT (Patricia a, NoTree Word a) a
differenceWithKeyT_ g =
let f k a b = let c = fromIntegral k + a + b
in if odd c
then Nothing
else Just c
in Test treeEq (\(a, _) b -> g f a b)
(\(_, a) b -> No.differenceWithKey f a b)
disjointT :: IdT (Patricia a, NoTree Word a) a Bool
disjointT = Test (==) (\(a, _) b -> Pat.disjoint a b)
(\(_, a) b -> No.null $ No.intersectionL a b)
intersectionT :: Eq a => TreeT (Patricia a, NoTree Word a) a
intersectionT = Test treeEq (\(a, _) b -> Pat.intersection a b)
(\(_, a) b -> No.intersectionL a b)
intersectionLT :: Eq a => TreeT (Patricia a, NoTree Word a) a
intersectionLT = Test treeEq (\(a, _) b -> Pat.intersectionL a b)
(\(_, a) b -> No.intersectionL a b)
intersectionWithT :: (Eq a, Num a) => TreeT (Patricia a, NoTree Word a) a
intersectionWithT = Test treeEq (\(a, _) b -> Pat.intersectionWith (+) a b)
(\(_, a) b -> No.intersectionWithKey (\_ -> (+)) a b)
intersectionWithKeyT
, mergeIntersectionT
:: (Eq a, Num a) => TreeT (Patricia a, NoTree Word a) a
intersectionWithKeyT = intersectionWithKeyT_ Pat.intersectionWithKey
mergeIntersectionT =
intersectionWithKeyT_ $ \f ->
Pat.merge
(\k a b -> Pat.Tip k $ f k a b)
(\_ _ -> Pat.Nil) (\_ _ _ -> Pat.Nil)
(\_ _ -> Pat.Nil) (\_ _ _ -> Pat.Nil)
intersectionWithKeyT_
:: (Eq a, Num a)
=> (forall x y z. (Word -> x -> y -> z) -> Patricia x -> Patricia y -> Patricia z)
-> TreeT (Patricia a, NoTree Word a) a
intersectionWithKeyT_ g =
let f k a b = fromIntegral k + a + b
in Test treeEq (\(a, _) b -> g f a b)
(\(_, a) b -> No.intersectionWithKey f a b)
compareT :: Eq a => IdT (Patricia a, NoTree Word a) a Pat.PartialOrdering
compareT = Test (==) (\(a, _) b -> Pat.compare (==) a b)
(\(_, a) b -> No.compare a b)
test :: Spec
test = do
describe "Single-key" $ do
it "lookup" $ run unary1_ lookupT
it "find" $ run unary1 findT
it "member" $ run unary1_ memberT
it "insert" $ run unary1 insertT
it "insertWith" $ run unary1 insertWithT
it "adjust" $ run unary1 adjustT
it "delete" $ run unary1_ deleteT
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
describe "Split" $ do
it "splitL" $ run unary1_ splitLT
it "splitR" $ run unary1_ splitRT
it "splitLookup" $ run unary1_ splitLookupT
describe "Left" $ do
it "lookupL" $ run unary1_ lookupLT
it "adjustL" $ run unary1 adjustLT
it "adjustLWithKey" $ run unary1 adjustLWithKeyT
it "deleteL" $ run unary1_ deleteLT
it "updateL/adjust" $ run unary1 updateLAdjustT
it "updateL/delete" $ run unary1 updateLDeleteT
it "updateLWithKey/adjust" $ run unary1 updateLWithKeyAdjustT
it "updateLWithKey/delete" $ run unary1 updateLWithKeyDeleteT
it "takeL" $ run unary1_ takeLT
describe "Right" $ do
it "lookupR" $ run unary1_ lookupRT
it "adjustR" $ run unary1 adjustRT
it "adjustRWithKey" $ run unary1 adjustRWithKeyT
it "deleteR" $ run unary1_ deleteRT
it "updateR/adjust" $ run unary1 updateRAdjustT
it "updateR/delete" $ run unary1 updateRDeleteT
it "updateRWithKey/adjust" $ run unary1 updateRWithKeyAdjustT
it "updateRWithKey/delete" $ run unary1 updateRWithKeyDeleteT
it "takeR" $ run unary1_ takeRT
describe "Range" $ do
it "adjustRange" $ run unary2 adjustRangeT
it "adjustRangeWithKey" $ run unary2 adjustRangeWithKeyT
it "deleteRange" $ run unary2_ deleteRangeT
it "updateRange/adjust" $ run unary2 updateRangeAdjustT
it "updateRange/delete" $ run unary2 updateRangeDeleteT
it "updateRangeWithKey/adjust" $ run unary2 updateRangeWithKeyAdjustT
it "updateRangeWithKey/delete" $ run unary2 updateRangeWithKeyDeleteT
it "takeRange" $ run unary2_ takeRangeT
describe "Min" $ do
it "lookupMin" $ run unary0 lookupMinT
it "lookupMinWithKey" $ run unary0 lookupMinWithKeyT
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 "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 "(==)" $ run (equal <> binaryL) eqT
it "map" $ run unary0 mapT
it "mapWithKey" $ run unary0 mapWithKeyT
it "size" $ run unary0 sizeT
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