module Main where

import Data.Word
import Foreign.C.Types
import Foreign.Ptr

import BDB.BDB
import qualified BDB.Env as E
import BDB.Txn
import BDB.Const
import BDB.Util


import Data.AltBinary hiding (get)
import Data.AltBinary.TH
-- import BDB.Binary
-- import BDB.DStore

-- * Other

data MyThing = MyThing Int String
             | YourThing Char String
             deriving Show

-- $(mkBinInstance ''MyThing)

$(deriveBinary ''MyThing)

mythingTest :: IO ()
mythingTest = 
    withDB Nothing Nothing "mydb.db" Nothing DbBTree ([DbCreate],[]) Nothing $ \ (db :: (Ptr (DB Int MyThing))) ->
           do put' db Nothing ([],[]) (1, (MyThing 10 "fish"))
              put' db Nothing ([],[]) (2, (YourThing 'h' "rar"))
              withDbCursor db Nothing ([],[]) $ \dbcursor ->
                  do (cGet dbcursor) Nothing Nothing ([],[DbFirst],[]) >>= showRes
                     (cGet dbcursor) Nothing Nothing ([],[DbNext],[]) >>= showRes
                     (cGet dbcursor) Nothing Nothing ([],[DbNext],[]) >>= showRes
--              get' db Nothing [] 1 >>= print
--              get' db Nothing [] 2 >>= print
--              get' db 3 >>= print

showRes :: (Show k, Show v) => Either CInt (k,v) -> IO ()
showRes (Left errno) = 
    do msg <- strError errno
       putStrLn msg
showRes (Right (k,v)) =
    print (k,v)

appendTest :: IO ()
appendTest =
    withDB Nothing Nothing "append.db" Nothing DbRecNo ([DbCreate],[]) Nothing $ \ (db :: (Ptr (DB Word32 Word32))) ->
      do a <- append db Nothing ([],[]) 0xab
         case a of
           Left e -> 
               do eMsg <- strError e
                  print eMsg
           Right recno ->
               do r <- get' db Nothing ([],[]) recno
                  print (recno, r)

get' :: (Binary k, Binary v {- , ToBin (Ptr Word8) IO k, ToBin (Ptr Word8) IO v -}, Show k, Show v) => Ptr (DB k v) -> Maybe (Ptr DbTxn) -> ([AccessFlag],[DbtFlag]) -> k -> IO v
get' db txnPtr flags k = 
    do ret <- get db txnPtr flags k
       case ret of 
         Left e -> 
          do msg <- strError e
             error ("get " ++ show k ++": " ++ msg)
         Right v -> return v

put' :: (Binary k, Binary v {- , ToBin (Ptr Word8) IO k, ToBin (Ptr Word8) IO v-}, Show k, Show v) => Ptr (DB k v) -> Maybe (Ptr DbTxn) -> ([AccessFlag],[DbtFlag]) -> (k,v) -> IO ()
put' db txnPtr flags (k,v) =
    do ret <- put db txnPtr flags (k,v) 
       case ret of 
         0 -> return ()
         n -> 
             do msg <- strError n
                error ("put " ++ show (k,v) ++": " ++ msg)


dbError :: String -> CInt -> IO a
dbError errMsg ret = 
    do retMsg <- strError ret
       error (errMsg ++ ": " ++ retMsg)

envTest :: IO ()
envTest =
    do ret <- E.withDbEnv [] $ (Just "MYTXN") ([DbCreate, DbRecover, DbThread],[DbInitLock, DbInitLog, DbInitMPool, DbInitTxn]) (Just 0x700) \dbEnv ->
                 home <- E.getHome dbEnv
                 case home of
                   Left n -> dbError "getHome failed" n
                   Right home' -> putStrLn $ "Home: " ++ home'
       case ret of
         Left n -> dbError "failed to initalize DB_ENV" n
         Right () -> return ()

onError :: String -> CInt -> IO ()
onError _ 0 = return ()
onError msg n = dbError msg n

txnTest :: IO ()
txnTest =
    do ret <- E.withDbEnv [] $ \dbEnv ->
              do openRet <- E.open dbEnv (Just "MYTXN") ([DbCreate, DbRecover],[DbInitLock, DbInitLog, DbInitMPool, DbInitTxn]) Nothing
                 case openRet of
                   0 -> 
                       do {-failed <- E.failChk dbEnv
                          case failed of
                            0 -> return ()
                            n -> dbError "failChk" n -}
                         -- The database open must be inside a transaction -- ususally done by using DbAutoCommit, me do it the hard way here
                         E.withTxn dbEnv Nothing ([],[]) $ \dbTxn ->
                             withDB (Just dbEnv) (Just dbTxn) "txn.db" Nothing DbRecNo ([DbCreate],[]) Nothing $ \ (db :: (Ptr (DB Word32 String))) ->
                                  do setErrFile db "db.errors"
                                     putStrLn "Attempting transaction"
                                     E.withTxn dbEnv (Just dbTxn) ([],[]) $ \dbTxn2 ->
                                      do tid <- txnId dbTxn2
                                         setName dbTxn2 "txn 1" >>= onError "setName Failed"
                                         gn <- getName dbTxn2
                                         case gn of
                                           Left n -> dbError "getName failed" n
                                           Right n -> print $ "getName: " ++ n
                                         putStrLn $ "tid: " ++ show tid
                                         putRet <- put db (Just dbTxn2) ([],[]) (1235, "dogz")
                                         case putRet of
                                           0 ->
                                              do ar <- append db (Just dbTxn2) ([],[]) "append test"
                                                 case ar of
                                                   Left n -> 
                                                       do -- abort dbTxn2
                                                          dbError "append failed" n
                                                   Right r -> putStrLn $ "appended record " ++ show r
                                                 commit dbTxn2 ([],[]) >>= onError "first commit dbTxn2 failed"
                                                        -- NOTE: txn can only be commited once or you get a seg fault  ?
--                                                 commit dbTxn2 ([],[]) >>= onError "second commit dbTxn2 failed"
                                                 putStrLn "transaction commited"
                                           n -> 
                                              do abortRet <- abort dbTxn2
                                                 putStrLn $ "abortRet: " ++ (show abortRet)
                                                 dbError "transactional put failed" n
                                         commit dbTxn ([],[]) >>= onError "commit dbTxn failed"
                                         
                         return ()
                   n -> dbError "failed to open DB_ENV" n
       case ret of
         Left n -> dbError "failed to initialize DB_ENV" n
         Right () -> return ()

-- * Main 

main :: IO ()
main =
    do envTest
       mythingTest
       appendTest
       txnTest