From e61404f0219cd8f07c6c278f7ee952c70ce5bdf4 Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Thu, 27 Aug 2026 01:35:53 +0000 Subject: Branch serialization --- lib/kernel/Branch.ml | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 lib/kernel/Branch.ml (limited to 'lib/kernel/Branch.ml') diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml new file mode 100644 index 0000000..2aaa9ca --- /dev/null +++ b/lib/kernel/Branch.ml @@ -0,0 +1,60 @@ +module Multigroup = Merkle.StringKey (* FIXME *) + +module Make (S : Abstract.Storage.STORAGE) = struct + (* Branch has a name, a set of multigroups, and a backlink to the previous state + multigroup has a name and a set of schemas + schema has a name and a set of relations + + /branch/master/multigroup/universe/schema/sky/relation/planet + *) + + module SI = Storage.Make (S) + + module MultigroupM = Merkle.Interface (S) (Merkle.StringKey) (Multigroup) + + type t = { + multigroups : MultigroupM.address; + previous : t SI.Pointer.t option + } + + module rec Representation : Concepts.Encoding.Record.S with type t = t = Concepts.Encoding.Record.Make (Body) + and Body : Concepts.Encoding.Record.BODY = struct + type nonrec t = t + + let load tx addr = + SI.get_req tx addr + |> Utilities.Result.fmap Representation.of_blob + + let tag = 'Y' + let malformed () = + Concepts.Condition. + (condition "malformed-branch" "The on-disk representation of a branch did not conform to what was expected. Is your database corrupted?" + empty) + + let fields { multigroups; previous } = + let open Concepts.Encoding in + ["multigroups", Value.bencode_of_hash multigroups; + "previous", Value.bencode_of_option + (fun v -> SI.Pointer.address_of v + |> SI.as_hash + |> Value.bencode_of_hash) + previous] + + let of_fields fields = + let open Utilities.Result in + let open Concepts.Encoding in + let* multigroups = Bencode.field "multigroups" fields |> fmap Value.hash_of_bencode in + let* previous = Bencode.field "previous" fields + |> fmap (Value.option_of_bencode + (fun v -> Value.hash_of_bencode v + |> Result.map (fun hash -> S.Hash hash) + |> Result.map (Fun.flip (SI.Pointer.make) load))) in + Ok { multigroups; previous } + end + + class branch = object + (* TODO *) + end + + let load _tx _conn _name _addr = failwith "TODO" +end -- cgit v1.2.3