aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel/Prototype.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/kernel/Prototype.ml')
-rw-r--r--lib/kernel/Prototype.ml27
1 files changed, 26 insertions, 1 deletions
diff --git a/lib/kernel/Prototype.ml b/lib/kernel/Prototype.ml
index 8c12b40..65de68f 100644
--- a/lib/kernel/Prototype.ml
+++ b/lib/kernel/Prototype.ml
@@ -9,7 +9,32 @@ let mixture ps = Protocols.Handle.make @@
let rec mixture_of value f =
mixture (f (fun value' -> mixture_of value' f) value)
+module Error = struct
+ open Concepts.Condition
+
+ let invalid_property key = condition "invalid-property" "The specified key does not correspond to any property of the object"
+ ("key" |=| Concepts.Value.String key)
+
+ let deletion_not_supported () = condition "deletion-not-supported" "Attempting to delete an object property"
+ empty
+end
+
module Associative = struct
+ let of_properties props =
+ Protocols.Associative.make @@
+ object
+ val props = BatList.to_seq props |> BatMap.of_seq
+
+ method update key value =
+ match BatMap.find_opt key props with
+ | None -> Error (Error.invalid_property key)
+ | Some f -> f value
+ end
+
+ let update_only f = function
+ | None -> Error (Error.deletion_not_supported ())
+ | Some x -> f x
+
module OfTree (S : Abstract.Storage.STORAGE) (K : Merkle.KEY with type t = string) = struct
module Tree = Merkle.Make (S) (K)
module SI = Storage.Make (S)
@@ -35,7 +60,7 @@ 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