blob: dcfe716d7f762b65d8f9d8aa191fabf6f9e2f887 (
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
|
open Utilities.Result
module Error = struct
open Condition
let unqualified_name name =
condition "unqualified-name" "A relation must be named as multigroup:relation"
("name" |=| Value.String name)
end
let page_limit = 16
let relation_path branch name =
match String.index_opt name ':' with
| Some i when i > 0 && i < String.length name - 1 ->
Ok
(String.concat "\\"
[ branch;
"multigroup";
String.sub name 0 i;
"relation";
String.sub name (i + 1) (String.length name - i - 1) ] )
| _ -> Error (Error.unqualified_name name)
let rec compile branch = function
| Ast.Base name -> relation_path branch name |> Result.map (fun path -> RNT.Base path)
| Ast.Project (attributes, query) ->
compile branch query |> Result.map (fun plan -> RNT.Project (plan, attributes))
let execute (ctx : Sublanguage_context.t) query =
let* plan = compile (ctx.session#path ^ "\\branch") query in
let* relation = RNT.execute ctx.kernel plan in
Fun.protect
~finally:(fun () -> RNT.release relation)
(fun () ->
let* cursor = RNT.enumerate relation in
Fun.protect
~finally:(fun () -> RNT.release cursor)
(fun () ->
let* {RNT.tuples; exhausted} = RNT.fetch cursor page_limit in
Ok (Sublanguage_types.Cursor {rows= tuples; has_more= not exhausted}) ) )
|
