diff options
Diffstat (limited to 'lib/dbms_language.ml')
| -rw-r--r-- | lib/dbms_language.ml | 37 |
1 files changed, 0 insertions, 37 deletions
diff --git a/lib/dbms_language.ml b/lib/dbms_language.ml deleted file mode 100644 index 47e5a99..0000000 --- a/lib/dbms_language.ml +++ /dev/null @@ -1,37 +0,0 @@ -(** 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) |