|
|
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]
|
