aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/kernel/Path.ml27
-rw-r--r--lib/kernel/Path.mli3
2 files changed, 30 insertions, 0 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