relation building

6 files changed, 85 insertions, 46 deletions

diff --git a/bin/main.ml b/bin/main.ml
index 8250c44..4ea66d0 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,28 +1,4 @@
-open Relational_engine.Disk
-
-let x() =
-  let command_write1: Command.t =
-    {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837830"; content = "asd"; filename = "trash"} in
-  let command_write2: Command.t =
-    {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837831"; content = "qwe"; filename = "trash2"} in
-  let command_write3: Command.t =
-    {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837832"; content = "fgh"; filename = "trash"} in
-  let command_write4: Command.t =
-    {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837833"; content = "rty"; filename = "trash2"} in
-  let command_write5: Command.t =
-    {kind = Command.WRITE; timestamp = 10.0; hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837834"; content = "jkl"; filename = "trash"} in
-  let command_read: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "trash"} 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 Relational_engine.Extensions.Result in
-  let+ (stream, locations) = Command.commit_and_perform stream locations command_write1 in
-  let+ (stream, locations) = Command.commit_and_perform stream locations command_write2 in
-  let+ (stream, locations) = Command.commit_and_perform stream locations command_write3 in
-  let+ (stream, locations) = Command.commit_and_perform stream locations command_write4 in
-  let+ (stream, locations) = Command.commit_and_perform stream locations command_write5 in
-  Command.commit_and_perform (List.tl stream) locations command_read
-
 let () =
   begin
-    let _ = x() in ()
+    let _ = Relational_engine.Relation.write_and_retrieve() in ()
   end
diff --git a/flake.nix b/flake.nix
index 7082073..3f1e64f 100644
--- a/flake.nix
+++ b/flake.nix
@@ -31,6 +31,12 @@
         lib = legacyPackages.lib;
         merklecpp = legacyPackages.callPackage ./deps/merklecpp.nix { };
         libressl = legacyPackages.callPackage ./deps/libressl.nix { };
+        ppx_xml_conv = ocamlPackages.janePackage {
+          pname = "ppx_xml_conv";
+          hash = "sha256-4U0ZlV8OYXwNUz3bbxf49qovGTI8vyn7L3YJy0AndrM=";
+          meta.description = "Generate XML conversion functions from records";
+          propagatedBuildInputs = [ ocamlPackages.ppxlib ocamlPackages.csvfields ocamlPackages.ppx_conv_func ];
+        };
         librelational_engine =
           legacyPackages.callPackage ./deps/relational_engine_lib.nix {
             libressl = libressl;
@@ -94,6 +100,9 @@
               ctypes-foreign
               data-encoding
               ppx_inline_test
+              ocamlPackages.ppx_deriving
+              ocamlPackages.ppx_sexp_conv
+              ppx_xml_conv
             ];
 
             strictDeps = true;
@@ -165,6 +174,8 @@
               legacyPackages.ocamlformat
               ocamlPackages.ppx_inline_test
               ocamlPackages.ppx_deriving
+              ocamlPackages.ppx_sexp_conv
+              ppx_xml_conv
             ];
           } ''
             echo "checking dune and ocaml formatting"
@@ -250,9 +261,11 @@
               ocamlPackages.data-encoding
               ocamlPackages.ppx_inline_test
               ocamlPackages.ppx_deriving
+              ocamlPackages.ppx_sexp_conv
               legacyPackages.cmake
               legacyPackages.gcc
               # legacyPackages.nixfmt-classic
+              ppx_xml_conv
             ];
 
             shellHook = ''
diff --git a/lib/disk.ml b/lib/disk.ml
index b29ea09..f39a8b5 100644
--- a/lib/disk.ml
+++ b/lib/disk.ml
@@ -134,7 +134,7 @@ module Executor = struct
             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 commit = {state = compose_new_state files; files}
-            in Ok (commit, locations)
+            in Ok ((commit, locations), Some computed_hash)
           end
         | Some hash_to_replace ->
            let update_fun = function
@@ -151,7 +151,7 @@ module Executor = struct
            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 commit = {state = compose_new_state files; files}
-           in Ok (commit, locations)
+           in Ok ((commit, locations), Some computed_hash)
         end
     | Some _ ->
         begin match hash_to_replace with
@@ -166,9 +166,9 @@ module Executor = struct
            in
            let files = StringMap.update filename update_fun files in
            let commit = {state = compose_new_state files; files}
-           in Ok (commit, locations)
+           in Ok ((commit, locations), Some computed_hash)
         | None ->
-           Ok (commit, locations)
+           Ok ((commit, locations), None)
         end
   
   let read ({files; _} as _commit: commit) (locations: locations) ~filename =
@@ -177,7 +177,8 @@ module Executor = struct
     let physical_locations = List.map (fun hash -> StringMap.find hash locations) location_hashes in
     (* Terrible! Here I read everything opening a new IO every time. We should be able to read with only one call, but changing the offset every time *)
     let content = List.map (fun ({offset; size; _}: Location.t) -> match FS.read FS.Storage offset size with | Ok x -> x | Error err -> failwith err) physical_locations
-    in Bytes.concat Bytes.empty @@ List.rev content
+    in (*Bytes.concat Bytes.empty @@*)
+         List.rev content
 end
 
 module Startup = struct
@@ -206,26 +207,33 @@ module Command = struct
         Data_encoding.empty
         (function READ -> Some () | _ -> None)
         (function () -> READ);
-    ]
+      ]
+  
   type t =
     { kind: command_kind;
       timestamp: float;
       hash: string;
       filename: string;
+      references: string list;
       (* branch must be added here later *)
       content: string }
   let command_encoding =
     conv 
-      (fun {kind; timestamp; hash; filename; content} -> (kind, timestamp, hash, filename, content))
-      (fun (kind, timestamp, hash, filename, content) -> {kind; timestamp; hash; filename; content})
-      Data_encoding.(tup5 command_kind_encoding float string string string)
+      (fun {kind; timestamp; hash; filename; references; content} -> (kind, timestamp, hash, filename, references, content))
+      (fun (kind, timestamp, hash, filename, references, content) -> {kind; timestamp; hash; filename; references; content})
+      Data_encoding.(tup6 command_kind_encoding float string string (list string) string)
   
   let parse_command ~data =
-    let contract_encoding = Data_encoding.(tup4 command_kind_encoding string string string) in
+    let contract_encoding = Data_encoding.(tup5 command_kind_encoding string string (list string) string) in
     match Binary.of_bytes_opt contract_encoding data with
-    | Some (kind, hash, filename, content) -> Ok {kind; timestamp = Unix.time(); hash; filename; content}
+    | Some (kind, hash, filename, references, content) -> Ok {kind; timestamp = Unix.time(); hash; filename; references; content}
     | None -> Error "Failed to parse command"
 
+  type return =
+    | ComputedHash of string
+    | Read of bytes list
+    | Nothing
+  
   (** 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) command =
@@ -235,15 +243,18 @@ module Command = struct
         @@ Binary.to_bytes command_encoding command in
       let+ _ = FS.append FS.Transaction serialized_command in
       match command.kind with
-      | WRITE ->
+      | WRITE -> begin
          let open Extensions.Result in
-         let+ (commit, locations) = 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 @@ Bytes.of_string command.content in
          let updated_stream = commit::stream in
-         Ok (updated_stream, locations)
+         match computed_hash_handle with
+         | Some computed_hash_handle -> Ok ((updated_stream, locations), ComputedHash computed_hash_handle)
+         | None -> Ok ((updated_stream, locations), Nothing)
+         end
       | READ ->
          let content = Executor.read (List.hd stream) locations ~filename:command.filename in
-         print_string "CONTENT: ";
-         print_endline @@ Bytes.to_string content;
-         Ok (stream, locations)
-      | _ -> Ok (stream, locations)
+         (* print_string "CONTENT: "; *)
+         (* print_endline @@ Bytes.to_string content; *)
+         Ok ((stream, locations), Read content)
+      | _ -> Error "Unimplemented method"
 end
diff --git a/lib/dune b/lib/dune
index b5e8596..8ad4a95 100644
--- a/lib/dune
+++ b/lib/dune
@@ -1,7 +1,7 @@
 (library
  (name relational_engine)
  (libraries ctypes ctypes-foreign data-encoding)
- (preprocess (pps ppx_deriving.show ppx_deriving.ord))
+ (preprocess (pps ppx_deriving.show ppx_sexp_conv))
  ;; (c_library_flags -lssl -lcrypto -L %{env:LIBRESSL_LIB_PATH=})
  ;; (foreign_stubs
  ;;  (language cxx)
diff --git a/lib/relation.ml b/lib/relation.ml
new file mode 100644
index 0000000..a4e14c4
--- /dev/null
+++ b/lib/relation.ml
@@ -0,0 +1,39 @@
+open Sexplib0
+open Sexplib0.Sexp_conv
+open Ppx_xml_conv
+module Protocol = struct
+  type tuples = string list list
+  [@@deriving sexp, ]
+end
+
+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
+  let command_read1: Command.t = {kind = Command.READ; timestamp = 0.0; hash = ""; content = ""; filename = "user/first-name"; references = []} 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"; references = []} 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); *)
+  Ok (Sexp.to_string (Protocol.sexp_of_tuples [List.map Bytes.to_string first_name; List.map Bytes.to_string last_name]))
+    [@@warning "-8"] (* Suppress pattern match incomplete warnings *)
diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml
index cc9652b..65d03d4 100644
--- a/test/test_relational_engine.ml
+++ b/test/test_relational_engine.ml
@@ -3,7 +3,7 @@ let%test _ =
   let open Relational_engine.Disk.Executor in
   let stream: history = [{state = _EMPTY_SHA_HASH_; files = StringMap.empty}] in
   let locations: locations = StringMap.empty in
-  let (new_commit, _) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in
+  let ((new_commit, _), _) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in
   let expected_state_hash = "bca39cc55b19274133ce57d0bea1ff794589f025d4bcf670c44d5d2811837830" in
   new_commit.state = expected_state_hash
 
@@ -11,7 +11,7 @@ let%test _ =
   let open Relational_engine.Disk.Executor in
   let stream: history = [{state = _EMPTY_SHA_HASH_; files = StringMap.empty}] in
   let locations: locations = StringMap.empty in
-  let (new_commit, new_locations) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in
+  let ((new_commit, new_locations), _) = Result.get_ok @@ write (List.hd stream) locations ~filename:"trash" @@ Bytes.of_string "abc" in
   let result_test =
     let open Relational_engine.Extensions.Option in
     let+ new_file_content = StringMap.find_opt "trash" new_commit.files in