List.hsc

module Database.QDBM.Cabin.List
    ( List
    , CBLIST

    , wrapList
    , withListPtr

    , newList
    , push
    , length
    , (!!)

    , toList
    , fromList
    )
    where

import qualified Data.ByteString as Strict (ByteString)
import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
import           Data.Maybe
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           Foreign.Storable
import           Foreign.Marshal.Alloc
import           Prelude hiding (length, (!!))


infixl 9 !!


newtype List = List (ForeignPtr CBLIST)
data CBLIST


foreign import ccall unsafe "cabin.h cblistopen"
        _open :: IO (Ptr CBLIST)

foreign import ccall unsafe "cabin.h &cblistclose"
        _close :: FunPtr (Ptr CBLIST -> IO ())

foreign import ccall unsafe "cabin.h cblistnum"
        _num :: Ptr CBLIST -> IO CInt

foreign import ccall unsafe "cabin.h cblistval"
        _val :: Ptr CBLIST -> CInt -> Ptr CInt -> IO (Ptr CChar)

foreign import ccall unsafe "cabin.h cblistpush"
        _push :: Ptr CBLIST -> Ptr CChar -> CInt -> IO ()


wrapList :: Ptr CBLIST -> IO List
wrapList listPtr = newForeignPtr _close listPtr >>= return . List


withListPtr :: List -> (Ptr CBLIST -> IO a) -> IO a
withListPtr (List list) = withForeignPtr list


newList :: IO List
newList = _open >>= wrapList


push :: List -> Strict.ByteString -> IO ()
push list value
    = withListPtr        list  $ \ listPtr              ->
      C8.useAsCStringLen value $ \ (valuePtr, valueLen) ->
      _push listPtr valuePtr (fromIntegral valueLen)


length :: List -> IO Int
length list
    = withListPtr list $ \ listPtr ->
      _num listPtr >>= return . fromIntegral


(!!) :: List -> Int -> IO (Maybe Strict.ByteString)
list !! index
    = withListPtr list $ \ listPtr   ->
      alloca           $ \ valLenPtr ->
      do valPtr <- _val listPtr (fromIntegral index) valLenPtr
         if valPtr == nullPtr then
             return Nothing
           else
             do valLen <- peek valLenPtr
                value  <- C8.packCStringLen (valPtr, fromIntegral valLen)
                return $ Just value


toList :: List -> IO [Strict.ByteString]
toList list
    = do len <- length list
         mapM (list !!) [0..len] >>= return . catMaybes


fromList :: [Strict.ByteString] -> IO List
fromList values
    = do list <- newList
         mapM_ (push list) values
         return list