blob: 151f8fc02a6bd14b9ad25dc338fb7aff31f12056 (
plain) (
blame)
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
|
open Alcotest
module Concepts = Rnt.Concepts
module Protocols = Rnt.Protocols
module Ephemeral = Rnt.Kernel.EphemeralRelation
let member n =
{ Concepts.Tuple.type_= "example";
attributes= BatMap.String.singleton "value" (Concepts.Value.Integer n) }
let description =
BatMap.String.singleton "value"
{ Protocols.Schematics.domain= "integer";
provenance= [{Protocols.Schematics.source= ["example"]; attribute= "value"}] }
let temporary = Ephemeral.temporary description
let over ?inputs ?(value = temporary) members =
Ephemeral.instantiate ?inputs description value
~modes:(fun () -> Ok [Concepts.(Mode.mode [] (Cardinality.bounded (List.length members)))])
(fun () -> Ok (Rnt.Kernel.Generator.cursor_of (fun ~yield -> List.iter yield members; Ok ())))
let endless () =
Ephemeral.instantiate description temporary
~modes:(fun () -> Ok [Concepts.(Mode.mode [] Cardinality.Countable)])
(fun () ->
Ok
(Rnt.Kernel.Generator.cursor_of (fun ~yield ->
let rec from n = yield (member n); from (n + 1) in
from 0 ) ) )
let values tuples =
BatFingerTree.to_list tuples
|> List.filter_map (fun tuple ->
match BatMap.String.find_opt "value" tuple.Concepts.Tuple.attributes with
| Some (Concepts.Value.Integer n) -> Some n
| _ -> None )
|> List.sort compare
let enumerates_every_member () =
let enumerated =
begin
let open Rnt.Utilities.Result in
let* tuples =
Protocols.Enumerable.scan
(over [member 1; member 2; member 3])
(fun scan -> Protocols.Cursor.drain scan ())
in
Ok (values tuples)
end
|> Helpers.condition_as_failure
in
check (list int) "every member" [1; 2; 3] enumerated
let decides_membership () =
let holds, rejects =
begin
let open Rnt.Utilities.Result in
let* relation = Protocols.Relation.require (over [member 1; member 2; member 3]) in
let* holds = Protocols.Relation.contains relation (member 2) in
let* rejects = Protocols.Relation.contains relation (member 9) in
Ok (holds, rejects)
end
|> Helpers.condition_as_failure
in
check bool "a member is held" true holds;
check bool "a stranger is refused" false rejects
let refuses_to_scan_without_end () =
match Protocols.Relation.require (endless ()) with
| Error condition -> fail (Concepts.Condition.to_string_hum condition)
| Ok relation -> (
match Protocols.Relation.contains relation (member 9) with
| Error condition ->
check bool "it fails as undecidable instead of scanning" true
(BatString.starts_with (Concepts.Condition.to_string_hum condition)
"undecidable-membership" )
| Ok _ -> fail "an endless relation with no test decided membership" )
let describes_itself () =
let described =
begin
let open Rnt.Utilities.Result in
let* schematics = Protocols.Handle.require Protocols.Schematics.from (over []) in
Protocols.Schematics.describe schematics
end
|> Helpers.condition_as_failure
in
match described with
| Protocols.Schematics.Relation description ->
check (list string) "the attributes of the result" ["value"]
(BatMap.String.keys description |> BatList.of_enum);
check (list string) "and where each was drawn from" ["example\\value"]
( BatMap.String.values description
|> BatList.of_enum
|> List.concat_map (fun attribute ->
attribute.Protocols.Schematics.provenance
|> List.map (fun origin ->
String.concat "\\" origin.Protocols.Schematics.source
^ "\\"
^ origin.Protocols.Schematics.attribute ) ) )
| _ -> fail "an ephemeral relation describes itself as a relation"
let addressed_once_persisted () =
let persisted code =
{ Ephemeral.name= Some "example";
schematics= `Persisted (Concepts.Hash.hash_of_int 1);
pointer= Some {Ephemeral.evaluator= "fol"; code= Concepts.Hash.hash_of_int code} }
in
let address value =
Protocols.Addressable.from (over ~value []) |> Option.map Protocols.Addressable.address
in
check bool "a temporary relation has no address" true (Option.is_none (address temporary));
check bool "a persisted one has" true (Option.is_some (address (persisted 2)));
check bool "and its program is part of it" false
(Option.equal Concepts.Hash.hash_equals (address (persisted 2)) (address (persisted 3)))
let releasing_releases_its_inputs () =
let released = ref false in
let input =
object
inherit Rnt.Kernel.Lifecycle.null
inherit Rnt.Kernel.Identity.of_id
method! release = released := true
method to_string = "input"
method protocols : Protocols.Handle.protocol list = []
end
in
let relation = over ~inputs:[Protocols.Handle.make input] [] in
check bool "an input is held while the relation lives" false !released;
Protocols.Handle.release relation;
check bool "and released with it" true !released
let suites () =
[ ( "kernel/ephemeral-relation",
[ test_case "enumerates-every-member" `Quick enumerates_every_member;
test_case "decides-membership" `Quick decides_membership;
test_case "refuses-to-scan-without-end" `Quick refuses_to_scan_without_end;
test_case "describes-itself" `Quick describes_itself;
test_case "addressed-once-persisted" `Quick addressed_once_persisted;
test_case "releasing-releases-its-inputs" `Quick releasing_releases_its_inputs ] ) ]
|
