appropriate enumeration for tuple split on object and resident

1 files changed, 31 insertions, 20 deletions

diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml
index b0c8a51..3094eb8 100644
--- a/lib/kernel/SubstantialRelation.ml
+++ b/lib/kernel/SubstantialRelation.ml
@@ -1,7 +1,4 @@
-module Make (S : Abstract.Storage.STORAGE) (Schematics : sig
-  include Protocols.Schematics.S
-  val of_blob : Concepts.Blob.t -> (Schema.t, Concepts.Condition.condition) result
-end) = struct
+module Make (S : Abstract.Storage.STORAGE) = struct
   module SI = Storage.Make (S)
 
   module Error = struct
@@ -40,7 +37,7 @@ end) = struct
   module TupleSet = Merkle.Make (S) (TupleKey)
 
   type t =
-    { heading: Concepts.Hash.hash;
+    { schematics: Concepts.Hash.hash;
       predicate: Concepts.Hash.hash option;
       local_constraints: Concepts.Hash.hash option;
       tuples: TupleSet.address;
@@ -55,9 +52,9 @@ end) = struct
     let tag = 'R'
     let malformed = Error.malformed_relation
 
-    let fields {heading; predicate; local_constraints; tuples; indexes} =
+    let fields {schematics; predicate; local_constraints; tuples; indexes} =
       let open Concepts.Encoding in
-      [ "heading", Value.bencode_of_hash heading;
+      [ "schema", Value.bencode_of_hash schematics;
         "predicate", Value.bencode_of_option Value.bencode_of_hash predicate;
         "local-constraints", Value.bencode_of_option Value.bencode_of_hash local_constraints;
         "tuples", Value.bencode_of_hash tuples;
@@ -66,7 +63,7 @@ end) = struct
     let of_fields fields =
       let open Utilities.Result in
       let open Concepts.Encoding in
-      let* heading = Bencode.field "heading" fields |> fmap Value.hash_of_bencode in
+      let* schematics = Bencode.field "schema" fields |> fmap Value.hash_of_bencode in
       let* predicate =
         Bencode.field "predicate" fields |> fmap (Value.option_of_bencode Value.hash_of_bencode)
       in
@@ -78,13 +75,13 @@ end) = struct
       let* indexes =
         Bencode.field "indexes" fields |> fmap (Value.option_of_bencode Value.hash_of_bencode)
       in
-      Ok {heading; predicate; local_constraints; tuples; indexes}
+      Ok {schematics; predicate; local_constraints; tuples; indexes}
   end
 
   let encode = Representation.to_blob
   let decode = Representation.of_blob
 
-  let heading {heading; _} = heading
+  let schematics {schematics; _} = schematics
   let predicate {predicate; _} = predicate
   let local_constraints {local_constraints; _} = local_constraints
   let tuples {tuples; _} = tuples
@@ -96,10 +93,10 @@ end) = struct
     let* tuples = TupleSet.find tx relation.tuples in
     Option.to_result ~none:(Error.invalid_tuple_root relation.tuples) tuples
 
-  let empty tx ~heading ?predicate ?local_constraints ?indexes () =
+  let empty tx ~schematics ?predicate ?local_constraints ?indexes () =
     let open Utilities.Result in
     let* tuples = TupleSet.empty_under tx in
-    Ok {heading; predicate; local_constraints; tuples; indexes}
+    Ok {schematics; predicate; local_constraints; tuples; indexes}
 
   let store tx relation = SI.store_blob tx (Representation.to_blob relation)
 
@@ -110,10 +107,20 @@ end) = struct
     let* present = TupleSet.lookup tx tuple node in
     Ok (Option.is_some present)
 
-  let heading_value tx relation =
+  let schema_of tx relation =
     let open Utilities.Result in
-    let* data = SI.get_req tx (S.Hash relation.heading) in
-    Schematics.of_blob data
+    let* data = SI.get_req tx (S.Hash relation.schematics) in
+    let* fields = Concepts.Encoding.Bencode.of_blob data in
+    let* kvs = Concepts.Encoding.Bencode.as_dict fields in
+    kvs
+    |> List.map (fun (name, domain) ->
+           Concepts.Encoding.Bencode.as_string domain
+           |> Result.map (fun domain -> (name, domain)))
+    |> Utilities.List.sequence
+    |> Result.map (fun kvs ->
+           List.fold_left
+             (fun acc (name, domain) -> BatMap.String.add name domain acc)
+             BatMap.String.empty kvs)
 
   let enumerate storage relation =
     let open Utilities.Result in
@@ -154,7 +161,6 @@ end) = struct
       inherit Lifecycle.null
       val storage : S.connection = storage
       val relation : t = value
-      method heading = Ok relation.heading
       method predicate = Ok relation.predicate
       method local_constraints = Ok relation.local_constraints
 
@@ -164,7 +170,10 @@ end) = struct
         SI.with_transaction storage (fun tx ->
             contains_tuple tx relation (Concepts.Tuple.Representation.to_blob tuple) )
 
-      method schema = SI.with_transaction storage (fun tx -> heading_value tx relation)
+      method describe () =
+        let open Utilities.Result in
+        let* description = SI.with_transaction storage (fun tx -> schema_of tx relation) in
+        Ok (Protocols.Schematics.Relation description)
 
       (* A substantial relation is finitely enumerable, so it carries [Enumerable] as well as
          [Relation]. A procedural relation would carry only the latter, which is how an evaluator
@@ -174,14 +183,16 @@ end) = struct
       method enumerate (_ : Protocols.Context.t) = enumerate storage relation
 
       method protocols : Protocols.Handle.protocol list =
-        [Protocols.Relation.make self; Protocols.Enumerable.make self; Schematics.make self]
+        [ Protocols.Relation.make self
+        ; Protocols.Enumerable.make self
+        ; Protocols.Schematics.make self ]
       method hash = hash relation
     end
 
-  let make conn ~heading ?predicate ?local_constraints ?indexes () =
+  let make conn ~schematics ?predicate ?local_constraints ?indexes () =
     let open Utilities.Result in
     SI.with_transaction conn (fun tx ->
-        let* relation = empty tx ~heading ?predicate ?local_constraints ?indexes () in
+        let* relation = empty tx ~schematics ?predicate ?local_constraints ?indexes () in
         let* _ = store tx relation in
         Ok (new relation conn relation |> Protocols.Handle.make) )