scratch root for testing with subsystems explorer

2 files changed, 30 insertions, 0 deletions

diff --git a/lib/Scratch.ml b/lib/Scratch.ml
new file mode 100644
index 0000000..0779db3
--- /dev/null
+++ b/lib/Scratch.ml
@@ -0,0 +1,23 @@
+module LMDB = Backend.Storage.LMDB
+module I = Kernel.Initialization.Make (LMDB)
+
+let rec remove path =
+  if Sys.is_directory path then begin
+    Array.iter (fun name -> remove (Filename.concat path name)) (Sys.readdir path);
+    Sys.rmdir path
+  end
+  else Sys.remove path
+
+let root ?(evaluators = ["fol", Evaluators.FOL.make ()]) () =
+  let open Utilities.Result in
+  let directory = Filename.temp_dir "rnt-scratch" "" in
+  let* connection =
+    Sexplib.Sexp.(
+      List [Atom "lmdb"; List [Atom "path"; Atom directory]; List [Atom "mode"; Atom "420"]] )
+    |> Concepts.Configuration.term_of_sexp
+    |> LMDB.connect
+  in
+  at_exit (fun () ->
+      LMDB.disconnect connection;
+      try remove directory with Sys_error _ -> () );
+  I.initialize ~evaluators connection
diff --git a/lib/Scratch.mli b/lib/Scratch.mli
new file mode 100644
index 0000000..804c2c2
--- /dev/null
+++ b/lib/Scratch.mli
@@ -0,0 +1,7 @@
+(** a root over a database of its own in a temporary directory, removed
+    when the program exits: for tests, and for trying things out. Its
+    system evaluators are [evaluators], FOL unless told otherwise. *)
+val root :
+  ?evaluators:(string * Protocols.Handle.t) list ->
+  unit ->
+  (Protocols.Handle.t, Concepts.Condition.condition) result