Something went wrong. Try again.
forked from gbury/dolmen
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102(* This file is free software, part of dolmen. See file "LICENSE" for more information *)
(* Lsp server class *)(* ************************************************************************ *)
exception ServerError of string
let parse_settings settings = match settings with | `Assoc [ "preludes", `List l ] -> List.map ( fun s -> match s with | `String f -> f | _ -> raise (ServerError ( Format.asprintf "Expected a path to a prelude file as a string, \ instead got %a@." Yojson.Safe.pp s)) ) l | _ -> raise (ServerError ( Format.asprintf "ChangeConfiguration: received unexpected settings: \n%a@." Yojson.Safe.pp settings))
let preprocess_uri uri = let prefix = "file://" in let prefix_len = String.length prefix in let uri_len = String.length uri in if prefix_len < uri_len && (String.sub uri 0 prefix_len) = prefix then String.sub uri prefix_len (uri_len - prefix_len) else uri
let mk_prelude files = List.map ( fun f -> let dir, file = Dolmen_loop.State.split_input (`File f) in Dolmen_loop.State.mk_file dir file ) files
class dolmen_lsp_server = object(self) inherit Linol_lwt.Jsonrpc2.server
method spawn_query_handler f = Linol_lwt.spawn f
(* one env per document *) val buffers: (Linol.Lsp.Types.DocumentUri.t, State.t) Hashtbl.t = Hashtbl.create 32
(* A list of include statements of the prelude files *) val mutable prelude = []
method! config_sync_opts = (* configure how sync happens *) let change = Linol.Lsp.Types.TextDocumentSyncKind.Incremental in (* Linol.Lsp.Types.TextDocumentSyncKind.Full *) Linol.Lsp.Types.TextDocumentSyncOptions.create ~openClose:true ~change ~save:(`SaveOptions (Linol.Lsp.Types.SaveOptions.create ~includeText:false ())) ()
method private _on_doc ~(notify_back:Linol_lwt.Jsonrpc2.notify_back) (uri:Linol.Lsp.Types.DocumentUri.t) (contents:string) = (* TODO: unescape uri/translate it to a correct path ? *) let uri_path = Linol.Lsp.Uri.to_path uri in match Loop.process prelude (preprocess_uri uri_path) (Some contents) with | Ok state -> let diags = State.get State.diagnostics state in Hashtbl.replace buffers uri state; notify_back#send_diagnostic diags | Error msg -> Linol_lwt.Jsonrpc2.IO.failwith ( Format.asprintf "Internal dolmen error: %s" msg )
method on_notif_doc_did_open ~notify_back d ~content = self#_on_doc ~notify_back d.uri content
method on_notif_doc_did_change ~notify_back d _c ~old_content:_old ~new_content = self#_on_doc ~notify_back d.uri new_content
method! on_notification_unhandled ~notify_back:_ (n:Linol.Lsp.Client_notification.t) = match n with | Linol.Lsp.Client_notification.ChangeConfiguration { settings; } -> begin try prelude <- mk_prelude (parse_settings settings); Linol_lwt.Jsonrpc2.IO.return () with ServerError s -> Linol_lwt.Jsonrpc2.IO.failwith s end | _ -> Linol_lwt.Jsonrpc2.IO.return ()
method on_notif_doc_did_close ~notify_back d = Hashtbl.remove buffers d.uri; notify_back#send_diagnostic []
end