Soilihi BEN SOILIHI BOINA pushed to branch soilih at Stefan / Typer
Commits: a1b864fd by Soilih BEN SOILIH at 2021-04-09T19:45:28-06:00 fix declaration order
- - - - - fad7704f by Soilih BEN SOILIH at 2021-04-11T21:01:01-06:00 linol update
- - - - -
2 changed files:
- emacs/typer-mode.el - src/typer_lsp_server.ml
Changes:
===================================== emacs/typer-mode.el ===================================== @@ -281,7 +281,6 @@
(defvar typer-lsp-server-command '("typer-lsp-server")) -(add-to-list 'lsp-language-id-configuration '(typer-mode . "typer")) (with-eval-after-load 'lsp-mode (lsp-register-client (make-lsp-client :new-connection @@ -289,7 +288,9 @@ (lambda () typer-lsp-server-command)) :major-modes '(typer-mode) :priority -1 - :server-id 'typer-ls))) + :server-id 'typer-ls)) + (add-to-list 'lsp-language-id-configuration '(typer-mode . "typer")) + )
(provide 'typer-mode)
===================================== src/typer_lsp_server.ml ===================================== @@ -58,29 +58,30 @@ let readstring (str:string) = let ectx = Elab.default_ectx in (*let rctx = Elab.default_rctx in*) ignore (Elab.lexp_decl_str str ectx); - !Log.typer_log - + !Log.typer_log + let process_some_input_file (_file_contents : string) : state_after_processing = - readstring _file_contents - + readstring _file_contents + let diagnostics (_state : state_after_processing) : Lsp.Types.Diagnostic.t list = -let log_tab = log_entry_to_list _state in -List.map (fun x -> - let (loc, lev, msg) = x in - let (_ (* file *), line, column, _ (* docstr *) ) = loc in - let severity = log_level_to_severity lev in - let message = msg in - let start_pos = Lsp.Types.Position.create ~line:line ~character:column in - let end_pos = Lsp.Types.Position.create ~line:line ~character:(column + 1) in - let range = Lsp.Types.Range.create ~start:start_pos ~end_:end_pos in - let diagnostic = Lsp.Types.Diagnostic.create () - ~range:range - ~severity:severity - ~source:"typerlsp" - ~message:message - in - diagnostic -) log_tab + let log_tab = log_entry_to_list _state in + List.map (fun x -> + let (loc, lev, msg) = x in + let (_ (* file *), line, column, _ (* docstr *) ) = loc in + let severity = log_level_to_severity lev in + let message = msg in + let start_pos = Lsp.Types.Position.create ~line:line ~character:column in + let end_pos = Lsp.Types.Position.create ~line:line ~character:(column + 1) in + let range = Lsp.Types.Range.create ~start:start_pos ~end_:end_pos in + let diagnostic = Lsp.Types.Diagnostic.create () + ~range:range + ~severity:severity + ~source:"typerlsp" + ~message:message + in + diagnostic + ) log_tab +
(* Lsp server class This is the main point of interaction beetween the code checking documents @@ -114,7 +115,7 @@ class lsp_server =
(* 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_lwt.Task.m = + method on_notif_doc_did_open ~notify_back d ~content : unit Linol_lwt.t = self#_on_doc ~notify_back d.uri content
(* Similarly, we also override the [on_notify_doc_did_change] method that will be called @@ -124,33 +125,22 @@ class lsp_server =
(* 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_lwt.Task.m = + method on_notif_doc_did_close ~notify_back:_ d : unit Linol_lwt.t = Hashtbl.remove buffers d.uri; - Linol_lwt.Jsonrpc2.IO.return () + Linol_lwt.return () + end
(* Main code This is the code that creates an instance of the lsp server class and runs it as a task. *) let run () = - let open Linol_lwt.Task.Infix in let s = new lsp_server in - (* TODO: the task is the LSP server *) - let task = - Linol_lwt.Task.start ~descr:"top task" - (fun _top_task -> - let server = Linol_lwt.Jsonrpc2.create_stdio s in - let* () = - Linol_lwt.Task.run_sub ~descr:"lsp server" ~parent:_top_task - (fun _ -> Linol_lwt.Jsonrpc2.run server _top_task) - >>= Linol_lwt.Task.unwrap - in - Linol_lwt.Task.return () - ) - in - match Linol_lwt.Task.run task with - | Ok () -> () - | Error e -> + let server = Linol_lwt.Jsonrpc2.create_stdio s in + let task = Linol_lwt.Jsonrpc2.run server in + match Linol_lwt.run task with + | () -> () + | exception e -> let e = Printexc.to_string e in Printf.eprintf "error: %s\n%!" e; exit 1 \ No newline at end of file
View it on GitLab: https://gitlab.com/monnier/typer/-/compare/6452296605b9317a616cca10b24c7c157...
Afficher les réponses par date