~kaction/haskell-gdbm

8156cb20b5bd459e1b4d0a8dfc1999346fe22d8b — Dmitry Bogatov 4 years ago 1abd39b
Write low-level bindings to GDBM

GDBM routines pass 'struct datum' by value, making them impossible to
call directly by means of GHC ccall interface, requiring writing glue
C code that assembles and disassembles 'struct datum' into pointer and
integer back and forth.
3 files changed, 106 insertions(+), 1 deletions(-)

A cbits/link.c
M package.yaml
M src/Database/GDBM/Internal.hs
A cbits/link.c => cbits/link.c +79 -0
@@ 0,0 1,79 @@
#include <gdbm.h>
#include <stdlib.h>

GDBM_FILE
cbit_open_reader(/*const*/ char *name)
{
	return gdbm_open(name, 0, GDBM_READER, 0, NULL);
}

GDBM_FILE
cbit_open_writer(/*const*/ char *name)
{
	return gdbm_open(name, 0, GDBM_WRITER, 0, NULL);
}

GDBM_FILE
cbit_open_recreate(/*const*/ char *name)
{
	return gdbm_open(name, 0, GDBM_WRCREAT, 0644, NULL);
}

void
cbit_close(GDBM_FILE db)
{
	gdbm_close(db);
}

int
cbit_insert(GDBM_FILE db, void *keyp, int keysize, void *valuep, int valuesize)
{
	datum key = { keyp, keysize };
	datum value = { valuep, valuesize };
	return gdbm_store(db, key, value, GDBM_REPLACE);
}

void* cbit_fetch(GDBM_FILE db, void *keyp, int keysize, int *valuesize)
{
	datum key = { keyp, keysize };
	datum value = gdbm_fetch(db, key);
	if (value.dptr) {
		*valuesize = value.dsize;
	}
	return value.dptr;
}

int
cbit_delete(GDBM_FILE db, void *keyp, int keysize)
{
	datum key = { keyp, keysize };
	return gdbm_delete(db, key);
}

void*
cbit_firstkey(GDBM_FILE db, int *size)
{
	datum first = gdbm_firstkey(db);
	if (first.dptr) {
		*size = first.dsize;
	}
	return first.dptr;
}

void*
cbit_nextkey(GDBM_FILE db, void *keyp, int keysize, int *nextsize)
{
	datum key = { keyp, keysize };
	datum next = gdbm_nextkey(db, key);
	if (next.dptr) {
		*nextsize = next.dsize;
	}
	return next.dptr;
}

int
cbit_exists(GDBM_FILE db, void *keyp, int keysize)
{
	datum key = { keyp, keysize };
	return gdbm_exists(db, key);
}

M package.yaml => package.yaml +2 -1
@@ 4,12 4,13 @@ synopsis: High-level interface to GNU dbm library
maintainer: Dmitry Bogatov <KAction@gnu.org>
category: System
license: GPL-3
ghc-options: -threaded
dependencies:
  - base
  - mtl
library:
  source-dirs: src
  c-sources: cbits/link.c
  extra-libraries: gdbm
  exposed-modules:
    - Database.GDBM
    - Database.GDBM.Internal

M src/Database/GDBM/Internal.hs => src/Database/GDBM/Internal.hs +25 -0
@@ 1,1 1,26 @@
{-# LANGUAGE ForeignFunctionInterface,CPP #-}
module Database.GDBM.Internal where
import Foreign.Ptr
import Foreign.C

newtype GDBM = GDBM (Ptr GDBM)

foreign import ccall unsafe "cbit_open_reader"
    c_open_reader :: CString -> IO GDBM
foreign import ccall unsafe "cbit_open_writer"
    c_open_writer :: CString -> IO GDBM
foreign import ccall unsafe "cbit_open_recreate"
    c_open_recreate :: CString -> IO GDBM
foreign import ccall unsafe "cbit_close"
    c_close :: GDBM -> IO ()
foreign import ccall unsafe "cbit_insert"
    c_store :: GDBM -> CString -> CInt -> CString -> CInt -> IO CInt
foreign import ccall unsafe "cbit_fetch"
    c_fetch :: GDBM -> CString -> CInt -> Ptr CInt -> IO CString
foreign import ccall unsafe "cbit_delete"
    c_delete :: GDBM -> CString -> CInt -> IO CInt
foreign import ccall unsafe "cbit_firstkey"
    c_firstkey :: GDBM -> Ptr CInt -> IO CString

c_null :: GDBM -> Bool
c_null (GDBM p) = p == nullPtr