forked from
jonmsterling.com/ocaml-forester
ocaml
Restore definitions handler
Fix mistaken logic in Analysis.
test_definitions is now meaningful but may break when we edit
forester-notes.org.
authored by
Kento Okura
and committed by
Jon Sterling
4915b159
f143576f
+61
-58
+34
-41
lib/language_server/Analysis.ml
+34
-41
lib/language_server/Analysis.ml
···
20
20
| Subtree (addr, _) -> addr
21
21
| Verbatim _ | Math (_, _) | Ident _ | Hash_ident _ | Xml_ident _ | Let (_, _, _) | Open _ | Scope _ | Put (_, _) | Default (_, _) | Get _ | Fun (_, _) | Object _ | Patch _ | Call (_, _) | Def (_, _, _) | Decl_xmlns (_, _) | Alloc _ | Namespace (_, _) | _ -> None
22
22
23
-
(* TODO: Think about this some more. *)
24
-
let rec flatten (tree : Code.t) : Code.t =
25
-
tree
26
-
|> List.concat_map @@ fun (node : 'a Range.located) ->
27
-
match node.value with
28
-
| Code.Subtree (_, nodes)
29
-
| Code.Scope nodes ->
30
-
flatten nodes
31
-
| _ -> [node]
32
-
33
-
let contains = fun
34
-
~(position : Lsp.Types.Position.t)
35
-
(located : _ Range.located)
36
-
->
37
-
let L.Position.{line = cursor_line; character = cursor_character} = position in
38
-
match located.loc with
39
-
| Some loc ->
40
-
begin
41
-
match Range.view loc with
42
-
| `Range (start, end_) ->
43
-
let start_pos = Lsp_shims.Loc.lsp_pos_of_pos start in
44
-
let end_pos = Lsp_shims.Loc.lsp_pos_of_pos end_ in
45
-
let at_or_after_start =
46
-
cursor_line < end_pos.line
47
-
|| (cursor_line = start_pos.line && start_pos.character <= cursor_character)
48
-
in
49
-
let before_or_at_end =
50
-
end_pos.line > cursor_line
51
-
|| (cursor_line = end_pos.line && cursor_character <= end_pos.character)
52
-
in
53
-
at_or_after_start && before_or_at_end
54
-
| _ -> false
55
-
end
56
-
| None -> false
57
-
58
23
let nodes_within (node : Code.node Range.located) =
59
24
match node.value with
60
25
| Code.Math (_, t)
···
70
35
| Code.Dx_const_content t
71
36
| Code.Call (t, _)
72
37
| Code.Subtree (_, t) ->
73
-
Some t
38
+
t
74
39
| Code.Dx_prop (_, t)
75
40
| Code.Dx_query (_, _, t)
76
41
| Code.Dx_sequent (_, t) ->
77
-
Some (List.concat t)
42
+
(List.concat t)
78
43
| Code.Object {methods; _} ->
79
-
Some (methods |> List.map snd |> List.concat)
44
+
(methods |> List.map snd |> List.concat)
80
45
| Code.Patch {obj; methods; _} ->
81
46
let methods = (methods |> List.map snd |> List.concat) in
82
-
Some (List.append obj methods)
47
+
(List.append obj methods)
83
48
| Code.Text _
84
49
| Code.Verbatim _
85
50
| Code.Ident _
···
93
58
| Code.Dx_var _
94
59
| Code.Comment _
95
60
| Code.Error _ ->
96
-
None
61
+
[]
62
+
63
+
let flatten (tree : Code.t) : Code.t =
64
+
List.concat_map nodes_within tree
65
+
66
+
let contains = fun
67
+
~(position : Lsp.Types.Position.t)
68
+
(located : _ Range.located)
69
+
->
70
+
let L.Position.{line = cursor_line; character = cursor_character} = position in
71
+
match located.loc with
72
+
| Some loc ->
73
+
begin
74
+
match Range.view loc with
75
+
| `Range (start, end_) ->
76
+
let start_pos = Lsp_shims.Loc.lsp_pos_of_pos start in
77
+
let end_pos = Lsp_shims.Loc.lsp_pos_of_pos end_ in
78
+
let at_or_after_start =
79
+
cursor_line < end_pos.line
80
+
|| (cursor_line = start_pos.line && start_pos.character <= cursor_character)
81
+
in
82
+
let before_or_at_end =
83
+
end_pos.line > cursor_line
84
+
|| (cursor_line = end_pos.line && cursor_character <= end_pos.character)
85
+
in
86
+
at_or_after_start && before_or_at_end
87
+
| _ -> false
88
+
end
89
+
| None -> false
97
90
98
91
let rec node_at ~(position : Lsp.Types.Position.t) (code : _ list) : Code.node Range.located option =
99
92
let flattened = flatten code in
100
93
match List.find_opt (contains ~position) flattened with
101
94
| None -> None
102
95
| Some n ->
103
-
match Option.bind (nodes_within n) (node_at ~position) with
96
+
match (node_at ~position) (nodes_within n) with
104
97
| Some inner -> Some inner
105
98
| None -> Some n
106
99
+20
-13
lib/language_server/Definitions.ml
+20
-13
lib/language_server/Definitions.ml
···
5
5
*
6
6
*)
7
7
8
-
(* open Forester_core *)
9
-
(* open Forester_frontend *)
8
+
open Forester_core
9
+
open Forester_compiler
10
10
11
11
module L = Lsp.Types
12
+
open State.Syntax
12
13
13
14
let (let*) = Option.bind
14
15
···
18
19
=
19
20
match params with
20
21
| {textDocument;
22
+
position;
21
23
_;
22
24
} ->
23
-
(* let server = State.get () in *)
24
-
(* let host = server.config.host in *)
25
-
(* let codes = server.parsed in *)
26
-
(* let resolver = Compiler.make_resolver ~host: server.config.host codes in *)
27
-
(* let* { code; _ } = Compiler.resolve ~host textDocument.uri codes in *)
28
-
(* let* addr = Analysis.addr_at ~position code in *)
29
-
(* let uri = URI_scheme.user_uri ~host: server.config.host addr in *)
30
-
(* let* uri = Hashtbl.find_opt resolver uri in *)
31
-
let range = L.Range.create ~start: {character = 1; line = 0} ~end_: {character = 1; line = 0} in
32
-
Some
33
-
(`Location [L.Location.{uri = textDocument.uri; range}])
25
+
let Lsp_state.{forest; _} = Lsp_state.get () in
26
+
let host = forest.config.host in
27
+
let uri = URI_scheme.lsp_uri_to_uri ~host textDocument.uri in
28
+
match Option.bind forest.={uri} Tree.to_code with
29
+
| None -> None
30
+
| Some code ->
31
+
match Analysis.addr_at ~position code.nodes with
32
+
| None -> assert false
33
+
| Some addr ->
34
+
let uri = URI_scheme.user_uri ~host addr in
35
+
let path = URI.Tbl.find forest.resolver uri in
36
+
let uri = Lsp.Uri.of_path path in
37
+
Logs.debug (fun m -> m "Definitions: %s" path);
38
+
let range = L.Range.create ~start: {character = 1; line = 0} ~end_: {character = 1; line = 0} in
39
+
Some
40
+
(`Location [L.Location.{uri; range}])
+7
-4
lib/language_server/test/Test_lsp.ml
+7
-4
lib/language_server/test/Test_lsp.ml
···
97
97
let@ () = Reporter.easy_run in
98
98
let path = find_tree "tfmt-0005" in
99
99
let textDocument : L.TextDocumentIdentifier.t = {uri = Lsp.Uri.of_path path} in
100
-
let position = L.Position.create ~line: 17 ~character: 1 in
100
+
let position = L.Position.create ~line: 16 ~character: 13 in
101
101
let params = L.DefinitionParams.create ~position ~textDocument () in
102
102
let result =
103
103
Handlers.Definitions.compute params |> function
104
104
| Some (`Location locations) -> locations
105
-
| _ -> assert false
105
+
| Some (`LocationLink _location_links) ->
106
+
assert false
107
+
(* location_links *)
108
+
| None -> assert false
106
109
in
107
110
Alcotest.(check int) "" 1 (List.length result);
108
111
let start = L.Position.create ~character: 1 ~line: 0 in
109
112
let end_ = L.Position.create ~character: 1 ~line: 0 in
110
113
let range = L.Range.create ~start ~end_ in
111
-
let uri = Lsp.Uri.of_path path in
114
+
let uri = Lsp.Uri.of_path @@ find_tree "tfmt-0006" in
112
115
Alcotest.(check location)
113
116
""
114
117
(L.Location.create ~range ~uri)
···
269
272
let result = Handlers.Inlay_hint.compute params in
270
273
Alcotest.(check int)
271
274
""
272
-
11
275
+
25
273
276
(List.length @@ Option.get result)
274
277
275
278
let test_workspace_symbols () =