From 41224db2c0929db32da31718af04655ce5e138e6 Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Thu, 8 Oct 2026 20:05:19 -0300 Subject: purge schema in favor of simple namespace --- lib/kernel/Prototype.ml | 35 +++++++++++++++++++++++------------ 1 file changed, 23 insertions(+), 12 deletions(-) (limited to 'lib/kernel/Prototype.ml') diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml index 3fd208e..ea1083b 100644 --- a/lib/kernel/Prototype.ml +++ b/lib/kernel/Prototype.ml @@ -49,29 +49,29 @@ module Associative = struct type 'tx admission = 'tx -> (Concepts.Hash.hash, Concepts.Condition.condition) result + (* A value with no address yet is [admit]ted: it is read here, before + the write begins, since reading it may itself need storage, and + stored by the write. *) + let admission admit key h = + match Protocols.Addressable.from h with + | Some a -> + let addr = Protocols.Addressable.address a in + Ok (fun _ -> Ok addr) + | None -> admit key h + module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) = struct module Tree = Merkle.Make (S) (K) module SI = Storage.Make (S) - (* A value with no address yet is [admit]ted: it is read here, before - the write begins, since reading it may itself need storage, and - stored by the write. *) - let make ?admit ~storage ~constructor ~node () = + let make ~admit ~storage ~constructor ~node = Protocols.Associative.make @@ object method update key value = let open Utilities.Result in - let open Protocols in let* store = match value with | None -> Ok None - | Some h -> ( - match Addressable.from h, admit with - | None, Some admit -> admit key h |> Result.map Option.some - | _ -> - let* addressable = Handle.require Addressable.from h in - let addr = Addressable.address addressable in - Ok (Some (fun _ -> Ok addr)) ) + | Some h -> admission admit key h |> Result.map Option.some in SI.with_transaction storage (fun tx -> let* node' = @@ -95,6 +95,17 @@ module Directory = struct method find k = Ok (BatMap.find_opt k props) end + let children directory = + let open Utilities.Result in + let* listing = Protocols.Handle.require Protocols.Directory.from directory in + let* names = Protocols.Directory.list listing in + BatFingerTree.to_list names + |> List.map (fun name -> + let* found = Protocols.Directory.find listing name in + Ok (Option.map (fun child -> name, child) found) ) + |> Utilities.List.sequence + |> Result.map (List.filter_map Fun.id) + module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) -- cgit v1.2.3