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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
open Rnt
module Make (S : Abstract.Storage.STORAGE) (C : Helpers.Storage.CONFIGURATOR) = struct
open Alcotest
module H = Helpers.Storage.Make (S) (C)
let alaric =
{ Concepts.Tuple.type_= "employee";
attributes= BatMap.String.empty |> BatMap.String.add "name" (Concepts.Value.String "Alaric")
}
let not_a_directory () =
Concepts.Condition.condition "not-a-directory"
"A handle was expected to carry the directory protocol and did not" Concepts.Condition.empty
let missing name =
Concepts.Condition.condition "missing" "A name was expected in the directory and was absent"
Concepts.Condition.("name" |=| Concepts.Value.String name)
let employee name age =
{ Concepts.Tuple.type_= "employee";
attributes=
BatMap.String.of_list ["name", Concepts.Value.String name; "age", Concepts.Value.Integer age]
}
let drain result =
let open Utilities.Result in
let* enumerable = Protocols.Enumerable.require result in
let* cursor = Protocols.Enumerable.enumerate enumerable in
let* scan = Protocols.Cursor.require cursor in
let* tuples = Protocols.Cursor.drain scan () in
Protocols.Handle.release cursor;
Protocols.Handle.release result;
Ok (BatFingerTree.to_list tuples)
let scan_a_base_relation conn =
let scanned =
begin
let open Utilities.Result in
let* employee = H.relation conn ["name"] [alaric] in
let root =
Kernel.Prototype.mixture
[ Kernel.Prototype.Directory.of_properties
["employee", employee; "fol", Rnt.Evaluators.FOL.make ()] ]
in
let* directory =
Protocols.Directory.from root |> Option.to_result ~none:(not_a_directory ())
in
let* found = Protocols.Directory.find directory "fol" in
let* evaluator = Option.to_result ~none:(missing "fol") found in
let* evaluator = Protocols.Evaluator.require evaluator in
let* result =
Rnt.Evaluators.FOL.(program (Base employee)) |> Protocols.Evaluator.invoke evaluator
in
drain result
end
|> Helpers.condition_as_failure
in
check int "one tuple scanned" 1 (List.length scanned);
check bool "the tuple that was asserted" true
(List.for_all
(fun tuple ->
Concepts.Hash.hash_equals (Concepts.Tuple.hash tuple) (Concepts.Tuple.hash alaric) )
scanned )
let project_away_an_attribute conn =
let projected =
begin
let open Utilities.Result in
let* employees =
H.relation conn ["name"; "age"]
[employee "Alaric" 42; employee "Alaric" 30; employee "Brunhild" 42]
in
let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
let* result =
Rnt.Evaluators.FOL.(program (Project (Base employees, BatFingerTree.singleton "name")))
|> Protocols.Evaluator.invoke evaluator
in
drain result
end
|> Helpers.condition_as_failure
in
check
(list (list (pair string Helpers.value)))
"each name once, and nothing else"
[["name", Concepts.Value.String "Alaric"]; ["name", Concepts.Value.String "Brunhild"]]
( projected
|> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes)
|> List.sort compare )
let instantiate_a_program conn =
let projected =
begin
let open Utilities.Result in
let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
let root = Kernel.Prototype.(mixture [Directory.of_properties ["employee", employees]]) in
let* plan =
Rnt.Evaluators.FOL.(
instantiate (Kernel.Path.lookup root)
(Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name")) )
in
let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
let* result = Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator in
drain result
end
|> Helpers.condition_as_failure
in
check
(list (list (pair string Helpers.value)))
"the program ran over the relation its path resolved to"
[["name", Concepts.Value.String "Alaric"]]
(projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
module E = Kernel.EphemeralRelation.Make (S)
let store conn term =
E.persist conn ~name:"view" ~evaluator:Rnt.Evaluators.FOL.name
~code:(Rnt.Evaluators.FOL.encode term)
(BatMap.String.singleton "name" {Protocols.Schematics.domain= "string"; provenance= []})
let namespace entries =
let open Utilities.Result in
let root = Kernel.Namespace.make () in
let* registry = Protocols.Handle.require Protocols.Registry.from root in
let* _ =
List.fold_left
(fun registered (name, handle) ->
let* _ = registered in
Protocols.Registry.update registry name None (Some handle) )
(Ok true) entries
in
Ok root
let expand_a_stored_program conn =
let projected =
begin
let open Utilities.Result in
let* employees = H.relation conn ["name"; "age"] [employee "Alaric" 42] in
let* view =
store conn
Rnt.Evaluators.FOL.(
Project (Base Kernel.Path.("employee" @/ this), BatFingerTree.singleton "name") )
in
let* root = namespace ["employee", employees; "view", view] in
let* plan =
Rnt.Evaluators.FOL.(
instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
in
let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
let* result = Rnt.Evaluators.FOL.program plan |> Protocols.Evaluator.invoke evaluator in
drain result
end
|> Helpers.condition_as_failure
in
check
(list (list (pair string Helpers.value)))
"the stored program ran in place of its name"
[["name", Concepts.Value.String "Alaric"]]
(projected |> List.map (fun tuple -> BatMap.String.bindings tuple.Concepts.Tuple.attributes))
let refuse_a_program_that_reads_itself conn =
let expanded =
begin
let open Utilities.Result in
let* view = store conn Rnt.Evaluators.FOL.(Base Kernel.Path.("view" @/ this)) in
let* root = namespace ["view", view] in
Rnt.Evaluators.FOL.(
instantiate (Kernel.Path.lookup root) (Base Kernel.Path.("view" @/ this)) )
end
in
check bool "the expansion stopped at the cycle" true
( match expanded with
| Error condition ->
BatString.starts_with (Concepts.Condition.to_string_hum condition) "cyclic-program"
| Ok _ -> false )
let pull_one_tuple_at_a_time () =
let produced = ref 0 and closed = ref false in
let description =
BatMap.String.singleton "value" {Protocols.Schematics.domain= "integer"; provenance= []}
in
let rec count ~yield n =
incr produced;
yield
{ Concepts.Tuple.type_= "counter";
attributes= BatMap.String.singleton "value" (Concepts.Value.Integer n) };
count ~yield (n + 1)
in
let source =
Kernel.EphemeralRelation.instantiate description
{Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None}
(fun () -> Ok (Kernel.Generator.cursor_of ~finally:(fun () -> closed := true) (count 0)))
in
let first =
begin
let open Utilities.Result in
let* evaluator = Protocols.Evaluator.require (Rnt.Evaluators.FOL.make ()) in
let* result =
Rnt.Evaluators.FOL.(program (Project (Base source, BatFingerTree.singleton "value")))
|> Protocols.Evaluator.invoke evaluator
in
let* enumerable = Protocols.Enumerable.require result in
let* cursor = Protocols.Enumerable.enumerate enumerable in
let* scan = Protocols.Cursor.require cursor in
let* first = Protocols.Cursor.next scan in
Protocols.Handle.release cursor; Protocols.Handle.release result; Ok first
end
|> Helpers.condition_as_failure
in
check bool "a tuple came through" true (Option.is_some first);
check int "the source produced only that tuple" 1 !produced;
check bool "and was closed with its consumer" true !closed
let suite =
( "evaluators/fol",
[ test_case "scan-a-base-relation" `Quick (H.with_connection scan_a_base_relation "fol-test");
test_case "project-away-an-attribute" `Quick
(H.with_connection project_away_an_attribute "fol-test");
test_case "instantiate-a-program" `Quick
(H.with_connection instantiate_a_program "fol-test");
test_case "expand-a-stored-program" `Quick
(H.with_connection expand_a_stored_program "fol-test");
test_case "refuse-a-program-that-reads-itself" `Quick
(H.with_connection refuse_a_program_that_reads_itself "fol-test");
test_case "pull-one-tuple-at-a-time" `Quick pull_one_tuple_at_a_time ] )
end
module LMDB = Make (Rnt.Backend.Storage.LMDB) (Helpers.Storage.LMDB_Configurator)
let suites () = [LMDB.suite]
|
