git » nmdb » commit b1c55dd

diff --git a/bindings/haskell/LICENSE b/bindings/haskell/LICENSE
new file mode 100644
index 0000000..f3a9498
--- /dev/null
+++ b/bindings/haskell/LICENSE
@@ -0,0 +1,34 @@
+
+I don't like licenses, because I don't like having to worry about all this
+legal stuff just for a simple piece of software I don't really mind anyone
+using. But I also believe that it's important that people share and give back;
+so I'm placing this library under the following license, so you feel guilty if
+you don't ;)
+
+
+BOLA - Buena Onda License Agreement
+-----------------------------------
+
+This work is provided 'as-is', without any express or implied warranty. In no
+event will the authors be held liable for any damages arising from the use of
+this work.
+
+To all effects and purposes, this work is to be considered Public Domain.
+
+
+However, if you want to be "Buena onda", you should:
+
+1. Not take credit for it, and give proper recognition to the authors.
+2. Share your modifications, so everybody benefits from them.
+4. Do something nice for the authors.
+5. Help someone who needs it: sign up for some volunteer work or help your
+   neighbour paint the house.
+6. Don't waste. Anything, but specially energy that comes from natural
+   non-renewable resources. Extra points if you discover or invent something
+   to replace them.
+7. Be tolerant. Everything that's good in nature comes from cooperation.
+
+The order is important, and the further you go the more "Buena onda" you are.
+Make the world a better place: be "Buena onda".
+
+
diff --git a/bindings/haskell/Nmdb.hs b/bindings/haskell/Nmdb.hs
new file mode 100644
index 0000000..5f0b4e9
--- /dev/null
+++ b/bindings/haskell/Nmdb.hs
@@ -0,0 +1,148 @@
+
+-- Haskell bindings for the nmdb C library
+-- Alberto Bertogli (albertito@gmail.com)
+
+module Nmdb (
+	NmdbStruct,
+	nmdbInit, nmdbFree,
+	nmdbAddTIPCServer, nmdbAddTCPServer, nmdbAddUDPServer,
+	nmdbSet, nmdbSetSync, nmdbCacheSet,
+	nmdbGet, nmdbCacheGet,
+	nmdbDel, nmdbDelSync, nmdbCacheDel,
+	nmdbCAS, nmdbCacheCAS,
+) where
+
+import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Marshal.Alloc
+
+
+-- Opaque pointer to nmdb_t
+data NmdbStruct = NmdbStruct
+type NmdbPtr = Ptr NmdbStruct
+
+
+-- DB creation and destroy
+foreign import ccall "nmdb.h nmdb_init" llNmdbInit :: IO NmdbPtr
+foreign import ccall "nmdb.h nmdb_free" llNmdbFree :: NmdbPtr -> IO ()
+
+nmdbInit :: IO NmdbPtr
+nmdbInit = llNmdbInit
+
+nmdbFree :: NmdbPtr -> IO ()
+nmdbFree = llNmdbFree
+
+
+-- Adding servers
+foreign import ccall "nmdb.h nmdb_add_tipc_server" llNmdbAddTIPCServer ::
+	NmdbPtr -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_add_tcp_server" llNmdbAddTCPServer ::
+	NmdbPtr -> CString -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_add_udp_server" llNmdbAddUDPServer ::
+	NmdbPtr -> CString -> Int -> IO Int
+
+nmdbAddTIPCServer db port = do
+	r <- llNmdbAddTIPCServer db port
+	return r
+
+nmdbAddTCPServer db host port = do
+	hstr <- newCString host
+	r <- llNmdbAddTCPServer db hstr port
+	free hstr
+	return r
+
+nmdbAddUDPServer db host port = do
+	hstr <- newCString host
+	r <- llNmdbAddUDPServer db hstr port
+	free hstr
+	return r
+
+-- Set functions
+foreign import ccall "nmdb.h nmdb_set" llNmdbSet ::
+	NmdbPtr -> CString -> Int -> CString -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_set_sync" llNmdbSetSync ::
+	NmdbPtr -> CString -> Int -> CString -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_cache_set" llNmdbCacheSet ::
+	NmdbPtr -> CString -> Int -> CString -> Int -> IO Int
+
+nmdbGenericSet llfunc db key val = do
+	kl <- newCStringLen key
+	vl <- newCStringLen val
+	r <- llfunc db (fst kl) (snd kl) (fst vl) (snd vl)
+	free (fst kl)
+	free (fst vl)
+	return r
+
+nmdbSet = nmdbGenericSet llNmdbSet
+nmdbSetSync = nmdbGenericSet llNmdbSetSync
+nmdbCacheSet = nmdbGenericSet llNmdbCacheSet
+
+
+-- Get functions
+foreign import ccall "nmdb.h nmdb_get" llNmdbGet ::
+	NmdbPtr -> CString -> Int -> CString -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_cache_get" llNmdbCacheGet ::
+	NmdbPtr -> CString -> Int -> CString -> Int -> IO Int
+
+nmdbGenericGet llfunc db key = do
+	let buflen = 64 * 1024
+	buf <- mallocBytes buflen
+	kl <- newCStringLen key
+	r <- llfunc db (fst kl) (snd kl) buf buflen
+	free (fst kl)
+	if r < 0
+	  then do
+		free buf
+		return Nothing
+	  else do
+		val <- peekCStringLen (buf, r)
+		free buf
+		return $ Just val
+
+nmdbGet = nmdbGenericGet llNmdbGet
+nmdbCacheGet = nmdbGenericGet llNmdbCacheGet
+
+
+-- Del functions
+foreign import ccall "nmdb.h nmdb_del" llNmdbDel ::
+	NmdbPtr -> CString -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_del_sync" llNmdbDelSync ::
+	NmdbPtr -> CString -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_cache_del" llNmdbCacheDel ::
+	NmdbPtr -> CString -> Int -> IO Int
+
+nmdbGenericDel llfunc db key = do
+	kl <- newCStringLen key
+	r <- llfunc db (fst kl) (snd kl)
+	free (fst kl)
+	return r
+
+nmdbDel = nmdbGenericDel llNmdbDel
+nmdbDelSync = nmdbGenericDel llNmdbDelSync
+nmdbCacheDel = nmdbGenericDel llNmdbCacheDel
+
+
+-- CAS functions
+foreign import ccall "nmdb.h nmdb_cas" llNmdbCAS ::
+	NmdbPtr -> CString -> Int -> CString -> Int -> CString -> Int -> IO Int
+foreign import ccall "nmdb.h nmdb_cache_cas" llNmdbCacheCAS ::
+	NmdbPtr -> CString -> Int -> CString -> Int -> CString -> Int -> IO Int
+
+nmdbGenericCAS llfunc db key oldval newval = do
+	kl <- newCStringLen key
+	ovl <- newCStringLen oldval
+	nvl <- newCStringLen newval
+	r <- llfunc db
+		(fst kl) (snd kl)
+		(fst ovl) (snd ovl)
+		(fst nvl) (snd nvl)
+	free (fst kl)
+	free (fst ovl)
+	free (fst nvl)
+	return r
+
+nmdbCAS = nmdbGenericCAS llNmdbCAS
+nmdbCacheCAS = nmdbGenericCAS llNmdbCacheCAS
+
+
diff --git a/bindings/haskell/Setup.lhs b/bindings/haskell/Setup.lhs
new file mode 100755
index 0000000..8193653
--- /dev/null
+++ b/bindings/haskell/Setup.lhs
@@ -0,0 +1,5 @@
+#!/usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
+
diff --git a/bindings/haskell/nmdb.cabal b/bindings/haskell/nmdb.cabal
new file mode 100644
index 0000000..5f1371d
--- /dev/null
+++ b/bindings/haskell/nmdb.cabal
@@ -0,0 +1,22 @@
+Name: Nmdb
+Version: 0.1
+License: PublicDomain
+License-file: LICENSE
+Author: Alberto Bertogli
+Homepage: http://auriga.wearlab.de/~alb/nmdb/
+Category: Database
+Build-Depends: base
+Exposed-modules: Nmdb
+Extra-libraries: nmdb
+Extensions: ForeignFunctionInterface
+Synopsis: nmdb Haskell bindings
+Description:
+  nmdb is a network database (dbm-style) for controlled networks that can use
+  different protocols to to communicate with its clients. At the moment, it
+  supports TIPC, TCP and UDP.
+  It consists of an in-memory cache that saves (key, value) pairs, and a
+  persistent backend that stores the pairs on disk.  Both work combined, but
+  the use of the backend is optional, so you can use the server only for cache
+  queries, pretty much like memcached.
+  This are the Haskell bindings for the C nmdb library.
+
diff --git a/tests/haskell/test1.hs b/tests/haskell/test1.hs
new file mode 100644
index 0000000..9a49f47
--- /dev/null
+++ b/tests/haskell/test1.hs
@@ -0,0 +1,37 @@
+
+-- Testing module for nmdb Haskell bindings.
+-- Build with ghc --make test1.hs
+
+module Main where
+
+import Nmdb
+
+-- putStrLn + show, all in one
+cshow desc f = do
+	r <- f
+	putStr desc
+	putStr " -> "
+	putStrLn $ show r
+
+main :: IO ()
+main = do
+	db <- nmdbInit
+
+	cshow "Add TIPC" $ nmdbAddTIPCServer db (-1)
+	cshow "Add TCP" $ nmdbAddTCPServer db "localhost" (-1)
+	cshow "Add UDP" $ nmdbAddUDPServer db "localhost" (-1)
+
+	cshow "Set 'Hello' 'Bye'" $ nmdbSet db "Hello" "Bye"
+
+	cshow "Get 'Hello'" $ nmdbGet db "Hello"
+	cshow "Get 'XYZ'" $ nmdbGet db "XYZ"
+
+	cshow "CAS 'Hello' 'Bye' 'Hey'" $ nmdbCAS db "Hello" "Bye" "Hey"
+	cshow "Get 'Hello'" $ nmdbGet db "Hello"
+
+	cshow "Del 'Hello'" $ nmdbDel db "Hello"
+
+	cshow "Free" $ nmdbFree db
+
+	return ()
+