tuple concept based atop of maps for attributes

2 files changed, 108 insertions, 0 deletions

diff --git a/lib/concepts/Tuple.ml b/lib/concepts/Tuple.ml
new file mode 100644
index 0000000..dc6eb5f
--- /dev/null
+++ b/lib/concepts/Tuple.ml
@@ -0,0 +1,89 @@
+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
new file mode 100644
index 0000000..06542c8
--- /dev/null
+++ b/lib/concepts/Tuple.mli
@@ -0,0 +1,19 @@
+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