aboutsummaryrefslogtreecommitdiffstats
path: root/test/unit/evaluators/FOL.ml
blob: 046fa3f95d3fe8641070e06b26a3688f6c9f5ace (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
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 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.schematics= `Temporary description}
        (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 "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]