data-stringmap-0.9: tests/StringMapProperties.hs
module Main
where
import Data.StringMap
import qualified Data.Char as Char (intToDigit)
import qualified Data.List as List (nubBy, (!!))
import qualified Data.Map as Map (empty, fromList,
map, toList)
import qualified Data.Set as Set (fromList)
import Prelude hiding (filter, foldl,
foldr, lookup, map, null)
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.HUnit hiding (Test, Testable)
import Text.Show.Functions ()
default (Int)
main :: IO ()
main = defaultMain
[
-- testCase "exclamation" test_exclamation
testCase "value" test_value
, testCase "valueWithDefault" test_valueWithDefault
, testCase "null" test_null
, testCase "size" test_size
, testCase "member" test_member
, testCase "lookup" test_lookup
, testCase "findWithDefault" test_findWithDefault
, testCase "prefixFind" test_prefixFind
, testCase "prefixFindWithKey" test_prefixFindWithKey
, testCase "prefixFindWithKeyBF" test_prefixFindWithKeyBF
, testCase "empty" test_empty
, testCase "singleton" test_singleton
, testCase "insert" test_insert
, testCase "insertWith" test_insertWith
, testCase "insertWithKey" test_insertWithKey
, testCase "delete" test_delete
, testCase "update" test_update
, testCase "updateWithKey" test_updateWithKey
, testCase "union" test_union
, testCase "unionWith" test_unionWith
, testCase "unionWithKey" test_unionWithKey
, testCase "difference" test_difference
, testCase "differenceWith" test_differenceWith
, testCase "differenceWithKey" test_differenceWithKey
, testCase "map" test_map
, testCase "mapWithKey" test_mapWithKey
-- , testCase "mapM" test_mapM
-- , testCase "mapWithKeyM" test_mapWithKeyM
, testCase "fold" test_fold
, testCase "foldWithKey" test_foldWithKey
, testCase "keys" test_keys
, testCase "elems" test_elems
, testCase "fromList" test_fromList
, testCase "toList" test_toList
, testCase "toListBF" test_toListBF
, testCase "fromMap" test_fromMap
, testCase "toMap" test_toMap
-- , testCase "space" test_space
-- , testCase "keyChars" test_keyChars
, testCase "prefixFindCaseWithKey" test_prefixFindCaseWithKey -- fuzzy search
, testCase "prefixFindNoCaseWithKey" test_prefixFindNoCaseWithKey
, testCase "prefixFindNoCase" test_prefixFindNoCase
, testCase "lookupNoCase" test_lookupNoCase
, testCase "prefixFindCaseWithKeyBF" test_prefixFindCaseWithKeyBF
, testCase "prefixFindNoCaseWithKeyBF" test_prefixFindNoCaseWithKeyBF
-- , testCase "lookupNoCaseBF" test_lookupNoCaseBF
, testProperty "insert to singleton" prop_singleton
, testProperty "map a StringMap" prop_map
, testProperty "fromList - toList" prop_fromListToList
, testProperty "space" prop_space
, testProperty "lookupNoCaseBF is redundant" prop_lookupNoCaseBF
]
------------------------------------------------------------------------
type UMap = StringMap ()
type IMap = StringMap Int
type SMap = StringMap String
cmpset :: (Eq a, Show a, Ord a) => [a] -> [a] -> Assertion
cmpset l r = (Set.fromList l) @?= (Set.fromList r)
cmpset' :: (Ord a) => [a] -> [a] -> Bool
cmpset' l r = (Set.fromList l) == (Set.fromList r)
mergeString :: String -> String -> String -> String
mergeString key l r = key ++ ":" ++ l ++ "|" ++ r
----------------------------------------------------------------
-- Unit tests
----------------------------------------------------------------
_1, _4 :: Int
_1 = 1
_4 = 4
test_exclamation :: Assertion
test_exclamation = undefined
test_value :: Assertion
test_value =
let m1 = fromList [("" ,_1),("a", 2)] in
let m2 = fromList [("x",_1),("a", 2)] in
do
value m1 @?= Just _1
value m2 @?= Nothing
test_valueWithDefault :: Assertion
test_valueWithDefault =
let m1 = fromList [("" ,_1),("a", 2)] in
let m2 = fromList [("x",_1),("a", 2)] in
do
valueWithDefault 3 m1 @?= _1
valueWithDefault 3 m2 @?= 3
test_null :: Assertion
test_null =
let m = fromList [("a",_1), ("ab", 2)] in
do
null m @?= False
null (empty :: UMap) @?= True
test_size :: Assertion
test_size = do
size (fromList [("a",_1), ("ab", 2)]) @?= 2
size (fromList [("a",_1), ("a", 2)]) @?= 1
size (empty :: UMap) @?= 0
test_member :: Assertion
test_member = do
member "ab" (fromList [("a",_1), ("ab", 2)]) @?= True
member "aba" (fromList [("a",_1), ("ab", 2)]) @?= False
member "" (empty :: UMap) @?= False
test_lookup :: Assertion
test_lookup = do
lookup "ab" (fromList [("a",_1), ("ab", 2)]) @?= Just 2
lookup "aba" (fromList [("a",_1), ("ab", 2)]) @?= Nothing
lookup "" (empty :: UMap) @?= Nothing
test_findWithDefault :: Assertion
test_findWithDefault = do
findWithDefault 7 "ab" (fromList [("a",_1), ("ab", 2)]) @?= 2
findWithDefault 7 "aba" (fromList [("a",_1), ("ab", 2)]) @?= 7
findWithDefault 7 "" (empty :: IMap) @?= 7
test_prefixFind :: Assertion
test_prefixFind = do
prefixFind "a" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [1, 2, 4]
prefixFind "" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [1, 2, 3, 4, 5]
prefixFind "foo" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= []
prefixFind "" (empty :: UMap) @?= []
test_prefixFindWithKey :: Assertion
test_prefixFindWithKey = do
prefixFindWithKey "a" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [("a",_1), ("ab", 2), ("aaa", 4)]
prefixFindWithKey "" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) `cmpset` [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]
prefixFindWithKey "foo" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= []
prefixFindWithKey "" (empty :: UMap) @?= []
test_prefixFindWithKeyBF :: Assertion
test_prefixFindWithKeyBF = do
prefixFindWithKeyBF "a" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= [("a",_1), ("ab", 2), ("aaa", 4)]
prefixFindWithKeyBF "" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= [("a",_1), ("b", 5), ("ab", 2), ("aaa", 4), ("cab", 3)]
prefixFindWithKeyBF "foo" (fromList [("a",_1), ("ab", 2), ("cab", 3), ("aaa", 4), ("b", 5)]) @?= []
prefixFindWithKeyBF "" (empty :: UMap) @?= []
test_empty :: Assertion
test_empty = do
(empty :: UMap) @?= fromList []
size empty @?= 0
test_singleton :: Assertion
test_singleton = do
singleton "k" 'a' @?= fromList [("k", 'a')]
size (singleton "k" 'a') @?= 1
test_insert :: Assertion
test_insert = do
insert "5" 'x' (fromList [("5",'a'), ("3",'b')]) @?= fromList [("3", 'b'), ("5", 'x')]
insert "7" 'x' (fromList [("5",'a'), ("3",'b')]) @?= fromList [("3", 'b'), ("5", 'a'), ("7", 'x')]
insert "5" 'x' empty @?= singleton "5" 'x'
test_insertWith :: Assertion
test_insertWith = do
insertWith (++) "5" "xxx" (fromList [("5","a"), ("3","b")]) @?= fromList [("3", "b"), ("5", "xxxa")]
insertWith (++) "7" "xxx" (fromList [("5","a"), ("3","b")]) @?= fromList [("3", "b"), ("5", "a"), ("7", "xxx")]
insertWith (++) "5" "xxx" empty @?= singleton "5" "xxx"
test_insertWithKey :: Assertion
test_insertWithKey = do
insertWithKey mergeString "5" "xxx" (fromList [("5","a"), ("3","b")]) @?= fromList [("3", "b"), ("5", "5:xxx|a")]
insertWithKey mergeString "7" "xxx" (fromList [("5","a"), ("3","b")]) @?= fromList [("3", "b"), ("5", "a"), ("7", "xxx")]
insertWithKey mergeString "5" "xxx" empty @?= singleton "5" "xxx"
test_delete :: Assertion
test_delete = do
delete "a" (fromList [("a",_1), ("ab", 2)]) @?= fromList [("ab", 2)]
delete "ab" (fromList [("a",_1), ("ab", 2)]) @?= fromList [("a", 1)]
delete "ab" (empty :: IMap) @?= empty
test_update :: Assertion
test_update = do
update f "a" (fromList [("a",_1), ("ab", 2)]) @?= fromList [("a",777), ("ab", 2)]
update f "a" (fromList [("a",_4), ("ab", 2)]) @?= fromList [("ab", 2)]
update f "a" (empty :: IMap) @?= empty
where
f 1 = Just 777
f _ = Nothing
test_updateWithKey :: Assertion
test_updateWithKey = do
updateWithKey f "a" (fromList [("a","a"), ("ab","b")]) @?= fromList [("ab", "b"), ("a", "a:new a")]
updateWithKey f "c" (fromList [("","a"), ("ab","b")]) @?= fromList [("ab", "b"), ("", "a")]
updateWithKey f "ab" (fromList [("","a"), ("ab","b")]) @?= singleton "" "a"
where
f k x = if x == "a" then Just ((k) ++ ":new a") else Nothing
test_union :: Assertion
test_union = do
union (fromList [("a",_1), ("ab", 3)]) (fromList [("a", 2), ("c",_4)]) @?= fromList [("a",_1), ("ab", 3), ("c",_4)]
union empty (fromList [("a", 2), ("c",_4)]) @?= fromList [("a", 2), ("c",_4)]
test_unionWith :: Assertion
test_unionWith = do
unionWith (+) (fromList [("a",_1), ("ab", 3)]) (fromList [("a", 2), ("c",_4)]) @?= fromList [("a", 3), ("ab", 3), ("c",_4)]
unionWith (+) empty (fromList [("a", 2), ("c",_4)]) @?= fromList [("a", 2), ("c",_4)]
test_unionWithKey :: Assertion
test_unionWithKey =
unionWithKey mergeString (fromList [("a", "a"), ("ab", "b")]) (fromList [("a", "A"), ("c", "C")]) @?= fromList [("ab", "b"), ("a", "a:a|A"), ("c", "C")]
test_difference :: Assertion
test_difference =
difference (fromList [("a", "a"), ("ab", "b")]) (fromList [("a", "A"), ("c", "C")]) @?= (singleton "ab" "b")
test_differenceWith :: Assertion
test_differenceWith =
differenceWith f (fromList [("a", "a"), ("ab", "b")]) (fromList [("a", "A"), ("ab", "B"), ("c", "C")]) @?= singleton "ab" "b:B"
where
f al ar = if al== "b" then Just (al ++ ":" ++ ar) else Nothing
test_differenceWithKey :: Assertion
test_differenceWithKey =
differenceWithKey f (fromList [("a", "a"), ("ab", "b")]) (fromList [("a", "A"), ("ab", "B"), ("c", "C")]) @?= singleton "ab" "ab:b|B"
where
f k al ar = if al == "b" then Just (mergeString k al ar) else Nothing
test_map :: Assertion
test_map =
map (* 10) (fromList [("a",_1), ("ab",2)]) @?= fromList [("a", 10), ("ab", 20)]
test_mapWithKey :: Assertion
test_mapWithKey =
mapWithKey (mergeString "") (fromList [("a","A"), ("ab","B")]) @?= fromList [("ab", ":a|B"), ("a", ":a|A")]
test_mapM :: Assertion
test_mapM = undefined
test_mapWithKeyM :: Assertion
test_mapWithKeyM = undefined
test_fold :: Assertion
test_fold = do
fold (\ l r -> (Char.intToDigit $ fromIntegral l) : r) "0" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "45260"
error "In Which Order?"
test_foldWithKey :: Assertion
test_foldWithKey = do
foldWithKey f "0" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= "a:4|aa:5|ab:2|b:6|0"
error "In Which Order?"
where
f k l = mergeString k [Char.intToDigit $ fromIntegral l]
test_keys :: Assertion
test_keys =
keys (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= ["a", "aa", "ab", "b"]
test_elems :: Assertion
test_elems =
elems (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)]) @?= [4, 5, 2, 6]
test_fromList :: Assertion
test_fromList = do
fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)] @?= fromList [("b", 6), ("ab", 2), ("a",_4), ("aa", 5)]
fromList [] @?= (empty :: UMap)
test_toList :: Assertion
test_toList = do
(toList.fromList) [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)] @?= [("a",_4), ("aa", 5), ("ab", 2), ("b", 6)]
toList (empty :: UMap) @?= []
test_toListBF :: Assertion
test_toListBF = do
(toListBF.fromList) [("a",_4), ("Ab", 2)] @?= [("a",_4), ("Ab", 2)]
(toListBF.fromList) [("a",_4), ("ab", 2), ("aa", 5), ("b", 6)] @?= [("a",_4), ("b", 6), ("aa", 5), ("ab", 2)]
toListBF (empty :: UMap) @?= []
test_fromMap :: Assertion
test_fromMap = do
fromMap (Map.fromList [("a",_4),("aa",5),("ab",2),("b",6)]) @?= fromList [("a",_4),("aa",5),("ab",2),("b",6)]
fromMap Map.empty @?= (empty :: UMap)
test_toMap :: Assertion
test_toMap = do
(toMap.fromList) [("a",_4),("aa",5),("ab",2),("b",6)] @?= Map.fromList [("a",_4),("aa",5),("ab",2),("b",6)]
toMap (empty :: UMap) @?= Map.empty
test_space :: Assertion
test_space = undefined
test_keyChars :: Assertion
test_keyChars = undefined
test_prefixFindCaseWithKey :: Assertion
test_prefixFindCaseWithKey = do
prefixFindCaseWithKey "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2), ("b", 6)]
prefixFindCaseWithKey "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("aa", 5), ("ab", 2)]
prefixFindCaseWithKey "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]
prefixFindCaseWithKey "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []
test_prefixFindNoCaseWithKey :: Assertion
test_prefixFindNoCaseWithKey = do
prefixFindNoCaseWithKey "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2), ("b", 6)]
prefixFindNoCaseWithKey "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("Ab", 7), ("a",_4), ("aa", 5), ("ab", 2)]
prefixFindNoCaseWithKey "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]
prefixFindNoCaseWithKey "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []
test_prefixFindNoCase :: Assertion
test_prefixFindNoCase = do
prefixFindNoCase "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= [4, 7, 5, 2, 6]
prefixFindNoCase "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= [4, 7, 5, 2]
prefixFindNoCase "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= [6]
prefixFindNoCase "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("aB", 7)]) @?= []
test_lookupNoCase :: Assertion
test_lookupNoCase = do
lookupNoCase "ab" (fromList [("a",_1), ("Ab", 2)]) @?= [("Ab", 2)]
lookupNoCase "aB" (fromList [("a",_1), ("Ab", 2)]) @?= [("Ab", 2)]
lookupNoCase "" (empty :: UMap) @?= []
test_prefixFindCaseWithKeyBF :: Assertion
test_prefixFindCaseWithKeyBF = do
prefixFindCaseWithKeyBF "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("b", 6), ("Ab", 7), ("aa", 5), ("ab", 2)]
prefixFindCaseWithKeyBF "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("aa", 5), ("ab", 2)]
prefixFindCaseWithKeyBF "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]
prefixFindCaseWithKeyBF "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []
test_prefixFindNoCaseWithKeyBF :: Assertion
test_prefixFindNoCaseWithKeyBF = do
prefixFindNoCaseWithKeyBF "" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("b", 6), ("Ab", 7), ("aa", 5), ("ab", 2)]
prefixFindNoCaseWithKeyBF "a" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("a",_4), ("Ab", 7), ("aa", 5), ("ab", 2)]
prefixFindNoCaseWithKeyBF "b" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= [("b", 6)]
prefixFindNoCaseWithKeyBF "c" (fromList [("a",_4), ("ab", 2), ("aa", 5), ("b", 6), ("Ab", 7)]) @?= []
test_lookupNoCaseBF :: Assertion
test_lookupNoCaseBF = undefined
----------------------------------------------------------------
-- QuickCheck
----------------------------------------------------------------
makeUnique :: [(Key, Int)] -> [(Key, Int)]
makeUnique = List.nubBy (\ (f,_) (s,_) -> f == s)
prop_singleton :: Key -> Key -> Bool
prop_singleton k x = insert k x empty == singleton k x
prop_map :: (Int -> Int) -> [(Key, Int)] -> Bool
prop_map f l = (toListBF.(map f).fromList) l `cmpset'` ((Map.toList).(Map.map f).(Map.fromList)) l
prop_fromListToList :: [(Key, Int)] -> Bool
prop_fromListToList l = ((toList.fromList.makeUnique) l) `cmpset'` (makeUnique l)
prop_space :: [(Key, Int)] -> Bool
prop_space [] = True
prop_space l = (space.fromList) l >= (space.fromList.tail) l
prop_lookupNoCaseBF :: [(Key, Int)] -> Int -> Bool
prop_lookupNoCaseBF [] _ = True
prop_lookupNoCaseBF l k = (test' lookupNoCaseBF) == (test' lookupNoCase)
where
ul = makeUnique l
key :: Key
key = fst $ ul List.!! (k `mod` length ul)
test' :: (Key -> StringMap Int -> [(Key, Int)]) -> [(Key, Int)]
test' f = f key (fromList ul)