Normalize keyed batches with atomic validation

src/change.ml

@@ -39,6 +39,57 @@ let string_of_value span value =
   | Value.VString text -> text
   | other -> Diagnostic.error span "runtime error: expected a string but got %s" (Value.to_string other)
 
+type input_op =
+  | OpInsert of int * Value.t
+  | OpRemove of int
+  | OpReplace of int * Value.t
+
+type 'a outcome = 'a Delta_runtime.outcome = Success of 'a | Failure of string
+
+let validate_batch ~existing ops =
+  let rec step temp touched = function
+    | [] -> Success (temp, touched)
+    | op :: rest -> (
+        match op with
+        | OpInsert (key, value) ->
+            if Delta_runtime.Pure_map.mem key temp then
+              Failure (Printf.sprintf "cannot insert key %d: it is already present" key)
+            else step (Delta_runtime.Pure_map.add key value temp) (key :: touched) rest
+        | OpRemove key ->
+            if Delta_runtime.Pure_map.mem key temp then
+              step (Delta_runtime.Pure_map.remove key temp) (key :: touched) rest
+            else Failure (Printf.sprintf "cannot remove key %d: it is not present" key)
+        | OpReplace (key, value) ->
+            if Delta_runtime.Pure_map.mem key temp then
+              step (Delta_runtime.Pure_map.add key value temp) (key :: touched) rest
+            else Failure (Printf.sprintf "cannot replace key %d: it is not present" key))
+  in
+  match step existing [] ops with
+  | Failure message -> Failure message
+  | Success (temp, touched) ->
+      let keys = List.sort_uniq compare touched in
+      let changes =
+        Util.filter_map
+          (fun key ->
+            match
+              ( Delta_runtime.Pure_map.find_opt key existing,
+                Delta_runtime.Pure_map.find_opt key temp )
+            with
+            | None, None -> None
+            | None, Some value -> Some (CInsert (key, value))
+            | Some value, None -> Some (CRemove (key, value))
+            | Some old_value, Some new_value ->
+                if Value.equal old_value new_value then None
+                else Some (CReplace (key, old_value, new_value)))
+          keys
+      in
+      Success (temp, changes)
+
+let apply_batch ~existing ops =
+  match validate_batch ~existing ops with
+  | Failure message -> Failure message
+  | Success (temp, changes) -> Success (temp, CCollection changes, changes)
+
 let scalar_mismatch span expected value =
   Diagnostic.error span "this change replaces a %s value but is applied to %s" expected
     (Value.to_string value)

src/change.mli

@@ -13,6 +13,23 @@ type change =
   | CRecord of string * (string * change) list
   | CCollection of keyed list
 
+type input_op =
+  | OpInsert of int * Value.t
+  | OpRemove of int
+  | OpReplace of int * Value.t
+
+type 'a outcome = 'a Delta_runtime.outcome = Success of 'a | Failure of string
+
+val validate_batch :
+  existing:Value.t Delta_runtime.Pure_map.t ->
+  input_op list ->
+  (Value.t Delta_runtime.Pure_map.t * keyed list) outcome
+
+val apply_batch :
+  existing:Value.t Delta_runtime.Pure_map.t ->
+  input_op list ->
+  (Value.t Delta_runtime.Pure_map.t * change * keyed list) outcome
+
 val empty : Types.t -> change
 val is_empty : change -> bool
 val apply : Value.t -> change -> Value.t