diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/disk.ml | 19 | ||||
| -rw-r--r-- | lib/planner.ml | 24 | ||||
| -rw-r--r-- | lib/relation.ml | 33 | ||||
| -rw-r--r-- | lib/server.ml | 15 |
4 files changed, 81 insertions, 10 deletions
diff --git a/lib/disk.ml b/lib/disk.ml index f39a8b5..0629a9e 100644 --- a/lib/disk.ml +++ b/lib/disk.ml @@ -77,7 +77,8 @@ module Executor = struct type t = { offset: int64; size: int; - hash: string } + hash: string; + references: string list } [@@deriving show] end module Hashes = struct @@ -109,7 +110,7 @@ module Executor = struct List.map (fun ({hash; _}: Hashes.t) -> hash) history) history in Interop.Merkle.merkle_generate_root all_hashes - let write ({files;_} as commit: commit) (locations: locations) ~filename ?hash_to_replace (content: Bytes.t) = + let write ({files;_} as commit: commit) (locations: locations) ~filename ?hash_to_replace references (content: Bytes.t) = let files = init_file files filename in let computed_hash: string = Interop.Sha256.compute_hash content in match StringMap.find_opt computed_hash locations with @@ -132,7 +133,7 @@ module Executor = struct let open Extensions.Result in let+ (size, offset) = FS.append Storage content in let () = print_endline @@ "OFFSET: " ^ (Int64.to_string offset) in - let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash}: Location.t) locations in + let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash; references = references}: Location.t) locations in let commit = {state = compose_new_state files; files} in Ok ((commit, locations), Some computed_hash) end @@ -149,7 +150,7 @@ module Executor = struct let open Extensions.Result in let+ (size, offset) = FS.append Storage content in let () = print_endline @@ "OFFSET: " ^ (Int64.to_string offset) in - let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash}: Location.t) locations in + let locations = StringMap.add computed_hash ({size; offset; hash = computed_hash; references = references}: Location.t) locations in let commit = {state = compose_new_state files; files} in Ok ((commit, locations), Some computed_hash) end @@ -164,8 +165,14 @@ module Executor = struct Some (new_entry::file_hashes) | None -> Some [{values = [computed_hash]; hash = computed_hash}] in + let location_update_fun = function + | Some (location: Location.t) -> + Some { location with references = references@location.references } + | None -> None (* This case is a bit weird to exist. Can we ever already add and get nothing? Refactor with the location passed on the `Some _` already *) + in let files = StringMap.update filename update_fun files in - let commit = {state = compose_new_state files; files} + let commit = {state = compose_new_state files; files} in + let locations = StringMap.update computed_hash location_update_fun locations in Ok ((commit, locations), Some computed_hash) | None -> Ok ((commit, locations), None) @@ -245,7 +252,7 @@ module Command = struct match command.kind with | WRITE -> begin let open Extensions.Result in - let+ ((commit, locations), computed_hash_handle) = Executor.write (List.hd stream) locations ~filename:command.filename @@ Bytes.of_string command.content in + let+ ((commit, locations), computed_hash_handle) = Executor.write (List.hd stream) locations ~filename:command.filename command.references @@ Bytes.of_string command.content in let updated_stream = commit::stream in match computed_hash_handle with | Some computed_hash_handle -> Ok ((updated_stream, locations), ComputedHash computed_hash_handle) diff --git a/lib/planner.ml b/lib/planner.ml new file mode 100644 index 0000000..ceaf815 --- /dev/null +++ b/lib/planner.ml @@ -0,0 +1,24 @@ +module Scan = struct + open Disk + let execute commit locations (entity: string) = + Executor.read commit locations ~filename:entity +end + +module Join = struct + open Disk + let execute (left_attributes: bytes list) (right_attributes: bytes list) locations = + (* Redundant operations that are already in the locations, but this is easier to implement now *) + (* Fix this when we persist the indexes *) + let left_computed_hashes: (int * string) list = List.mapi (fun index elem -> (index, Interop.Sha256.compute_hash elem)) left_attributes in + let right_computed_hashes: (int * string) list = List.mapi (fun index elem -> (index, Interop.Sha256.compute_hash elem)) right_attributes in + let references_locations_right = List.filter_map (fun (index, rhash) -> Option.map (fun (elem: Executor.Location.t) -> index, rhash, elem.references) + @@ Executor.StringMap.find_opt rhash locations) right_computed_hashes in + let indexes = + List.filter_map (fun (lindex, lhash) -> Option.map (fun (rindex, rhash, _) -> lindex, rindex, lhash, rhash) + @@ List.find_opt (fun (_rindex, _rhash, references) -> List.exists ((=) lhash) references) references_locations_right) left_computed_hashes + in List.map (fun (lindex, rindex, _, _) -> List.nth left_attributes lindex, List.nth right_attributes rindex) indexes + +end + +module Filter = struct +end diff --git a/lib/relation.ml b/lib/relation.ml index 5a896d4..5c8d1e0 100644 --- a/lib/relation.ml +++ b/lib/relation.ml @@ -10,10 +10,10 @@ module Protocol = struct attribute_type: string; tuples: tuple } [@@deriving sexp, protocol ~driver:(module Xml_light)] - type t = relation list [@@deriving sexp, protocol ~driver:(module Xml_light)] + type facts = relation list [@@deriving sexp, protocol ~driver:(module Xml_light)] end -let write_and_retrieve() = +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 @@ -45,6 +45,33 @@ let write_and_retrieve() = 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.to_xml_light relation_result)) + Ok (Xml.to_string (Protocol.facts_to_xml_light relation_result)) (* (Sexp.to_string (Protocol.sexp_of_t )) *) [@@warning "-8"] (* Suppress pattern match incomplete warnings *) + + +let 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"; references = []} 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"; references = [handle]} in + let command_write3: Command.t = + {kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Minnie"; filename = "user/first-name"; references = []} 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"; references = [handle]} 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"; references = []} 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"; references = [handle]} in + let+ ((stream, locations), Command.ComputedHash _handle) = Command.commit_and_perform stream locations command_write6 in + Ok (stream, locations) + [@@warning "-8"] (* Suppress pattern match incomplete warnings *) diff --git a/lib/server.ml b/lib/server.ml index 22bee73..3a6d1fa 100644 --- a/lib/server.ml +++ b/lib/server.ml @@ -22,7 +22,20 @@ let client_read sock maxlen = then Lwt.return acc else _read sock acc in _read sock String.empty - >>= fun _ -> match Relation.write_and_retrieve() with | Ok results -> return results | Error err -> return err + >>= fun _ -> + match Relation.write_and_retrieve () with + | Ok (last_commit::_, locations) -> + begin + let (first_names, last_names) = (Planner.Scan.execute last_commit locations "user/first-name", Planner.Scan.execute last_commit locations "user/last-name") in + let tuples = Planner.Join.execute first_names last_names locations in + let (fname, lname) = List.split tuples in + let relation_result: Relation.Protocol.facts = + [{attribute_name = "user/first-name"; attribute_type = "string"; tuples = List.map Bytes.to_string fname}; + {attribute_name = "user/last-name"; attribute_type = "string"; tuples = List.map Bytes.to_string lname}] in + return @@ Xml.to_string (Relation.Protocol.facts_to_xml_light relation_result) + end + | Ok _ -> return "Unstable" + | Error err -> return err let rec socket_read sock = (* (Int32.of_int (String.length results))) *) |