aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2025-01-19 21:26:18 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2025-01-19 21:26:18 -0300
commitfbb9318eede78561970676c9d98d82e3851aeae5 (patch)
tree4db4fa3471cecafb0a16ef7025d30d9837a273f9 /lib
parent3a32e46f647314aea380449b31384ad121f31e4e (diff)
downloadSakura-fbb9318eede78561970676c9d98d82e3851aeae5.tar.gz
Sakura-fbb9318eede78561970676c9d98d82e3851aeae5.zip
entity idents for reference mapping
Diffstat (limited to 'lib')
-rw-r--r--lib/disk.ml34
-rw-r--r--lib/relation.ml34
2 files changed, 47 insertions, 21 deletions
diff --git a/lib/disk.ml b/lib/disk.ml
index 85b37d7..96bb06a 100644
--- a/lib/disk.ml
+++ b/lib/disk.ml
@@ -72,6 +72,7 @@ end
module Executor = struct
module StringMap = Map.Make(String)
+ module IntMap = Map.Make(Int64)
module FS = FileSystem(DevelopmentConfiguration)
module Location = struct
type t =
@@ -244,13 +245,15 @@ module Command = struct
type return =
| ComputedHash of string
- | Read of (string * bytes list) list
+ | Read of (int64 * bytes list) list
| Nothing
[@@deriving show]
+ type references = string list Executor.IntMap.t Executor.StringMap.t
+
(** TODO: This does not write atomically. If the system crashes while it attempts to write, it will corrupt.
Solve this with a temporary file and move later. *)
- let commit_and_perform (stream: Executor.history) (locations: Executor.locations) references command =
+ let commit_and_perform (stream: Executor.history) (locations: Executor.locations) (references: references) ~entity_id command =
let open Extensions.Result in
let+ serialized_command =
Result.map_error (fun _ -> "Failed to serialize command to binary format.")
@@ -262,14 +265,31 @@ module Command = struct
let+ ((commit, locations), computed_hash_handle) = Executor.write (List.hd stream) locations ~filename:command.filename @@ 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)
- | None -> Ok ((updated_stream, locations), Nothing)
+ | Some computed_hash_handle ->
+ print_endline "WRITE A";
+ let references =
+ let relation_name = List.hd @@ String.split_on_char '/' command.filename
+ in Executor.StringMap.update
+ relation_name
+ (function | Some entity ->
+ print_endline "WRITE SOME 1";
+ Some (Executor.IntMap.update entity_id (function
+ | Some locations ->
+ print_endline "WRITE SOME 2";
+ Some (computed_hash_handle::locations)
+ | None -> Some [computed_hash_handle]) entity)
+ | None -> Some (Executor.IntMap.empty |> Executor.IntMap.add entity_id [computed_hash_handle])) references in
+ Ok ((updated_stream, locations, references), ComputedHash computed_hash_handle)
+ | None -> Ok ((updated_stream, locations, references), Nothing)
end
| READ ->
- let entities: string list Executor.StringMap.t = Executor.StringMap.find command.filename references in
- let content = Executor.StringMap.fold (fun key hashes acc -> (key,List.map (fun location -> Executor.read_location ~hash:location locations) hashes)::acc) entities [] in
+ let relation_name = List.hd @@ String.split_on_char '/' command.filename in
+ print_endline "READ";
+ print_endline relation_name;
+ let entities: string list Executor.IntMap.t = Executor.StringMap.find relation_name references in
+ let content = Executor.IntMap.fold (fun key hashes acc -> (key,List.map (fun location -> Executor.read_location ~hash:location locations) hashes)::acc) entities [] in
(* print_string "CONTENT: "; *)
(* print_endline @@ Bytes.to_string content; *)
- Ok ((stream, locations), Read content)
+ Ok ((stream, locations, references), Read content)
| _ -> Error "Unimplemented method"
end
diff --git a/lib/relation.ml b/lib/relation.ml
index 2f0c2a5..d6a1b70 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -53,33 +53,39 @@ 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 references = Executor.StringMap.empty in
+ let relation_name = "user" in
+ (* let entity_id, _ = Executor.StringMap.find relation_name references |> Executor.IntMap.max_binding in *)
+ let entity_id = 0L in
+ (* let references =
+ Executor.StringMap.empty
+ |> Executor.StringMap.add "user" (Executor.StringMap.empty
+ |> Executor.StringMap.add "entity_0" [handle11; handle12]
+ |> Executor.StringMap.add "entity_1" [handle21; handle22]
+ |> Executor.StringMap.add "entity_2" [handle31; handle32]) 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 handle11) = Command.commit_and_perform stream locations Executor.StringMap.empty command_write1 in
+ let+ ((stream, locations, references), Command.ComputedHash handle11) = Command.commit_and_perform stream locations references ~entity_id command_write1 in
let command_write2: Command.t =
{kind = Command.WRITE; timestamp = 10.0; hash = ""; content = "Blossom"; filename = "user/last-name"} in
- let+ ((stream, locations), Command.ComputedHash handle12) = Command.commit_and_perform stream locations Executor.StringMap.empty command_write2 in
+ let+ ((stream, locations, references), Command.ComputedHash handle12) = Command.commit_and_perform stream locations references ~entity_id command_write2 in
+ let entity_id = 1L 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 handle21) = Command.commit_and_perform stream locations Executor.StringMap.empty command_write3 in
+ let+ ((stream, locations, references), Command.ComputedHash handle21) = Command.commit_and_perform stream locations references ~entity_id 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 handle22) = Command.commit_and_perform stream locations Executor.StringMap.empty command_write4 in
+ let+ ((stream, locations, references), Command.ComputedHash handle22) = Command.commit_and_perform stream locations references ~entity_id command_write4 in
+ let entity_id = 2L 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 handle31) = Command.commit_and_perform stream locations Executor.StringMap.empty command_write5 in
+ let+ ((stream, locations, references), Command.ComputedHash handle31) = Command.commit_and_perform stream locations references ~entity_id 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 handle32) = Command.commit_and_perform stream locations Executor.StringMap.empty command_write6 in
- let references =
- Executor.StringMap.empty
- |> Executor.StringMap.add "user" (Executor.StringMap.empty
- |> Executor.StringMap.add "entity_0" [handle11; handle12]
- |> Executor.StringMap.add "entity_1" [handle21; handle22]
- |> Executor.StringMap.add "entity_2" [handle31; handle32]) in
+ let+ ((stream, locations, references), Command.ComputedHash handle32) = Command.commit_and_perform stream locations references ~entity_id command_write6 in
let command_read: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user"} in
- let+ (_, (Command.Read content as response)) = Command.commit_and_perform (List.tl stream) locations references command_read in
+ let+ (_, (Command.Read content as response)) = Command.commit_and_perform (List.tl stream) locations references ~entity_id command_read in
print_endline (Command.show_return response);
Ok (stream, locations)
- [@@warning "-8-27"] (* Suppress pattern match incomplete warnings *)
+ [@@warning "-8-27-26"] (* Suppress pattern match incomplete warnings *)