aboutsummaryrefslogtreecommitdiffstats
path: root/lib/concepts/Branch.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/concepts/Branch.ml49
-rw-r--r--lib/concepts/Branch.mli9
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