1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
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 ] ) ]
|
