packages feed

tokyocabinet-haskell 0.0.5 → 0.0.6

raw patch · 21 files changed

+2197/−59 lines, 21 filesdep +HUnitdep +directorydep ~basenew-uploader

Dependencies added: HUnit, directory

Dependency ranges changed: base

Files

Changes view
@@ -1,5 +1,8 @@ Revision history for tokyocabinet-haskell package. +0.0.6  Thu May 07 02:44:59 UTC 2020+  - Fixed build for newer GHC+ 0.0.5  Sat May 09 06:00:00 UTC 2009   - added ADB interface.
Database/TokyoCabinet.hs view
@@ -27,7 +27,6 @@ import qualified Database.TokyoCabinet.BDB.Cursor as C import qualified Database.TokyoCabinet.Error as E -import Data.Int import Data.Word  -- $doc@@ -68,7 +67,7 @@ newtype TCM a =     TCM { -- | Unwrap TCM.           runTCM :: IO a-    } deriving (Monad, MonadIO)+    } deriving (Functor, Applicative, Monad, MonadIO)  -- | Represent open mode for `open' function. data OpenMode = OREADER |
Database/TokyoCabinet/ADB.hs view
@@ -4,7 +4,6 @@     (     -- $doc       ADB-    , ECODE(..)     , new     , delete     , open@@ -39,7 +38,7 @@ import Foreign.ForeignPtr  import Database.TokyoCabinet.ADB.C-import Database.TokyoCabinet.Error+import Database.TokyoCabinet.Error (cINT_MIN) import Database.TokyoCabinet.Internal import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Sequence
Database/TokyoCabinet/Associative.hs view
@@ -1,7 +1,5 @@ module Database.TokyoCabinet.Associative where -import Data.Maybe- import Foreign.Ptr import Foreign.ForeignPtr
Database/TokyoCabinet/Error.hsc view
@@ -11,7 +11,7 @@     , cINT_MIN     ) where -import Foreign+import System.IO.Unsafe (unsafePerformIO) import Foreign.C.Types import Foreign.C.String
Database/TokyoCabinet/FDB/Key.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Database.TokyoCabinet.FDB.Key (Key(..), ID(..)) where  import Database.TokyoCabinet.FDB.C (ID(..), unID)
Database/TokyoCabinet/List/C.hs view
@@ -1,4 +1,3 @@-{-# INCLUDE <tcutil.h> #-} {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.List.C where
Database/TokyoCabinet/Map/C.hs view
@@ -1,4 +1,3 @@-{-# INCLUDE <tcutil.h> #-} {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.Map.C where
+ TestUtil.hs view
@@ -0,0 +1,18 @@+module TestUtil where+import Test.HUnit+import System.Directory+import Control.Monad+import Control.Exception++setupFile :: FilePath -> IO String+setupFile fn =+  doesFileExist fn >>=+  flip when (assertFailure ("setupFile: (" ++ fn ++ ") already exists!")) >>+  return fn++teardownFile :: String -> IO ()+teardownFile fn = doesFileExist fn >>= flip when (removeFile fn)++withoutFile :: String -> (String -> IO a) -> IO a+withoutFile fn = bracket (setupFile fn) teardownFile+
− examples/tctdb.hs 
@@ -1,38 +0,0 @@-import Control.Monad (unless)-import Database.TokyoCabinet.TDB-import Database.TokyoCabinet.TDB.Query hiding (new)-import qualified Database.TokyoCabinet.Map as M-import qualified Database.TokyoCabinet.TDB.Query as Q (new)--data Profile = Profile { name :: String-                       , age  :: Int } deriving Show--insertProfile :: TDB -> Profile -> IO Bool-insertProfile tdb profile =-    do m <- M.new-       M.put m "name" (name profile)-       M.put m "age" (show . age $ profile)-       Just pk <- genuid tdb-       put tdb (show pk) m--main :: IO ()-main = do t <- new-          open t "foo.tct" [OWRITER, OCREAT] >>= err t--          mapM_ (insertProfile t) [ Profile "tom" 23-                                  , Profile "bob" 24-                                  , Profile "alice" 20 ]--          q <- Q.new t-          addcond q "age" QCNUMGE "23"-          setorder q "name" QOSTRASC-          proc q $ \pk cols -> do-            Just name <- M.get cols "name"-            putStrLn name-            M.put cols "name" (name ++ "!")-            return (QPPUT cols)--          close t >>= err t-          return ()-    where-      err tdb = flip unless $ ecode tdb >>= error . show
+ tests/ADBTest.hs view
@@ -0,0 +1,181 @@+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
+ tests/BDBTest.hs view
@@ -0,0 +1,258 @@+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
+ tests/FDBTest.hs view
@@ -0,0 +1,198 @@+module Main where++import Test.HUnit hiding (path)+import TestUtil+import Database.TokyoCabinet.FDB++import Data.Maybe (catMaybes, fromJust)+import Data.List (sort)+import Control.Monad++dbname :: String+dbname = "foo.tcf"++withOpenedFDB :: String -> (FDB -> IO a) -> IO ()+withOpenedFDB 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+  fdb <- new+  delete fdb++test_open_close =+    withoutFile dbname $ \fn -> do+      fdb <- new+      not `fmap` open fdb fn [OREADER] @? "file does not exist"+      open fdb fn [OREADER, OWRITER, OCREAT] @? "open"+      close fdb @? "close"+      not `fmap` close fdb @? "cannot close closed file"++test_putxx =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          put fdb "1" "bar"+          get fdb "1" >>= (Just "bar" @=?)+          putkeep fdb "1" "baz"+          get fdb "1" >>= (Just "bar" @=?)+          putcat fdb "1" "baz"+          get fdb "1" >>= (Just "barbaz" @=?)++test_out =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          put fdb "1" "bar"+          get fdb "1" >>= (Just "bar" @=?)+          out fdb "1" @? "out succeeded"+          get fdb "1" >>= ((Nothing :: Maybe String) @=?)++test_put_get =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          put fdb "2" "foo"+          put fdb "3" "bar"+          put fdb "4" "baz"+          put fdb IDNEXT "hoge"+          put fdb IDPREV "fuga"+          get fdb "2" >>= (Just "foo" @=?)+          get fdb "3" >>= (Just "bar" @=?)+          get fdb "4" >>= (Just "baz" @=?)+          get fdb (5 :: Int) >>= (Just "hoge" @=?)+          get fdb (1 :: Int) >>= (Just "fuga" @=?)+          put fdb IDMAX "max"+          put fdb IDMIN "min"+          get fdb (5 :: Int) >>= (Just "max" @=?)+          get fdb (1 :: Int) >>= (Just "min" @=?)++test_iterate =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          let keys = [1, 2, 3] :: [Int]+              vals = ["foo", "bar", "baz"]+          zipWithM_ (put fdb) keys vals+          iterinit fdb+          keys' <- sequence $ replicate (length keys) (iternext fdb)+          (sort $ catMaybes keys') @?= (sort keys)+          iternext fdb >>= ((Nothing :: Maybe String) @=?)++test_vsiz =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          put fdb "123" "bar"+          vsiz fdb "123" >>= (Just 3 @=?)+          vsiz fdb "234" >>= ((Nothing :: Maybe Int) @=?)++test_range =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          zipWithM_ (put fdb) ([1..10] :: [Int]) ([100, 200..1000] :: [Int])+          range fdb (2 :: Int) (5 :: Int) (-1)+                    >>= (([2..5] :: [Int]) @=?)+          range fdb IDMIN IDMAX (-1)+                    >>= (([1..10] :: [Int]) @=?)+          range fdb IDMIN IDMAX 2+                    >>= (([1..2] :: [Int]) @=?)++test_fwmkeys =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          zipWithM_ (put fdb) ([1..10] :: [Int]) ([100, 200..1000] :: [Int])+          fwmkeys fdb "[min,max]" 10 >>= ((map show [1..10]) @=?)++test_addint =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          let ini = 32 :: Int+          put fdb "10" ini+          get fdb "10" >>= (Just ini @=?)+          addint fdb "10" 3+          get fdb "10" >>= (Just (ini+3) @=?)+          addint fdb "20" 1 >>= (Just 1 @=?)+          put fdb "20" "foo"+          addint fdb "20" 1 >>= (Nothing @=?)++test_adddouble =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb -> do+          let ini = 0.003 :: Double+          put fdb "1" ini+          get fdb "1" >>= (Just ini @=?)+          adddouble fdb "1" 0.3+          (get fdb "1" >>= (isIn (ini+0.3))) @? "isIn"+          adddouble fdb "2" 0.5 >>= (Just 0.5 @=?)+          put fdb "2" "foo"+          adddouble fdb "2" 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 ->+        withOpenedFDB fn $ \fdb -> do+            put fdb "1" "111"+            put fdb "2" "222"+            put fdb "3" "333"+            rnum fdb >>= (3 @=?)+            vanish fdb+            rnum fdb >>= (0 @=?)++test_copy =+    withoutFile dbname $ \fns ->+        withoutFile "bar.tcf" $ \fnd ->+            withOpenedFDB fns $ \fdb -> do+                put fdb "1" "bar"+                copy fdb fnd+                close fdb+                open fdb fnd [OREADER]+                get fdb "1" >>= (Just "bar" @=?)++test_path =+    withoutFile dbname $ \fn ->+        withOpenedFDB fn $ \fdb ->+            path fdb >>= (Just dbname @=?)++test_util =+    withoutFile dbname $ \fn -> do+      fdb <- new+      tune fdb 0 100000000 @? "tune"+      open fdb fn [OREADER, OWRITER, OCREAT]+      path fdb >>= (Just fn @=?)+      rnum fdb >>= (0 @=?)+      ((> 0) `fmap` fsiz fdb) @? "fsiz"+      sync fdb @? "sync"+      put fdb (1 :: Int) "dummy record"+      optimize fdb 0 0 @? "optimize"+      close fdb++tests = test [+          "new delete" ~: test_new_delete+        , "ecode" ~: test_ecode+        , "open close"  ~: test_open_close+        , "put get" ~: test_put_get+        , "out" ~: test_out+        , "putxx" ~: test_putxx+        , "copy" ~: test_copy+        , "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
+ tests/HDBTest.hs view
@@ -0,0 +1,201 @@+module Main where++import Test.HUnit hiding (path)+import TestUtil+import Database.TokyoCabinet.HDB++import Data.Maybe (catMaybes)+import Data.List (sort)+import Control.Monad++dbname :: String+dbname = "foo.tch"++withOpenedHDB :: String -> (HDB -> IO a) -> IO a+withOpenedHDB name action = do+  h <- new+  open h name [OREADER, OWRITER, OCREAT]+  res <- action h+  close h+  return res++test_ecode =+    withoutFile dbname $ \fn -> do+        h <- new+        open h fn [OREADER]+        ecode h >>= (ENOFILE @=?)++test_new_delete = do+  hdb <- new+  delete hdb++test_open_close =+    withoutFile dbname $ \fn -> do+      hdb <- new+      not `fmap` open hdb fn [OREADER] @? "file does not exist"+      open hdb fn [OREADER, OWRITER, OCREAT] @? "open"+      close hdb @? "close"+      not `fmap` close hdb @? "cannot close closed file"++test_putxx =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          put hdb "foo" "bar"+          get hdb "foo" >>= (Just "bar" @=?)+          putkeep hdb "foo" "baz"+          get hdb "foo" >>= (Just "bar" @=?)+          putcat hdb "foo" "baz"+          get hdb "foo" >>= (Just "barbaz" @=?)+          putasync hdb "bar" "baz"+          sync hdb+          get hdb "bar" >>= (Just "baz" @=?)++test_out =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          put hdb "foo" "bar"+          get hdb "foo" >>= (Just "bar" @=?)+          out hdb "foo" @? "out succeeded"+          get hdb "foo" >>= ((Nothing :: Maybe String) @=?)++test_put_get =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          put hdb "1" "foo"+          put hdb "2" "bar"+          put hdb "3" "baz"+          get hdb "1" >>= (Just "foo" @=?)+          get hdb "2" >>= (Just "bar" @=?)+          get hdb "3" >>= (Just "baz" @=?)++test_vsiz =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          put hdb "foo" "bar"+          vsiz hdb "foo" >>= (Just 3 @=?)+          vsiz hdb "bar" >>= ((Nothing :: Maybe Int) @=?)++test_iterate =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          let keys = [1, 2, 3] :: [Int]+              vals = ["foo", "bar", "baz"]+          zipWithM_ (put hdb) keys vals+          iterinit hdb+          keys' <- sequence $ replicate (length keys) (iternext hdb)+          (sort $ catMaybes keys') @?= (sort keys)++test_fwmkeys =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          mapM_ (uncurry (put hdb)) ([ ("foo", 100)+                                     , ("bar", 200)+                                     , ("baz", 201)+                                     , ("jkl", 300)] :: [(String, Int)])+          fwmkeys hdb "ba" 10 >>= (["bar", "baz"] @=?) . sort+          fwmkeys hdb "ba" 1 >>= (["bar"] @=?)+          fwmkeys hdb "" 10 >>= (["bar", "baz", "foo", "jkl"] @=?) . sort++test_addint =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          let ini = 32 :: Int+          put hdb "foo" ini+          get hdb "foo" >>= (Just ini @=?)+          addint hdb "foo" 3+          get hdb "foo" >>= (Just (ini+3) @=?)+          addint hdb "bar" 1 >>= (Just 1 @=?)+          put hdb "bar" "foo"+          addint hdb "bar" 1 >>= (Nothing @=?)++test_adddouble =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          let ini = 0.003 :: Double+          put hdb "foo" ini+          get hdb "foo" >>= (Just ini @=?)+          adddouble hdb "foo" 0.3+          (get hdb "foo" >>= (isIn (ini+0.3))) @? "isIn"+          adddouble hdb "bar" 0.5 >>= (Just 0.5 @=?)+          put hdb "bar" "foo"+          adddouble hdb "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 ->+        withOpenedHDB fn $ \hdb -> do+            put hdb "foo" "111"+            put hdb "bar" "222"+            put hdb "baz" "333"+            rnum hdb >>= (3 @=?)+            vanish hdb+            rnum hdb >>= (0 @=?)++test_copy =+    withoutFile dbname $ \fns ->+        withoutFile "bar.tch" $ \fnd ->+            withOpenedHDB fns $ \hdb -> do+                put hdb "foo" "bar"+                copy hdb fnd+                close hdb+                open hdb fnd [OREADER]+                get hdb "foo" >>= (Just "bar" @=?)++test_txn =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb -> do+          tranbegin hdb+          put hdb "foo" "bar"+          get hdb "foo" >>= (Just "bar" @=?)+          tranabort hdb+          get hdb "foo" >>= ((Nothing :: Maybe String) @=?)+          tranbegin hdb+          put hdb "foo" "baz"+          get hdb "foo" >>= (Just "baz" @=?)+          trancommit hdb+          get hdb "foo" >>= (Just "baz" @=?)++test_path =+    withoutFile dbname $ \fn ->+        withOpenedHDB fn $ \hdb ->+            path hdb >>= (Just dbname @=?)++test_util =+    withoutFile dbname $ \fn -> do+      hdb <- new+      setcache hdb 1000000 @? "setcache"+      setxmsiz hdb 1000000 @? "setxmsiz"+      tune hdb 150000 5 11 [TLARGE, TBZIP] @? "tune"+      open hdb fn [OREADER, OWRITER, OCREAT]+      path hdb >>= (Just fn @=?)+      rnum hdb >>= (0 @=?)+      ((> 0) `fmap` fsiz hdb) @? "fsiz"+      sync hdb @? "sync"+      optimize hdb 0 (-1) (-1) [] @? "optimize"+      close hdb++tests = test [+          "new delete" ~: test_new_delete+        , "ecode" ~: test_ecode+        , "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+        ]++main = runTestTT tests
+ tests/ListTest.hs view
@@ -0,0 +1,221 @@+module Main where+import Test.HUnit++import Control.Monad+import Data.Int+import Data.Word+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L++import Database.TokyoCabinet.List++len_test = do+  xs <- new+  (==0) `fmap` len xs @? "empty"+  push xs "foo"+  (==1) `fmap` len xs @? "1 element"+  push xs "baz"+  (==2) `fmap` len xs @? "2 elements"+  pop xs :: IO (Maybe String)+  (==1) `fmap` len xs @? "1 element again"+  pop xs :: IO (Maybe String)+  (==0) `fmap` len xs @? "empty again"+  delete xs++push_pop_test = do+  xs <- new+  push xs "foo"+  push xs "bar"+  push xs "baz"+  (@?= (Just "baz")) =<< pop xs+  (@?= (Just "bar")) =<< pop xs+  (@?= (Just "foo")) =<< pop xs+  (@?= (Nothing :: Maybe String)) =<< pop xs+  delete xs++unshift_shift_test = do+  xs <- new+  unshift xs "foo"+  unshift xs "bar"+  unshift xs "baz"+  (@?= (Just "baz")) =<< shift xs+  (@?= (Just "bar")) =<< shift xs+  (@?= (Just "foo")) =<< shift xs+  (@?= (Nothing :: Maybe String)) =<< shift xs+  delete xs++clear_test = do+  xs <- new+  push xs ""+  push xs ""+  push xs ""+  (@?= 3) =<< len xs+  clear xs+  (@?= 0) =<< len xs+  delete xs++insert_remove_test = do+  xs <- new+  (@?= (Nothing :: Maybe String)) =<< remove xs 0+  insert xs 0 "foo"+  insert xs 0 "bar"+  insert xs 1 "baz"+  (@?= 3)            =<< len xs+  (@?= (Just "bar")) =<< get xs 0+  (@?= (Just "baz")) =<< get xs 1+  (@?= (Just "foo")) =<< get xs 2+  (@?= (Nothing :: Maybe String)) =<< get xs 3+  remove xs 0 :: IO (Maybe String)+  (@?= 2) =<< len xs+  (@?= (Just "foo")) =<< get xs 1+  remove xs 1 :: IO (Maybe String)+  (@?= 1)                         =<< len xs+  (@?= (Just "baz"))              =<< get xs 0+  (@?= (Nothing :: Maybe String)) =<< get xs 1+  (@?= (Nothing :: Maybe String)) =<< remove xs 1+  delete xs++sort_test = do+  xs <- new+  let x = 12 :: Int+      y = 49 :: Int+      z = 5  :: Int+  push xs x+  push xs y+  push xs z+  sort xs+  (@?= 3)        =<< len xs+  (@?= (Just z)) =<< get xs 0+  (@?= (Just x)) =<< get xs 1+  (@?= (Just y)) =<< get xs 2+  delete xs++lsearch_test = do+  xs <- new+  let x = 12 :: Int+      y = 49 :: Int+      z = 5  :: Int+  push xs x+  push xs y+  push xs z+  (@?= 2) =<< lsearch xs z+  (@?= 0) =<< lsearch xs x+  (@?= 1) =<< lsearch xs y+  delete xs++bsearch_test = do+  xs <- new+  let x = 12 :: Int+      y = 49 :: Int+      z = 5  :: Int+  push xs z+  push xs x+  push xs y+  (@?= 0) =<< bsearch xs z+  (@?= 1) =<< bsearch xs x+  (@?= 2) =<< bsearch xs y+  delete xs++int_test = do+  xs   <- new :: IO (List Int)+  xs8  <- new :: IO (List Int8)+  xs16 <- new :: IO (List Int16)+  xs32 <- new :: IO (List Int32)+  xs64 <- new :: IO (List Int64)+  let num_int   = [ 1..10]+      num_int8  = [11..20]+      num_int16 = [21..30]+      num_int32 = [31..40]+      num_int64 = [41..50]+  pushlist xs   num_int+  pushlist xs8  num_int8+  pushlist xs16 num_int16+  pushlist xs32 num_int32+  pushlist xs64 num_int64+  get xs   0 >>= (@?= (Just (num_int   !! 0)))+  get xs   9 >>= (@?= (Just (num_int   !! 9)))+  get xs8  0 >>= (@?= (Just (num_int8  !! 0)))+  get xs8  9 >>= (@?= (Just (num_int8  !! 9)))+  get xs16 0 >>= (@?= (Just (num_int16 !! 0)))+  get xs16 9 >>= (@?= (Just (num_int16 !! 9)))+  get xs32 0 >>= (@?= (Just (num_int32 !! 0)))+  get xs32 9 >>= (@?= (Just (num_int32 !! 9)))+  get xs64 0 >>= (@?= (Just (num_int64 !! 0)))+  get xs64 9 >>= (@?= (Just (num_int64 !! 9)))+    where+      pushlist xs ys = mapM_ (push xs) ys++word_test = do+  xs8  <- new :: IO (List Word8)+  xs16 <- new :: IO (List Word16)+  xs32 <- new :: IO (List Word32)+  xs64 <- new :: IO (List Word64)+  let num_word8   = [ 1..10]+      num_word16  = [11..20]+      num_word32  = [21..30]+      num_word64  = [31..40]+  pushlist xs8  num_word8+  pushlist xs16 num_word16+  pushlist xs32 num_word32+  pushlist xs64 num_word64+  get xs8  0 >>= (@?= (Just (num_word8  !! 0)))+  get xs8  9 >>= (@?= (Just (num_word8  !! 9)))+  get xs16 0 >>= (@?= (Just (num_word16 !! 0)))+  get xs16 9 >>= (@?= (Just (num_word16 !! 9)))+  get xs32 0 >>= (@?= (Just (num_word32 !! 0)))+  get xs32 9 >>= (@?= (Just (num_word32 !! 9)))+  get xs64 0 >>= (@?= (Just (num_word64 !! 0)))+  get xs64 9 >>= (@?= (Just (num_word64 !! 9)))+    where+      pushlist xs ys = mapM_ (push xs) ys++strict_bytestring_test = do+  xs <- new+  let vals = map S.pack ["foo", "bar", "baz"]+  mapM_ (push xs) vals+  get xs 0 >>= (@?= (Just (vals  !! 0)))+  get xs 1 >>= (@?= (Just (vals  !! 1)))+  get xs 2 >>= (@?= (Just (vals  !! 2)))++lazy_bytestring_test = do+  xs <- new+  let vals = map L.pack ["foo", "bar", "baz"]+  mapM_ (push xs) vals+  get xs 0 >>= (@?= (Just (vals  !! 0)))+  get xs 1 >>= (@?= (Just (vals  !! 1)))+  get xs 2 >>= (@?= (Just (vals  !! 2)))++dump_load_test = do+  xs <- new+  mapM_ (push xs) ["foo", "bar", "baz"]+  bytes <- dump xs+  ys <- load bytes+  xsiz <- len xs+  ysiz <- len ys+  xsiz @?= ysiz+  tclist_equal xs ys 0 xsiz+  where+    tclist_equal xs ys ix num =+        do if ix == num+             then return ()+             else do liftM2 (@?=) (get xs ix :: IO (Maybe String))+                                  (get ys ix :: IO (Maybe String))+                     tclist_equal xs ys (1 + ix) num++tests = test [+          "len test" ~: len_test+        , "push pop test" ~: push_pop_test+        , "unshift shift test" ~: unshift_shift_test+        , "clear test" ~: clear_test+        , "insert remove test" ~: insert_remove_test+        , "sort test" ~: sort_test+        , "lsearch test" ~: lsearch_test+        , "bsearch test" ~: bsearch_test+        , "int_test" ~: int_test+        , "word_test" ~: word_test+        , "strict_bytestring_test" ~: strict_bytestring_test+        , "lazy_bytestring_test" ~: lazy_bytestring_test+        , "dump_load_test" ~: dump_load_test+        ]++main = runTestTT tests
+ tests/MapTest.hs view
@@ -0,0 +1,126 @@+module Main where+import Test.HUnit++import Control.Monad+import Database.TokyoCabinet.Map++new_delete_test = do+  m <- new+  delete m+  m' <- new2 10+  delete m'++dup_test = do+  m1 <- new+  put m1 "foo" "bar"+  m2 <- dup m1+  get m2 "foo" >>= (Just "bar" @=?)++putxx_test = do+  m <- new+  put m "foo" "bar"+  get m "foo" >>= (Just "bar" @=?)+  putkeep m "foo" "baz"+  get m "foo" >>= (Just "bar" @=?)+  putcat m "foo" "baz"+  get m "foo" >>= (Just "barbaz" @=?)+  get m "hoge" >>= (Nothing @=?)++out_test = do+  m <- new+  put m "foo" "bar"+  get m "foo" >>= (Just "bar" @=?)+  out m "foo"+  get m "foo" >>= (Nothing @=?)++move_test = do+  m <- new+  put m "foo" "100"+  put m "bar" "200"+  put m "baz" "300"+  keys m >>= ("foo" @=?) . head+  move m "bar" True+  keys m >>= ("bar" @=?) . head+  move m "foo" False+  keys m >>= ("foo" @=?) . last++iter_test = do+  m <- new+  zipWithM_ (put m) ["foo", "bar", "baz"] ([1..] :: [Int])+  iterinit m+  iternext m >>= (Just "foo" @=?)+  iternext m >>= (Just "bar" @=?)+  iternext m >>= (Just "baz" @=?)++util_test = do+  m <- new+  zipWithM_ (put m) ["foo", "bar", "baz"] ([1..] :: [Int])+  rnum m >>= (3 @=?)+  siz <- msiz m+  (siz > 0) @? "msiz returns positive int value"+  m' <- new+  rnum m' >>= (0 @=?)++keys_vals_test = do+  m <- new+  zipWithM_ (put m) ["foo", "bar", "baz"] ([1..] :: [Int])+  keys m >>= (["foo", "bar", "baz"] @=?)+  vals m >>= ([1..3] @=?)+  m' <- new :: IO (Map String String)+  keys m' >>= ([] @=?)+  vals m' >>= ([] @=?)++add_test = do+  mi <- new+  put mi "foo" (1 :: Int)+  addint mi "foo" 23 >>= (Just 24 @=?)+  addint mi "bar" 23 >>= (Just 23 @=?)+  md <- new+  put md "foo" (1 :: Double)+  adddouble md "foo" 2.0 >>= (Just 3.0 @=?)+  adddouble md "bar" 2.0 >>= (Just 2.0 @=?)++clear_test = do+  m <- new+  zipWithM_ (put m) ["foo", "bar", "baz"] ([1..] :: [Int])+  rnum m >>= (3 @=?)+  get m "foo" >>= (Just 1 @=?)+  clear m+  rnum m >>= (0 @=?)+  get m "foo" >>= (Nothing @=?)++cutfront_test = do+  m <- new+  zipWithM_ (put m) ["foo", "bar", "baz"] ([1..] :: [Int])+  keys m >>= ("foo" @=?) . head+  cutfront m 2+  keys m >>= ("baz" @=?) . head+  m' <- new :: IO (Map Int Int)+  cutfront m' 10+  keys m' >>= ([] @=?)++dump_load_test = do+  m <- new+  zipWithM_ (put m) ["foo", "bar", "baz"] ([1..] :: [Int])+  bytes <- dump m+  m' <- load bytes+  liftM2 (==) (keys m) (keys m') @? "original and dumped have the same keys"+  liftM2 (==) (vals m) (vals m') @? "original and dumped have the same vals"+  delete m++tests = test [+          "new delete test" ~: new_delete_test+        , "dup test" ~: dup_test+        , "putxx test" ~: putxx_test+        , "out test" ~: out_test+        , "move test" ~: move_test+        , "iter test" ~: iter_test+        , "util test" ~: util_test+        , "keys vals test" ~: keys_vals_test+        , "add test" ~: add_test+        , "clear test" ~: clear_test+        , "cutfront test" ~: cutfront_test+        , "dump load test" ~: dump_load_test+        ]++main = runTestTT tests
+ tests/StorableTest.hs view
@@ -0,0 +1,145 @@+module Main where++import TestUtil+import Test.HUnit hiding (path)++import Database.TokyoCabinet+import Database.TokyoCabinet.Storable+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L++import Data.Int+import Data.Word++import Control.Monad.Trans (liftIO)++e @=?: a = liftIO $ e @=? a++check :: (TCDB tc, Eq a, Storable a) => tc -> a -> a -> TCM ()+check tc k v = do put tc k v+                  get tc k >>= (Just v @=?:)+                  iterinit tc+                  iternext tc >>= (Just k @=?:)++bdb :: TCM BDB+bdb = new++hdb :: TCM HDB+hdb = new++fdb :: TCM FDB+fdb = new++string = "100"+bstring = S.pack "100"+lstring = L.pack "100000"++int = 100 :: Int+int8 = 100 :: Int8+int16 = 100 :: Int16+int32 = 100 :: Int32+int64 = 100 :: Int64++word8 = 100 :: Word8+word16 = 100 :: Word16+word32 = 100 :: Word32+word64 = 100 :: Word64++double = 100 :: Double+float = 100 :: Float++char = '1'++dbname tc = "foo" ++ (defaultExtension tc)++make_check :: (TCDB tc, Eq a, Storable a) => TCM tc -> a -> IO Bool+make_check tcm k = runTCM $ do+                     tc <- tcm+                     liftIO $ withoutFile (dbname tc) $ \fn ->+                         runTCM $ do+                              open tc fn [OWRITER, OCREAT]+                              check tc k k+                              close tc++tests = test [+          make_check bdb string+        , make_check hdb string+        , make_check fdb string+        , make_check bdb bstring+        , make_check hdb bstring+        , make_check fdb bstring+        , make_check bdb lstring+        , make_check hdb lstring+        , make_check fdb lstring+        , make_check bdb int+        , make_check hdb int+        , make_check fdb int+        , make_check bdb [int]+        , make_check hdb [int]+        , make_check fdb [int]+        , make_check bdb int8+        , make_check hdb int8+        , make_check fdb int8+        , make_check bdb [int8]+        , make_check hdb [int8]+        , make_check fdb [int8]+        , make_check bdb int16+        , make_check hdb int16+        , make_check fdb int16+        , make_check bdb [int16]+        , make_check hdb [int16]+        , make_check fdb [int16]+        , make_check bdb int32+        , make_check hdb int32+        , make_check fdb int32+        , make_check bdb [int32]+        , make_check hdb [int32]+        , make_check fdb [int32]+        , make_check bdb int64+        , make_check hdb int64+        , make_check fdb int64+        , make_check bdb [int64]+        , make_check hdb [int64]+        , make_check fdb [int64]+        , make_check bdb word8+        , make_check hdb word8+        , make_check fdb word8+        , make_check bdb [word8]+        , make_check hdb [word8]+        , make_check fdb [word8]+        , make_check bdb word16+        , make_check hdb word16+        , make_check fdb word16+        , make_check bdb [word16]+        , make_check hdb [word16]+        , make_check fdb [word16]+        , make_check bdb word32+        , make_check hdb word32+        , make_check fdb word32+        , make_check bdb [word32]+        , make_check hdb [word32]+        , make_check fdb [word32]+        , make_check bdb word64+        , make_check hdb word64+        , make_check fdb word64+        , make_check bdb [word64]+        , make_check hdb [word64]+        , make_check fdb [word64]+        , make_check bdb double+        , make_check hdb double+        , make_check bdb [double]+        , make_check hdb [double]+        , make_check bdb float+        , make_check hdb float+        , make_check bdb [float]+        , make_check hdb [float]+        , make_check bdb char+        , make_check hdb char+        , make_check fdb char+        , make_check bdb [char]+        , make_check hdb [char]+        , make_check fdb [char]+        ]+                          ++main = runTestTT tests
+ tests/TCDBTest.hs view
@@ -0,0 +1,260 @@+module Main where++import TestUtil+import Test.HUnit hiding (path)+import Database.TokyoCabinet+import qualified Database.TokyoCabinet.BDB as B++import Data.Maybe (catMaybes)+import Data.List (sort)++import Control.Monad+import Control.Exception+import Control.Monad.Trans (liftIO)++withoutFileM :: String -> (String -> TCM a) -> TCM a+withoutFileM fn action = liftIO $ bracket (setupFile fn) teardownFile+                         (runTCM . action)++withOpenedTC :: (TCDB tc) => String -> tc -> (tc -> TCM a) -> TCM a+withOpenedTC name tc action = do+  open tc name [OREADER, OWRITER, OCREAT]+  res <- action tc+  close tc+  return res++tcdb :: (TCDB tc) => (tc -> TCM a) -> TCM a+tcdb = (new >>=)++bdb :: (BDB -> TCM a) -> TCM a+bdb = tcdb++hdb :: (HDB -> TCM a) -> TCM a+hdb = tcdb++fdb :: (FDB -> TCM a) -> TCM a+fdb = tcdb++tdb :: (TDB -> TCM a) -> TCM a+tdb = tcdb++bbdb :: (B.BDB -> TCM a) -> TCM a+bbdb = tcdb++dbname tc = "foo" ++ (defaultExtension tc)++test_new_delete tc = delete tc++e @=?: a = liftIO $ e @=? a+e @?=: a = liftIO $ e @?= a+e @?: msg = liftIO $ runTCM e @? msg++test_ecode tc =+    withoutFileM (dbname tc) $ \fn -> do+        open tc fn [OREADER]+        ecode tc >>= (ENOFILE @=?:)++test_open_close tc =+    withoutFileM (dbname tc) $ \fn -> do+      not `liftM` open tc fn [OREADER] @?: "file does not exist"+      open tc fn [OREADER, OWRITER, OCREAT] @?: "open"+      close tc @?: "close"+      not `liftM` close tc @?: "cannot close closed file"++test_putxx tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          put tc' "1" "bar"+          get tc' "1" >>= (Just "bar" @=?:)+          putkeep tc' "1" "baz"+          get tc' "1" >>= (Just "bar" @=?:)+          putcat tc' "1" "baz"+          get tc' "1" >>= (Just "barbaz" @=?:)++test_out tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          put tc' "1" "bar"+          get tc' "1" >>= (Just "bar" @=?:)+          out tc' "1" @?: "out succeeded"+          get tc' "1" >>= ((Nothing :: Maybe String) @=?:)++test_put_get tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          put tc' "1" "foo"+          put tc' "2" "bar"+          put tc' "3" "baz"+          get tc' "1" >>= (Just "foo" @=?:)+          get tc' "2" >>= (Just "bar" @=?:)+          get tc' "3" >>= (Just "baz" @=?:)++test_vsiz tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          put tc' "1" "bar"+          vsiz tc' "1" >>= (Just 3 @=?:)+          vsiz tc' "2" >>= ((Nothing :: Maybe Int) @=?:)++test_iterate tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          let keys = [1..3] :: [Int]+              vals = ["foo", "bar", "baz"]+          zipWithM_ (put tc') keys vals+          iterinit tc'+          keys' <- sequence $ replicate (length keys) (iternext tc')+          (sort $ catMaybes keys') @?=: (sort keys)++test_fwmkeys tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          mapM_ (uncurry (put tc')) ([ ("foo", 100)+                                     , ("bar", 200)+                                     , ("baz", 201)+                                     , ("jkl", 300)] :: [(String, Int)])+          fwmkeys tc' "ba" 10 >>= (["bar", "baz"] @=?:) . sort+          fwmkeys tc' "ba" 1 >>= (["bar"] @=?:)+          fwmkeys tc' "" 10 >>= (["bar", "baz", "foo", "jkl"] @=?:) . sort++test_fwmkeys_fdb tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          zipWithM_ (put tc') ([1..10] :: [Int]) ([100, 200..1000] :: [Int])+          fwmkeys tc' "[min,max]" 10 >>= (([1..10] :: [Int]) @=?:)++test_addint tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          let ini = 32 :: Int+          put tc' "100" ini+          get tc' "100" >>= (Just ini @=?:)+          addint tc' "100" 3+          get tc' "100" >>= (Just (ini+3) @=?:)+          addint tc' "200" 1 >>= (Just 1 @=?:)+          put tc' "200" "foo"+          addint tc' "200" 1 >>= (Nothing @=?:)++test_adddouble tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+          let ini = 0.003 :: Double+          put tc' "100" ini+          get tc' "100" >>= (Just ini @=?:)+          adddouble tc' "100" 0.3+          (get tc' "100" >>= (return . isIn (ini+0.3))) @?: "isIn"+          adddouble tc' "200" 0.5 >>= (Just 0.5 @=?:)+          put tc' "200" "foo"+          adddouble tc' "200" 1.2 >>= (Nothing @=?:)+    where+      margin = 1e-30+      isIn :: Double -> (Maybe Double) -> Bool+      isIn expected (Just actual) =+          let diff = expected - actual+          in abs diff <= margin++test_vanish tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' -> do+            put tc' "100" "111"+            put tc' "200" "222"+            put tc' "300" "333"+            rnum tc' >>= (3 @=?:)+            vanish tc'+            rnum tc' >>= (0 @=?:)++test_copy tc =+    withoutFileM (dbname tc) $ \fns ->    +        withoutFileM ("bar" ++ defaultExtension tc) $ \fnd ->+            withOpenedTC fns tc $ \tc' -> do+                put tc' "100" "bar"+                copy tc' fnd+                close tc'+                open tc' fnd [OREADER]+                get tc' "100" >>= (Just "bar" @=?:)++test_path tc =+    withoutFileM (dbname tc) $ \fn ->+        withOpenedTC fn tc $ \tc' ->+            path tc' >>= (Just (dbname tc) @=?:)++test_util tc =+    withoutFileM (dbname tc) $ \fn -> do+      open tc fn [OWRITER, OCREAT]+      path tc >>= (Just fn @=?:)+      rnum tc >>= (0 @=?:)+      ((> 0) `liftM` size tc) @?: "fsiz"+      sync tc @?: "sync"+      close tc++tests = test [+          "new delete BDB" ~: (runTCM $ bdb test_new_delete)+        , "new delete HDB" ~: (runTCM $ hdb test_new_delete)+        , "new delete FDB" ~: (runTCM $ fdb test_new_delete)+        , "new delete B.BDB" ~: (runTCM $ bbdb test_new_delete)+        , "ecode BDB" ~: (runTCM $ bdb test_ecode)+        , "ecode HDB" ~: (runTCM $ hdb test_ecode)+        , "ecode FDB" ~: (runTCM $ fdb test_ecode)+        , "ecode B.BDB" ~: (runTCM $ bbdb test_ecode)+        , "open close BDB" ~: (runTCM $ bdb test_open_close)+        , "open close HDB" ~: (runTCM $ hdb test_open_close)+        , "open close FDB" ~: (runTCM $ fdb test_open_close)+        , "open close B.BDB" ~: (runTCM $ bbdb test_open_close)+        , "putxxx BDB" ~: (runTCM $ bdb test_putxx)+        , "putxxx HDB" ~: (runTCM $ hdb test_putxx)+        , "putxxx FDB" ~: (runTCM $ fdb test_putxx)+        , "putxxx B.BDB" ~: (runTCM $ bbdb test_putxx)+        , "out BDB" ~: (runTCM $ bdb test_out)+        , "out HDB" ~: (runTCM $ hdb test_out)+        , "out FDB" ~: (runTCM $ fdb test_out)+        , "out B.BDB" ~: (runTCM $ bbdb test_out)+        , "put get BDB" ~: (runTCM $ bdb test_put_get)+        , "put get HDB" ~: (runTCM $ hdb test_put_get)+        , "put get FDB" ~: (runTCM $ fdb test_put_get)+        , "put get B.BDB" ~: (runTCM $ bbdb test_put_get)+        , "vsiz BDB" ~: (runTCM $ bdb test_vsiz)+        , "vsiz HDB" ~: (runTCM $ hdb test_vsiz)+        , "vsiz FDB" ~: (runTCM $ fdb test_vsiz)+        , "vsiz B.BDB" ~: (runTCM $ bbdb test_vsiz)+        , "iterate BDB" ~: (runTCM $ bdb test_iterate)+        , "iterate HDB" ~: (runTCM $ hdb test_iterate)+        , "iterate FDB" ~: (runTCM $ fdb test_iterate)+        , "fwmkeys BDB" ~: (runTCM $ bdb test_fwmkeys)+        , "fwmkeys HDB" ~: (runTCM $ hdb test_fwmkeys)+        , "fwmkeys FDB" ~: (runTCM $ fdb test_fwmkeys_fdb)+        , "fwmkeys B.BDB" ~: (runTCM $ bbdb test_fwmkeys)+        , "addint BDB" ~: (runTCM $ bdb test_addint)+        , "addint HDB" ~: (runTCM $ hdb test_addint)+        , "addint FDB" ~: (runTCM $ fdb test_addint)+        , "addint B.BDB" ~: (runTCM $ bbdb test_addint)+        , "adddouble BDB" ~: (runTCM $ bdb test_adddouble)+        , "adddouble HDB" ~: (runTCM $ hdb test_adddouble)+        , "adddouble FDB" ~: (runTCM $ fdb test_adddouble)+        , "adddouble B.BDB" ~: (runTCM $ bbdb test_adddouble)+        , "vanish BDB" ~: (runTCM $ bdb test_vanish)+        , "vanish HDB" ~: (runTCM $ hdb test_vanish)+        , "vanish FDB" ~: (runTCM $ fdb test_vanish)+        , "vanish B.BDB" ~: (runTCM $ bbdb test_vanish)+        , "copy BDB" ~: (runTCM $ bdb test_copy)+        , "copy HDB" ~: (runTCM $ hdb test_copy)+        , "copy FDB" ~: (runTCM $ fdb test_copy)+        , "copy B.BDB" ~: (runTCM $ bbdb test_copy)+        , "path BDB" ~: (runTCM $ bdb test_path)+        , "path HDB" ~: (runTCM $ hdb test_path)+        , "path FDB" ~: (runTCM $ fdb test_path)+        , "path B.BDB" ~: (runTCM $ bbdb test_path)+        , "util BDB" ~: (runTCM $ bdb test_util)+        , "util HDB" ~: (runTCM $ hdb test_util)+        , "util FDB" ~: (runTCM $ fdb test_util)+        , "util B.BDB" ~: (runTCM $ bbdb test_util)+        , "new delete TDB" ~: (runTCM $ tdb test_new_delete)+        , "ecode TDB" ~: (runTCM $ tdb test_ecode)+        , "open close TDB" ~: (runTCM $ tdb test_open_close)+        , "iterate TDB" ~: (runTCM $ tdb test_iterate)+        , "fwmkeys B.BDB" ~: (runTCM $ bbdb test_fwmkeys)+        , "vanish TDB" ~: (runTCM $ tdb test_vanish)+        , "path TDB" ~: (runTCM $ tdb test_path)+        , "util TDB" ~: (runTCM $ tdb test_util)+        ]++main = runTestTT tests
+ tests/TDBQRYTest.hs view
@@ -0,0 +1,150 @@+module Main where++import Test.HUnit hiding (path)+import TestUtil+import Data.IORef+import Data.List (isPrefixOf)+import Database.TokyoCabinet.TDB+import Database.TokyoCabinet.TDB.Query hiding (new, delete)+import qualified Database.TokyoCabinet.TDB.Query as Q (new, delete)++dbname :: String+dbname = "foo.tct"++withOpenedTDB :: String -> (TDB -> IO a) -> IO ()+withOpenedTDB name action = do+  h <- new+  open h name [OWRITER, OCREAT]+  action h+  close h+  return ()++test_new_delete = do+  tdb <- new+  qry <- Q.new tdb+  Q.delete qry+  delete tdb++samples :: [ (String, AssocList String String) ]+samples = [ ("hop" , AssocList [("foo", "1"), ("bar", "abc")])+          , ("step", AssocList [("foo", "2"), ("bar", "def")])+          , ("jump", AssocList [("foo", "3"), ("bar", "deg")]) ]+++test_addcond =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGT "1"+               search qry >>= (["step", "jump"] @=?)+               qry <- Q.new tdb+               addcond qry "bar" QCSTRBW "de"+               search qry >>= (["step", "jump"] @=?)+               qry <- Q.new tdb+               addcond qry "bar" QCSTRBW "de"+               search qry >>= (["step", "jump"] @=?)+               qry <- Q.new tdb+               addcond qry "bar" (QCNEGATE QCSTRBW) "de"+               search qry >>= (["hop"] @=?)+               qry <- Q.new tdb+               addcond qry "bar" QCSTRRX ".e."+               search qry >>= (["step", "jump"] @=?)++test_setorder =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGT "0"+               setorder qry "bar" QOSTRDESC+               search qry >>= (["jump", "step", "hop"] @=?)+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGT "0"+               setorder qry "bar" QOSTRASC+               search qry >>= (["hop", "step", "jump"] @=?)+               qry <- Q.new tdb+               addcond qry "bar" QCSTRBW ""+               setorder qry "foo" QONUMDESC+               search qry >>= (["jump", "step", "hop"] @=?)+               qry <- Q.new tdb+               addcond qry "bar" QCSTRBW ""+               setorder qry "foo" QONUMASC+               search qry >>= (["hop", "step", "jump"] @=?)++test_setlimit =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGT "0"+               setlimit qry 1 0+               search qry >>= (["hop"] @=?)+               setlimit qry 1 1+               search qry >>= (["step"] @=?)+               setlimit qry 2 2+               search qry >>= (["jump"] @=?)+               setlimit qry 2 1+               search qry >>= (["step", "jump"] @=?)++test_searchout =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGT "2"+               searchout qry @? "searchout"+               fwmkeys tdb "" (-1) >>= (["hop", "step"] @=?)++test_hint =+    withoutFile dbname $ \fn ->+    withoutFile (dbname ++ ".idx.foo.dec") $ \_ ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGT "2"+               search qry :: IO [String]+               ("scanning the whole table" `isPrefixOf`) `fmap` hint qry @? "whole"+               setindex tdb "foo" ITDECIMAL+               search qry :: IO [String]+               ("using an index: \"foo\"" `isPrefixOf`) `fmap` hint qry @? "index"++test_proc1 =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGE "2"+               (proc qry $ \pkey (AssocList cols) -> do+                 let val = [(k, v ++ "!") | (k, v) <- cols] :: [(String, String)]+                 return $ QPPUT (AssocList val)) @? "proc"+               (AssocList res) <- get tdb "step"+               lookup "foo" res @?= Just "2!"+               (AssocList res) <- get tdb "jump"+               lookup "foo" res @?= Just "3!"++test_proc2 =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               acc <- newIORef [] :: IO (IORef [String])+               qry <- Q.new tdb+               addcond qry "foo" QCNUMGE "1"+               proc qry $ \pkey (AssocList cols) -> do+                 let Just foo = lookup "foo" cols+                 writeIORef acc . (foo:) =<< readIORef acc+                 return $ if foo == "2" then QPSTOP else QPNOP+               readIORef acc >>= (["2", "1"] @=?)++tests = test [+          "new delete" ~: test_new_delete+        , "addcond" ~: test_addcond+        , "setorder" ~: test_setorder+        , "setlimit" ~: test_setlimit+        , "searchout" ~: test_searchout+        , "hint" ~: test_hint+        , "proc1" ~: test_proc1+        , "proc2" ~: test_proc2+        ]++main = runTestTT tests
+ tests/TDBTest.hs view
@@ -0,0 +1,203 @@+module Main where++import Test.HUnit hiding (path)+import TestUtil+import System.Directory+import Database.TokyoCabinet.TDB++dbname :: String+dbname = "foo.tct"++withOpenedTDB :: String -> (TDB -> IO a) -> IO ()+withOpenedTDB name action = do+  h <- new+  open h name [OWRITER, OCREAT]+  action h+  close h+  return ()++test_ecode =+    withoutFile dbname $ \fn -> do+        h <- new+        open h fn [OREADER]+        ecode h >>= (ENOFILE @=?)++test_new_delete = do+  tdb <- new+  delete tdb++test_open_close =+    withoutFile dbname $ \fn -> do+      tdb <- new+      not `fmap` open tdb fn [OREADER] @? "file does not exist"+      open tdb fn [OWRITER, OCREAT] @? "open"+      close tdb @? "close"+      not `fmap` close tdb @? "cannot close closed file"++test_util =+    withoutFile dbname $ \fn -> do+      tdb <- new+      setcache tdb 10000 4096 512 @? "setcache"+      setxmsiz tdb 67108864 @? "setxmsiz"+      tune tdb 100000 (-1) (-1) [TLARGE, TBZIP] @? "tune"+      open tdb fn [OWRITER, OCREAT] @? "open"+      path tdb >>= (Just fn @=?)+      rnum tdb >>= (0 @=?)+      ((> 0) `fmap` fsiz tdb) @? "fsiz"+      sync tdb @? "sync"+      optimize tdb 0 0 0 [] @? "optimize"+      close tdb++samples :: [ (String, AssocList String String) ]+samples = [ ("1", AssocList [("foo", "1"), ("bar", "2")])+          , ("2", AssocList [("foo", "1"), ("bar", "3")])+          , ("3", AssocList [("foo", "2"), ("bar", "1")]) ]++samples' :: [(String, String)]+samples' = [ ("1", "foo\0" ++ "1\0bar\0" ++ "2")+           , ("2", "foo\0" ++ "1\0bar\0" ++ "3")+           , ("3", "foo\0" ++ "2\0bar\0" ++ "1") ]++test_put =+    withoutFile dbname $ \fn -> do+      withOpenedTDB fn $ \tdb ->+          do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+             get tdb "1" >>= (hd @=?)+             putkeep tdb "4" (AssocList [("foo", "10"), ("bar", "20")]) @? "putkeep"+             putkeep tdb "1" (AssocList [("foo", "10"), ("bar", "20")])+             get tdb "1" >>= (hd @=?)+             putcat tdb "1" (AssocList [("baz", "3")]) @? "putcat"+             get tdb "1" >>= (AssocList [("foo", "1"), ("bar", "2"), ("baz", "3")] @=?)+          where+            hd = snd (head samples)++test_put' =+    withoutFile dbname $ \fn -> do+      withOpenedTDB fn $ \tdb ->+          do all id `fmap` mapM (uncurry $ put' tdb) samples' @? "put'"+             get' tdb "1" >>= (Just hd @=?)+             putkeep' tdb "4" ("foo\0" ++ "10\0bar\0" ++ "20") @? "putkeep'"+             putkeep' tdb "1" ("foo\0" ++ "10\0bar\0" ++ "20")+             get' tdb "1" >>= (Just hd @=?)+             putcat' tdb "1" ("baz\0" ++ "3") @? "putcat'"+             get' tdb "1" >>= (Just ("foo\0" ++ "1\0bar\0" ++ "2\0baz\0" ++ "3") @=?)+          where+            hd = snd (head samples')+test_out =+    withoutFile dbname $ \fn -> do+      withOpenedTDB fn $ \tdb ->+          do put tdb "1" (AssocList [("foo", "100"), ("bar", "200")]) @? "put"+             get tdb "1" >>= (AssocList [("foo", "100"), ("bar", "200")] @=?)+             out tdb "1" @? "out"+             get tdb "1" >>= (AssocList ([] :: [(String, String)]) @=?)++test_txn =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb -> do+          let sample = AssocList [("foo", "100"), ("bar", "200")]+              empty = AssocList [] :: AssocList String String+          tranbegin tdb+          put tdb "1" sample+          get tdb "1" >>= (sample @=?)+          tranabort tdb+          get tdb "1" >>= (empty @=?)+          tranbegin tdb+          put tdb "1" sample+          get tdb "1" >>= (sample @=?)+          trancommit tdb+          get tdb "1" >>= (sample @=?)++test_iter =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               iterinit tdb @? "iterinit"+               iternext tdb >>= (Just "1" @=?)+               iternext tdb >>= (Just "2" @=?)+               iternext tdb >>= (Just "3" @=?)+               iternext tdb >>= ((Nothing :: Maybe String) @=?)++test_vanish =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               get tdb "1" >>= (snd (head samples) @=?)+               vanish tdb+               get tdb "1" >>= ((AssocList [] :: AssocList String String) @=?)++test_copy =+    withoutFile dbname $ \fns ->+        withoutFile "bar.tcb" $ \fnd ->+            withOpenedTDB fns $ \tdb ->+                do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+                   copy tdb fnd @? "copy"+                   close tdb+                   open tdb fnd [OREADER]+                   get tdb "1" >>= (snd (head samples) @=?)++test_vsiz =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               vsiz tdb "1" >>= (Just 12 @=?)+               vsiz tdb "10" >>= (Nothing @=?)++test_add =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               addint tdb "1" 1 >>= (Just 1 @=?)+               addint tdb "1" 1 >>= (Just 2 @=?)+               v <- get tdb "1"+               lookup "_num" (unAssocList v) @?= Just "2"+               adddouble tdb "2" 1.2 >>= (Just 1.2 @=?)+               adddouble tdb "2" 1.2 >>= (Just 2.4 @=?)+               v <- get tdb "2"+               lookup "_num" (unAssocList v) @?= Just "2.4"++test_fwmkeys =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do put tdb "foo" (AssocList [("foo", "100")])+               put tdb "bar" (AssocList [("foo", "100")])+               put tdb "baz" (AssocList [("foo", "100")])+               fwmkeys tdb "ba" 10 >>= (["bar", "baz"] @=?)+               fwmkeys tdb "bak" 10 >>= (([] :: [String]) @=?)+               fwmkeys tdb "" 2 >>= (["foo", "bar"] @=?)++test_genuid =+    withoutFile dbname $ \fn -> do+      tdb <- new+      genuid tdb >>= (Nothing @=?)+      open tdb fn [OWRITER, OCREAT]+      genuid tdb >>= (Just 1 @=?)+      close tdb++test_setindex =+    withoutFile dbname $ \fn ->+        withOpenedTDB fn $ \tdb ->+            do all id `fmap` mapM (uncurry $ put tdb) samples @? "put"+               withoutFile (dbname ++ ".idx.foo.dec") $ \ifn -> do+                   setindex tdb "foo" ITDECIMAL+                   doesFileExist ifn @? "index"++tests = test [+          "new delete" ~: test_new_delete+        , "ecode" ~: test_ecode+        , "open close"  ~: test_open_close+        , "util" ~: test_util+        , "put" ~: test_put+        , "put'" ~: test_put'+        , "out" ~: test_out+        , "transaction" ~: test_txn+        , "iterate" ~: test_iter+        , "vanish" ~: test_vanish+        , "copy" ~: test_copy+        , "vsiz" ~: test_vsiz+        , "add" ~: test_add+        , "fwmkeys" ~: test_fwmkeys+        , "genuid" ~: test_genuid+        , "setindex" ~: test_setindex+        ]++main = runTestTT tests
tokyocabinet-haskell.cabal view
@@ -1,11 +1,11 @@ Name:           tokyocabinet-haskell-Version:        0.0.5-Cabal-Version:  >= 1.6+Version:        0.0.6+Cabal-Version:  >= 1.10 License:        BSD3 License-File:   LICENSE Author:         Tom Tsuruhara-Maintainer:     tom.lpsd@gmail.com-Homepage:       http://tom-lpsd.github.com/tokyocabinet-haskell/+Maintainer:     Stephen Paul Weber <singpolyma@singpolyma.net>+Homepage:       https://git.singpolyma.net/tokyocabinet-haskell Stability:      experimental Category:       Database Synopsis:       Haskell binding of Tokyo Cabinet@@ -23,14 +23,11 @@  Source-Repository head   type: git-  location: git://github.com/tom-lpsd/tokyocabinet-haskell.git--Flag BuildTest-  Description:  make tests and install it if True-  Default:      False+  location: https://git.singpolyma.net/tokyocabinet-haskell  Library-  Build-Depends:        base >= 4.0, bytestring >= 0.9, mtl >= 1.1+  Default-Language:     Haskell2010+  Build-Depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, mtl >= 1.1   Exposed-modules:     Database.TokyoCabinet     Database.TokyoCabinet.HDB@@ -59,10 +56,231 @@    Other-modules:     Database.TokyoCabinet.Internal-  Extensions:           CPP, ForeignFunctionInterface,+  Default-Extensions:   CPP, ForeignFunctionInterface,                         EmptyDataDecls, TypeSynonymInstances,                         GeneralizedNewtypeDeriving   Extra-libraries:      tokyocabinet   Extra-lib-dirs:       /usr/local/lib   Include-dirs:         /usr/local/include   GHC-Options:          -Wall++test-suite ListTest+  Default-Language:     Haskell2010+  Main-Is:              tests/ListTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Storable++test-suite MapTest+  Default-Language:     Haskell2010+  Main-Is:              tests/MapTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Map+    Database.TokyoCabinet.Map.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable++test-suite HDBTest+  Default-Language:     Haskell2010+  Main-Is:              tests/HDBTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.HDB+    Database.TokyoCabinet.HDB.C+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable++test-suite BDBTest+  Default-Language:     Haskell2010+  Main-Is:              tests/BDBTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet.BDB+    Database.TokyoCabinet.BDB.C+    Database.TokyoCabinet.BDB.Cursor+    Database.TokyoCabinet.BDB.Cursor.C+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable++test-suite FDBTest+  Default-Language:     Haskell2010+  Main-Is:              tests/FDBTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.FDB+    Database.TokyoCabinet.FDB.C+    Database.TokyoCabinet.FDB.Key+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable++test-suite TDBTest+  Default-Language:     Haskell2010+  Main-Is:              tests/TDBTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet.Associative+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Map+    Database.TokyoCabinet.Map.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable+    Database.TokyoCabinet.TDB+    Database.TokyoCabinet.TDB.C++test-suite TDBQRYTest+  Default-Language:     Haskell2010+  Main-Is:              tests/TDBQRYTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet.Associative+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.FDB.C+    Database.TokyoCabinet.FDB.Key+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Map+    Database.TokyoCabinet.Map.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable+    Database.TokyoCabinet.TDB+    Database.TokyoCabinet.TDB.C+    Database.TokyoCabinet.TDB.Query+    Database.TokyoCabinet.TDB.Query.C++test-suite ADBTest+  Default-Language:     Haskell2010+  Main-Is:              tests/ADBTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet.ADB+    Database.TokyoCabinet.ADB.C+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Storable+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Internal++test-suite TCDBTest+  Default-Language:     Haskell2010+  Main-Is:              tests/TCDBTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet+    Database.TokyoCabinet.Associative+    Database.TokyoCabinet.BDB+    Database.TokyoCabinet.BDB.C+    Database.TokyoCabinet.BDB.Cursor+    Database.TokyoCabinet.BDB.Cursor.C+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.FDB+    Database.TokyoCabinet.FDB.C+    Database.TokyoCabinet.FDB.Key+    Database.TokyoCabinet.HDB+    Database.TokyoCabinet.HDB.C+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Map+    Database.TokyoCabinet.Map.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable+    Database.TokyoCabinet.TDB+    Database.TokyoCabinet.TDB.C++test-suite StorableTest+  Default-Language:     Haskell2010+  Main-Is:              tests/StorableTest.hs+  Type:                 exitcode-stdio-1.0+  Extra-libraries:      tokyocabinet+  Build-depends:        base >= 4.0 && < 4.12, bytestring >= 0.9, HUnit >= 1.2, directory >= 1.0, mtl >= 1.1+  Default-Extensions:   CPP, ForeignFunctionInterface,+                        EmptyDataDecls, TypeSynonymInstances+  Other-modules:+    TestUtil+    Database.TokyoCabinet+    Database.TokyoCabinet.Associative+    Database.TokyoCabinet.BDB+    Database.TokyoCabinet.BDB.C+    Database.TokyoCabinet.BDB.Cursor+    Database.TokyoCabinet.BDB.Cursor.C+    Database.TokyoCabinet.Error+    Database.TokyoCabinet.FDB+    Database.TokyoCabinet.FDB.C+    Database.TokyoCabinet.FDB.Key+    Database.TokyoCabinet.HDB+    Database.TokyoCabinet.HDB.C+    Database.TokyoCabinet.Internal+    Database.TokyoCabinet.List+    Database.TokyoCabinet.List.C+    Database.TokyoCabinet.Map+    Database.TokyoCabinet.Map.C+    Database.TokyoCabinet.Sequence+    Database.TokyoCabinet.Storable+    Database.TokyoCabinet.TDB+    Database.TokyoCabinet.TDB.C