Import the initial, proof of concept implementation.

1 files changed, 65 insertions, 0 deletions

diff --git a/lib/bindings.ml b/lib/bindings.ml
new file mode 100644
index 0000000..387e1b5
--- /dev/null
+++ b/lib/bindings.ml
@@ -0,0 +1,65 @@
+open Ctypes
+open Foreign
+
+module CT = Config_tree
+
+let make_config_tree name = Ctypes.Root.create (Config_tree.make name)
+
+let destroy c_ptr = 
+    Root.release c_ptr
+
+let set_add_value c_ptr path value =
+    let ct = Root.get c_ptr in
+    let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
+    try
+        let new_ct = CT.set ct path (Some value) Config_tree.AddValue in
+        Root.set c_ptr new_ct;
+        0 (* return 0 *)
+    with CT.Duplicate_value -> 1
+
+let set_replace_value c_ptr path value =
+    let	ct = Root.get c_ptr in
+    let	path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
+    let new_ct = Config_tree.set ct path (Some value) Config_tree.ReplaceValue in
+    Root.set c_ptr new_ct;
+    0 (* return 0 *)
+
+let set_valueless c_ptr path =
+    let	ct = Root.get c_ptr in
+    let	path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
+    try
+        let new_ct = Config_tree.set ct path None CT.AddValue in
+        Root.set c_ptr new_ct;
+        0 (* return 0 *)
+    with CT.Useless_set -> 1
+
+let delete_value c_ptr path value =
+    let ct = Root.get c_ptr in
+    let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
+    try
+        let new_ct = Config_tree.delete ct path (Some value) in
+        Root.set c_ptr new_ct;
+        0 (* return 0 *)
+    with CT.No_such_value -> 1
+
+let delete_node c_ptr path =
+    let ct = Root.get c_ptr in
+    let path = Pcre.split ~rex:(Pcre.regexp "\\s+") path in
+    if not (Vytree.exists ct path) then 1 else
+    let new_ct = Config_tree.delete ct path None in
+    Root.set c_ptr new_ct;
+    0 (* return 0 *)
+
+
+module Stubs(I : Cstubs_inverted.INTERNAL) =
+struct
+
+  let () = I.internal "make" (string @-> returning (ptr void)) make_config_tree
+  let () = I.internal "destroy" ((ptr void) @-> returning void) destroy
+  let () = I.internal "set_add_value" ((ptr void) @-> string @-> string @-> returning int) set_add_value
+  let () = I.internal "set_replace_value" ((ptr void) @-> string @-> string @-> returning int) set_replace_value
+  let () = I.internal "set_valueless" ((ptr void) @-> string @-> returning int) set_valueless
+  let () = I.internal "delete_value" ((ptr void) @-> string @-> string @-> returning int) delete_value
+  let () = I.internal "delete_node" ((ptr void) @-> string @-> returning int) delete_node
+
+end