forked from
jonmsterling.com/ocaml-forester
ocaml
refactor lsp analysis
authored by
Kento Okura
and committed by
Jon Sterling
8afcaae7
d60f5567
+97
-19
+87
-11
lib/language_server/Analysis.ml
+87
-11
lib/language_server/Analysis.ml
···
5
5
*
6
6
*)
7
7
8
+
open Forester_prelude
8
9
open Forester_core
9
10
10
11
module L = Lsp.Types
11
12
12
-
let extract_addr (node : Code.node Range.located) : string option =
13
-
match node.value with
14
-
| Group (Braces, [{value = Text addr; _}])
15
-
| Group (Parens, [{value = Text addr; _}])
16
-
| Group (Squares, [{value = Group (Squares, [{value = Text addr; _}]); _}])
17
-
| Text addr
18
-
| Import (_, addr) ->
19
-
Some addr
20
-
| Subtree (addr, _) -> addr
21
-
| Verbatim _ | Math (_, _) | Ident _ | Hash_ident _ | Xml_ident _ | Let (_, _, _) | Open _ | Scope _ | Put (_, _) | Default (_, _) | Get _ | Fun (_, _) | Object _ | Patch _ | Call (_, _) | Def (_, _, _) | Decl_xmlns (_, _) | Alloc _ | Namespace (_, _) | _ -> None
13
+
module Item = struct
14
+
type t = [
15
+
| `Path of Trie.path
16
+
| `Addr of string
17
+
]
18
+
let addr str = `Addr str
19
+
let path p = `Path p
20
+
end
21
+
22
+
module S = Algaeff.Sequencer.Make(struct
23
+
type t = Item.t Range.located
24
+
end)
22
25
23
26
let nodes_within (node : Code.node Range.located) =
24
27
match node.value with
···
63
66
let flatten (tree : Code.t) : Code.t =
64
67
List.concat_map nodes_within tree
65
68
69
+
let paths_in_bindings =
70
+
List.map snd
71
+
72
+
(* This function should not descend into the nodes!*)
73
+
let paths : Code.node Range.located -> _ = function
74
+
| {value; loc;} ->
75
+
match value with
76
+
| Ident path
77
+
| Open (path)
78
+
| Put (path, _)
79
+
| Default (path, _)
80
+
| Get path
81
+
| Alloc path
82
+
| Namespace (path, _) ->
83
+
Some ([path], loc)
84
+
| Def (path, bindings, _)
85
+
| Let (path, bindings, _) ->
86
+
Some (path :: paths_in_bindings bindings, loc)
87
+
| Patch {self; _}
88
+
| Object {self; _;} ->
89
+
(* Option.to_list self; *)
90
+
Option.map (fun path -> [path], loc) self
91
+
| Fun (bindings, _) -> Some (paths_in_bindings bindings, loc)
92
+
| Subtree _
93
+
| Group _
94
+
| Scope _
95
+
| Math _
96
+
| Dx_sequent _
97
+
| Dx_const_uri _
98
+
| Dx_const_content _
99
+
| Dx_query _
100
+
| Dx_prop _
101
+
| Text _
102
+
| Verbatim _
103
+
| Hash_ident _
104
+
| Xml_ident _
105
+
| Call _
106
+
| Import _
107
+
| Decl_xmlns _
108
+
| Dx_var _
109
+
| Comment _
110
+
| Error _ ->
111
+
None
112
+
113
+
let extract_addr (node : Code.node Range.located) =
114
+
match node.value with
115
+
| Group (Braces, [{value = Text addr; _}])
116
+
| Group (Parens, [{value = Text addr; _}])
117
+
| Group (Squares, [{value = Group (Squares, [{value = Text addr; _}]); _}])
118
+
| Text addr
119
+
| Import (_, addr) ->
120
+
Some (Range.{value = addr; loc = node.loc})
121
+
| Subtree (addr, _) ->
122
+
Option.map (fun s -> Range.{value = s; loc = node.loc}) addr
123
+
| _ -> None
124
+
125
+
let rec analyse (node : Code.node Range.located) =
126
+
begin
127
+
let@ {value; loc} = Option.iter @~ extract_addr node in
128
+
S.yield ({value = Item.addr value; loc});
129
+
end;
130
+
begin
131
+
let@ paths, loc = Option.iter @~ paths node in
132
+
let@ path = List.iter @~ paths in
133
+
S.yield ({value = Item.path path; loc});
134
+
end;
135
+
let children = nodes_within node in
136
+
List.iter analyse children
137
+
66
138
let contains = fun
67
139
~(position : Lsp.Types.Position.t)
68
140
(located : _ Range.located)
···
97
169
| Some inner -> Some inner
98
170
| None -> Some n
99
171
100
-
let addr_at ~(position : Lsp.Types.Position.t) (code : _ list) : string option =
172
+
let addr_at ~(position : Lsp.Types.Position.t) (code : _ list) : _ Range.located option =
101
173
Option.bind (node_at ~position code) extract_addr
174
+
175
+
let analyse_syntax nodes =
176
+
let@ () = S.run in
177
+
List.iter analyse nodes
+4
-2
lib/language_server/Analysis.mli
+4
-2
lib/language_server/Analysis.mli
···
19
19
*)
20
20
val extract_addr :
21
21
Code.node Range.located ->
22
-
string option
22
+
string Range.located option
23
23
24
24
(** Attempts to find the smallest located {{!type:Forester_compiler.Code.node}node} which contains [position]*)
25
25
val node_at :
···
32
32
val addr_at :
33
33
position: Lsp.Types.Position.t ->
34
34
Code.t ->
35
-
string option
35
+
string Asai.Range.located option
36
36
37
37
(** [flatten code] is a "flat" list of nodes. This function is underspecified and needs to be thought about more.*)
38
38
val flatten : Code.t -> Code.t
39
+
40
+
val analyse_syntax : Code.t -> [ `Addr of string | `Path of Trie.path ] Asai.Range.located Seq.t
+4
-4
lib/language_server/Definitions.ml
+4
-4
lib/language_server/Definitions.ml
···
21
21
let uri = URI_scheme.lsp_uri_to_uri ~host textDocument.uri in
22
22
match Option.bind forest.={uri} Tree.to_code with
23
23
| None -> None
24
-
| Some code ->
25
-
match Analysis.addr_at ~position code.nodes with
24
+
| Some {nodes; _} ->
25
+
match Analysis.addr_at ~position nodes with
26
26
| None -> None
27
-
| Some addr ->
28
-
let uri = URI_scheme.user_uri ~host addr in
27
+
| Some {value = str; _} ->
28
+
let uri = URI_scheme.user_uri ~host str in
29
29
let path = URI.Tbl.find forest.resolver uri in
30
30
let uri = Lsp.Uri.of_path path in
31
31
Logs.debug (fun m -> m "Definitions: %s" path);
+1
-1
lib/language_server/Hover.ml
+1
-1
lib/language_server/Hover.ml
···
40
40
(* TODO: use node_at and provide hover for things other than links.*)
41
41
match Analysis.addr_at ~position tree.nodes with
42
42
| None -> Format.asprintf "character: %i, line: %i." position.character position.line;
43
-
| Some addr_at_cursor ->
43
+
| Some Range.{value = addr_at_cursor; _} ->
44
44
let uri_under_cursor = URI_scheme.user_uri ~host addr_at_cursor in
45
45
match State.get_article uri_under_cursor forest with
46
46
| None ->
+1
-1
lib/language_server/Inlay_hint.ml
+1
-1
lib/language_server/Inlay_hint.ml