mqtt-0.1.0.0: test/TrieTest.hs
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module TrieTest ( tests ) where
import Data.Functor.Identity
import qualified Data.IntSet as IS
import Prelude hiding (head)
import Test.Tasty
import Test.Tasty.HUnit
import qualified Network.MQTT.Trie as R
tests :: TestTree
tests = testGroup "Trie"
[ testGroup "null"
[ testCase "! null $ singleton \"a\" ()" $ assertBool "" $ not $ R.null $ R.singleton "a" ()
, testCase "! null $ singleton \"a/b\" ()" $ assertBool "" $ not $ R.null $ R.singleton "a/b" ()
]
, testGroup "empty"
[ testCase " null empty" $ assertBool "not null" $ R.null R.empty
]
, testGroup "size"
[ testCase "size empty == 0" $ R.size (R.empty :: R.Trie ()) @?= 0
, testCase "size tree1 == 9" $ R.size tree1 @?= 9
, testCase "size tree2 == 2" $ R.size tree2 @?= 2
, testCase "size tree3 == 2" $ R.size tree3 @?= 2
, testCase "size tree4 == 3" $ R.size tree4 @?= 3
]
, testGroup "sizeWith"
[ testCase "sizeWith IS.size empty == 0" $ R.sizeWith IS.size R.empty @?= 0
, testCase "sizeWith IS.size tree1 == 9" $ R.sizeWith IS.size tree1 @?= 9
, testCase "sizeWith IS.size tree2 == 2" $ R.sizeWith IS.size tree2 @?= 2
, testCase "sizeWith IS.size tree3 == 7" $ R.sizeWith IS.size tree3 @?= 7
]
, testGroup "singleton"
[ testCase " matchTopic \"a\" $ singleton \"a\" ()" $ assertBool "" $ R.matchTopic "a" $ R.singleton "a" ()
, testCase " matchTopic \"a/b/c\" $ singleton \"a/b/c\" ()" $ assertBool "" $ R.matchTopic "a/b/c" $ R.singleton "a/b/c" ()
]
, testGroup "matchTopic"
[ testCase " matchTopic \"a\" $ singleton \"a\" ()" $ assertBool "" $ R.matchTopic "a" $ R.singleton "a" ()
, testCase " matchTopic \"a\" $ singleton \"#\" ()" $ assertBool "" $ R.matchTopic "a" $ R.singleton "#" ()
, testCase " matchTopic \"a\" $ singleton \"a/#\" ()" $ assertBool "" $ R.matchTopic "a" $ R.singleton "a/#" ()
, testCase " matchTopic \"a/b\" $ singleton \"a/#\" ()" $ assertBool "" $ R.matchTopic "a/b" $ R.singleton "a/#" ()
, testCase " matchTopic \"a/b/c\" $ singleton \"a/#\" ()" $ assertBool "" $ R.matchTopic "a/b/c" $ R.singleton "a/#" ()
, testCase "! matchTopic \"b/c/d\" $ singleton \"a/#\" ()" $ assertBool "" $ not $ R.matchTopic "b/c/d" $ R.singleton "a/#" ()
, testCase "! matchTopic \"a\" $ singleton \"a/+\" ()" $ assertBool "" $ not $ R.matchTopic "a" $ R.singleton "a/+" ()
, testCase "! matchTopic \"a\" $ singleton \"/a\" ()" $ assertBool "" $ not $ R.matchTopic "a" $ R.singleton "/a" ()
, testCase " matchTopic \"a/b\" $ singleton \"a/b\" ()" $ assertBool "" $ R.matchTopic "a/b" $ R.singleton "a/b" ()
, testCase " matchTopic \"a/b\" $ singleton \"a/+\" ()" $ assertBool "" $ R.matchTopic "a/b" $ R.singleton "a/+" ()
, testCase " matchTopic \"a/b\" $ singleton \"a/#\" ()" $ assertBool "" $ R.matchTopic "a/b" $ R.singleton "a/#" ()
, testCase " matchTopic \"a/b\" $ singleton \"a/b/#\" ()" $ assertBool "" $ R.matchTopic "a/b" $ R.singleton "a/b/#" ()
, testCase "! matchTopic \"$SYS\" $ singleton \"#\" ()" $ assertBool "" $ not $ R.matchTopic "$SYS" $ R.singleton "#" ()
, testCase "! matchTopic \"$SYS/a\" $ singleton \"#\" ()" $ assertBool "" $ not $ R.matchTopic "$SYS/a" $ R.singleton "#" ()
, testCase " matchTopic \"$SYS\" $ singleton \"$SYS/#\" ()" $ assertBool "" $ R.matchTopic "$SYS" $ R.singleton "$SYS/#" ()
, testCase " matchTopic \"$SYS/a\" $ singleton \"$SYS/#\" ()" $ assertBool "" $ R.matchTopic "$SYS/a" $ R.singleton "$SYS/#" ()
, testCase "! matchTopic \"$SYS\" $ singleton \"+\" ()" $ assertBool "" $ not $ R.matchTopic "$SYS" $ R.singleton "+" ()
, testCase "! matchTopic \"$SYS/a\" $ singleton \"+\" ()" $ assertBool "" $ not $ R.matchTopic "$SYS/a" $ R.singleton "+" ()
, testCase "! matchTopic \"$SYS\" $ singleton \"$SYS/+\" ()" $ assertBool "" $ not $ R.matchTopic "$SYS" $ R.singleton "$SYS/+" ()
, testCase " matchTopic \"$SYS/a\" $ singleton \"$SYS/+\" ()" $ assertBool "" $ R.matchTopic "$SYS/a" $ R.singleton "$SYS/+" ()
]
, testGroup "matchFilter"
[ testCase " matchFiler \"#\" $ singleton \"#\" ()" $ assertBool "" $ R.matchFilter "#" $ R.singleton "#" ()
, testCase " matchFiler \"+\" $ singleton \"#\" ()" $ assertBool "" $ R.matchFilter "+" $ R.singleton "#" ()
, testCase " matchFiler \"a\" $ singleton \"#\" ()" $ assertBool "" $ R.matchFilter "a" $ R.singleton "#" ()
, testCase "! matchFiler \"#\" $ singleton \"+\" ()" $ assertBool "" $ not $ R.matchFilter "#" $ R.singleton "+" ()
, testCase " matchFiler \"+\" $ singleton \"+\" ()" $ assertBool "" $ R.matchFilter "+" $ R.singleton "+" ()
, testCase " matchFiler \"a\" $ singleton \"+\" ()" $ assertBool "" $ R.matchFilter "a" $ R.singleton "+" ()
, testCase "! matchFiler \"#\" $ singleton \"a\" ()" $ assertBool "" $ not $ R.matchFilter "#" $ R.singleton "a" ()
, testCase "! matchFiler \"+\" $ singleton \"a\" ()" $ assertBool "" $ not $ R.matchFilter "+" $ R.singleton "a" ()
, testCase " matchFiler \"a\" $ singleton \"a\" ()" $ assertBool "" $ R.matchFilter "a" $ R.singleton "a" ()
, testCase " matchFiler \"a\" $ singleton \"a/#\" ()" $ assertBool "" $ R.matchFilter "a" $ R.singleton "a/#" ()
, testCase "! matchFiler \"a\" $ singleton \"a/+\" ()" $ assertBool "" $ not $ R.matchFilter "a" $ R.singleton "a/+" ()
, testCase " matchFiler \"a/#\" $ singleton \"#\" ()" $ assertBool "" $ R.matchFilter "a/#" $ R.singleton "#" ()
, testCase " matchFiler \"a/b/#\" $ singleton \"#\" ()" $ assertBool "" $ R.matchFilter "a/b/#" $ R.singleton "#" ()
, testCase "! matchFiler \"a/+/c\" $ singleton \"a/b/c\" ()" $ assertBool "" $ not $ R.matchFilter "a/+/c" $ R.singleton "a/b/c" ()
]
, testGroup "lookup"
[ testCase "lookup \"a\" tree1 == [0,1,2,4]" $ R.lookup "a" tree1 @?= IS.fromList [0,1,2,4]
, testCase "lookup \"b\" tree1 == [0,1]" $ R.lookup "b" tree1 @?= IS.fromList [0,1]
, testCase "lookup \"a/a\" tree1 == [0,3,4]" $ R.lookup "a/a" tree1 @?= IS.fromList [0,3,4]
, testCase "lookup \"a/a/a\" tree1 == [0,4]" $ R.lookup "a/a/a" tree1 @?= IS.fromList [0,4]
, testCase "lookup \"$SYS\" tree1 == []" $ R.lookup "$SYS" tree1 @?= IS.fromList []
, testCase "lookup \"$SYS/a\" tree1 == [5,6,7]" $ R.lookup "$SYS/a" tree1 @?= IS.fromList [5,6,7]
, testCase "lookup \"$SYS/a/a\" tree1 == [5,7,8]" $ R.lookup "$SYS/a/a" tree1 @?= IS.fromList [5,7,8]
]
, testGroup "findMaxBounded"
[ testCase "findMaxBounded \"a/b/c\" tree5 == Just LT" $ R.findMaxBounded "a/b/c" tree5 @?= Just (Identity LT)
, testCase "findMaxBounded \"a/b/c/d\" tree5 == Just EQ" $ R.findMaxBounded "a/b/c/d" tree5 @?= Just (Identity EQ)
, testCase "findMaxBounded \"s\" tree5 == Just GT" $ R.findMaxBounded "s" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"t/a\" tree5 == Just GT" $ R.findMaxBounded "t/a" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"u/a\" tree5 == Just GT" $ R.findMaxBounded "u/a" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"x/a\" tree5 == Just GT" $ R.findMaxBounded "x/a" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"y/a\" tree5 == Just GT" $ R.findMaxBounded "y/a" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"z/x/x\" tree5 == Nothing" $ R.findMaxBounded "z/x/x" tree5 @?= Nothing
, testCase "findMaxBounded \"z/x/x/q\" tree5 == Just EQ" $ R.findMaxBounded "z/x/x/q" tree5 @?= Just (Identity EQ)
, testCase "findMaxBounded \"z/x/x/q/t\" tree5 == Nothing" $ R.findMaxBounded "z/x/x/q/t" tree5 @?= Nothing
, testCase "findMaxBounded \"z/x/r/q\" tree5 == Just GT" $ R.findMaxBounded "z/x/r/q" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"z/x/r/q/t\" tree5 == Just GT" $ R.findMaxBounded "z/x/r/q/t" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"SYS/SYS\" tree5 == Just GT" $ R.findMaxBounded "SYS/SYS" tree5 @?= Just (Identity GT)
, testCase "findMaxBounded \"$SYS/SYS\" tree5 == Nothing" $ R.findMaxBounded "$SYS/SYS" tree5 @?= Nothing
]
, testGroup "insert"
[ testCase "lookup \"a/b\" tree2 == [3]" $ R.lookup "a/b" tree2 @?= IS.fromList [3]
, testCase "lookup \"a/b/c\" tree2 == [2]" $ R.lookup "a/b/c" tree2 @?= IS.fromList [2]
]
, testGroup "insertWith" [
testCase "parameter order (new, old)" $ ( R.lookup "a" $ R.insertWith const "a" (IS.singleton 2) $ R.singleton "a" (IS.singleton 1) ) @?= IS.fromList [2]
]
, testGroup "map" [ ]
, testGroup "mapMaybe" [
testCase "Trie (Identity [Int]) -> Trie (): #1" $
let trie = R.insert "abc/#" (Identity [1 :: Int]) $ R.singleton "abc/def" (Identity [2])
f (Identity xs)
| 1 `elem` xs = Just ()
| otherwise = Nothing
in R.mapMaybe f trie @?= R.singleton "abc/#" ()
, testCase "Trie (Identity [Int]) -> Trie (): #2" $
let trie = R.insert "abc/#" (Identity [1 :: Int]) $ R.singleton "abc/def" (Identity [2])
f (Identity xs)
| 2 `elem` xs = Just ()
| otherwise = Nothing
in R.mapMaybe f trie @?= R.singleton "abc/def" ()
, testCase "Trie (Identity [Int]) -> Trie (): #3" $
let trie = R.insert "abc/#" (Identity [1 :: Int]) $ R.singleton "abc/def" (Identity [2])
f (Identity xs)
| 3 `elem` xs = Just ()
| otherwise = Nothing
in R.mapMaybe f trie @?= R.empty
, testCase "Trie (Identity [Int]) -> Trie (): #4" $
let trie = R.insert "abc" (Identity [1 :: Int]) $ R.insert "abc/hij" (Identity [2]) $ R.singleton "abc/def" (Identity [3])
f (Identity xs)
| 1 `elem` xs = Just ()
| otherwise = Nothing
in R.mapMaybe f trie @?= R.singleton "abc" ()
, testCase "Trie (Identity [Int]) -> Trie (): #5" $
let trie = R.insert "abc" (Identity [1 :: Int]) $ R.insert "abc/hij" (Identity [2]) $ R.singleton "abc/def" (Identity [3])
f (Identity xs)
| 2 `elem` xs = Just ()
| otherwise = Nothing
in R.mapMaybe f trie @?= R.singleton "abc/hij" ()
, testCase "Trie (Identity [Int]) -> Trie (): #6" $
let trie = R.insert "abc" (Identity [1 :: Int]) $ R.insert "abc/def" (Identity [2]) $ R.singleton "abc/def/hij" (Identity [1])
f (Identity xs)
| 1 `elem` xs = Just ()
| otherwise = Nothing
in R.mapMaybe f trie @?= (R.insert "abc" () $ R.singleton "abc/def/hij" ())
, testCase "Trie (Identity [Int]) -> Trie (): #7" $
let trie = R.insert "abc" (Identity [1 :: Int]) $ R.insert "abc/def" (Identity [2]) $ R.singleton "abc/def/hij" (Identity [1])
f (Identity xs)
| 2 `elem` xs = Just ()
| otherwise = Nothing
in R.mapMaybe f trie @?= R.singleton "abc/def" ()
]
, testGroup "adjust" [ ]
, testGroup "delete" [ ]
, testGroup "union" [
testCase "structurally distinct trees with shared prefix"
$ (R.singleton "a/b/y" $ IS.singleton 1) `R.union` (R.singleton "a/b/x" $ IS.singleton 2)
@?= R.insertFoldable [("a/b/y", IS.singleton 1), ("a/b/x", IS.singleton 2)] R.empty
, testCase "structurally equal trees with distinct values"
$ (R.singleton "a/b/x" $ IS.singleton 1) `R.union` (R.singleton "a/b/x" $ IS.singleton 2)
@?= R.singleton "a/b/x" (IS.fromList [1,2])
]
, testGroup "unionWith" [
testCase "structurally distinct trees with shared prefix"
$ R.unionWith IS.union (R.singleton "a/b/y" $ IS.singleton 1) (R.singleton "a/b/x" $ IS.singleton 2)
@?= R.insertFoldable [("a/b/y", IS.singleton 1), ("a/b/x", IS.singleton 2)] R.empty
, testCase "structurally equal trees with distinct values"
$ R.unionWith IS.union (R.singleton "a/b/x" $ IS.singleton 1) (R.singleton "a/b/x" $ IS.singleton 2)
@?= R.singleton "a/b/x" (IS.fromList [1,2])
]
, testGroup "differenceWith" [ ]
]
tree1 :: R.Trie IS.IntSet
tree1
= R.insertWith IS.union "#" (IS.singleton 0)
$ R.insertWith IS.union "+" (IS.singleton 1)
$ R.insertWith IS.union "a" (IS.singleton 2)
$ R.insertWith IS.union "a/+" (IS.singleton 3)
$ R.insertWith IS.union "a/#" (IS.singleton 4)
$ R.insertWith IS.union "$SYS/#" (IS.singleton 5)
$ R.insertWith IS.union "$SYS/+" (IS.singleton 6)
$ R.insertWith IS.union "$SYS/a/#" (IS.singleton 7)
$ R.insertWith IS.union "$SYS/+/a" (IS.singleton 8)
$ R.empty
tree2 :: R.Trie IS.IntSet
tree2
= R.insert "a/b" (IS.singleton 3)
$ R.insert "a/b/c" (IS.singleton 2)
$ R.insert "a/b/c" (IS.singleton 1)
$ R.empty
tree3 :: R.Trie IS.IntSet
tree3
= R.insert "a/b" (IS.fromList [])
$ R.insert "a/b/c" (IS.fromList [1,2,3,4])
$ R.insert "a/b/d" (IS.fromList [5,6,7])
$ R.insert "a/b/d/e" (IS.fromList [])
$ R.empty
tree4 :: R.Trie ()
tree4
= R.insert "a/b" ()
$ R.insert "a/b/c/d" ()
$ R.insert "b/c/d" ()
$ R.empty
tree5 :: R.Trie (Identity Ordering)
tree5
= R.insert "a/b/c" (Identity LT)
$ R.insert "a/b/c/d" (Identity EQ)
$ R.insert "s" (Identity EQ)
$ R.insert "s/#" (Identity GT)
$ R.insert "t/a" (Identity EQ)
$ R.insert "t/a/#" (Identity GT)
$ R.insert "u/+" (Identity EQ)
$ R.insert "u/a/#" (Identity GT)
$ R.insert "x/+" (Identity GT)
$ R.insert "x/a" (Identity undefined)
$ R.insert "y/#" (Identity GT)
$ R.insert "y/a" (Identity undefined)
$ R.insert "z/+/+/q" (Identity EQ)
$ R.insert "z/+/r/+/#" (Identity GT)
$ R.singleton "+/SYS" (Identity GT)