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
|
let balance_parens str =
let rec go i open_parens close_parens =
if i >= String.length str
then open_parens, close_parens
else (
match str.[i] with
| '(' -> go (i + 1) (open_parens + 1) close_parens
| ')' when open_parens > 0 -> go (i + 1) (open_parens - 1) close_parens
| ')' -> go (i + 1) open_parens (close_parens + 1)
| _ -> go (i + 1) open_parens close_parens)
in
let open_parens, close_parens = go 0 0 0 in
String.make close_parens '(' ^ str ^ String.make open_parens ')'
let type_of_string str =
let str = balance_parens str in
let lexbuf = Lexing.from_string str in
try `typ (Type_parser.main Type_lexer.token lexbuf) with
| _ -> `parse_error
let naive_of_string str =
List.filter (fun s -> String.length s > 0) (String.split_on_char ' ' str)
let guess_type_search str =
String.length str >= 1
&& (str.[0] = '\'' || String.contains str '-' || String.contains str '(')
type t =
{ name : string list
; typ : [ `typ of Db.Typexpr.t | `no_typ | `parse_error ]
}
let of_string str =
let query_name, typ =
match String.index_opt str ':' with
| None -> if guess_type_search str then "", type_of_string str else str, `no_typ
| Some loc ->
let str_name = String.sub str 0 loc in
let str_typ = String.sub str (loc + 1) (String.length str - loc - 1) in
str_name, type_of_string str_typ
in
let name = naive_of_string query_name in
{ name; typ }
let to_string { name; typ } =
let words = String.concat " " name in
match typ with
| `typ typ -> words ^ " : " ^ Db.Typexpr.show typ
| `parse_error -> words ^ " : <parsing error>"
| `no_typ -> words
|
