Merge pull request #4 from domsj/options

support more rocksdb options
domsj · Aug 4, 2015 · 5dea7bf · 5dea7bf
2 parents 14b72b4 + 1014258
commit 5dea7bf
Show file tree

Hide file tree

Showing 6 changed files with 550 additions and 96 deletions.
diff --git a/Makefile b/Makefile
@@ -4,7 +4,7 @@ OCAML_FIND ?= ocamlfind
 
 
 build:
-	ocamlbuild -use-ocamlfind -lflags -cclib,/usr/local/lib/librocksdb.so rocks.inferred.mli rocks.cma rocks.cmxa rocks.cmxs
+	ocamlbuild -use-ocamlfind -lflags -cclib,/usr/local/lib/librocksdb.so rocks.inferred.mli rocks.cma rocks.cmxa rocks.cmxs rocks_options.inferred.mli
 
 build_test:
 	ocamlbuild -use-ocamlfind -lflags -cclib,/usr/local/lib/librocksdb.so rocks_test.native rocks.inferred.mli rocks.cma rocks.cmxa rocks.cmxs

diff --git a/README.md b/README.md
@@ -2,7 +2,9 @@ ORocksDb
 ========
 
 This repository contains some ocaml bindings to the C api of [rocksdb](http://github.com/facebook/rocksdb/).
-It is far from complete and basically only contains what I needed so far.
+It is most certainly not complete. Not all available/implemented options have been tested.
+
+The binding is used as part of https://github.com/openvstorage/alba .
 
 Feel free to suggest features / report bugs using the issue tracker available on the repo.
 Pull requests are definitely welcome too!
diff --git a/rocks.ml b/rocks.ml
@@ -1,100 +1,11 @@
 open Ctypes
 open Foreign
+open Rocks_common
 
-module Views = struct
-  let bool_to_int =
-    view
-      ~read:(fun i -> i <> 0)
-      ~write:(function true -> 1 | false -> 0)
-      int
-
-  let bool_to_uchar =
-    view
-      ~read:(fun u -> u <> Unsigned.UChar.zero)
-      ~write:(function true -> Unsigned.UChar.one | false -> Unsigned.UChar.zero)
-      uchar
-
-  let int_to_size_t =
-    view
-      ~read:(fun size -> Unsigned.Size_t.to_int size)
-      ~write:(fun i -> Unsigned.Size_t.of_int i)
-      size_t
-end
-
-let free =
-  foreign
-    "free"
-    (ptr void @-> returning void)
-
-module type RocksType = sig
-  val name : string
-end
-
-type t' =  {
-  ptr : unit ptr;
-  mutable valid : bool;
-}
-
-exception OperationOnInvalidObject
-
-let t : t' typ =
-  view
-    ~read:(fun ptr -> { ptr; valid = true; })
-    ~write:(
-      fun { ptr; valid; } ->
-        if valid
-        then ptr
-        else raise OperationOnInvalidObject)
-    (ptr void)
-
-module CreateConstructors_(T : RocksType) = struct
-  type t = t'
-  let t = t
+module Views = Views
+module Options = Rocks_options.Options
 
-  let type_name = T.name
-
-  let create_no_gc =
-    foreign
-      ("rocksdb_" ^ T.name ^ "_create")
-      (void @-> returning t)
-
-  let destroy =
-    let inner =
-      foreign
-        ("rocksdb_" ^ T.name ^ "_destroy")
-        (t @-> returning void) in
-    fun t ->
-      inner t;
-      t.valid <- false
-
-  let create_gc () =
-    let t = create_no_gc () in
-    Gc.finalise (fun t -> destroy t) t;
-    t
-
-  let with_t f =
-    let t = create_no_gc () in
-    try
-      let res = f t in
-      destroy t;
-      res
-    with exn ->
-      destroy t;
-      raise exn
-
-  let create_setter property_name property_typ =
-    foreign
-      ("rocksdb_" ^ type_name ^ "_" ^ property_name)
-      (t @-> property_typ @-> returning void)
-end
-
-module Options = struct
-  module C = CreateConstructors_(struct let name = "options" end)
-  include C
-
-  let set_create_if_missing = create_setter "set_create_if_missing" Views.bool_to_uchar
-  let set_use_fsync = create_setter "set_use_fsync" Views.bool_to_int
-end
+exception OperationOnInvalidObject = Rocks_common.OperationOnInvalidObject
 
 module WriteOptions = struct
   module C = CreateConstructors_(struct let name = "writeoptions" end)
@@ -299,7 +210,7 @@ module Iterator = struct
 
   let create db read_options =
     let t = create_no_gc db read_options in
-    Gc.finalise (fun t -> destroy t) t;
+    Gc.finalise destroy t;
     t
 
   let with_t db read_options f =

diff --git a/rocks.mli b/rocks.mli
@@ -17,8 +17,67 @@ module Options :
     val create_gc : unit -> t
     val with_t : (t -> 'a) -> 'a
 
+    val increase_parallelism : t -> int -> unit
+    val optimize_for_point_lookup : t -> int -> unit
+    val optimize_level_style_compaction : t -> int -> unit
+    val optimize_universal_style_compaction : t -> int -> unit
     val set_create_if_missing : t -> bool -> unit
+    val set_create_missing_column_families : t -> bool -> unit
+    val set_error_if_exists : t -> bool -> unit
+    val set_paranoid_checks : t -> bool -> unit
+    val set_write_buffer_size : t -> int -> unit
+    val set_max_open_files : t -> int -> unit
+    val set_max_total_wal_size : t -> int -> unit
+    val set_max_write_buffer_number : t -> int -> unit
+    val set_min_write_buffer_number_to_merge : t -> int -> unit
+    val set_max_write_buffer_number_to_maintain :
+      t -> int -> unit
+    val set_max_background_compactions : t -> int -> unit
+    val set_max_background_flushes : t -> int -> unit
+    val set_max_log_file_size : t -> int -> unit
+    val set_log_file_time_to_roll : t -> int -> unit
+    val set_keep_log_file_num : t -> int -> unit
+    val set_soft_rate_limit : t -> float -> unit
+    val set_hard_rate_limit : t -> float -> unit
+    val set_rate_limit_delay_max_milliseconds :
+      t -> int -> unit
+    val set_max_manifest_file_size : t -> int -> unit
+    val set_table_cache_numshardbits : t -> int -> unit
+    val set_table_cache_remove_scan_count_limit :
+      t -> int -> unit
+    val set_arena_block_size : t -> int -> unit
     val set_use_fsync : t -> bool -> unit
+    val set_WAL_ttl_seconds : t -> int -> unit
+    val set_WAL_size_limit_MB : t -> int -> unit
+    val set_manifest_preallocation_size : t -> int -> unit
+    val set_purge_redundant_kvs_while_flush : t -> bool -> unit
+    val set_allow_os_buffer : t -> bool -> unit
+    val set_allow_mmap_reads : t -> bool -> unit
+    val set_allow_mmap_writes : t -> bool -> unit
+    val set_is_fd_close_on_exec : t -> bool -> unit
+    val set_skip_log_error_on_recovery : t -> bool -> unit
+    val set_stats_dump_period_sec : t -> int -> unit
+    val set_advise_random_on_open : t -> bool -> unit
+    val set_access_hint_on_compaction_start : t -> int -> unit
+    val set_use_adaptive_mutex : t -> bool -> unit
+    val set_bytes_per_sync : t -> int -> unit
+    val set_verify_checksums_in_compaction : t -> bool -> unit
+    val set_filter_deletes : t -> bool -> unit
+    val set_max_sequential_skip_in_iterations :
+      t -> int -> unit
+    val set_disable_data_sync : t -> int -> unit
+    val set_disable_auto_compactions : t -> int -> unit
+    val set_delete_obsolete_files_period_micros :
+      t -> int -> unit
+    val set_source_compaction_factor : t -> int -> unit
+    val set_min_level_to_compress : t -> int -> unit
+    val set_memtable_prefix_bloom_bits : t -> int -> unit
+    val set_memtable_prefix_bloom_probes : t -> int -> unit
+    val set_max_successive_merges : t -> int -> unit
+    val set_min_partial_merge_operands : t -> int -> unit
+    val set_bloom_locality : t -> int -> unit
+    val set_inplace_update_support : t -> bool -> unit
+    val set_inplace_update_num_locks : t -> int -> unit
   end
 module WriteOptions :
   sig

diff --git a/rocks_common.ml b/rocks_common.ml
@@ -0,0 +1,109 @@
+open Ctypes
+open Foreign
+
+module Views = struct
+  open Unsigned
+
+  let bool_to_int =
+    view
+      ~read:(fun i -> i <> 0)
+      ~write:(function true -> 1 | false -> 0)
+      int
+
+  let bool_to_uchar =
+    view
+      ~read:(fun u -> u <> UChar.zero)
+      ~write:(function true -> UChar.one | false -> UChar.zero)
+      uchar
+
+  let int_to_size_t =
+    view
+      ~read:Size_t.to_int
+      ~write:Size_t.of_int
+      size_t
+
+  let int_to_uint_t =
+    view
+      ~read:UInt.to_int
+      ~write:UInt.of_int
+      uint
+
+  let int_to_uint32_t =
+    view
+      ~read:UInt32.to_int
+      ~write:UInt32.of_int
+      uint32_t
+
+  let int_to_uint64_t =
+    view
+      ~read:UInt64.to_int
+      ~write:UInt64.of_int
+      uint64_t
+end
+
+let free =
+  foreign
+    "free"
+    (ptr void @-> returning void)
+
+    module type RocksType = sig
+  val name : string
+end
+
+type t' =  {
+  ptr : unit ptr;
+  mutable valid : bool;
+}
+
+exception OperationOnInvalidObject
+
+let t : t' typ =
+  view
+    ~read:(fun ptr -> { ptr; valid = true; })
+    ~write:(
+      fun { ptr; valid; } ->
+        if valid
+        then ptr
+        else raise OperationOnInvalidObject)
+    (ptr void)
+
+module CreateConstructors_(T : RocksType) = struct
+  type t = t'
+  let t = t
+
+  let type_name = T.name
+
+  let create_no_gc =
+    foreign
+      ("rocksdb_" ^ T.name ^ "_create")
+      (void @-> returning t)
+
+  let destroy =
+    let inner =
+      foreign
+        ("rocksdb_" ^ T.name ^ "_destroy")
+        (t @-> returning void) in
+    fun t ->
+      inner t;
+      t.valid <- false
+
+  let create_gc () =
+    let t = create_no_gc () in
+    Gc.finalise destroy t;
+    t
+
+  let with_t f =
+    let t = create_no_gc () in
+    try
+      let res = f t in
+      destroy t;
+      res
+    with exn ->
+      destroy t;
+      raise exn
+
+  let create_setter property_name property_typ =
+    foreign
+      ("rocksdb_" ^ type_name ^ "_" ^ property_name)
+      (t @-> property_typ @-> returning void)
+end