Multigroup objects

1 files changed, 33 insertions, 0 deletions

diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml
new file mode 100644
index 0000000..9c1dcd2
--- /dev/null
+++ b/lib/kernel/Prototype.ml
@@ -0,0 +1,33 @@
+let mixture ps = Protocols.Handle.make @@
+                   object
+                     inherit Lifecycle.null
+                     inherit Identity.of_id (* Should we allow the user to override this? *)
+
+                     method protocols = ps
+                   end
+
+module Directory = struct
+  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)
+      end
+
+  module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) (V : Merkle.VALUE) = struct
+    module Interface = Merkle.Interface (S) (K) (V)
+    module SI = Storage.Make (S)
+
+    let make ~storage ~constructor ~node =
+      Protocols.Directory.make @@
+        object
+          method list = SI.with_transaction storage (Fun.flip Interface.keys node)
+          method find k = SI.with_transaction storage (fun tx -> Interface.lookup tx k node)
+                          |> Utilities.Result.fmap (function
+                                 | None -> Ok None
+                                 | Some x -> constructor x |> Result.map (Option.some))
+        end
+  end
+end