Avoid implementing `Directory` inline?

3 files changed, 14 insertions, 20 deletions

diff --git a/lib/kernel/Branch.ml b/lib/kernel/Branch.ml
index 439339e..89a16ff 100644
--- a/lib/kernel/Branch.ml
+++ b/lib/kernel/Branch.ml
@@ -143,21 +143,10 @@ module Make (S : Abstract.Storage.STORAGE) = struct
                     update_only (fun node' ->
                         Handle.require Addressable.from node'
                         |> Result.map Addressable.address
-                        |>> (fun addr -> self#deriving {branch with multigroups= addr}) ) ) ] );
-            Directory.make
-              object
-                method list =
-                  Ok
-                    (BatFingerTree.of_list
-                       ( "multigroup"
-                       :: Option.fold ~none:[] ~some:(fun _ -> ["previous"]) branch.previous ) )
-
-                method find =
-                  function
-                  | "multigroup" -> Ok (Some multigroups)
-                  | "previous" -> self#previous
-                  | _ -> Ok None
-              end ]
+                        |>> fun addr -> self#deriving {branch with multigroups= addr} ) ) ] );
+            Prototype.Directory.of_properties'
+              [ ("multigroup", fun () -> Ok (Some multigroups));
+                ("previous", fun () -> self#previous) ] ]
 
       method hash = Representation.to_blob branch |> Concepts.Hash.hash_of_blob
       method address = self#hash
diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml
index 217b221..185f12c 100644
--- a/lib/kernel/Prototype.ml
+++ b/lib/kernel/Prototype.ml
@@ -87,14 +87,17 @@ module Associative = struct
 end
 
 module Directory = struct
-  let of_properties props =
+  let of_properties' props =
     Protocols.Directory.make
     @@ object
          val props = BatList.to_seq props |> BatMap.of_seq
          method list = Ok (BatMap.keys props |> BatFingerTree.of_enum)
-         method find k = Ok (BatMap.find_opt k props)
+         method find k = match BatMap.find_opt k props with None -> Ok None | Some f -> f ()
        end
 
+  let of_properties props =
+    List.map (fun (p, h) -> p, fun () -> Ok (Some h)) props |> of_properties'
+
   let children directory =
     let open Utilities.Result in
     let* listing = Protocols.Handle.require Protocols.Directory.from directory in
@@ -122,9 +125,7 @@ module Directory = struct
            method find k =
              let open Utilities.Result in
              SI.with_read storage (fun tx -> Tree.lookup tx k node)
-             |>> (function
-               | None -> Ok None
-               | Some x -> constructor x |> Result.map Option.some )
+             |>> function None -> Ok None | Some x -> constructor x |> Result.map Option.some
          end
   end
 end
diff --git a/lib/kernel/Prototype.mli b/lib/kernel/Prototype.mli
index 9c446fc..ec1f08e 100644
--- a/lib/kernel/Prototype.mli
+++ b/lib/kernel/Prototype.mli
@@ -6,6 +6,10 @@ val mixture : Protocols.Handle.protocol list -> Protocols.Handle.t
 module Directory : sig
   val of_properties : (string * Protocols.Handle.t) list -> Protocols.Handle.protocol
 
+  val of_properties' :
+    (string * (unit -> (Protocols.Handle.t option, Concepts.Condition.condition) result)) list ->
+    Protocols.Handle.protocol
+
   (** the names a directory lists, and what each reaches. *)
   val children :
     Protocols.Handle.t -> ((string * Protocols.Handle.t) list, Concepts.Condition.condition) result