add relation type and format

7 files changed, 85 insertions, 61 deletions

diff --git a/bin/main.ml b/bin/main.ml
index 5f63adb..557473b 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,9 +1,9 @@
-let main () =
-  Relational_engine.Server.start ()
+let main () = Relational_engine.Server.start ()
+
 let () =
   (* let response = *)
   (* Relational_engine.Relation.write_and_retrieve() *)
   (* in match response with *)
   (* | Ok response -> print_endline response *)
   (* | Error err -> print_endline err; *)
-  main()
+  main ()
diff --git a/lib/disk.ml b/lib/disk.ml
index 503eda3..7d53f77 100644
--- a/lib/disk.ml
+++ b/lib/disk.ml
@@ -31,7 +31,8 @@ module FileSystem (C : Configuration) : FileSystem = struct
     | Storage -> C.storage ^ "storage.re"
     | Transaction -> C.transactions ^ "transaction.re"
 
-  (** [append target content] writes content to file in append only format, returning [content_length * offset_written] *)
+  (** [append target content] writes content to file in append only format,
+      returning [content_length * offset_written] *)
   let append target content =
     let register channel =
       let offset_written =
@@ -92,12 +93,14 @@ 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 relational_type =
+    | Text
+    | Integer32
+    | Integer64
+    | Boolean
+    | DiscriminatedUnion of (string * relational_type option) list * string
+      (* [("MemberA", None); ("MemberB", Some Integer32)], "NameOfDU" *)
+    | Relation of string
 
   type schema = (string * relational_type) list StringMap.t
   type references = string list IntMap.t StringMap.t
@@ -106,7 +109,7 @@ module Executor = struct
     state : string;
     files : Hashes.history StringMap.t;
     references : references;
-    schema : schema
+    schema : schema;
   }
 
   type history = commit list
@@ -242,10 +245,13 @@ module Executor = struct
             Ok ((commit, locations), Some computed_hash)
         | None -> Ok ((commit, locations), None))
 
-  let read ({ files; _ } as _commit : commit) (locations : locations) ~filename =
+  let read ({ files; _ } as _commit : commit) (locations : locations) ~filename
+      =
     let open Extensions.Option in
     let+ history : Hashes.history = StringMap.find_opt filename files in
-    let+ { values = location_hashes; _ } : Hashes.t = match history with [] -> None | history -> Some(List.hd history) in
+    let+ { values = location_hashes; _ } : Hashes.t =
+      match history with [] -> None | history -> Some (List.hd history)
+    in
     let physical_locations =
       List.map (fun hash -> StringMap.find hash locations) location_hashes
     in
@@ -263,11 +269,10 @@ module Executor = struct
 
   let read_location ~hash (locations : locations) =
     match StringMap.find_opt hash locations with
-    | Some ({ offset; size; _ } : Location.t) ->
-       begin match FS.read FS.Storage offset size with
-       | Ok x -> x
-       | Error err -> failwith err
-       end
+    | Some ({ offset; size; _ } : Location.t) -> (
+        match FS.read FS.Storage offset size with
+        | Ok x -> x
+        | Error err -> failwith err)
     | None -> failwith "Location could not be found."
 end
 
@@ -318,7 +323,7 @@ module Command = struct
       (fun (kind, timestamp, hash, filename, entity_id, content) ->
         { kind; timestamp; hash; filename; entity_id; content })
       Data_encoding.(
-      tup6 command_kind_encoding float string string (option int64) string)
+        tup6 command_kind_encoding float string string (option int64) string)
 
   let parse_command ~data =
     let contract_encoding =
@@ -337,8 +342,9 @@ module Command = struct
     | Nothing
   [@@deriving show]
 
-  (** 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. *)
+  (** 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 (commit : Executor.commit)
       (locations : Executor.locations) command =
     let open Extensions.Result in
@@ -396,12 +402,13 @@ module Command = struct
         let entities : string list Executor.IntMap.t =
           print_endline command.filename;
           Executor.StringMap.find_opt command.filename commit.references
-          |> function Some entities ->
-                       print_endline "-----> A";
-                       entities
-                    | None ->
-                       print_endline "-----> B";
-                       Executor.IntMap.empty
+          |> function
+          | Some entities ->
+              print_endline "-----> A";
+              entities
+          | None ->
+              print_endline "-----> B";
+              Executor.IntMap.empty
         in
         let content =
           Executor.IntMap.fold
diff --git a/lib/planner.ml b/lib/planner.ml
index 0d333f1..0470092 100644
--- a/lib/planner.ml
+++ b/lib/planner.ml
@@ -1,28 +1,33 @@
 module type Action = sig
   (* Names of the attributes & The tuples *)
   type tuples = string list * bytes list list
-  val execute: tuples -> int
+
+  val execute : tuples -> int
 end
 
 module Scan = struct
   open Disk
-  let execute commit locations (entity: string) =
-    Executor.read commit locations ~filename:("schema~" ^ entity)
-    |> function
-      | Some binary ->
-         begin
-           let relation =
-             Result.map_error (fun _ -> "Failed to deserialize relation from binary format.")
-             @@ Data_encoding.Binary.of_bytes Schema.Protocol.relation_encoding (Bytes.concat Bytes.empty binary) in
-           match relation with
-           | Ok relation ->
-              begin
-                let _attrs = List.map (fun (a: Schema.Protocol.attribute) -> relation.name ^ "/" ^ a.name) relation.attributes in
-                Executor.read commit locations ~filename:("schema~" ^ entity)
-              end
-           | Error err -> failwith err
-         end
-      | None -> failwith ""
+
+  let execute commit locations (entity : string) =
+    Executor.read commit locations ~filename:("schema~" ^ entity) |> function
+    | Some binary -> (
+        let relation =
+          Result.map_error (fun _ ->
+              "Failed to deserialize relation from binary format.")
+          @@ Data_encoding.Binary.of_bytes Schema.Protocol.relation_encoding
+               (Bytes.concat Bytes.empty binary)
+        in
+        match relation with
+        | Ok relation ->
+            let _attrs =
+              List.map
+                (fun (a : Schema.Protocol.attribute) ->
+                  relation.name ^ "/" ^ a.name)
+                relation.attributes
+            in
+            Executor.read commit locations ~filename:("schema~" ^ entity)
+        | Error err -> failwith err)
+    | None -> failwith ""
 end
 
 module Join = struct
diff --git a/lib/protocol.ml b/lib/protocol.ml
index 9dea3ce..79ed8d0 100644
--- a/lib/protocol.ml
+++ b/lib/protocol.ml
@@ -1,8 +1,7 @@
 open Protocol_conv_xml
 open Sexplib0.Sexp_conv
 
-type tuple = string list
-[@@deriving sexp, protocol ~driver:(module Xml_light)]
+type tuple = string list [@@deriving sexp, protocol ~driver:(module Xml_light)]
 
 type relation = {
   attribute_name : string;
@@ -12,4 +11,4 @@ type relation = {
 [@@deriving sexp, protocol ~driver:(module Xml_light)]
 
 type facts = relation list
-[@@deriving sexp, protocol ~driver:(module Xml_light)]
\ No newline at end of file
+[@@deriving sexp, protocol ~driver:(module Xml_light)]
diff --git a/lib/relation.ml b/lib/relation.ml
index 798a082..275bd10 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -1,12 +1,22 @@
 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 schema =
+    Executor.StringMap.empty
+    |> Executor.StringMap.add "user"
+         [
+           ("first_name", Executor.Text);
+           ("last_name", Executor.Text);
+           ("address", Executor.Relation "address");
+         ]
+    |> Executor.StringMap.add "address"
+         [ ("street", Executor.Text); ("number", Executor.Integer32) ]
+  in
   let commit : Executor.commit =
     {
       state = Executor._EMPTY_SHA_HASH_;
       files = Executor.StringMap.empty;
       references = Executor.StringMap.empty;
-      schema
+      schema;
     }
   in
   let locations : Executor.locations = Executor.StringMap.empty in
@@ -112,11 +122,16 @@ let write_and_retrieve () =
   let+ _, (Command.Read content as response) =
     Command.commit_and_perform commit locations command_read
   in
-  Executor.StringMap.iter (fun k v -> print_endline ("→ " ^ k ^ ": ");
-                                      Executor.IntMap.iter (fun k v ->
-                                          print_endline ("  ↳ " ^ (Int64.to_string k));
-                                          List.iter (fun v -> print_endline ("    → " ^ v)) v) v;
-                                      print_newline()) references;
+  Executor.StringMap.iter
+    (fun k v ->
+      print_endline ("→ " ^ k ^ ": ");
+      Executor.IntMap.iter
+        (fun k v ->
+          print_endline ("  ↳ " ^ Int64.to_string k);
+          List.iter (fun v -> print_endline ("    → " ^ v)) v)
+        v;
+      print_newline ())
+    references;
   print_endline (Command.show_return response);
   Ok (commit, locations)
 [@@warning "-8-27-26"]
diff --git a/lib/server.ml b/lib/server.ml
index 46ef85d..4a99b29 100644
--- a/lib/server.ml
+++ b/lib/server.ml
@@ -46,8 +46,7 @@ let client_read sock maxlen =
           };
         ]
       in
-      return
-      @@ Xml.to_string (Protocol.facts_to_xml_light relation_result)
+      return @@ Xml.to_string (Protocol.facts_to_xml_light relation_result)
   | Error err -> return err
 [@@warning "-27"]
 
@@ -56,8 +55,7 @@ let rec socket_read sock =
   Lwt_unix.accept sock >>= fun (client, _) ->
   client_read client 512
   (* >>= fun results -> Lwt_unix.send client (Data_encoding.Binary.to_bytes_exn Data_encoding.Encoding.int32 5l) 0 1 [] *)
-  >>=
-  fun results ->
+  >>= fun results ->
   Lwt_unix.send client (Bytes.of_string results) 0 (String.length results) []
   >>= fun _ ->
   Lwt_unix.wait_write client >>= fun () ->
diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml
index e9e4525..e476c39 100644
--- a/test/test_relational_engine.ml
+++ b/test/test_relational_engine.ml
@@ -6,7 +6,7 @@ let%test _ =
         state = _EMPTY_SHA_HASH_;
         files = StringMap.empty;
         references = StringMap.empty;
-        schema = StringMap.empty
+        schema = StringMap.empty;
       };
     ]
   in
@@ -29,7 +29,7 @@ let%test _ =
         state = _EMPTY_SHA_HASH_;
         files = StringMap.empty;
         references = StringMap.empty;
-        schema = StringMap.empty
+        schema = StringMap.empty;
       };
     ]
   in