journal for the websitejournal

1 files changed, 133 insertions, 0 deletions

diff --git a/test/unit/kernel/Journal.ml b/test/unit/kernel/Journal.ml
new file mode 100644
index 0000000..d0ab9f6
--- /dev/null
+++ b/test/unit/kernel/Journal.ml
@@ -0,0 +1,133 @@
+open Rnt
+open Alcotest
+module J = Protocols.Journal
+
+let ok = Helpers.condition_as_failure
+let thing () = Rnt.Kernel.Prototype.mixture []
+
+let journal () =
+  let handle = Rnt.Kernel.Journal.make ~bindings:["A", thing ()] () in
+  handle, ok (J.require handle)
+
+let bound directory name =
+  let listing = ok (Protocols.Handle.require Protocols.Directory.from directory) in
+  ok (Protocols.Directory.find listing name) |> Option.is_some
+
+let a_registry_update_is_a_commit () =
+  let handle, journal = journal () in
+  let registry = Protocols.Registry.from handle |> Option.get in
+  check bool "bound" true (ok (Protocols.Registry.update registry "B" None (Some (thing ()))));
+  let history = J.history journal in
+  check (list int) "numbered" [0; 1] (List.map (fun (c : J.commit) -> c.number) history);
+  check bool "the first snapshot keeps its past" false (bound (List.hd history).snapshot "B");
+  check bool "the head sees it" true (bound (J.head journal).snapshot "B")
+
+let a_commit_binds_together_or_not_at_all () =
+  let _, journal = journal () in
+  let changes stale =
+    J.
+      [ {name= "B"; expected= None; replacement= Some (thing ())};
+        { name= "C";
+          expected= (if stale then Some (thing ()) else None);
+          replacement= Some (thing ()) } ]
+  in
+  check bool "a stale expectation" true (ok (J.commit journal (changes true)) = None);
+  check int "nothing landed" 0 (J.head journal).number;
+  let commit = ok (J.commit journal (changes false)) |> Option.get in
+  check (list string) "both" ["B"; "C"] commit.changed;
+  check bool "B" true (bound commit.snapshot "B");
+  check bool "C" true (bound commit.snapshot "C")
+
+let a_guard_refuses_and_an_observer_hears () =
+  let _, journal = journal () in
+  let heard = ref [] in
+  J.observe journal "ear" (Some (fun c -> heard := c.number :: !heard));
+  J.guard journal "no-B"
+    (Some
+       (fun {proposed; _} ->
+         if List.mem "B" proposed.changed then
+           Error Concepts.Condition.(condition "no-B" "B stays unbound" empty)
+         else Ok () ) );
+  let change name = [J.{name; expected= None; replacement= Some (thing ())}] in
+  check bool "refused" true (Result.is_error (J.commit journal (change "B")));
+  check bool "allowed" true (Result.is_ok (J.commit journal (change "C")));
+  check (list int) "heard only what landed" [1] !heard
+
+let a_snapshot_hands_out_derived_relations_against_itself () =
+  let derived =
+    Rnt.Kernel.Prototype.mixture
+      [ Protocols.Derived.make
+          object
+            method within directory =
+              Ok
+                (Rnt.Kernel.Prototype.mixture
+                   [Rnt.Kernel.Prototype.Directory.of_properties ["seen", directory]] )
+          end ]
+  in
+  let snapshot = Rnt.Kernel.Journal.snapshot ["D", derived] in
+  let read = ok (Rnt.Kernel.Path.lookup snapshot Rnt.Kernel.Path.("D" @/ "seen" @/ this)) in
+  check bool "read against the snapshot" true (Protocols.Handle.equal read snapshot)
+
+let suites () =
+  [ ( "kernel/journal",
+      [ test_case "a registry update is a commit" `Quick a_registry_update_is_a_commit;
+        test_case "a commit binds together or not at all" `Quick
+          a_commit_binds_together_or_not_at_all;
+        test_case "a guard refuses and an observer hears" `Quick
+          a_guard_refuses_and_an_observer_hears;
+        test_case "a snapshot hands out derived relations against itself" `Quick
+          a_snapshot_hands_out_derived_relations_against_itself ] ) ]
+
+let schema = BatMap.String.singleton "N" {Protocols.Schematics.domain= "integer"; provenance= []}
+
+let row n =
+  {Concepts.Tuple.type_= "R"; attributes= BatMap.String.singleton "N" (Concepts.Value.Integer n)}
+
+let count relation =
+  let _, tuples = ok (Rnt.Kernel.View.read relation) in
+  List.length tuples
+
+let rebinding_lands_as_one_commit_or_one_name_at_a_time () =
+  let handle, journal = journal () in
+  let fixed n = Rnt.Kernel.View.fixed schema (List.init n row) in
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 1); "B", Some (fixed 2)]);
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 3)]);
+  check (list int) "two commits after the first" [0; 1; 2]
+    (List.map (fun (c : J.commit) -> c.number) (J.history journal));
+  let plain = Rnt.Kernel.Namespace.make () in
+  ok (Rnt.Kernel.Journal.rebind plain ["A", Some (fixed 1)]);
+  ok (Rnt.Kernel.Journal.rebind plain ["A", Some (fixed 4)]);
+  check int "a plain namespace too" 4
+    (count (ok (Rnt.Kernel.Path.lookup plain Rnt.Kernel.Path.("A" @/ this))))
+
+(* A computed relation counts the tuples of A in whatever it is read
+   against, so the first snapshot still sees one and the head three. *)
+let a_computed_relation_reads_as_of_its_snapshot () =
+  let ( let* ) = Result.bind in
+  let handle, journal = journal () in
+  let fixed n = Rnt.Kernel.View.fixed schema (List.init n row) in
+  let counting =
+    Rnt.Kernel.View.computed schema
+      ~current:(fun () -> Ok handle)
+      (fun directory ->
+        let* a = Rnt.Kernel.Path.lookup directory Rnt.Kernel.Path.("A" @/ this) in
+        Ok [row (count a)] )
+  in
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 1); "C", Some counting]);
+  ok (Rnt.Kernel.Journal.rebind handle ["A", Some (fixed 3)]);
+  let read snapshot =
+    let c = ok (Rnt.Kernel.Path.lookup snapshot Rnt.Kernel.Path.("C" @/ this)) in
+    let _, tuples = ok (Rnt.Kernel.View.read c) in
+    BatMap.String.find "N" (List.hd tuples).Concepts.Tuple.attributes
+  in
+  let history = J.history journal in
+  check Helpers.value "as it was" (Concepts.Value.Integer 1) (read (List.nth history 1).snapshot);
+  check Helpers.value "as it is" (Concepts.Value.Integer 3) (read (J.head journal).snapshot)
+
+let suites () =
+  suites ()
+  @ [ ( "kernel/view",
+        [ test_case "rebinding lands as one commit, or one name at a time" `Quick
+            rebinding_lands_as_one_commit_or_one_name_at_a_time;
+          test_case "a computed relation reads as of its snapshot" `Quick
+            a_computed_relation_reads_as_of_its_snapshot ] ) ]