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
