summaryrefslogtreecommitdiff
path: root/lib/bindings.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/bindings.ml')
-rw-r--r--lib/bindings.ml65
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