rework on tuple non resident object with schematics as protocol

4 files changed, 0 insertions, 232 deletions

diff --git a/lib/concepts/Heading.ml b/lib/concepts/Heading.ml
deleted file mode 100644
index 58bbef9..0000000
--- a/lib/concepts/Heading.ml
+++ /dev/null
@@ -1,100 +0,0 @@
-type t = (string, string) BatMap.t
-
-let of_alist pairs = List.fold_left (fun acc (name, domain) -> BatMap.add name domain acc) BatMap.empty pairs
-
-(* Relies on BatMap's iteration order being key order (it is, for the
-   polymorphic tree map keyed by Stdlib.compare on strings), rather
-   than sorting again on every call. *)
-let attributes heading =
-  BatMap.foldi (fun name domain acc -> BatFingerTree.snoc acc (name, domain)) heading BatFingerTree.empty
-
-let names heading = BatMap.foldi (fun name _ acc -> BatSet.add name acc) heading BatSet.empty
-let arity heading = BatMap.cardinal heading
-let mem name heading = BatMap.mem name heading
-
-module Error = struct
-  open Condition
-
-  let unknown_attribute name =
-    condition "unknown-attribute" "No such attribute on this heading"
-      ("attribute" |=| Value.String name)
-
-  let incompatible_domain name =
-    condition "incompatible-domain" "The same attribute name is declared on two different domains"
-      ("attribute" |=| Value.String name)
-end
-
-let domain_of name heading =
-  match BatMap.find_opt name heading with
-  | Some domain -> Ok domain
-  | None -> Error (Error.unknown_attribute name)
-
-let project names heading =
-  let open Utilities.Result in
-  BatFingerTree.fold_left
-    (fun acc name ->
-      let* acc = acc in
-      let* domain = domain_of name heading in
-      if BatMap.mem name acc then
-        Error (Condition.condition "duplicate-attribute" "An attribute was selected more than once"
-          Condition.("attribute" |=| Value.String name))
-      else Ok (BatMap.add name domain acc))
-    (Ok BatMap.empty) names
-
-let rename pairs heading =
-  let open Utilities.Result in
-  BatFingerTree.fold_left
-    (fun acc (old_name, new_name) ->
-      let* acc = acc in
-      let* domain = domain_of old_name heading in
-      if BatMap.mem new_name acc then
-        Error (Condition.condition "duplicate-attribute" "Two attributes have the same renamed name"
-          Condition.("attribute" |=| Value.String new_name))
-      else Ok (BatMap.add new_name domain acc))
-    (Ok BatMap.empty) pairs
-
-let shared left right = BatSet.intersect (names left) (names right)
-
-(* TODO: this checks that shared attributes agree on domain, then
-   takes their union favouring [right]'s bindings for the shared names
-   (they already agree, so it doesn't matter which side wins). It does
-   NOT guard against two attributes that happen to share a name and a
-   domain tag by coincidence rather than by being "the same" join
-   column. Domain tags are (for now at least) opaque unchecked
-   strings. Refer to the docs/object-taxonomy.org Schematics section
-   for more. *)
-let joined left right =
-  let open Utilities.Result in
-  BatSet.fold
-    (fun name acc ->
-      let* acc = acc in
-      let* dl = domain_of name left in
-      let* dr = domain_of name right in
-      if dl = dr then Ok acc else Error (Error.incompatible_domain name))
-    (shared left right) (Ok ())
-  |> Result.map (fun () -> BatMap.foldi BatMap.add right left)
-
-let compatible left right = BatMap.equal ( = ) left right
-
-module rec Representation : (Encoding.Record.S with type t = t) = Encoding.Record.Make (Body)
-
-and Body : Encoding.Record.BODY = struct
-  type nonrec t = t
-
-  let tag = 'H'
-
-  let malformed () =
-    Condition.condition "malformed-heading"
-      "The on-disk representation of a heading did not conform to what was expected" Condition.empty
-
-  let fields heading =
-    BatMap.foldi (fun name domain acc -> (name, Encoding.Bencode.String domain) :: acc) heading []
-
-  let of_fields data =
-    let open Utilities.Result in
-    let* kvs = Encoding.Bencode.as_dict data in
-    kvs
-    |> List.map (fun (name, v) -> Encoding.Bencode.as_string v |> Result.map (fun d -> (name, d)))
-    |> Utilities.List.sequence
-    |> Result.map (List.fold_left (fun acc (name, d) -> BatMap.add name d acc) BatMap.empty)
-end
diff --git a/lib/concepts/Heading.mli b/lib/concepts/Heading.mli
deleted file mode 100644
index 98b8e60..0000000
--- a/lib/concepts/Heading.mli
+++ /dev/null
@@ -1,24 +0,0 @@
-type t
-
-val of_alist : (string * string) list -> t
-
-(** attributes in name order. *)
-val attributes : t -> (string * string) BatFingerTree.t
-
-val names : t -> string BatSet.t
-val arity : t -> int
-val mem : string -> t -> bool
-
-module Error : sig
-  val unknown_attribute : string -> Condition.condition
-  val incompatible_domain : string -> Condition.condition
-end
-
-val domain_of : string -> t -> (string, Condition.condition) result
-val project : string BatFingerTree.t -> t -> (t, Condition.condition) result
-val rename : (string * string) BatFingerTree.t -> t -> (t, Condition.condition) result
-val shared : t -> t -> string BatSet.t
-val joined : t -> t -> (t, Condition.condition) result
-val compatible : t -> t -> bool
-
-module Representation : Encoding.Record.S with type t = t
diff --git a/lib/concepts/Tuple.ml b/lib/concepts/Tuple.ml
deleted file mode 100644
index dc6eb5f..0000000
--- a/lib/concepts/Tuple.ml
+++ /dev/null
@@ -1,89 +0,0 @@
-type t = (string, Value.value) BatMap.t
-
-let empty = BatMap.empty
-let is_empty = BatMap.is_empty
-let set = BatMap.add
-let find_opt = BatMap.find_opt
-
-module Error = struct
-  open Condition
-
-  let unknown_attribute name =
-    condition "unknown-attribute" "No such attribute on this tuple"
-      ("attribute" |=| Value.String name)
-end
-
-let get name tuple =
-  match BatMap.find_opt name tuple with
-  | Some v -> Ok v
-  | None -> Error (Error.unknown_attribute name)
-
-let attributes tuple = BatMap.foldi (fun name _ acc -> BatSet.add name acc) tuple BatSet.empty
-
-let project names tuple =
-  let open Utilities.Result in
-  BatFingerTree.fold_left
-    (fun acc name ->
-      let* acc = acc in
-      let* value = get name tuple in
-      Ok (set name value acc))
-    (Ok empty) names
-
-let rename pairs tuple =
-  let open Utilities.Result in
-  BatFingerTree.fold_left
-    (fun acc (old_name, new_name) ->
-      let* acc = acc in
-      let* value = get old_name tuple in
-      Ok (set new_name value acc))
-    (Ok empty) pairs
-
-let merge left right =
-  BatMap.foldi
-    (fun name value acc ->
-      match acc with
-      | None -> None
-      | Some acc -> (
-         match BatMap.find_opt name acc with
-         | None -> Some (BatMap.add name value acc)
-         | Some value' -> if Value.equal value value' then Some acc else None))
-    right (Some left)
-
-(* Tuple's own wire format for a single value: kept local rather than
-   added to Concepts.Encoding.Value (which only ever encodes hashes and
-   options of them today) so this module owns its representation
-   end to end. *)
-let bencode_of_value = function
-  | Value.String s -> Encoding.Bencode.Tagged ('s', Encoding.Bencode.String s)
-  | Value.Integer n -> Encoding.Bencode.Tagged ('i', Encoding.Bencode.Int n)
-
-let malformed_value () =
-  Condition.condition "malformed-tuple-value"
-    "A tuple field did not conform to what was expected" Condition.empty
-
-let value_of_bencode = function
-  | Encoding.Bencode.Tagged ('s', Encoding.Bencode.String s) -> Ok (Value.String s)
-  | Encoding.Bencode.Tagged ('i', Encoding.Bencode.Int n) -> Ok (Value.Integer n)
-  | _ -> Error (malformed_value ())
-
-module rec Representation : (Encoding.Record.S with type t = t) = Encoding.Record.Make (Body)
-
-and Body : Encoding.Record.BODY = struct
-  type nonrec t = t
-
-  let tag = 'T'
-  let malformed = malformed_value
-
-  let fields tuple =
-    BatMap.foldi (fun name value acc -> (name, bencode_of_value value) :: acc) tuple []
-
-  let of_fields data =
-    let open Utilities.Result in
-    let* kvs = Encoding.Bencode.as_dict data in
-    kvs
-    |> List.map (fun (name, v) -> value_of_bencode v |> Result.map (fun v -> (name, v)))
-    |> Utilities.List.sequence
-    |> Result.map (List.fold_left (fun acc (name, v) -> set name v acc) empty)
-end
-
-let hash tuple = Representation.to_blob tuple |> Hash.hash_of_blob
diff --git a/lib/concepts/Tuple.mli b/lib/concepts/Tuple.mli
deleted file mode 100644
index 06542c8..0000000
--- a/lib/concepts/Tuple.mli
+++ /dev/null
@@ -1,19 +0,0 @@
-type t
-
-val empty : t
-val is_empty : t -> bool
-val set : string -> Value.value -> t -> t
-val find_opt : string -> t -> Value.value option
-
-module Error : sig
-  val unknown_attribute : string -> Condition.condition
-end
-
-val get : string -> t -> (Value.value, Condition.condition) result
-val attributes : t -> string BatSet.t
-val project : string BatFingerTree.t -> t -> (t, Condition.condition) result
-val rename : (string * string) BatFingerTree.t -> t -> (t, Condition.condition) result
-val merge : t -> t -> t option
-val hash : t -> Hash.hash
-
-module Representation : Encoding.Record.S with type t = t