2 files changed, 41 insertions, 0 deletions
diff --git a/lib/runtime/Context.ml b/lib/runtime/Context.ml
new file mode 100644
index 0000000..000f5d6
--- /dev/null
+++ b/lib/runtime/Context.ml
@@ -0,0 +1,30 @@
+module Error = struct
+  open Concepts.Condition
+
+  let not_a_directory segment =
+    condition "not-a-directory" "A path segment named an object with no Directory protocol"
+      ("segment" |=| Concepts.Value.String segment)
+end
+
+let resolve { Protocols.Context.root; _ } name =
+  let open Utilities.Result in
+  let rec walk handle = function
+    | [] -> Ok (Protocols.Handle.copy handle)
+    | segment :: rest ->
+       let* directory =
+         Protocols.Directory.from handle
+         |> Option.to_result ~none:(Error.not_a_directory segment)
+       in
+       let* found = Protocols.Directory.find directory segment in
+       match found with
+       | None -> Ok None
+       | Some child ->
+          Fun.protect ~finally:(fun () -> Protocols.Handle.release child)
+            (fun () -> walk child rest)
+  in
+  String.split_on_char '/' name |> List.filter (fun segment -> segment <> "") |> walk root
+
+let over ~snapshot ~root ?(cancelled = fun () -> false) () =
+  { Protocols.Context.snapshot
+  ; root
+  ; status = (fun () -> if cancelled () then `Cancelled else `Live) }
diff --git a/lib/runtime/Context.mli b/lib/runtime/Context.mli
new file mode 100644
index 0000000..6e7ab2f
--- /dev/null
+++ b/lib/runtime/Context.mli
@@ -0,0 +1,11 @@
+val resolve :
+  Protocols.Context.t ->
+  string ->
+  (Protocols.Handle.t option, Concepts.Condition.condition) result
+
+val over :
+  snapshot:Concepts.Hash.hash ->
+  root:Protocols.Handle.t ->
+  ?cancelled:(unit -> bool) ->
+  unit ->
+  Protocols.Context.t