Sublanguages improvement & Coq experiment (#53)

* separation and functor for sublanguages

* add coq experiment for termination

* fix tests with envelopes

* add timestamp and print responses to server on terminal

* remove coq experiment for trivial cases and rework gate

* refactor nesting with let*

* remove non-envelope sublang support and tests on server

* manip_err duplication purge and better format as s-expr

* abstract storage with dispatch for sublanguages

* dead code and minor refactor due to old non-envelope parsing on subl

* refactor server to use proper dml alg error and wire ephem relations

* remove (schema)

* change .gitignore to blacklist folders

1 files changed, 39 insertions, 0 deletions

diff --git a/lib/dbms_language.ml b/lib/dbms_language.ml
new file mode 100644
index 0000000..8d61aa3
--- /dev/null
+++ b/lib/dbms_language.ml
@@ -0,0 +1,39 @@
+(** Composable dispatch over sublanguages.
+
+    All commands must use the tagged envelope format: (tag payload)
+    where [tag] is the sublanguage name (drl, dml, ddl, icl, dcl, ...).
+    Adding a new sublanguage is just extending the list passed to [create]. *)
+
+module Make (Storage : Management.Physical.S with type error = string) = struct
+  module type SubS = Sublanguage.S with type storage = Storage.t
+
+  type dispatch_error = NoMatch of Sexplib.Sexp.t
+
+  type dispatch = (module SubS) list
+
+  let create (langs : (module SubS) list) : dispatch = langs
+
+  let execute
+      (langs : dispatch)
+      (storage : Storage.t)
+      (db : Management.Database.t)
+      (input : string)
+    : (Sublanguage.result, dispatch_error) Result.t =
+    let no_match s = Error (NoMatch Sexplib.Sexp.(List [Atom "parse-error"; Atom s])) in
+    match Envelope.parse input with
+    | Error msg -> no_match msg
+    | Ok { tag; payload } ->
+      match List.find_opt (fun (module L : SubS) -> L.name = tag) langs with
+      | None -> no_match ("unknown sublanguage: " ^ tag)
+      | Some (module L) ->
+        match L.parse_sexp payload with
+        | Error e -> Error (NoMatch (L.sexp_of_error e))
+        | Ok ast ->
+          match L.execute storage db ast with
+          | Ok result -> Ok result
+          | Error e   -> Error (NoMatch (L.sexp_of_error e))
+
+  let sexp_of_dispatch_error (NoMatch sexp) = sexp
+end
+
+module Memory = Make(Management.Physical.Memory)