module Database.TokyoCabinet.Internal where

import Database.TokyoCabinet.List.C
import Database.TokyoCabinet.Storable
import Database.TokyoCabinet.Sequence

import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.C.String
import Foreign.Storable (peek)
import Foreign.Marshal (alloca, copyBytes, mallocBytes)
import Foreign.Marshal.Utils (maybePeek)

import Data.Word

type Lifter ptr tcdb = Ptr ptr -> tcdb
type UnLifter tcdb fptr = tcdb -> ForeignPtr fptr
type Combiner mode c_mode = [mode] -> c_mode
type Caster a b = a -> b
type Checker a = a -> Bool

type FunOpen p c_mode = Ptr p -> CString -> c_mode -> IO Bool
type FunPath p = Ptr p -> IO CString
type FunCopy p = Ptr p -> CString -> IO Bool
type FunPut  p r = Ptr p -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO r
type FunGet  p = Ptr p -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8)
type FunOut  p = Ptr p -> Ptr Word8 -> CInt -> IO Bool
type FunAdd  p n = Ptr p -> Ptr Word8 -> CInt -> n -> IO n
type FunFwm  p = Ptr p -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST)
type FunVsiz p =  Ptr p -> Ptr Word8 -> CInt -> IO CInt
type FunIterNext p = Ptr p -> Ptr CInt -> IO (Ptr Word8)

openHelper :: FunOpen p c_mode -> UnLifter tcdb p
           -> Combiner mode c_mode -> tcdb -> String -> [mode] -> IO Bool
openHelper opener unlifter combiner tcdb name modes =
    withForeignPtr (unlifter tcdb) $ \db ->
        withCString name $ \c_name ->
            opener db c_name (combiner modes)

pathHelper :: FunPath p -> UnLifter tcdb p -> tcdb -> IO (Maybe String)
pathHelper c_path unlifter tcdb =
    withForeignPtr (unlifter tcdb) $ \db ->
        c_path db >>= (maybePeek peekCString)

copyHelper :: FunCopy p -> UnLifter tcdb p -> tcdb -> String -> IO Bool
copyHelper c_copy unlifter tcdb fpath =
    withForeignPtr (unlifter tcdb) $ \db -> withCString fpath (c_copy db)

putHelper :: (Storable a, Storable b) =>
             FunPut p r -> UnLifter tcdb p -> tcdb -> a -> b -> IO r
putHelper c_put unlifter tcdb key val =
    withForeignPtr (unlifter tcdb) $ \db ->
        withPtrLen key $ \(kbuf, ksize) ->
        withPtrLen val $ \(vbuf, vsize) -> c_put db kbuf ksize vbuf vsize

getHelper :: (Storable a, Storable b) =>
             FunGet p -> UnLifter tcdb p -> tcdb -> a -> IO (Maybe b)
getHelper c_get unlifter tcdb key =
    withForeignPtr (unlifter tcdb) $ \db ->
        withPtrLen key $ \(kbuf, ksiz) ->
            alloca $ \sizbuf -> do
              vbuf <- c_get db kbuf ksiz sizbuf
              flip maybePeek vbuf $ \vp ->
                  do siz <- peek sizbuf
                     peekPtrLen (vp, siz)

getHelper' :: (Storable a, Storable b) =>
              FunGet p -> UnLifter tcdb p -> tcdb -> a -> IO (Maybe b)
getHelper' c_get unlifter tcdb key =
    withForeignPtr (unlifter tcdb) $ \db ->
        withPtrLen key $ \(kbuf, ksiz) ->
            alloca $ \sizbuf -> do
              vbuf <- c_get db kbuf ksiz sizbuf
              flip maybePeek vbuf $ \vp ->
                  do siz <- peek sizbuf
                     buf <- mallocBytes (fromIntegral siz)
                     copyBytes buf vp (fromIntegral siz)
                     peekPtrLen (buf, siz)

outHelper :: (Storable a) =>
             FunOut p -> UnLifter tcdb p -> tcdb -> a -> IO Bool
outHelper c_out unlifter tcdb key =
    withForeignPtr (unlifter tcdb) $ \db ->
        withPtrLen key $ \(kbuf, ksize) -> c_out db kbuf ksize

addHelper :: (Storable a) =>
             FunAdd p n -> UnLifter tcdb p
                        -> Caster hv n -> Caster n hv -> Checker n
                        -> tcdb -> a -> hv -> IO (Maybe hv)
addHelper c_add unlifter cast_in cast_out check tcdb key num =
    withForeignPtr (unlifter tcdb) $ \db ->
        withPtrLen key $ \(kbuf, ksiz) -> do
            sumval <- c_add db kbuf ksiz (cast_in num)
            return $ if check sumval
                       then Nothing
                       else Just $ cast_out sumval


fwmHelper :: (Storable a, Storable b, Sequence q) =>
             FunFwm p -> UnLifter tcdb p -> tcdb -> a -> Int -> IO (q b)
fwmHelper c_fwm unlifter tcdb key maxn = 
    withForeignPtr (unlifter tcdb) $ \db ->
        withPtrLen key $ \(kbuf, ksiz) ->
            c_fwm db kbuf ksiz (fromIntegral maxn) >>= peekList'

vsizHelper :: (Storable a) =>
              FunVsiz p -> UnLifter tcdb p -> tcdb -> a -> IO (Maybe Int)
vsizHelper c_vsiz unlifter tcdb key =
    withForeignPtr (unlifter tcdb) $ \db ->
        withPtrLen key $ \(kbuf, ksiz) -> do
          vsize <- c_vsiz db kbuf ksiz
          return $ if vsize == -1
                     then Nothing
                     else Just (fromIntegral vsize)

iternextHelper :: (Storable k) =>
                  FunIterNext p -> UnLifter tcdb p -> tcdb -> IO (Maybe k)
iternextHelper c_iternext unlifter tcdb =
    withForeignPtr (unlifter tcdb) $ \p ->
        alloca $ \sizbuf -> do
            vbuf <- c_iternext p sizbuf
            flip maybePeek vbuf $ \vp ->
                do siz <- peek sizbuf
                   peekPtrLen (vp, siz)