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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
(* This file is free software, part of linol. See file "LICENSE" for more information *)
open StdLabels
(* Some user code
The code here is just a placeholder to make this file compile, it is expected
that users have an implementation of a processing function for input contents.
Here we expect a few things:
- a type to represent a state/environment that results from processing an
input file
- a function procdessing an input file (given the file contents as a string),
which return a state/environment
- a function to extract a list of diagnostics from a state/environment.
Diagnostics includes all the warnings, errors and messages that the processing
of a document are expected to be able to return.
*)
module Lsp = Linol.Lsp
type state_after_processing =
(Qsp_syntax.Report.t list, Qsp_syntax.Report.t) result
let process_some_input_file (_file_contents : string) : state_after_processing =
let lexer, parameters =
( Sedlexing.Utf8.from_string _file_contents,
Args.{ reset_line = true; filters = { level = None } } )
in
let lexer =
Qparser.Lexbuf.from_lexbuf ~reset_line:parameters.reset_line lexer
in
(* Initialize all the checkers before parsing the source *)
let (module Check) = Lazy.force Checklist.checkers in
let check_context = Check.initialize () in
Checklist.get_report (module Check) check_context lexer
let diagnostics (state : state_after_processing) : Lsp.Types.Diagnostic.t list =
match state with
| Error e -> [ Lsp_diagnostic.build e ]
| Ok e -> List.map e ~f:Lsp_diagnostic.build
(* Lsp server class
This is the main point of interaction beetween the code checking documents
(parsing, typing, etc...), and the code of linol.
The [Linol_eio.Jsonrpc2.server] class defines a method for each of the action
that the lsp server receives, such as opening of a document, when a document
changes, etc.. By default, the method predefined does nothing (or errors out ?),
so that users only need to override methods that they want the server to
actually meaningfully interpret and respond to.
*)
class lsp_server =
object (self)
inherit Linol_eio.Jsonrpc2.server
(* one env per document *)
val buffers : (Lsp.Types.DocumentUri.t, state_after_processing) Hashtbl.t =
Hashtbl.create 32
method spawn_query_handler f = Linol_eio.spawn f
(* We define here a helper method that will:
- process a document
- store the state resulting from the processing
- return the diagnostics from the new state
*)
method private _on_doc ~(notify_back : Linol_eio.Jsonrpc2.notify_back)
(uri : Lsp.Types.DocumentUri.t) (contents : string) =
let new_state = process_some_input_file contents in
Hashtbl.replace buffers uri new_state;
let diags = diagnostics new_state in
notify_back#send_diagnostic diags
(* We now override the [on_notify_doc_did_open] method that will be called
by the server each time a new document is opened. *)
method on_notif_doc_did_open ~notify_back d ~content : unit Linol_eio.t =
self#_on_doc ~notify_back d.uri content
(* Similarly, we also override the [on_notify_doc_did_change] method that will be called
by the server each time a new document is opened. *)
method on_notif_doc_did_change ~notify_back d _c ~old_content:_old
~new_content =
self#_on_doc ~notify_back d.uri new_content
(* On document closes, we remove the state associated to the file from the global
hashtable state, to avoid leaking memory. *)
method on_notif_doc_did_close ~notify_back:_ d : unit Linol_eio.t =
Hashtbl.remove buffers d.uri;
()
end
(* Main code
This is the code that creates an instance of the lsp server class
and runs it as a task. *)
let run () =
(* Deactivate the tests which only applies to a global file *)
List.iter Checklist.available_checks ~f:(fun t ->
let (module C : Qsp_syntax.Analyzer.T) =
Qsp_syntax.Identifier.get_module t
in
if C.is_global && !C.active then C.active := false);
Qsp_checks.Dynamics.active := true;
Eio_main.run @@ fun env ->
let s = new lsp_server in
let server = Linol_eio.Jsonrpc2.create_stdio ~env s in
let task () =
let shutdown () = s#get_status = `ReceivedExit in
Linol_eio.Jsonrpc2.run ~shutdown server
in
match task () with
| () -> ()
| exception e ->
let e = Printexc.to_string e in
Printf.eprintf "error: %s\n%!" e;
exit 1
let speclist =
[
( "--version",
Arg.Unit
(fun () ->
Printf.printf "Version %s\n" Tools.Git_hash.revision;
exit 0),
"\tDisplay the version of the application and exit" );
]
let () =
Arg.parse (Arg.align speclist) (fun _ -> ()) "LSP server for QSP language"
(* Finally, we actually run the server *)
let () = run ()
|
