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
134
135
136
137
138
139
140
141
142
143
144
|
open Alcotest
module K = Rnt.Kernel
module P = Rnt.Protocols
module C = Rnt.Concepts
let ok = Helpers.condition_as_failure
let library = {K.Scope.multigroup= "library"; schema= "default"}
let master = K.Path.("system" @/ "branch" @/ "master" @/ this)
let under a b = K.Path.(of_list (to_list a @ to_list b))
let shelf = K.Scope.path library "shelf"
let s v = C.Value.String v
let title = BatMap.String.singleton "title" {P.Schematics.domain= "string"; provenance= []}
let books titles =
K.EphemeralRelation.literal title
(List.map
(fun t -> {C.Tuple.type_= "book"; attributes= BatMap.String.singleton "title" (s t)})
titles )
let titles relation = ok (Helpers.titles relation)
let read root path = titles (ok (K.Path.lookup root path))
(* shelf is a stored FOL program reading book where it is stored *)
let shelved =
K.Source.view ~language:"fol" ~heading:title
( Rnt.Evaluators.FOL.(encode (Base (K.Scope.path library "book")))
|> C.Blob.bytes_of_blob
|> Bytes.to_string )
let publish root changes = ok (K.Scope.publish root ~branch:"master" ~home:library changes)
let fresh books' =
let root = ok (Rnt.Scratch.root ()) in
publish root ["book", Some (books books'); "shelf", Some shelved];
root
let address handle = P.Addressable.address (Option.get (P.Addressable.from handle))
let reads_as_of_each_state () =
let root = fresh ["Codd"] in
publish root ["book", Some (books ["Codd"; "Date"])];
check (list Helpers.value) "the head's view reads the books as they are"
[s "Codd"; s "Date"]
(read root (under master shelf));
check (list Helpers.value) "the previous state's view reads them as they were"
[s "Codd"]
(read root (under master K.Path.("previous" @/ shelf)))
let a_batch_is_one_successor () =
let root = fresh ["Codd"] in
let head = ok (K.Path.lookup root master) in
publish root ["book", Some (books ["Date"]); "loan", Some (books ["Codd"])];
let next = ok (K.Path.lookup root master) in
let previous = ok (K.Path.lookup next K.Path.("previous" @/ this)) in
check bool "two changes, one state after the head" true
(C.Hash.hash_equals (address previous) (address head));
let changed =
ok
(K.Path.diff
(ok (K.Path.lookup head K.Path.("multigroup" @/ this)))
(ok (K.Path.lookup next K.Path.("multigroup" @/ this))) )
in
check
(list (list string))
"the diff names what changed and nothing else"
[ ["library"; "schema"; "default"; "relation"; "book"];
["library"; "schema"; "default"; "relation"; "loan"] ]
(List.map K.Path.to_list changed)
let unbinding_removes_a_relation () =
let root = fresh ["Codd"] in
publish root ["shelf", None];
check bool "shelf is gone" true (Result.is_error (K.Path.lookup root (under master shelf)));
check (list Helpers.value) "book stays"
[s "Codd"]
(read root (under master (K.Scope.path library "book")))
let a_scope_reads_names_from_its_home () =
let root = fresh ["Codd"] in
K.Scope.publish root ~branch:"master"
~home:{K.Scope.multigroup= "store"; schema= "default"}
["stock", Some (books ["Date"]); "archive:old", Some (books ["Codd"])]
|> ok;
let scope = ok (K.Scope.of_root root ~branch:"master" library) in
let directory = Option.get (P.Directory.from scope) in
let found name = ok (P.Directory.find directory name) |> Option.map titles in
check
(option (list Helpers.value))
"a bare name is the home schema's"
(Some [s "Codd"])
(found "book");
check
(option (list Helpers.value))
"schema:name stays in the home multigroup"
(Some [s "Codd"])
(found "default:book");
check
(option (list Helpers.value))
"multigroup:schema:name leaves it"
(Some [s "Date"])
(found "store:default:stock");
check (option (list Helpers.value)) "what is not there is not found" None (found "stock");
check
(option (list Helpers.value))
"four parts name an attribute, not a relation" None (found "library:default:book:title");
let catalog = ok (K.Scope.catalog (ok (K.Scope.require scope))) in
check (list string) "the catalog is every relation of the state"
["library:default:book"; "library:default:shelf"; "store:archive:old"; "store:default:stock"]
(List.sort compare catalog);
check (option string) "a qualified attribute names the relation's own" (Some "title")
(K.Scope.attribute library "book" "library:default:book:title");
check (option string) "but not another relation's" None
(K.Scope.attribute library "book" "shelf:title")
(* A toy language answers a stored relation with its own name, and a run
with the source it was given. *)
let a_stored_relation_is_viewed_and_a_program_run () =
let root = fresh ["Codd"] in
let answer text = Ok (books [text]) in
let toy =
K.Source.evaluator ~language:"toy"
~view:(fun ~within:_ ~name source -> answer (name ^ " of " ^ source))
(fun ~within:_ source -> answer source)
in
let _ = ok (K.Initialization.mount root "toys") in
ok (K.Source.register root ~scope:"toys" ~language:"toy" toy);
publish root ["named", Some (K.Source.view ~language:"toys:toy" ~heading:title "this")];
check (list Helpers.value) "read from the branch, the view is asked for it by name"
[s "named of this"]
(read root (under master (K.Scope.path library "named")));
check (list Helpers.value) "run, the program is just run"
[s "that"]
(titles (ok (K.Source.run root ~language:"toys:toy" ~within:root "that")));
check bool "an unqualified name is the system's" true
(Result.is_error (K.Source.run root ~language:"toy" ~within:root "that"))
let suites () =
[ ( "kernel/branch",
[ test_case "reads-as-of-each-state" `Quick reads_as_of_each_state;
test_case "a-batch-is-one-successor" `Quick a_batch_is_one_successor;
test_case "unbinding-removes-a-relation" `Quick unbinding_removes_a_relation;
test_case "a-scope-reads-names-from-its-home" `Quick a_scope_reads_names_from_its_home;
test_case "a-stored-relation-is-viewed-and-a-program-run" `Quick
a_stored_relation_is_viewed_and_a_program_run ] ) ]
|
