Sequence.hs

module Database.TokyoCabinet.Sequence where

import Foreign.Ptr
import Foreign.Storable (peek)
import Foreign.Marshal (alloca, mallocBytes, copyBytes)
import Foreign.ForeignPtr

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

class Sequence a where
    withList  :: (Storable s) => a s -> (Ptr LIST -> IO b) -> IO b
    peekList' :: (Storable s) => Ptr LIST -> IO (a s)
    empty :: (Storable s) => IO (a s)
    smap :: (Storable s1, Storable s2) => (s1 -> s2) -> a s1 -> IO (a s2)

instance Sequence List where
    withList xs action = withForeignPtr (unTCList xs) action
    peekList' tcls = List `fmap` newForeignPtr tclistFinalizer tcls
    empty = List `fmap` (c_tclistnew >>= newForeignPtr tclistFinalizer)
    smap f tcls =
        withForeignPtr (unTCList tcls) $ \tcls' ->
            alloca $ \sizbuf ->
                do num <- c_tclistnum tcls'
                   vals <- c_tclistnew
                   loop tcls' 0 num sizbuf vals
        where
          loop tcls' n num sizbuf acc
                | n < num = do vbuf <- c_tclistval tcls' n sizbuf
                               vsiz <- peek sizbuf
                               buf <- mallocBytes (fromIntegral vsiz)
                               copyBytes buf vbuf (fromIntegral vsiz)
                               val <- f `fmap` peekPtrLen (buf, vsiz)
                               withPtrLen val $ uncurry (c_tclistpush acc)
                               loop tcls' (n+1) num sizbuf acc
                | otherwise = List `fmap` newForeignPtr tclistFinalizer acc

instance Sequence [] where
    withList xs action =
        do list <- c_tclistnew
           mapM_ (push list) xs
           result <- action list
           c_tclistdel list
           return result
        where
          push list val = withPtrLen val $ uncurry (c_tclistpush list)

    peekList' tcls = do
        vals <- peekList'' tcls []
        c_tclistdel tcls
        return vals
      where
        peekList'' lis acc =
            alloca $ \sizbuf ->
                do val <- c_tclistpop lis sizbuf
                   siz <- peek sizbuf
                   if val == nullPtr
                     then return acc
                     else do elm <- peekPtrLen (val, siz)
                             peekList'' lis (elm:acc)

    empty = return []
    smap f = return . (map f)