diff options
| -rw-r--r-- | lib/disk.ml | 17 | ||||
| -rw-r--r-- | lib/protocol.ml | 15 | ||||
| -rw-r--r-- | lib/relation.ml | 58 | ||||
| -rw-r--r-- | lib/server.ml | 4 | ||||
| -rw-r--r-- | test/test_relational_engine.ml | 2 |
5 files changed, 34 insertions, 62 deletions
diff --git a/lib/disk.ml b/lib/disk.ml index d97a60c..b9f8155 100644 --- a/lib/disk.ml +++ b/lib/disk.ml @@ -92,12 +92,21 @@ module Executor = struct type history = t list [@@deriving show] end + type relational_type = + | Text + | Integer32 + | Integer64 + | Boolean + | DiscriminatedUnion of (string * relational_type option) list * string (* [("MemberA", None); ("MemberB", Some Integer32)], "NameOfDU" *) + + type schema = (string * relational_type) list StringMap.t type references = string list IntMap.t StringMap.t type commit = { state : string; files : Hashes.history StringMap.t; references : references; + schema : schema } type history = commit list @@ -127,7 +136,7 @@ module Executor = struct in Interop.Merkle.merkle_generate_root all_hashes - let write ({ files; references; _ } as commit : commit) + let write ({ files; references; schema; _ } as commit : commit) (locations : locations) ~filename ?hash_to_replace (content : Bytes.t) = let files = init_file files filename in let computed_hash : string = Interop.Sha256.compute_hash content in @@ -162,7 +171,7 @@ module Executor = struct locations in let commit = - { state = compose_new_state files; files; references } + { state = compose_new_state files; files; references; schema } in Ok ((commit, locations), Some computed_hash) | Some hash_to_replace -> @@ -195,7 +204,7 @@ module Executor = struct locations in let commit = - { state = compose_new_state files; files; references } + { state = compose_new_state files; files; references; schema } in Ok ((commit, locations), Some computed_hash)) | Some _ -> ( @@ -227,7 +236,7 @@ module Executor = struct in *) let files = StringMap.update filename update_fun files in let commit = - { state = compose_new_state files; files; references } + { state = compose_new_state files; files; references; schema } in (* let locations = StringMap.update computed_hash location_update_fun locations in *) Ok ((commit, locations), Some computed_hash) diff --git a/lib/protocol.ml b/lib/protocol.ml new file mode 100644 index 0000000..9dea3ce --- /dev/null +++ b/lib/protocol.ml @@ -0,0 +1,15 @@ +open Protocol_conv_xml +open Sexplib0.Sexp_conv + +type tuple = string list +[@@deriving sexp, protocol ~driver:(module Xml_light)] + +type relation = { + attribute_name : string; + attribute_type : string; + tuples : tuple; +} +[@@deriving sexp, protocol ~driver:(module Xml_light)] + +type facts = relation list +[@@deriving sexp, protocol ~driver:(module Xml_light)]
\ No newline at end of file diff --git a/lib/relation.ml b/lib/relation.ml index d27f2e2..c01c761 100644 --- a/lib/relation.ml +++ b/lib/relation.ml @@ -1,66 +1,12 @@ -module Protocol = struct - open Protocol_conv_xml - open Sexplib0.Sexp_conv - - type tuple = string list - [@@deriving sexp, protocol ~driver:(module Xml_light)] - - type relation = { - attribute_name : string; - attribute_type : string; - tuples : tuple; - } - [@@deriving sexp, protocol ~driver:(module Xml_light)] - - type facts = relation list - [@@deriving sexp, protocol ~driver:(module Xml_light)] -end - -(* -let test_write_and_retrieve() = - let open Disk in - let stream: Executor.history = [{state = Executor._EMPTY_SHA_HASH_; files = Executor.StringMap.empty}] in - let locations: Executor.locations = Executor.StringMap.empty in - let open Extensions.Result in - let command_write1: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Daisy"; filename = "user/first-name"} in - let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write1 in - let command_write2: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Blossom"; filename = "user/last-name"} in - let command_write3: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Minnie"; filename = "user/first-name"} in - let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write2 in - let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write3 in - let command_write4: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Mouse"; filename = "user/last-name"} in - let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write4 in - let command_write5: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Billie"; filename = "user/first-name"} in - let+ ((stream, locations), Command.ComputedHash handle) = Command.commit_and_perform stream locations command_write5 in - let command_write6: Command.t = - {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Beans"; filename = "user/last-name"} in - let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write6 in - let command_read1: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user/first-name"} in - let+ (_, Command.Read first_name) = Command.commit_and_perform (List.tl stream) locations command_read1 in - let command_read2: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user/last-name"} in - let+ (_, Command.Read last_name) = Command.commit_and_perform (List.tl stream) locations command_read2 in - (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string first_name); *) - (* List.iter (fun a -> print_endline a) (List.map Bytes.to_string last_name); *) - let relation_result: Protocol.relation list = - [{attribute_name = "user/first-name"; attribute_type = "string"; tuples = List.map Bytes.to_string first_name}; - {attribute_name = "user/last-name"; attribute_type = "string"; tuples = List.map Bytes.to_string last_name}] in - Ok (Xml.to_string (Protocol.facts_to_xml_light relation_result)) - (* (Sexp.to_string (Protocol.sexp_of_t )) *) - [@@warning "-8-27"] (* Suppress pattern match incomplete warnings *) -*) - let write_and_retrieve () = let open Disk in + let schema = Executor.StringMap.empty |> Executor.StringMap.add "user" [("first_name", Executor.Text); ("last_name", Executor.Text)] in let commit : Executor.commit = { state = Executor._EMPTY_SHA_HASH_; files = Executor.StringMap.empty; references = Executor.StringMap.empty; + schema } in let locations : Executor.locations = Executor.StringMap.empty in diff --git a/lib/server.ml b/lib/server.ml index 3fab513..46ef85d 100644 --- a/lib/server.ml +++ b/lib/server.ml @@ -32,7 +32,7 @@ let client_read sock maxlen = (* let tuples = Planner.Join.execute first_names last_names locations in *) let fname, lname = List.split [] in (* tuples in *) - let relation_result : Relation.Protocol.facts = + let relation_result : Protocol.facts = [ { attribute_name = "user/first-name"; @@ -47,7 +47,7 @@ let client_read sock maxlen = ] in return - @@ Xml.to_string (Relation.Protocol.facts_to_xml_light relation_result) + @@ Xml.to_string (Protocol.facts_to_xml_light relation_result) | Error err -> return err [@@warning "-27"] diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml index 3092acc..e9e4525 100644 --- a/test/test_relational_engine.ml +++ b/test/test_relational_engine.ml @@ -6,6 +6,7 @@ let%test _ = state = _EMPTY_SHA_HASH_; files = StringMap.empty; references = StringMap.empty; + schema = StringMap.empty }; ] in @@ -28,6 +29,7 @@ let%test _ = state = _EMPTY_SHA_HASH_; files = StringMap.empty; references = StringMap.empty; + schema = StringMap.empty }; ] in |