forked from
jonmsterling.com/ocaml-forester
ocaml
Factor out Actions module
- track history in compiler state
- fix issue in `Did_change` and `Did_open` handler that resulted in
unparsed trees. This fixes the definitions handler.
- Add some tests
authored by
Kento Okura
and committed by
Jon Sterling
b04bab4c
8afcaae7
+134
-91
+36
lib/compiler/Action.ml
+36
lib/compiler/Action.ml
···
1
+
(*
2
+
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
+
*
4
+
* SPDX-License-Identifier: GPL-3.0-or-later
5
+
*)
6
+
7
+
open Forester_core
8
+
9
+
type exit =
10
+
Fail | Finished
11
+
[@@deriving show]
12
+
13
+
type t =
14
+
| Quit of exit
15
+
| Build_import_graph
16
+
| Plant_assets
17
+
| Plant_foreign
18
+
| Done
19
+
| Load_all_configured_dirs
20
+
| Parse_all
21
+
| Expand_all
22
+
| Eval_all
23
+
| Load_tree of (Eio.Fs.dir_ty Eio.Path.t [@printer Eio.Path.pp])
24
+
| Parse of (Lsp.Uri.t [@printer fun fmt uri -> fprintf fmt "%s" (Lsp.Uri.to_string uri)])
25
+
| Expand of URI.t
26
+
| Eval of URI.t
27
+
| Query of (string, Vertex.t) Datalog_expr.query
28
+
| Query_results of (Vertex_set.t [@opaque])
29
+
| Report_errors of ((Reporter.Message.t Asai.Diagnostic.t [@opaque]) list * t)
30
+
| Run_jobs of Job.job Range.located list
31
+
[@@deriving show]
32
+
33
+
let report ~next_action ~errors =
34
+
if List.length errors > 0 then
35
+
Report_errors (errors, next_action)
36
+
else next_action
+4
-41
lib/compiler/Driver.ml
+4
-41
lib/compiler/Driver.ml
···
10
10
11
11
module T = Types
12
12
13
-
module Action = struct
14
-
type exit =
15
-
Fail | Finished
16
-
[@@deriving show]
17
-
18
-
type t =
19
-
| Quit of exit
20
-
| Build_import_graph
21
-
| Plant_assets
22
-
| Plant_foreign
23
-
| Done
24
-
| Load_all_configured_dirs
25
-
| Parse_all
26
-
| Expand_all
27
-
| Eval_all
28
-
| Load_tree of (Eio.Fs.dir_ty Eio.Path.t [@printer Eio.Path.pp])
29
-
| Parse of (Lsp.Uri.t [@printer fun fmt uri -> fprintf fmt "%s" (Lsp.Uri.to_string uri)])
30
-
| Expand of URI.t
31
-
| Eval of URI.t
32
-
| Query of (string, Vertex.t) Datalog_expr.query
33
-
| Query_results of (Vertex_set.t [@opaque])
34
-
| Report_errors of ((Reporter.Message.t Asai.Diagnostic.t [@opaque]) list * t)
35
-
| Run_jobs of Job.job Range.located list
36
-
[@@deriving show]
37
-
38
-
let report ~next_action ~errors =
39
-
if List.length errors > 0 then
40
-
Report_errors (errors, next_action)
41
-
else next_action
42
-
end
43
-
44
-
let update
45
-
: Action.t -> State.t -> Action.t * State.t
46
-
= fun action forest ->
13
+
let update (action : Action.t) (forest : State.t) =
47
14
let open Action in
48
15
let host = forest.config.host in
16
+
let forest = State.update_history forest action in
49
17
match action with
50
18
| Quit e ->
51
19
begin
···
224
192
let implant_foreign = run_until_done Plant_foreign
225
193
let plant_assets = run_until_done Plant_assets
226
194
227
-
let batch_run_with_history ~env ~(config : Config.t) ~dev =
228
-
let history = ref [] in
195
+
let batch_run ~env ~(config : Config.t) ~dev =
229
196
let init =
230
197
State.make ~env ~config ~dev ()
231
198
|> plant_assets
232
199
|> implant_foreign
233
200
in
234
201
let rec go action state =
235
-
history := action :: !history;
236
202
let new_action, new_state = update action state in
237
203
match action with
238
204
| Quit Fail -> exit 1
···
246
212
| _ ->
247
213
go new_action new_state
248
214
in
249
-
let history = !history in
250
-
go Load_all_configured_dirs init, history
251
-
252
-
let batch_run ~env ~config ~dev = fst @@ batch_run_with_history ~env ~config ~dev
215
+
go Load_all_configured_dirs init
253
216
254
217
let language_server ~env ~config =
255
218
let init = State.make ~env ~config ~dev: true () in
+1
lib/compiler/Forester_compiler.ml
+1
lib/compiler/Forester_compiler.ml
+13
-18
lib/compiler/Phases.ml
+13
-18
lib/compiler/Phases.ml
···
17
17
Dir_scanner.scan_directories tree_dirs
18
18
|> Seq.map Imports.load_tree
19
19
20
-
let parse
21
-
(forest : State.t)
22
-
: Reporter.Message.t Asai.Diagnostic.t list * Tree.code list
23
-
=
20
+
let parse (forest : State.t) =
24
21
let host = forest.config.host in
25
22
let trees = forest.index |> URI.Tbl.to_seq_values |> List.of_seq in
26
-
let f tree =
27
-
if Tree.is_unparsed tree then
28
-
tree
29
-
|> Tree.to_doc
30
-
|> Option.map (Parse.parse_document ~host)
31
-
else None
23
+
let results =
24
+
let@ tree = List.filter_map @~ trees in
25
+
match tree with
26
+
| Document doc -> Some (Parse.parse_document ~host doc)
27
+
| Parsed _
28
+
| Expanded _
29
+
| Resource _ ->
30
+
None
32
31
in
33
-
let results = List.filter_map f trees in
34
-
results
35
-
|> List.partition_map
36
-
(function
37
-
| Ok t -> Right t
38
-
| Error d ->
39
-
Left d
40
-
)
32
+
let@ result = List.partition_map @~ results in
33
+
match result with
34
+
| Ok t -> Right t
35
+
| Error d -> Left d
41
36
42
37
let reparse (doc : Lsp.Text_document.t) (forest : State.t) =
43
38
Logs.debug (fun m -> m "reparsing");
+5
-2
lib/compiler/State.ml
+5
-2
lib/compiler/State.ml
···
23
23
dependency_cache: Cache.t;
24
24
resolver: string URI.Tbl.t;
25
25
search_index: Forester_search.Index.t;
26
-
usages: (Tree.exports, URI.t Asai.Range.located) Hashtbl.t
26
+
usages: (Tree.exports, URI.t Asai.Range.located) Hashtbl.t;
27
+
history: Action.t list;
27
28
}
28
29
29
30
let make
···
39
40
?(search_index = Forester_search.Index.create [])
40
41
?(dependency_cache = Cache.empty)
41
42
()
42
-
= {env; dev; config; index; diagnostics; resolver; import_graph; graphs; search_index; dependency_cache; usages;}
43
+
= {env; dev; config; index; diagnostics; resolver; import_graph; graphs; search_index; dependency_cache; usages; history = []}
43
44
44
45
module Syntax = struct
45
46
let (.={}) state uri =
···
87
88
end
88
89
89
90
open Syntax
91
+
92
+
let update_history forest action = {forest with history = action :: forest.history}
90
93
91
94
let find_opt state uri = URI.Tbl.find_opt state.index uri
92
95
let to_seq state = URI.Tbl.to_seq state.index
+2
-5
lib/compiler/test/Test_errors.ml
+2
-5
lib/compiler/test/Test_errors.ml
···
54
54
Sys.chdir (Eio.Path.native_exn tmp_dir);
55
55
let@ () = check_diagnostic (Resource_not_found (URI.of_string_exn "asdf")) in
56
56
let@ () = Reporter.easy_run in
57
-
let forest, history =
58
-
(* State.make ~env ~config ~dev: false () |> *)
59
-
Driver.batch_run_with_history ~env ~config ~dev: false
60
-
in
57
+
let forest = Driver.batch_run ~env ~config ~dev: false in
61
58
Alcotest.(check @@ list action)
62
59
""
63
60
[
···
69
66
(Run_jobs []);
70
67
Done
71
68
]
72
-
history;
69
+
(List.rev forest.history);
73
70
Alcotest.(check int) "" 1 (URI.Tbl.length forest.diagnostics);
74
71
in
75
72
let open Alcotest in
+1
lib/core/Code.mli
+1
lib/core/Code.mli
+1
-1
lib/core/Tree.ml
+1
-1
lib/core/Tree.ml
+1
-2
lib/language_server/Analysis.ml
+1
-2
lib/language_server/Analysis.ml
···
161
161
| None -> false
162
162
163
163
let rec node_at ~(position : Lsp.Types.Position.t) (code : _ list) : Code.node Range.located option =
164
-
let flattened = flatten code in
165
-
match List.find_opt (contains ~position) flattened with
164
+
match List.find_opt (contains ~position) code with
166
165
| None -> None
167
166
| Some n ->
168
167
match (node_at ~position) (nodes_within n) with
+14
-12
lib/language_server/Definitions.ml
+14
-12
lib/language_server/Definitions.ml
···
19
19
let Lsp_state.{forest; _} = Lsp_state.get () in
20
20
let host = forest.config.host in
21
21
let uri = URI_scheme.lsp_uri_to_uri ~host textDocument.uri in
22
-
match Option.bind forest.={uri} Tree.to_code with
23
-
| None -> None
24
-
| Some {nodes; _} ->
25
-
match Analysis.addr_at ~position nodes with
22
+
match forest.={uri} with
23
+
| None -> assert false
24
+
| Some tree ->
25
+
match Tree.to_code tree with
26
26
| None -> None
27
-
| Some {value = str; _} ->
28
-
let uri = URI_scheme.user_uri ~host str in
29
-
let path = URI.Tbl.find forest.resolver uri in
30
-
let uri = Lsp.Uri.of_path path in
31
-
Logs.debug (fun m -> m "Definitions: %s" path);
32
-
let range = L.Range.create ~start: {character = 1; line = 0} ~end_: {character = 1; line = 0} in
33
-
Some
34
-
(`Location [L.Location.{uri; range}])
27
+
| Some {nodes; _} ->
28
+
match Analysis.addr_at ~position nodes with
29
+
| None -> assert false
30
+
| Some {value = str; _} ->
31
+
let uri = URI_scheme.user_uri ~host str in
32
+
let path = URI.Tbl.find forest.resolver uri in
33
+
let uri = Lsp.Uri.of_path path in
34
+
let range = L.Range.create ~start: {character = 1; line = 0} ~end_: {character = 1; line = 0} in
35
+
Some
36
+
(`Location [L.Location.{uri; range}])
+6
-2
lib/language_server/Did_change.ml
+6
-2
lib/language_server/Did_change.ml
···
14
14
let compute (params : L.DidChangeTextDocumentParams.t) =
15
15
let Lsp_state.{forest; _} = Lsp_state.get () in
16
16
match params with
17
-
| {textDocument = {uri; _}; contentChanges} ->
18
-
let uri = URI_scheme.lsp_uri_to_uri ~host: forest.config.host uri in
17
+
| {textDocument = {uri = lsp_uri; _}; contentChanges} ->
18
+
let uri = URI_scheme.lsp_uri_to_uri ~host: forest.config.host lsp_uri in
19
19
match forest.={uri} with
20
20
| None -> ()
21
21
| Some tree ->
···
25
25
let new_doc = Lsp.Text_document.apply_content_changes doc contentChanges in
26
26
Eio.traceln "After change, doc has content %s" (Lsp.Text_document.text new_doc);
27
27
forest.={uri} <- Document new_doc;
28
+
Lsp_state.modify (fun ({forest; _} as lsp_state) ->
29
+
let new_forest = Driver.run_until_done (Action.Parse lsp_uri) forest in
30
+
{lsp_state with forest = new_forest}
31
+
);
28
32
Diagnostics.compute new_doc
+8
-4
lib/language_server/Did_open.ml
+8
-4
lib/language_server/Did_open.ml
···
6
6
*)
7
7
8
8
open Forester_core
9
-
open Forester_compiler.State.Syntax
9
+
open Forester_compiler
10
+
open State.Syntax
10
11
module L = Lsp.Types
11
12
12
13
let compute
13
-
({textDocument = {uri; _}} as params: L.DidOpenTextDocumentParams.t)
14
+
({textDocument = {uri = lsp_uri; _}} as params: L.DidOpenTextDocumentParams.t)
14
15
=
15
16
let Lsp_state.{forest; _} = Lsp_state.get () in
16
17
let document =
···
18
19
~position_encoding: `UTF16
19
20
params
20
21
in
21
-
(* Hashtbl.replace forest.documents uri document; *)
22
-
let uri = URI_scheme.lsp_uri_to_uri ~host: forest.config.host uri in
22
+
let uri = URI_scheme.lsp_uri_to_uri ~host: forest.config.host lsp_uri in
23
23
forest.={uri} <- Document document;
24
+
Lsp_state.modify (fun ({forest; _} as lsp_state) ->
25
+
let new_forest = Driver.run_until_done (Action.Parse lsp_uri) forest in
26
+
{lsp_state with forest = new_forest}
27
+
);
24
28
Diagnostics.compute document
+1
lib/language_server/Forester_lsp.ml
+1
lib/language_server/Forester_lsp.ml
+33
lib/language_server/test/Test_lsp.ml
+33
lib/language_server/test/Test_lsp.ml
···
11
11
open Forester_compiler
12
12
open Forester_frontend
13
13
open Forester_lsp
14
+
open Forester_test
15
+
open Testables
14
16
15
17
module Handlers = Server.Handlers
16
18
···
284
286
151
285
287
(List.length result)
286
288
289
+
let test_contains () =
290
+
let position = L.Position.create ~character: 12 ~line: 0 in
291
+
let src = `File "foo" in
292
+
let start_pos = Asai.Range.{source = src; offset = 1; start_of_line = 0; line_num = 1} in
293
+
let end_pos = Asai.Range.{source = src; offset = 13; start_of_line = 0; line_num = 1} in
294
+
let loc = Option.some @@ Asai.Range.make (start_pos, end_pos) in
295
+
let located = Range.{value = (); loc} in
296
+
let result = Analysis.contains ~position located in
297
+
Alcotest.(check bool) "" true result
298
+
299
+
let test_node_at () =
300
+
let position = L.Position.create ~character: 12 ~line: 0 in
301
+
let code = Result.get_ok @@ parse_string_loc {|\import{asdf}|} in
302
+
let result = Option.get @@ Analysis.node_at ~position code in
303
+
Alcotest.(check code_node)
304
+
""
305
+
(Import (Private, "asdf"))
306
+
(Asai.Range.(result.value))
307
+
308
+
let test_addr_at () =
309
+
let code = Result.get_ok @@ parse_string_loc {|\transclude{tfmt-0005}|} in
310
+
let position = L.Position.create ~character: 13 ~line: 0 in
311
+
let result = Option.get @@ Analysis.addr_at ~position code in
312
+
Alcotest.(check string) "" "tfmt-0005" (Asai.Range.(result.value))
313
+
287
314
let () =
288
315
Random.self_init ();
289
316
Printexc.record_backtrace true;
···
308
335
Alcotest.run
309
336
"Test_lsp"
310
337
[
338
+
"Analysis",
339
+
[
340
+
"contains", `Quick, test_contains;
341
+
"node_at", `Quick, test_node_at;
342
+
"addr_at", `Quick, test_addr_at;
343
+
];
311
344
"Handlers",
312
345
[
313
346
"call hierarchy", `Quick, test_call_hierarchy;
+1
lib/language_server/test/dune
+1
lib/language_server/test/dune
+5
-3
test/Prelude.ml
+5
-3
test/Prelude.ml
···
53
53
54
54
type raw_tree = {path: string; content: string}
55
55
56
-
let parse_string str =
56
+
let parse_string_loc str =
57
57
let lexbuf = Lexing.from_string str in
58
-
let res = Parse.parse lexbuf in
59
-
Result.map strip_loc res
58
+
Parse.parse lexbuf
59
+
60
+
let parse_string str =
61
+
Result.map strip_loc (parse_string_loc str)
60
62
61
63
let with_open_tmp_dir ~env kont =
62
64
let open Eio in
+2
-1
test/Testables.ml
+2
-1
test/Testables.ml
···
39
39
let message = testable Reporter.Message.pp (=)
40
40
41
41
let code = testable Forester_core.Code.pp (=)
42
+
let code_node = testable Forester_core.Code.pp_node (=)
42
43
let syn = testable Syn.pp (=)
43
44
let path = testable Trie.pp_path (=)
44
45
let data = testable Resolver.P.pp_data (=)
···
59
60
let result = testable Eval.pp_result (=)
60
61
let content = testable Types.pp_content (=)
61
62
62
-
let action = testable Driver.Action.pp (=)
63
+
let action = testable Action.pp (=)