Added a lsp server

1 files changed, 136 insertions, 0 deletions

diff --git a/bin/lsp_server.ml b/bin/lsp_server.ml
new file mode 100644
index 0000000..62e6105
--- /dev/null
+++ b/bin/lsp_server.ml
@@ -0,0 +1,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 ()