nested relations

5 files changed, 136 insertions, 68 deletions

diff --git a/client.el b/client.el
index 91f833f..434d709 100644
--- a/client.el
+++ b/client.el
@@ -19,6 +19,7 @@
     (process-send-string connection content)))
 
 (setq msg "(SequentialRead (relation_name address))")
+(setq msg "(Nest (relation_name user))")
 
 (relational-client msg)
 
diff --git a/lib/disk.ml b/lib/disk.ml
index fbb6219..05f4d82 100644
--- a/lib/disk.ml
+++ b/lib/disk.ml
@@ -148,6 +148,7 @@ module Executor = struct
     | LInteger64 of int64
     | LBoolean of bool
     | LRelation of int64*string
+    | LRelationNested of int64*string*((string*relational_literal) list)
   [@@deriving show, sexp, protocol ~driver:(module Xml_light)]
 
   type schema = (string * relational_type) list StringMap.t
@@ -413,6 +414,7 @@ module Executor = struct
                     end
        | Ok x -> x
        end
+    | LRelationNested _ -> Bytes.empty
     | LBoolean x -> Data_encoding.Binary.to_bytes_exn Data_encoding.bool x
 
   let read_location ~hash (locations: locations) (cast_type: relational_type): relational_literal =
@@ -455,6 +457,7 @@ module Command = struct
                            attributes: (string*Executor.relational_type) list }
     | NaturalJoin of {left_relation: string;
                       right_relation: string}
+    | Nest of {relation_name: string}
   [@@deriving sexp, protocol ~driver:(module Xml_light)]
   
   let command_encoding =
@@ -537,37 +540,4 @@ module Command = struct
             ComputedHash computed_hash_handle )
     | Some _, None -> Error "Cannot write an entity without its referential."
     | None, _ -> Ok ((commit, locations), Nothing)
-  
-  let perform (commit : Executor.commit) (locations : Executor.locations) (command : t) =
-    match command with
-    | NaturalJoin {left_relation = _; right_relation = _} ->
-       Ok ((commit, locations), Nothing)
-    | SpecifyRelation {relation_name; attributes} ->
-       (* If it already exists under the relation name key, it will be replaced *)
-       Ok (({ commit with
-              schema = commit.schema
-                       |> Executor.StringMap.add relation_name attributes}, locations), Nothing)
-    | SequentialRead { relation_name } ->
-        let relation_name = List.hd @@ String.split_on_char '/' relation_name in
-        let entities : (string * Executor.relational_type * string) list Executor.IntMap.t =
-          print_endline relation_name;
-          Executor.StringMap.find_opt relation_name commit.references
-          |> function
-          | Some entities -> entities
-          | None -> Executor.IntMap.empty
-        in
-
-        let content: (int64 * (string*Executor.relational_literal) list) list =
-          Executor.IntMap.fold
-            (fun key elems acc ->
-              (key,
-                List.map
-                  (fun (location, type', attribute_name) ->
-                    (attribute_name, Executor.read_location ~hash:location locations type'))
-                  elems)
-              :: acc)
-            entities []
-        in
-        
-        Ok ((commit, locations), Read content)
 end
diff --git a/lib/planner.ml b/lib/planner.ml
index db48bca..c66e46b 100644
--- a/lib/planner.ml
+++ b/lib/planner.ml
@@ -8,7 +8,7 @@ end
 module Scan = struct
   open Disk
 
-  let execute (commit: Executor.commit) locations (entity : string) =
+  let execute (commit : Executor.commit) locations (entity : string) =
     (*Executor.read commit locations ~filename:("schema~" ^ entity) |> function
     | Some binary -> (
         let relation =
@@ -29,40 +29,51 @@ module Scan = struct
         | Error err -> failwith err)
     | None -> failwith ""
     *)
-    let entities : (string * Executor.relational_type * string) list Executor.IntMap.t =
-      Executor.StringMap.find_opt entity commit.references
-      |> function
-        | Some entities -> entities
-        | None -> Executor.IntMap.empty
+    let entities :
+        (string * Executor.relational_type * string) list Executor.IntMap.t =
+      Executor.StringMap.find_opt entity commit.references |> function
+      | Some entities -> entities
+      | None -> Executor.IntMap.empty
     in
 
-    let content: (int64 * (string*Executor.relational_literal) list) list =
+    let content : (int64 * (string * Executor.relational_literal) list) list =
       Executor.IntMap.fold
         (fun key elems acc ->
-          (key,
-           List.map
-             (fun (location, type', attribute_name) ->
-               (attribute_name, Executor.read_location ~hash:location locations type'))
-             elems)
+          ( key,
+            List.map
+              (fun (location, type', attribute_name) ->
+                ( attribute_name,
+                  Executor.read_location ~hash:location locations type' ))
+              elems )
           :: acc)
         entities []
-    in content
-    
+    in
+    content
 end
 
 module Join = struct
   open Disk
+
   module NestedLoop = struct
     let execute
-          (left: (int64 * (string*Executor.relational_literal) list) list)
-          (right: (int64 * (string*Executor.relational_literal) list) list)
-          (join_clause: ((int64 * (string*Executor.relational_literal) list) *
-                         (int64 * (string*Executor.relational_literal) list)) -> bool) =
+        (left : (int64 * (string * Executor.relational_literal) list) list)
+        (right : (int64 * (string * Executor.relational_literal) list) list)
+        (join_clause :
+          (int64 * (string * Executor.relational_literal) list)
+          * (int64 * (string * Executor.relational_literal) list) ->
+          bool) =
       let result = ref [] in
-      List.iter (fun left_tuple -> List.iter (fun right_tuple -> if join_clause(left_tuple, right_tuple)
-                                                                 then result := (left_tuple,right_tuple)::(!result)) right) left;
+      List.iter
+        (fun left_tuple ->
+          List.iter
+            (fun right_tuple ->
+              if join_clause (left_tuple, right_tuple) then
+                result := (left_tuple, right_tuple) :: !result)
+            right)
+        left;
       !result
   end
+
   (* 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 *)
@@ -76,26 +87,112 @@ module Join = struct
                                                  @@ 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 *)
   open Disk
+
   let natural commit locations left_relation right_relation =
     let left_scan = Scan.execute commit locations left_relation in
     let right_scan = Scan.execute commit locations right_relation in
     let common_attributes =
-      let left_attributes = commit.schema
-                            |> Executor.StringMap.find left_relation in
-      let right_attributes = commit.schema
-                             |> Executor.StringMap.find right_relation in
-      List.filter_map (fun left_attr -> if List.mem left_attr right_attributes
-                                        then Some (fst left_attr)
-                                        else None) left_attributes
+      let left_attributes =
+        commit.schema |> Executor.StringMap.find left_relation
+      in
+      let right_attributes =
+        commit.schema |> Executor.StringMap.find right_relation
+      in
+      List.filter_map
+        (fun left_attr ->
+          if List.mem left_attr right_attributes then Some (fst left_attr)
+          else None)
+        left_attributes
     in
-    let join_clause = fun ((_entity_id_1, left_tuple), (_entity_id_2,right_tuple)): bool ->
+    let join_clause =
+     fun ((_entity_id_1, left_tuple), (_entity_id_2, right_tuple)) : bool ->
       (* Check only the key name for now, not subtype, so literals must be equal for it to work *)
-      let left_tuple = Executor.StringMap.filter (fun key _ -> List.mem key common_attributes)
-                       @@ Executor.StringMap.of_list left_tuple in
-      let right_tuple = Executor.StringMap.filter (fun key _ -> List.mem key common_attributes)
-                        @@ Executor.StringMap.of_list right_tuple in
+      let left_tuple =
+        Executor.StringMap.filter (fun key _ -> List.mem key common_attributes)
+        @@ Executor.StringMap.of_list left_tuple
+      in
+      let right_tuple =
+        Executor.StringMap.filter (fun key _ -> List.mem key common_attributes)
+        @@ Executor.StringMap.of_list right_tuple
+      in
       left_tuple = right_tuple
-    in NestedLoop.execute left_scan right_scan join_clause
+    in
+    NestedLoop.execute left_scan right_scan join_clause
+
+  let nest commit locations (relation: string) =
+    let parent_scan = Scan.execute commit locations relation in
+    let nested_attributes =
+      Executor.StringMap.find relation commit.schema
+      |> List.filter (fun (_, (elem : Executor.relational_type)) ->
+             match elem with Executor.Relation _ -> true | _ -> false)
+    in
+    let nested_scans =
+      List.concat_map
+        (fun (nested_relation_attr, _) ->
+          Scan.execute commit locations nested_relation_attr)
+        nested_attributes
+    in
+    List.map
+      (fun (entity_id, x) ->
+        ( entity_id,
+          List.map
+            (fun (name_attr, item) ->
+              match item with
+              | Executor.LRelation (nested_entity_id, nested_name_attr) ->
+                  ( name_attr,
+                    Executor.LRelationNested
+                      ( nested_entity_id,
+                        nested_name_attr,
+                        List.find_map
+                          (fun (iter_entity_id, iter_attrs) ->
+                            if iter_entity_id = nested_entity_id then
+                              Some iter_attrs
+                            else None)
+                          nested_scans
+                        |> Option.to_list |> List.concat ) )
+              | _ -> (name_attr, item))
+            x ))
+      parent_scan
 end
 
 module Filter = struct end
+
+module Executor = struct
+  open Disk
+  open Disk.Executor
+  let perform (commit : Executor.commit) (locations : Executor.locations) (command : Command.t) =
+    match command with
+    | Nest {relation_name;} ->
+       let results = Join.nest commit locations relation_name in
+       Ok ((commit, locations), Command.Read results)
+    | NaturalJoin {left_relation = _; right_relation = _} ->
+       Ok ((commit, locations), Nothing)
+    | SpecifyRelation {relation_name; attributes} ->
+       (* If it already exists under the relation name key, it will be replaced *)
+       Ok (({ commit with
+              schema = commit.schema
+                       |> Executor.StringMap.add relation_name attributes}, locations), Nothing)
+    | SequentialRead { relation_name } ->
+        let relation_name = List.hd @@ String.split_on_char '/' relation_name in
+        let entities : (string * Executor.relational_type * string) list Executor.IntMap.t =
+          print_endline relation_name;
+          Executor.StringMap.find_opt relation_name commit.references
+          |> function
+          | Some entities -> entities
+          | None -> Executor.IntMap.empty
+        in
+
+        let content: (int64 * (string*Executor.relational_literal) list) list =
+          Executor.IntMap.fold
+            (fun key elems acc ->
+              (key,
+                List.map
+                  (fun (location, type', attribute_name) ->
+                    (attribute_name, Executor.read_location ~hash:location locations type'))
+                  elems)
+              :: acc)
+            entities []
+        in
+        
+        Ok ((commit, locations), Read content)
+end
diff --git a/lib/relation.ml b/lib/relation.ml
index a7b86c1..b163d8a 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -354,7 +354,7 @@ let write_and_retrieve () =
     |> Command.transact commit locations
   in
   let+ _, (Command.Read content as response) =
-    Command.perform commit locations (SequentialRead { relation_name = "user" })
+    Planner.Executor.perform commit locations (SequentialRead { relation_name = "user" })
   in
   print_endline (Command.show_return response);
   (* Ok (commit, locations) *)
diff --git a/lib/server.ml b/lib/server.ml
index bc7dac2..d06f8e8 100644
--- a/lib/server.ml
+++ b/lib/server.ml
@@ -32,7 +32,7 @@ let client_read sock maxlen =
   (* let command = Protocol.command_of_xml_light_exn (Protocol_conv_xml.Xml_light.of_string x) in *)
   let Ok (commit, locations) = Relation.prepare () in
   let Ok (_, (Disk.Command.Read response)) =
-    Disk.Command.perform commit locations command
+    Planner.Executor.perform commit locations command
   in return @@ Sexplib.Sexp.to_string (Protocol.sexp_of_facts response)
   (* in return @@ Xml.to_string (Protocol.facts_to_xml_light response) *)
   (* match *)