From 2d0ce6252c94cf23477478b35b39466aa120b7cc Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Sat, 12 Sep 2026 01:20:42 +0000 Subject: Directory and registry ergonomics --- lib/kernel/Path.ml | 27 +++++++++++++++++++++++++++ lib/kernel/Path.mli | 3 +++ test/integration/Registration.ml | 39 +++++++++++---------------------------- 3 files changed, 41 insertions(+), 28 deletions(-) diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml index 803d8cf..936704d 100644 --- a/lib/kernel/Path.ml +++ b/lib/kernel/Path.ml @@ -3,6 +3,23 @@ type t = string list let this = [] let (@/) x y = x::y +let to_string path = + path + |> List.map (fun x -> + let str = BatString.replace ~str:x ~sub:"^" ~by:"^^" |> snd in + BatString.replace ~str ~sub:"/" ~by:"^/" |> snd) + |> BatIO.to_string (BatList.print ~first:"/" ~last:"" ~sep:"/" BatString.print) + +module Error = struct + open Concepts.Condition + + let path_not_found path = condition "path-not-found" "A given path was not found under the specified object" + ("path" |=| Concepts.Value.String (to_string path)) + + let not_a_registry path = condition "not-a-registry" "The specified path did not point to a registry" + ("path" |=| Concepts.Value.String (to_string path)) +end + let rec lookup handle = function | [] -> Ok (Some handle) | x::xs -> @@ -15,3 +32,13 @@ let rec lookup handle = function match elem with | None -> Ok None | Some elem -> lookup elem xs + +let lookup' handle path = lookup handle path + |> Result.map (Option.to_result ~none:(Error.path_not_found path)) + |> Result.join + +let update handle path key reference value = + let open Utilities.Result in + let* handle = lookup' handle path in + let* registry = Protocols.Registry.from handle |> Option.to_result ~none:(Error.not_a_registry path) in + Protocols.Registry.update registry key reference value diff --git a/lib/kernel/Path.mli b/lib/kernel/Path.mli index 85d0ca9..e3eac9c 100644 --- a/lib/kernel/Path.mli +++ b/lib/kernel/Path.mli @@ -4,3 +4,6 @@ val this : t val (@/) : string -> t -> t val lookup : Protocols.Handle.t -> t -> (Protocols.Handle.t option, Concepts.Condition.condition) result +val lookup' : Protocols.Handle.t -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result + +val update : Protocols.Handle.t -> t -> string -> Protocols.Handle.t option -> Protocols.Handle.t option -> (bool, Concepts.Condition.condition) result diff --git a/test/integration/Registration.ml b/test/integration/Registration.ml index c77a139..f9d865f 100644 --- a/test/integration/Registration.ml +++ b/test/integration/Registration.ml @@ -7,36 +7,19 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = module I = Kernel.Initialization.Make (S) module B = Kernel.Branch.Make (S) - module Error = struct - open Concepts.Condition - - let not_found () = condition "not-found" "An expected object was not present" empty - end - let run conn = let open Utilities.Result in - let open Protocols in - let registration = - begin - let* root = I.initialize conn in - let* bm = Kernel.Path.(lookup root ("branch" @/ this)) - |> fmap (Option.to_result ~none:(Error.not_found ())) in - let* bm = Registry.from bm |> Option.to_result ~none:(Error.not_found ()) in - let* branch = B.make conn in - Registry.update bm "master" None (Some branch) - end - |> Helpers.condition_as_failure in - let presence = - begin - let* root = I.initialize conn in - let* bm = Kernel.Path.(lookup root ("branch" @/ this)) - |> fmap (Option.to_result ~none:(Error.not_found ())) in - let* bm = Directory.from bm |> Option.to_result ~none:(Error.not_found ()) in - Directory.find bm "master" |> Result.map Option.is_some - end - |> Helpers.condition_as_failure in - check bool "" true registration; - check bool "" true presence + begin + let* root = I.initialize conn in + let* branch = B.make conn in + Kernel.Path.(update root ("branch" @/ this) "master" None (Some branch)) + end + |> Helpers.condition_as_failure |> ignore; + begin + let* root = I.initialize conn in + Kernel.Path.(lookup' root ("branch" @/ "master" @/ "multigroup" @/ this)) + end + |> Helpers.condition_as_failure |> ignore let suite prefix = ( "registration/" ^ prefix, -- cgit v1.2.3 From 2ec420d1542ea64978bdd4666a51ec4959f648b7 Mon Sep 17 00:00:00 2001 From: Estevan Castilho Date: Thu, 17 Sep 2026 01:39:06 +0000 Subject: Forsake `lookup'` --- lib/kernel/Path.ml | 36 +++++++++++++++++++----------------- lib/kernel/Path.mli | 3 +-- test/integration/Registration.ml | 2 +- 3 files changed, 21 insertions(+), 20 deletions(-) diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml index 936704d..629a527 100644 --- a/lib/kernel/Path.ml +++ b/lib/kernel/Path.ml @@ -17,28 +17,30 @@ module Error = struct ("path" |=| Concepts.Value.String (to_string path)) let not_a_registry path = condition "not-a-registry" "The specified path did not point to a registry" + ("path" |=| Concepts.Value.String (to_string path)) + + let not_a_directory path = condition "not-a-directory" "The specified path did not point to a directory" ("path" |=| Concepts.Value.String (to_string path)) end -let rec lookup handle = function - | [] -> Ok (Some handle) - | x::xs -> - let open Utilities.Result in - let open Protocols in - match Protocols.Directory.from handle with - | None -> Ok None - | Some dir -> - let* elem = Directory.find dir x in - match elem with - | None -> Ok None - | Some elem -> lookup elem xs - -let lookup' handle path = lookup handle path - |> Result.map (Option.to_result ~none:(Error.path_not_found path)) - |> Result.join +let lookup handle path = + let rec walk handle = function + | [] -> Ok handle + | x::xs -> + let open Utilities.Result in + let open Protocols in + match Directory.from handle with + | None -> Error (Error.path_not_found path) + | Some dir -> + let* elem = Directory.find dir x in + match elem with + | None -> Error (Error.not_a_directory path) + | Some elem -> walk elem xs + in + walk handle path let update handle path key reference value = let open Utilities.Result in - let* handle = lookup' handle path in + let* handle = lookup handle path in let* registry = Protocols.Registry.from handle |> Option.to_result ~none:(Error.not_a_registry path) in Protocols.Registry.update registry key reference value diff --git a/lib/kernel/Path.mli b/lib/kernel/Path.mli index e3eac9c..6a74350 100644 --- a/lib/kernel/Path.mli +++ b/lib/kernel/Path.mli @@ -3,7 +3,6 @@ type t val this : t val (@/) : string -> t -> t -val lookup : Protocols.Handle.t -> t -> (Protocols.Handle.t option, Concepts.Condition.condition) result -val lookup' : Protocols.Handle.t -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result +val lookup : Protocols.Handle.t -> t -> (Protocols.Handle.t, Concepts.Condition.condition) result val update : Protocols.Handle.t -> t -> string -> Protocols.Handle.t option -> Protocols.Handle.t option -> (bool, Concepts.Condition.condition) result diff --git a/test/integration/Registration.ml b/test/integration/Registration.ml index f9d865f..413be9f 100644 --- a/test/integration/Registration.ml +++ b/test/integration/Registration.ml @@ -17,7 +17,7 @@ module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = |> Helpers.condition_as_failure |> ignore; begin let* root = I.initialize conn in - Kernel.Path.(lookup' root ("branch" @/ "master" @/ "multigroup" @/ this)) + Kernel.Path.(lookup root ("branch" @/ "master" @/ "multigroup" @/ this)) end |> Helpers.condition_as_failure |> ignore -- cgit v1.2.3