Serialize runtime objects: Multigroup, Branch & Relation

2 files changed, 58 insertions, 0 deletions

diff --git a/lib/concepts/Branch.ml b/lib/concepts/Branch.ml
new file mode 100644
index 0000000..cd4213b
--- /dev/null
+++ b/lib/concepts/Branch.ml
@@ -0,0 +1,49 @@
+type address = Hash.hash
+
+type t =
+  { name: string;
+    target: address }
+
+module Field = struct
+  let name = "name"
+  let target = "target"
+end
+
+module Error = struct
+  open Condition
+
+  let malformed_branch () =
+    condition "branch-malformed" "A branch representation did not conform to what was expected"
+      empty
+
+  let malformed_hash length =
+    condition "branch-malformed-hash" "A branch target root was not a valid hash"
+      ("length" |=| Value.Integer length)
+end
+
+let make ~name ~target = {name; target}
+
+let name branch = branch.name
+let target branch = branch.target
+
+module Body = struct
+  type nonrec t = t
+
+  let tag = 'b'
+  let malformed = Error.malformed_branch
+
+  let equal left right =
+    left.name = right.name && Hash.hash_equals left.target right.target
+
+  let fields branch =
+    [ Field.name, Object.Field.string branch.name;
+      Field.target, Object.Field.address branch.target ]
+
+  let of_fields data =
+    let open Utilities.Result in
+    let* name = Object.Field.require_string Field.name data in
+    let* target = Object.Field.require_address ~malformed:Error.malformed_hash Field.target data in
+    Ok {name; target}
+end
+
+include (Object.Codec.Make (Body) : Object.S with type t := t)
diff --git a/lib/concepts/Branch.mli b/lib/concepts/Branch.mli
new file mode 100644
index 0000000..0e7e9f9
--- /dev/null
+++ b/lib/concepts/Branch.mli
@@ -0,0 +1,9 @@
+type t
+type address = Hash.hash
+
+include Object.S with type t := t
+
+val make : name:string -> target:address -> t
+
+val name : t -> string
+val target : t -> address