module Main where import Test.HUnit hiding (path) import TestUtil import Database.TokyoCabinet.BDB import qualified Database.TokyoCabinet.BDB.Cursor as C import Data.Maybe (catMaybes, fromJust) import Data.List (sort) import Control.Monad dbname :: String dbname = "foo.tcb" withOpenedBDB :: String -> (BDB -> IO a) -> IO () withOpenedBDB name action = do h <- new open h name [OREADER, OWRITER, OCREAT] res <- action h close h return () test_ecode = withoutFile dbname $ \fn -> do h <- new open h fn [OREADER] ecode h >>= (ENOFILE @=?) test_new_delete = do bdb <- new delete bdb test_open_close = withoutFile dbname $ \fn -> do bdb <- new not `fmap` open bdb fn [OREADER] @? "file does not exist" open bdb fn [OREADER, OWRITER, OCREAT] @? "open" close bdb @? "close" not `fmap` close bdb @? "cannot close closed file" test_putxx = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do put bdb "foo" "bar" get bdb "foo" >>= (Just "bar" @=?) putkeep bdb "foo" "baz" get bdb "foo" >>= (Just "bar" @=?) putcat bdb "foo" "baz" get bdb "foo" >>= (Just "barbaz" @=?) putdup bdb "foo" "bar2" @? "putdup" getlist bdb "foo" >>= (["barbaz", "bar2"] @=?) putlist bdb "bar" ["hoge", "fuga", "abc"] @? "putlist" getlist bdb "bar" >>= (["hoge", "fuga", "abc"] @=?) test_out = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do put bdb "foo" "bar" get bdb "foo" >>= (Just "bar" @=?) out bdb "foo" @? "out succeeded" get bdb "foo" >>= ((Nothing :: Maybe String) @=?) putlist bdb "bar" ([1, 2, 3] :: [Int]) out bdb "bar" -- first one is removed get bdb "bar" >>= ((Just 2 :: Maybe Int) @=?) outlist bdb "bar" get bdb "bar" >>= ((Nothing :: Maybe Int) @=?) test_put_get = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do put bdb "1" "foo" put bdb "2" "bar" put bdb "3" "baz" get bdb "1" >>= (Just "foo" @=?) get bdb "2" >>= (Just "bar" @=?) get bdb "3" >>= (Just "baz" @=?) putdup bdb "1" "foo2" get bdb "4" >>= ((Nothing :: Maybe String) @=?) getlist bdb "1" >>= (["foo", "foo2"] @=?) getlist bdb "4" >>= (([] :: [String]) @=?) test_vnum = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do putlist bdb "foo" ["bar", "baz", "hoge", "fuga"] vnum bdb "foo" >>= (Just 4 @=?) vnum bdb "bar" >>= (Nothing @=?) test_vsiz = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do put bdb "foo" "bar" vsiz bdb "foo" >>= (Just 3 @=?) vsiz bdb "bar" >>= ((Nothing :: Maybe Int) @=?) test_iterate = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do let keys = ["foo", "bar", "baz", "jkl"] vals = [100, 200 ..] :: [Int] kvs = sort $ zip keys vals destkey = "baz" destval = fromJust $ lookup destkey kvs zipWithM (put bdb) keys vals cur <- C.new bdb C.first cur C.key cur >>= (Just (fst . head $ kvs) @=?) C.val cur >>= (Just (snd . head $ kvs) @=?) C.out cur @? "cursor out" get bdb (fst . head $ kvs) >>= ((Nothing :: Maybe String) @=?) C.key cur >>= (Just (fst . (!! 1) $ kvs) @=?) C.val cur >>= (Just (snd . (!! 1) $ kvs) @=?) C.next cur @? "cursor next" C.key cur >>= (Just (fst . (!! 2) $ kvs) @=?) C.val cur >>= (Just (snd . (!! 2) $ kvs) @=?) C.prev cur @? "cursor prev" C.key cur >>= (Just (fst . (!! 1) $ kvs) @=?) C.val cur >>= (Just (snd . (!! 1) $ kvs) @=?) C.jump cur "b" @? "cursor jump" C.key cur >>= (Just destkey @=?) C.put cur (100 :: Int) C.CPAFTER @? "cursor put" getlist bdb destkey >>= (([destval, 100] :: [Int]) @=?) C.last cur @? "cursor last" C.key cur >>= (Just (fst . last $ kvs) @=?) C.delete cur test_range = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do let keys = ["abc", "abd", "bcd", "bcz", "fgh", "ghjc", "ziji"] zipWithM (put bdb) keys ([1..] :: [Int]) range bdb (Just "a") True (Just "abz") True 10 >>= (["abc", "abd"] @=?) range bdb (Just "a") True (Just "abd") False 10 >>= (["abc"] @=?) range bdb (Just "abc") False (Just "fgh") False 3 >>= (["abd", "bcd", "bcz"] @=?) range bdb (Just "a") False (Just "ab") False 10 >>= (([] :: [String]) @=?) range bdb Nothing False Nothing False (-1) >>= (keys @=?) test_fwmkeys = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do mapM_ (uncurry (put bdb)) ([ ("foo", 100) , ("bar", 200) , ("baz", 201) , ("jkl", 300)] :: [(String, Int)]) fwmkeys bdb "ba" 10 >>= (["bar", "baz"] @=?) . sort fwmkeys bdb "ba" 1 >>= (["bar"] @=?) fwmkeys bdb "" 10 >>= (["bar", "baz", "foo", "jkl"] @=?) . sort test_addint = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do let ini = 32 :: Int put bdb "foo" ini get bdb "foo" >>= (Just ini @=?) addint bdb "foo" 3 get bdb "foo" >>= (Just (ini+3) @=?) addint bdb "bar" 1 >>= (Just 1 @=?) put bdb "bar" "foo" addint bdb "bar" 1 >>= (Nothing @=?) test_adddouble = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do let ini = 0.003 :: Double put bdb "foo" ini get bdb "foo" >>= (Just ini @=?) adddouble bdb "foo" 0.3 (get bdb "foo" >>= (isIn (ini+0.3))) @? "isIn" adddouble bdb "bar" 0.5 >>= (Just 0.5 @=?) put bdb "bar" "foo" adddouble bdb "bar" 1.2 >>= (Nothing @=?) where margin = 1e-30 isIn :: Double -> (Maybe Double) -> IO Bool isIn expected (Just actual) = let diff = expected - actual in return $ abs diff <= margin test_vanish = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do put bdb "foo" "111" put bdb "bar" "222" put bdb "baz" "333" rnum bdb >>= (3 @=?) vanish bdb rnum bdb >>= (0 @=?) test_copy = withoutFile dbname $ \fns -> withoutFile "bar.tcb" $ \fnd -> withOpenedBDB fns $ \bdb -> do put bdb "foo" "bar" copy bdb fnd close bdb open bdb fnd [OREADER] get bdb "foo" >>= (Just "bar" @=?) test_txn = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> do tranbegin bdb put bdb "foo" "bar" get bdb "foo" >>= (Just "bar" @=?) tranabort bdb get bdb "foo" >>= ((Nothing :: Maybe String) @=?) tranbegin bdb put bdb "foo" "baz" get bdb "foo" >>= (Just "baz" @=?) trancommit bdb get bdb "foo" >>= (Just "baz" @=?) test_path = withoutFile dbname $ \fn -> withOpenedBDB fn $ \bdb -> path bdb >>= (Just dbname @=?) test_util = withoutFile dbname $ \fn -> do bdb <- new setcache bdb 1000000 0 @? "setcache" setxmsiz bdb 1000000 @? "setxmsiz" tune bdb 0 0 0 (-1) (-1) [TLARGE, TBZIP] @? "tune" open bdb fn [OREADER, OWRITER, OCREAT] path bdb >>= (Just fn @=?) rnum bdb >>= (0 @=?) ((> 0) `fmap` fsiz bdb) @? "fsiz" sync bdb @? "sync" optimize bdb 0 0 0 (-1) (-1) [] @? "optimize" close bdb tests = test [ "new delete" ~: test_new_delete , "ecode" ~: test_ecode , "open close" ~: test_open_close , "put get" ~: test_put_get , "vnum" ~: test_vnum , "out" ~: test_out , "putxx" ~: test_putxx , "copy" ~: test_copy , "transaction" ~: test_txn , "range" ~: test_range , "fwmkeys" ~: test_fwmkeys , "path" ~: test_path , "addint" ~: test_addint , "adddouble" ~: test_adddouble , "util" ~: test_util , "vsiz" ~: test_vsiz , "vanish" ~: test_vanish , "iterate" ~: test_iterate ] main = runTestTT tests