tokyocabinet-haskell-0.0.6: tests/ADBTest.hs

module Main where

import Test.HUnit hiding (path)
import TestUtil
import Database.TokyoCabinet.ADB

import Data.Maybe (catMaybes)
import Data.List (sort)
import Control.Monad

dbname :: String
dbname = "+"

withOpenedADB :: String -> (ADB -> IO a) -> IO a
withOpenedADB name action = do
  a <- new
  open a name
  res <- action a
  close a
  return res

test_new_delete = new >>= delete

test_open_close =
    do adb <- new
       not `fmap` open adb "foo.tch#mode=r" @? "file does not exist"
       open adb "+" @? "open"
       close adb @? "close"
       not `fmap` close adb @? "cannot close closed file"

test_putxx =
    do withOpenedADB dbname $ \adb -> do
         put adb "foo" "bar"
         get adb "foo" >>= (Just "bar" @=?)
         putkeep adb "foo" "baz"
         get adb "foo" >>= (Just "bar" @=?)
         putcat adb "foo" "baz"
         get adb "foo" >>= (Just "barbaz" @=?)

test_out =
    do withOpenedADB dbname $ \adb -> do
         put adb "foo" "bar"
         get adb "foo" >>= (Just "bar" @=?)
         out adb "foo" @? "out succeeded"
         get adb "foo" >>= ((Nothing :: Maybe String) @=?)

test_put_get =
    do withOpenedADB dbname $ \adb -> do
         put adb "1" "foo"
         put adb "2" "bar"
         put adb "3" "baz"
         get adb "1" >>= (Just "foo" @=?)
         get adb "2" >>= (Just "bar" @=?)
         get adb "3" >>= (Just "baz" @=?)

test_vsiz =
    do withOpenedADB dbname $ \adb -> do
         put adb "foo" "bar"
         vsiz adb "foo" >>= (Just 3 @=?)
         vsiz adb "bar" >>= ((Nothing :: Maybe Int) @=?)

test_iterate =
    do withOpenedADB dbname $ \adb -> do
         let keys = [1, 2, 3] :: [Int]
             vals = ["foo", "bar", "baz"]
         zipWithM_ (put adb) keys vals
         iterinit adb
         keys' <- sequence $ replicate (length keys) (iternext adb)
         (sort $ catMaybes keys') @?= (sort keys)

test_fwmkeys =
    do withOpenedADB dbname $ \adb -> do
         mapM_ (uncurry (put adb)) ([ ("foo", 100)
                                    , ("bar", 200)
                                    , ("baz", 201)
                                    , ("jkl", 300)] :: [(String, Int)])
         fwmkeys adb "ba" 10 >>= (["bar", "baz"] @=?) . sort
         fwmkeys adb "ba" 1 >>= (["bar"] @=?)
         fwmkeys adb "" 10 >>= (["bar", "baz", "foo", "jkl"] @=?) . sort

test_addint =
    do withOpenedADB dbname $ \adb -> do
         let ini = 32 :: Int
         put adb "foo" ini
         get adb "foo" >>= (Just ini @=?)
         addint adb "foo" 3
         get adb "foo" >>= (Just (ini+3) @=?)
         addint adb "bar" 1 >>= (Just 1 @=?)
         put adb "bar" "foo"
         addint adb "bar" 1 >>= (Nothing @=?)

test_adddouble =
    do withOpenedADB dbname $ \adb -> do
         let ini = 0.003 :: Double
         put adb "foo" ini
         get adb "foo" >>= (Just ini @=?)
         adddouble adb "foo" 0.3
         (get adb "foo" >>= (isIn (ini+0.3))) @? "isIn"
         adddouble adb "bar" 0.5 >>= (Just 0.5 @=?)
         put adb "bar" "foo"
         adddouble adb "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 =
    withOpenedADB dbname $ \adb -> do
      put adb "foo" "111"
      put adb "bar" "222"
      put adb "baz" "333"
      rnum adb >>= (3 @=?)
      vanish adb
      rnum adb >>= (0 @=?)

test_copy =
   withoutFile "bar.tch" $ \fnd ->
        withOpenedADB dbname $ \adb -> do
          put adb "foo" "bar"
          copy adb fnd
          close adb
          open adb fnd
          get adb "foo" >>= (Just "bar" @=?)

test_txn =
    withoutFile "foo.tcb" $ \fn ->
        withOpenedADB fn $ \adb -> do
          tranbegin adb @? "tranbegin"
          put adb "foo" "bar"
          get adb "foo" >>= (Just "bar" @=?)
          tranabort adb @? "tranabort"
          get adb "foo" >>= ((Nothing :: Maybe String) @=?)
          tranbegin adb @? "tranbegin2"
          put adb "foo" "baz"
          get adb "foo" >>= (Just "baz" @=?)
          trancommit adb @? "trancommit"
          get adb "foo" >>= (Just "baz" @=?)

test_path =
    withOpenedADB dbname $ \adb ->
        path adb >>= (Just dbname @=?)

test_util =
    do adb <- new
       open adb dbname
       put adb "foo" "bar"
       path adb >>= (Just dbname @=?)
       rnum adb >>= (1 @=?)
       ((> 0) `fmap` size adb) @? "size"
       sync adb @? "sync"
       optimize adb "capnum=1000" @? "optimize"
       close adb

test_misc =
    withoutFile "foo.tct" $ \fn ->
        withOpenedADB fn $ \adb -> do
          misc adb "put" ["1", "foo", "100", "bar", "200"] >>= (([] :: String) @=?)
          misc adb "get" ["1"] >>= (["foo", "100", "bar", "200"] @=?)

tests = test [
          "new delete" ~: test_new_delete
        , "open close"  ~: test_open_close
        , "put get" ~: test_put_get
        , "out" ~: test_out
        , "putxx" ~: test_putxx
        , "copy" ~: test_copy
        , "transaction" ~: test_txn
        , "fwmkeys" ~: test_fwmkeys
        , "path" ~: test_path
        , "addint" ~: test_addint
        , "adddouble" ~: test_adddouble
        , "util" ~: test_util
        , "vsiz" ~: test_vsiz
        , "vanish" ~: test_vanish
        , "iterate" ~: test_iterate
        , "misc" ~: test_misc
        ]

main = runTestTT tests