2 * Copyright (c) 2015, Facebook, Inc.
5 * This source code is licensed under the MIT license found in the
6 * LICENSE file in the "hack" directory of this source tree.
15 (* All hack-specific code relating to LSP goes in here. *)
19 config
: (string * string) list
;
26 use_serverless_ide
: bool;
27 use_ffp_autocomplete
: bool;
28 use_ranked_autocomplete
: bool;
31 (** This gets initialized to env.from, but maybe modified in the light of the initialize request *)
32 let from = ref "[init]"
34 (** This gets initialized in the initialize request *)
35 let ref_local_config : ServerLocalConfig.t
option ref = ref None
37 (************************************************************************)
38 (* Protocol orchestration & helpers *)
39 (************************************************************************)
41 (** We have an idea of server state based on what we hear from the server:
42 When we attempt a connection, we hear hopefully hear back that it's
43 INITIALIZING, and when we eventually receive "hello" that means it's
44 HANDLING_OR_READY, i.e. either handling a message, or ready to accept one.
45 But at connection attempt, we might see that it's STOPPED, or hear from it
46 that it's DENYING_CONNECTION (typically due to rebase).
47 When the server's running normally, we sometimes here push notifications to
48 tell us that it's TYPECHECKING, or has been STOLEN by another editor.
49 At any point of communication we might hear from the server that it
50 encountered a fatal exception, i.e. shutting down the pipe, so presumably
51 it has been STOPPED. When we reattempt to connect once a second, maybe we'll
53 type hh_server_state
=
55 | Hh_server_initializing
56 | Hh_server_handling_or_ready
57 | Hh_server_denying_connection
59 | Hh_server_typechecking_local
60 | Hh_server_typechecking_global_blocking
61 | Hh_server_typechecking_global_interruptible
62 | Hh_server_typechecking_global_remote_blocking
67 let hh_server_restart_button_text = "Restart hh_server"
69 let client_ide_restart_button_text = "Restart Hack IDE"
71 let see_output_hack = " See Output\xE2\x80\xBAHack for details." (* chevron *)
73 type incoming_metadata
= {
74 timestamp
: float; (** time this message arrived at stdin *)
76 (** a unique random string of our own creation, which we can use for logging *)
79 (** A push message from the server might come while we're waiting for a server-rpc
80 response, or while we're free. The current architecture allows us to have
81 arbitrary responses to push messages while we're free, but only a limited set
82 of responses while we're waiting for a server-rpc - e.g. we can update our
83 notion of the server_state, or send a message to the client, but we can't
84 update our own state monad. The has_* fields are ad-hoc push-specific indicators
85 of whether we've done some part of the response during the rpc. *)
86 type server_message
= {
87 push
: ServerCommandTypes.push
;
88 has_updated_server_state
: bool;
92 ic
: Timeout.in_channel
;
94 server_specific_files
: ServerCommandTypes.server_specific_files
;
95 pending_messages
: server_message
Queue.t
;
96 (** ones that arrived during current rpc *)
99 module Main_env
= struct
103 most_recent_file
: documentUri
option;
104 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
105 uris_with_diagnostics
: UriSet.t
;
106 uris_with_unsaved_changes
: UriSet.t
;
107 (** see comment in get_uris_with_unsaved_changes *)
108 hh_server_status
: ShowStatusFB.params
;
109 (** is updated by [handle_server_message] > [do_server_busy]. Shows status of
110 a connected hh_server, whether it's busy typechecking or ready:
111 (1) type_=InfoMessage when done typechecking, or WarningMessage during.
112 (2) shortMessage="Hack" if IDE is available, or "Hack: busy" if not
113 (3) message is a descriptive status about what it's doing. *)
117 module In_init_env
= struct
120 first_start_time
: float; (** our first attempt to connect *)
121 most_recent_start_time
: float; (** for subsequent retries *)
122 most_recent_file
: documentUri
option;
123 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
124 uris_with_unsaved_changes
: UriSet.t
;
125 (** see comment in get_uris_with_unsaved_changes *)
126 hh_server_status_diagnostic
: PublishDiagnostics.params
option;
127 (** Diagnostic messages warning about server not fully running. *)
131 module Lost_env
= struct
134 most_recent_file
: documentUri
option;
135 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
136 uris_with_unsaved_changes
: UriSet.t
;
137 (** see comment in get_uris_with_unsaved_changes *)
139 hh_server_status_diagnostic
: PublishDiagnostics.params
option;
140 (** Diagnostic messages warning about server not fully running. *)
145 new_hh_server_state
: hh_server_state
;
146 start_on_click
: bool;
147 (** if user clicks Restart, do we ClientStart before reconnecting? *)
148 trigger_on_lsp
: bool;
149 (** reconnect if we receive any LSP request/notification *)
150 trigger_on_lock_file
: bool; (** reconnect if lockfile is created *)
155 | Pre_init
(** Pre_init: we haven't yet received the initialize request. *)
156 | In_init
of In_init_env.t
157 (** In_init: we did respond to the initialize request, and now we're
158 waiting for a "Hello" from the server. When that comes we'll
159 request a permanent connection from the server, and process the
160 file_changes backlog, and switch to Main_loop. *)
161 | Main_loop
of Main_env.t
162 (** Main_loop: we have a working connection to both server and client. *)
163 | Lost_server
of Lost_env.t
164 (** Lost_server: someone stole the persistent connection from us.
165 We might choose to grab it back if prompted... *)
167 (** Post_shutdown: we received a shutdown request from the client, and
168 therefore shut down our connection to the server. We can't handle
169 any more requests from the client and will close as soon as it
170 notifies us that we can exit. *)
172 let is_post_shutdown (state
: state
) : bool =
174 | Post_shutdown
-> true
181 let is_pre_init (state
: state
) : bool =
190 type result_handler
= lsp_result
-> state
-> state
Lwt.t
192 type result_telemetry
= {
193 (* how many results did we send back to the user? *)
195 (* other message-specific data *)
196 result_extra_telemetry
: Telemetry.t
option;
199 let initialize_params_ref : Lsp.Initialize.params
option ref = ref None
201 let initialize_params_exc () : Lsp.Initialize.params
=
202 match !initialize_params_ref with
203 | None
-> failwith
"initialize_params not yet received"
204 | Some initialize_params
-> initialize_params
206 (** root only becomes available after the initialize message *)
207 let get_root_opt () : Path.t
option =
208 match !initialize_params_ref with
210 | Some initialize_params
->
211 let path = Some
(Lsp_helpers.get_root initialize_params
) in
212 Some
(Wwwroot.get
path)
214 (** root only becomes available after the initialize message *)
215 let get_root_exn () : Path.t
= Option.value_exn
(get_root_opt ())
217 (** local_config only becomes available after the initialize message *)
218 let get_local_config_exn () : ServerLocalConfig.t
=
219 Option.value_exn
!ref_local_config
221 (** We remember the last version of .hhconfig, and hack_rc_mode switch,
222 so that if they change then we know we must terminate and be restarted. *)
223 let hhconfig_version_and_switch : string ref = ref "[NotYetInitialized]"
225 (** This flag is used to control how much will be written
226 to log-files. It can be turned on initially by --verbose at the command-line or
227 setting "trace:Verbose" in initializationParams. Thereafter, it can
228 be changed by the user dynamically via $/setTraceNotification.
229 Don't alter this reference directly; instead use [set_verbose_to_file]
230 so as to pass the message on to ide_service as well.
231 Note: control for how much will be written to stderr is solely
232 controlled by --verbose at the command-line, stored in env.verbose. *)
233 let verbose_to_file : bool ref = ref false
235 let can_autostart_after_mismatch : bool ref = ref true
237 let requests_outstanding : (lsp_request
* result_handler
) IdMap.t
ref =
240 let get_outstanding_request_exn (id
: lsp_id
) : lsp_request
=
241 match IdMap.find_opt id
!requests_outstanding with
242 | Some
(request
, _
) -> request
243 | None
-> failwith
"response id doesn't correspond to an outstanding request"
245 (** hh_server pushes BUSY_STATUS messages over the persistent connection
246 to mark key milestones like "begin typechecking". We handle them in two
247 ways. First, update_hh_server_state_if_necessary updates a historical
248 record of state transitions over the past two minutes, called both from
249 the main message loop and also during rpc progress callbacks. It's
250 stored in a global variable because we don't want rpc callbacks to have
251 to be part of the state monad. It's kept as an ordered list of states
252 over the past two minutes (head is newest) so that if we were busy at
253 the time a jsonrpc request arrived on stdin, we can still know what was
254 the server state at the time. The second way we handle them is inside
255 handle_server_message, called as part of the main message loop, whose
256 job is to update the Main_env representation of current hh_server status. *)
257 let hh_server_state_log : (float * hh_server_state
) list
ref = ref []
259 (** hh_server pushes a different form of its state to the monitor e.g.
260 "busy typechecking 1/50 files" or "init is slow due to lack of saved state".
261 It does this for the sake of clients who don't have a persistent connection;
262 they can ask the monitor what was the latest that hh_server pushed. We use
263 this during In_init when we don't have a persistent connection; other
264 command-line clients of hh_client do this when they're waiting their turn.
265 On idle, i.e. during [Tick] events, we update the following global
266 variable which synthesizes our best knowledge about the current hh_server
267 state; during Main_loop it's obtained from the latest Main_env representation
268 of the current hh_server state, and during In_init it's obtained by
269 asking the monitor. We store this in a global value so we can access
270 it during rpc callbacks, without requiring them to have the state monad. *)
271 let latest_hh_server_status : ShowStatusFB.params
option ref = ref None
273 (** Have we already sent a status message over LSP? If so, and our new
274 status will be just the same as the previous one, we won't need to send it
275 again. This stores the most recent status that the LSP client has. *)
276 let showStatus_outstanding : string ref = ref ""
278 let log s
= Hh_logger.log ("[client-lsp] " ^^ s
)
280 let log_debug s
= Hh_logger.debug
("[client-lsp] " ^^ s
)
282 let log_error s
= Hh_logger.error
("[client-lsp] " ^^ s
)
284 let set_up_hh_logger_for_client_lsp (root
: Path.t
) : unit =
285 (* Log to a file on disk. Note that calls to `Hh_logger` will always write to
286 `stderr`; this is in addition to that. *)
287 let client_lsp_log_fn = ServerFiles.client_lsp_log root
in
289 try Sys.rename
client_lsp_log_fn (client_lsp_log_fn ^
".old") with
292 Hh_logger.set_log
client_lsp_log_fn;
293 log "Starting clientLsp at %s" client_lsp_log_fn
295 let to_stdout (json
: Hh_json.json
) : unit =
296 let s = Hh_json.json_to_string json ^
"\r\n\r\n" in
297 Http_lite.write_message stdout
s
299 let get_editor_open_files (state
: state
) :
300 Lsp.TextDocumentItem.t
UriMap.t
option =
305 | Main_loop menv
-> Some menv
.Main_env.editor_open_files
306 | In_init ienv
-> Some ienv
.In_init_env.editor_open_files
307 | Lost_server lenv
-> Some lenv
.Lost_env.editor_open_files
309 (** This is the most recent file that was subject of an LSP request
310 from the client. There's no guarantee that the file is still open. *)
311 let get_most_recent_file (state
: state
) : documentUri
option =
316 | Main_loop menv
-> menv
.Main_env.most_recent_file
317 | In_init ienv
-> ienv
.In_init_env.most_recent_file
318 | Lost_server lenv
-> lenv
.Lost_env.most_recent_file
322 | Server_message
of server_message
323 | Client_message
of incoming_metadata
* lsp_message
324 (** Client_message stores raw json, and the parsed form of it *)
325 | Client_ide_notification
of ClientIdeMessage.notification
326 | Tick
(** once per second, on idle *)
328 let event_to_string (event
: event
) : string =
330 | Server_hello
-> "Server_hello"
331 | Server_message _
-> "Server_message(_)"
332 | Client_message
(metadata
, m
) ->
334 "Client_message(#%s: %s)"
336 (Lsp_fmt.denorm_message_to_string m
)
337 | Client_ide_notification n
->
339 "Client_ide_notification(%s)"
340 (ClientIdeMessage.notification_to_string n
)
343 let is_tick (event
: event
) : bool =
349 | Client_ide_notification _
->
352 (* Here are some exit points. *)
353 let exit_ok () = exit
0
355 let exit_fail () = exit
1
357 (* The following connection exceptions inform the main LSP event loop how to
358 respond to an exception: was the exception a connection-related exception
359 (one of these) or did it arise during other logic (not one of these)? Can
360 we report the exception to the LSP client? Can we continue handling
361 further LSP messages or must we quit? If we quit, can we do so immediately
362 or must we delay? -- Separately, they also help us marshal callstacks
363 across daemon- and process-boundaries. *)
366 Client_fatal_connection_exception
of Marshal_tools.remote_exception_data
369 Client_recoverable_connection_exception
of Marshal_tools.remote_exception_data
372 Server_fatal_connection_exception
of Marshal_tools.remote_exception_data
374 exception Server_nonfatal_exception
of Lsp.Error.t
376 (** Helper function to construct an Lsp.Error. Its goal is to gather
377 useful information in the optional freeform 'data' field. It assembles
378 that data out of any data already provided, the provided stack, and the
379 current stack. A typical scenario is that we got an error marshalled
380 from a remote server with its remote stack where the error was generated,
381 and we also want to record the stack where we received it. *)
383 ?
(data
: Hh_json.json
option = None
)
384 ?
(stack
: string option)
385 ?
(current_stack
: bool = true)
386 ?
(code
: Lsp.Error.code
= Lsp.Error.UnknownErrorCode
)
387 (message
: string) : Lsp.Error.t
=
391 | Some
(Hh_json.JSON_Object
elems) -> elems
392 | Some json
-> [("data", json
)]
396 | Some stack
when not
(List.Assoc.mem ~equal
:String.equal
elems "stack") ->
397 ("stack", stack
|> Exception.clean_stack
|> Hh_json.string_
) :: elems
401 match current_stack
with
402 | true when not
(List.Assoc.mem ~equal
:String.equal
elems "current_stack")
405 Exception.get_current_callstack_string
99
406 |> Exception.clean_stack
411 { Lsp.Error.code
; message
; data
= Some
(Hh_json.JSON_Object
elems) }
413 (** Use ignore_promise_but_handle_failure when you want don't care about awaiting
414 results of an async piece of work, but still want any exceptions to be logged.
415 This is similar to Lwt.async except (1) it logs to our HackEventLogger and
416 Hh_logger rather than stderr, (2) it you can decide on a case-by-case basis what
417 should happen to exceptions rather than having them all share the same
418 Lwt.async_exception_hook, (3) while Lwt.async takes a lambda for creating the
419 promise and so catches exceptions during promise creation, this function takes
420 an already-existing promise and so the caller has to handle such exceptions
421 themselves - I resent using lambdas as a control-flow primitive.
423 You can think of this function as similar to [ignore], but enhanced because
424 it's poor practice to ignore a promise. *)
425 let ignore_promise_but_handle_failure
426 ~
(desc
: string) ~
(terminate_on_failure
: bool) (promise
: unit Lwt.t
) :
430 let%lwt
() = promise
in
435 let exn = Exception.wrap
exn in
436 let message = "Unhandled exception: " ^
Exception.get_ctor_string
exn in
438 Exception.get_backtrace_string
exn |> Exception.clean_stack
443 ("description", string_ desc
);
444 ("message", string_
message);
445 ("stack", string_
stack);
448 HackEventLogger.client_lsp_exception
449 ~root
:(get_root_opt ())
450 ~
message:"Unhandled exception"
451 ~data_opt
:(Some
data)
453 log_error "%s\n%s\n%s" message desc
stack;
454 if terminate_on_failure
then
455 (* exit 2 is the same as used by Lwt.async *)
460 let state_to_string (state
: state
) : string =
462 | Pre_init
-> "Pre_init"
463 | In_init _ienv
-> "In_init"
464 | Main_loop _menv
-> "Main_loop"
465 | Lost_server _lenv
-> "Lost_server"
466 | Post_shutdown
-> "Post_shutdown"
468 let hh_server_state_to_string (hh_server_state
: hh_server_state
) : string =
469 match hh_server_state
with
470 | Hh_server_denying_connection
-> "hh_server denying connection"
471 | Hh_server_initializing
-> "hh_server initializing"
472 | Hh_server_stopped
-> "hh_server stopped"
473 | Hh_server_stolen
-> "hh_server stolen"
474 | Hh_server_typechecking_local
-> "hh_server typechecking (local)"
475 | Hh_server_typechecking_global_blocking
->
476 "hh_server typechecking (global, blocking)"
477 | Hh_server_typechecking_global_interruptible
->
478 "hh_server typechecking (global, interruptible)"
479 | Hh_server_typechecking_global_remote_blocking
->
480 "hh_server typechecking (global remote, blocking)"
481 | Hh_server_handling_or_ready
-> "hh_server ready"
482 | Hh_server_unknown
-> "hh_server unknown state"
483 | Hh_server_forgot
-> "hh_server forgotten state"
485 (** This conversion is imprecise. Comments indicate potential gaps *)
486 let completion_kind_to_si_kind
487 (completion_kind
: Completion.completionItemKind
option) :
488 SearchUtils.si_kind
=
490 let open SearchUtils
in
491 match completion_kind
with
492 | Some
Completion.Class
-> SI_Class
493 | Some
Completion.Method
-> SI_ClassMethod
494 | Some
Completion.Function
-> SI_Function
495 | Some
Completion.Variable
->
496 SI_LocalVariable
(* or SI_Mixed, but that's never used *)
497 | Some
Completion.Property
-> SI_Property
498 | Some
Completion.Constant
-> SI_GlobalConstant
(* or SI_ClassConstant *)
499 | Some
Completion.Interface
-> SI_Interface
(* or SI_Trait *)
500 | Some
Completion.Enum
-> SI_Enum
501 | Some
Completion.Module
-> SI_Namespace
502 | Some
Completion.Constructor
-> SI_Constructor
503 | Some
Completion.Keyword
-> SI_Keyword
504 | Some
Completion.Value
-> SI_Literal
505 | Some
Completion.TypeParameter
-> SI_Typedef
506 (* The completion enum includes things we don't really support *)
509 let si_kind_to_completion_kind (kind
: SearchUtils.si_kind
) :
510 Completion.completionItemKind
option =
513 | SearchUtils.SI_Class
->
514 Some
Completion.Class
515 | SearchUtils.SI_ClassMethod
-> Some
Completion.Method
516 | SearchUtils.SI_Function
-> Some
Completion.Function
517 | SearchUtils.SI_Mixed
518 | SearchUtils.SI_LocalVariable
->
519 Some
Completion.Variable
520 | SearchUtils.SI_Property
-> Some
Completion.Property
521 | SearchUtils.SI_ClassConstant
-> Some
Completion.Constant
522 | SearchUtils.SI_Interface
523 | SearchUtils.SI_Trait
->
524 Some
Completion.Interface
525 | SearchUtils.SI_Enum
-> Some
Completion.Enum
526 | SearchUtils.SI_Namespace
-> Some
Completion.Module
527 | SearchUtils.SI_Constructor
-> Some
Completion.Constructor
528 | SearchUtils.SI_Keyword
-> Some
Completion.Keyword
529 | SearchUtils.SI_Literal
-> Some
Completion.Value
530 | SearchUtils.SI_GlobalConstant
-> Some
Completion.Constant
531 | SearchUtils.SI_Typedef
-> Some
Completion.TypeParameter
532 | SearchUtils.SI_Unknown
-> None
534 (** We keep a log of server state over the past 2mins. When adding a new server
535 state: if this state is the same as the current one, then ignore it. Also,
536 retain only states younger than 2min plus the first one older than 2min.
537 Newest state is at head of list. *)
538 let set_hh_server_state (new_hh_server_state
: hh_server_state
) : unit =
539 let new_time = Unix.gettimeofday
() in
540 let rec retain rest
=
543 | (time
, state
) :: rest
when Float.(time
>= new_time -. 120.0) ->
544 (time
, state
) :: retain rest
545 | (time
, state
) :: _rest
-> [(time
, state
)]
546 (* retain only the first that's older *)
548 hh_server_state_log :=
549 match !hh_server_state_log with
550 | (prev_time
, prev_hh_server_state
) :: rest
551 when equal_hh_server_state prev_hh_server_state new_hh_server_state
->
552 (prev_time
, prev_hh_server_state
) :: retain rest
553 | rest
-> (new_time, new_hh_server_state
) :: retain rest
555 let get_older_hh_server_state (requested_time
: float) : hh_server_state
=
556 (* find the first item which is older than the specified time. *)
558 List.find
!hh_server_state_log ~f
:(fun (time
, _
) ->
559 Float.(time
<= requested_time
))
561 | None
-> Hh_server_forgot
562 | Some
(_
, hh_server_state
) -> hh_server_state
564 let read_hhconfig_version () : string Lwt.t
=
565 match get_root_opt () with
566 | None
-> Lwt.return
"[NoRoot]"
568 let file = Filename.concat
(Path.to_string root
) ".hhconfig" in
569 let%lwt config
= Config_file_lwt.parse_hhconfig
file in
571 | Ok
(_hash
, config
) ->
574 |> Config_file.Getters.string_opt
"version"
575 |> Config_file_lwt.parse_version
576 |> Config_file_lwt.version_to_string_opt
577 |> Option.value ~default
:"[NoVersion]"
580 | Error
message -> Lwt.return
(Printf.sprintf
"[NoHhconfig:%s]" message))
582 let read_hhconfig_version_and_switch () : string Lwt.t
=
583 let%lwt hack_rc_mode_result
=
584 Lwt_utils.read_all
(Sys_utils.expanduser
"~/.hack_rc_mode")
587 match hack_rc_mode_result
with
588 | Ok
s -> " hack_rc_mode=" ^
s
592 match Sys.getenv_opt
"HH_HOME" with
593 | Some
s -> " HH_HOME=" ^
s
596 let%lwt hhconfig_version
= read_hhconfig_version () in
597 Lwt.return
(hhconfig_version ^
hack_rc_mode ^
hh_home)
599 (** get_uris_with_unsaved_changes is the set of files for which we've
600 received didChange but haven't yet received didSave/didOpen. It is purely
601 a description of what we've heard of the editor, and is independent of
602 whether or not they've yet been synced with hh_server.
603 As it happens: in Main_loop state all these files will already have been
604 sent to hh_server; in In_init state all these files will have been queued
605 up inside editor_open_files ready to be sent when we receive the hello; in
606 Lost_server state they're not even queued up, and if ever we see hh_server
607 ready then we'll terminate the LSP server and trust the client to relaunch
608 us and resend a load of didOpen/didChange events. *)
609 let get_uris_with_unsaved_changes (state
: state
) : UriSet.t
=
611 | Main_loop menv
-> menv
.Main_env.uris_with_unsaved_changes
612 | In_init ienv
-> ienv
.In_init_env.uris_with_unsaved_changes
613 | Lost_server lenv
-> lenv
.Lost_env.uris_with_unsaved_changes
616 let update_hh_server_state_if_necessary (event
: event
) : unit =
617 let open ServerCommandTypes
in
620 | BUSY_STATUS Needs_local_typecheck
621 | BUSY_STATUS Done_local_typecheck
622 | BUSY_STATUS Done_global_typecheck
->
623 set_hh_server_state Hh_server_handling_or_ready
624 | BUSY_STATUS Doing_local_typecheck
->
625 set_hh_server_state Hh_server_typechecking_local
626 | BUSY_STATUS
(Doing_global_typecheck global_typecheck_kind
) ->
628 (match global_typecheck_kind
with
629 | Blocking
-> Hh_server_typechecking_global_blocking
630 | Interruptible
-> Hh_server_typechecking_global_interruptible
631 | Remote_blocking _
-> Hh_server_typechecking_global_remote_blocking
)
632 | NEW_CLIENT_CONNECTED
-> set_hh_server_state Hh_server_stolen
635 | NONFATAL_EXCEPTION _
->
639 | Server_message
{ push
; has_updated_server_state
= false } -> helper push
642 (** This cancellable async function will block indefinitely until a notification is
643 available from ide_service, and return. If there's no ide_service then it awaits indefinitely. *)
644 let pop_from_ide_service (ide_service
: ClientIdeService.t
ref option) :
646 match ide_service
with
647 | None
-> Lwt.task
() |> fst
(* a never-fulfilled, cancellable promise *)
648 | Some ide_service
->
649 let%lwt notification_opt
=
650 Lwt_message_queue.pop
(ClientIdeService.get_notifications
!ide_service
)
652 (match notification_opt
with
653 | None
-> Lwt.task
() |> fst
(* a never-fulfilled, cancellable promise *)
654 | Some notification
-> Lwt.return
(Client_ide_notification notification
))
656 (** This cancellable async function will block indefinitely until
657 data is available from the server, but won't read from it. *)
658 let wait_until_server_has_data (server
: server_conn
) : unit Lwt.t
=
659 let fd = Unix.descr_of_out_channel server
.oc
|> Lwt_unix.of_unix_file_descr
in
660 let%lwt
() = Lwt_unix.wait_read
fd in
663 (** This cancellable async function will block indefinitely until data is
664 available from the client, but won't read from it. If there's no client
665 then it awaits indefinitely. *)
666 let wait_until_client_has_data (client
: Jsonrpc.t
option) : unit Lwt.t
=
668 | None
-> Lwt.task
() |> fst
(* a never-fulfilled, cancellable promise *)
671 match Jsonrpc.await_until_message client
with
672 | `Already_has_message
-> Lwt.return_unit
673 | `Wait_for_data_here
fd ->
674 let fd = Lwt_unix.of_unix_file_descr
fd in
675 let%lwt
() = Lwt_unix.wait_read
fd in
680 (** Determine whether to read a message from the client (the editor) or the
681 server (hh_server), or whether neither is ready within 1s. *)
682 let get_message_source
683 (server
: server_conn
)
684 (client
: Jsonrpc.t
option)
685 (ide_service
: ClientIdeService.t
ref option) :
686 [ `From_server
| `From_client
| `From_ide_service
of event
| `No_source
]
688 (* Take action on server messages in preference to client messages, because
689 server messages are very easy and quick to service (just send a message to
690 the client), while client messages require us to launch a potentially
691 long-running RPC command. *)
692 let has_server_messages = not
(Queue.is_empty server
.pending_messages
) in
693 if has_server_messages then
694 Lwt.return `From_server
695 else if Option.value_map client ~default
:false ~f
:Jsonrpc.has_message
then
696 Lwt.return `From_client
698 (* If no immediate messages are available, then wait up to 1 second. *)
699 let%lwt message_source
=
702 (let%lwt
() = Lwt_unix.sleep
1.0 in
703 Lwt.return `No_source
);
704 (let%lwt
() = wait_until_server_has_data server
in
705 Lwt.return `From_server
);
706 (let%lwt
() = wait_until_client_has_data client
in
707 Lwt.return `From_client
);
708 (let%lwt notification
= pop_from_ide_service ide_service
in
709 Lwt.return
(`From_ide_service notification
));
712 Lwt.return message_source
714 (** A simplified version of get_message_source which only looks at client *)
715 let get_client_message_source
716 (client
: Jsonrpc.t
option) (ide_service
: ClientIdeService.t
ref option) :
717 [ `From_client
| `From_ide_service
of event
| `No_source
] Lwt.t
=
718 if Option.value_map client ~default
:false ~f
:Jsonrpc.has_message
then
719 Lwt.return `From_client
721 let%lwt message_source
=
724 (let%lwt
() = Lwt_unix.sleep
1.0 in
725 Lwt.return `No_source
);
726 (let%lwt
() = wait_until_client_has_data client
in
727 Lwt.return `From_client
);
728 (let%lwt notification
= pop_from_ide_service ide_service
in
729 Lwt.return
(`From_ide_service notification
));
732 Lwt.return message_source
734 (** Read a message unmarshaled from the server's out_channel. *)
735 let read_message_from_server (server
: server_conn
) : event
Lwt.t
=
736 let open ServerCommandTypes
in
739 Unix.descr_of_out_channel server
.oc
|> Lwt_unix.of_unix_file_descr
741 let%lwt
(message : 'a
ServerCommandTypes.message_type
) =
742 Marshal_tools_lwt.from_fd_with_preamble
fd
745 | Response _
-> failwith
"unexpected response without request"
747 Lwt.return
(Server_message
{ push
; has_updated_server_state
= false })
748 | Hello
-> Lwt.return Server_hello
749 | Ping
-> failwith
"unexpected ping on persistent connection"
750 | Monitor_failed_to_handoff
->
751 failwith
"unexpected monitor_failed_to_handoff on persistent connection"
754 let e = Exception.wrap
exn in
755 raise
(Server_fatal_connection_exception
(Marshal_tools.of_exception
e))
757 (** get_next_event: picks up the next available message from either client or
758 server. The way it's implemented, at the first character of a message
759 from either client or server, we block until that message is completely
760 received. Note: if server is None (meaning we haven't yet established
761 connection with server) then we'll just block waiting for client. *)
765 (ide_service
: ClientIdeService.t
ref option) : event
Lwt.t
=
767 match (ide_service
, !initialize_params_ref) with
768 | (Some ide_service
, Some
{ Initialize.initializationOptions
; _
})
769 when initializationOptions
.Initialize.delayUntilDoneInit
->
771 match ClientIdeService.get_status
!ide_service
with
772 | ClientIdeService.Status.(Initializing
| Processing_files _
| Rpc _
) ->
774 | ClientIdeService.Status.(Ready
| Stopped _
) -> true
778 let client = Option.some_if
can_use_client client in
779 let from_server (server
: server_conn
) : event
Lwt.t
=
780 if Queue.is_empty server
.pending_messages
then
781 read_message_from_server server
783 Lwt.return
(Server_message
(Queue.dequeue_exn server
.pending_messages
))
785 let from_client (client : Jsonrpc.t
) : event
Lwt.t
=
786 let%lwt
message = Jsonrpc.get_message
client in
788 | `Message
{ Jsonrpc.json
; timestamp
} ->
791 let message = Lsp_fmt.parse_lsp json
get_outstanding_request_exn in
792 let rnd = Random_id.short_string
() in
795 | RequestMessage
(id
, _
) -> rnd ^
"." ^
Lsp_fmt.id_to_string id
798 Lwt.return
(Client_message
({ tracking_id; timestamp
}, message))
801 let e = Exception.wrap
e in
804 Marshal_tools.stack = Exception.get_backtrace_string
e;
805 message = Exception.get_ctor_string
e;
808 raise
(Client_recoverable_connection_exception
edata)
810 | `Fatal_exception
edata -> raise
(Client_fatal_connection_exception
edata)
811 | `Recoverable_exception
edata ->
812 raise
(Client_recoverable_connection_exception
edata)
815 | Main_loop
{ Main_env.conn
; _
}
816 | In_init
{ In_init_env.conn
; _
} ->
817 let%lwt message_source
= get_message_source conn
client ide_service
in
818 (match message_source
with
820 let%lwt
message = from_client (Option.value_exn
client) in
823 let%lwt
message = from_server conn
in
825 | `From_ide_service
message -> Lwt.return
message
826 | `No_source
-> Lwt.return Tick
)
830 let%lwt message_source
= get_client_message_source client ide_service
in
831 (match message_source
with
833 let%lwt
message = from_client (Option.value_exn
client) in
835 | `From_ide_service
message -> Lwt.return
message
836 | `No_source
-> Lwt.return Tick
)
843 let add_powered_by ~
(powered_by
: powered_by
) (json
: Hh_json.json
) :
846 match (json
, powered_by
) with
847 | (JSON_Object props
, Serverless_ide
) ->
848 JSON_Object
(("powered_by", JSON_String
"serverless_ide") :: props
)
852 ~
(powered_by
: powered_by
) (id
: lsp_id
) (result
: lsp_result
) : unit =
853 print_lsp_response id result
|> add_powered_by ~powered_by
|> to_stdout
855 let notify_jsonrpc ~
(powered_by
: powered_by
) (notification
: lsp_notification
)
857 print_lsp_notification notification
|> add_powered_by ~powered_by
|> to_stdout
859 (** respond_to_error: if we threw an exception during the handling of a request,
860 report the exception to the client as the response to their request. *)
861 let respond_to_error (event
: event
option) (e : Lsp.Error.t
) : unit =
862 let result = ErrorResult
e in
864 | Some
(Client_message
(_
, RequestMessage
(id
, _request
))) ->
865 respond_jsonrpc ~powered_by
:Language_server id
result
867 (* We want to report LSP error 'e' over jsonrpc. But jsonrpc only allows
868 errors to be reported in response to requests. So we'll stick the information
869 in a telemetry/event. The format of this event isn't defined. We're going to
870 roll our own, using ad-hoc json fields to emit all the data out of 'e' *)
871 let open Lsp.Error
in
873 ("code", e.code
|> Error.show_code
|> Hh_json.string_
)
874 :: Option.value_map
e.data ~default
:[] ~f
:(fun data -> [("data", data)])
876 Lsp_helpers.telemetry_error
to_stdout e.message ~
extras
878 (** request_showStatusFB: pops up a dialog *)
879 let request_showStatusFB
880 ?
(on_result
: ShowStatusFB.result -> state
-> state
Lwt.t
=
881 (fun _ state
-> Lwt.return state
))
882 ?
(on_error
: Error.t
-> state
-> state
Lwt.t
=
883 (fun _ state
-> Lwt.return state
))
884 (params
: ShowStatusFB.params
) : unit =
885 let initialize_params = initialize_params_exc () in
886 if not
(Lsp_helpers.supports_status
initialize_params) then
889 (* We try not to send duplicate statuses.
890 That means: if you call request_showStatus but your message is the same as
891 what's already up, then you won't be shown, and your callbacks won't be shown. *)
892 let msg = params
.ShowStatusFB.request
.ShowMessageRequest.message in
893 if String.equal
msg !showStatus_outstanding then
896 showStatus_outstanding := msg;
897 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
898 let request = ShowStatusRequestFB params
in
899 to_stdout (print_lsp_request
id request);
901 let handler (result : lsp_result
) (state
: state
) : state
Lwt.t
=
902 if String.equal
msg !showStatus_outstanding then
903 showStatus_outstanding := "";
905 | ShowStatusResultFB
result -> on_result
result state
906 | ErrorResult error
-> on_error error state
910 Error.code
= Error.ParseError
;
911 message = "expected ShowStatusResult";
917 requests_outstanding :=
918 IdMap.add
id (request, handler) !requests_outstanding
921 (** request_showMessage: pops up a dialog *)
922 let request_showMessage
923 (on_result
: ShowMessageRequest.result -> state
-> state
Lwt.t
)
924 (on_error
: Error.t
-> state
-> state
Lwt.t
)
925 (type_
: MessageType.t
)
927 (titles
: string list
) : ShowMessageRequest.t
=
928 (* send the request *)
929 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
931 List.map titles ~f
:(fun title
-> { ShowMessageRequest.title
})
934 ShowMessageRequestRequest
{ ShowMessageRequest.type_
; message; actions }
936 to_stdout (print_lsp_request
id request);
938 let handler (result : lsp_result
) (state
: state
) : state
Lwt.t
=
940 | ShowMessageRequestResult
result -> on_result
result state
941 | ErrorResult
error -> on_error
error state
945 Error.code
= Error.ParseError
;
946 message = "expected ShowMessageRequestResult";
952 requests_outstanding := IdMap.add
id (request, handler) !requests_outstanding;
955 ShowMessageRequest.Present
{ id }
957 (** dismiss_showMessageRequest: sends a cancellation-request for the dialog *)
958 let dismiss_showMessageRequest (dialog
: ShowMessageRequest.t
) :
959 ShowMessageRequest.t
=
962 | ShowMessageRequest.Absent
-> ()
963 | ShowMessageRequest.Present
{ id; _
} ->
964 let notification = CancelRequestNotification
{ CancelRequest.id } in
965 let json = Lsp_fmt.print_lsp
(NotificationMessage
notification) in
968 ShowMessageRequest.Absent
970 (** These functions are not currently used, but may be useful in the future. *)
971 let (_
: 'a
-> 'b
) = request_showMessage
973 and (_
: 'c
-> 'd
) = dismiss_showMessageRequest
975 (** Dismiss all diagnostics from a state,
976 both the error diagnostics in Main_loop and the hh_server_status
977 diagnostics in In_init and Lost_server. *)
978 let dismiss_diagnostics (state
: state
) : state
=
979 let dismiss_one ~isStatusFB uri
=
980 let params = { PublishDiagnostics.uri
; diagnostics
= []; isStatusFB
} in
981 let notification = PublishDiagnosticsNotification
params in
982 notification |> print_lsp_notification
|> to_stdout
984 let dismiss_status diagnostic
=
985 dismiss_one ~isStatusFB
:true diagnostic
.PublishDiagnostics.uri
989 let open In_init_env
in
990 Option.iter ienv
.hh_server_status_diagnostic ~f
:dismiss_status;
991 In_init
{ ienv
with hh_server_status_diagnostic
= None
}
994 UriSet.iter
(dismiss_one ~isStatusFB
:false) menv
.uris_with_diagnostics
;
995 Main_loop
{ menv
with uris_with_diagnostics
= UriSet.empty
}
996 | Lost_server lenv
->
998 Option.iter lenv
.hh_server_status_diagnostic ~f
:dismiss_status;
999 Lost_server
{ lenv
with hh_server_status_diagnostic
= None
}
1000 | Pre_init
-> Pre_init
1001 | Post_shutdown
-> Post_shutdown
1003 (************************************************************************)
1004 (* Conversions - ad-hoc ones written as needed them, not systematic *)
1005 (************************************************************************)
1007 let lsp_uri_to_path = Lsp_helpers.lsp_uri_to_path
1009 let path_to_lsp_uri = Lsp_helpers.path_to_lsp_uri
1011 let lsp_position_to_ide (position
: Lsp.position
) : Ide_api_types.position
=
1012 { Ide_api_types.line
= position
.line
+ 1; column
= position
.character
+ 1 }
1014 let lsp_file_position_to_hack (params : Lsp.TextDocumentPositionParams.t
) :
1015 string * int * int =
1016 let open Lsp.TextDocumentPositionParams
in
1017 let { Ide_api_types.line
; column
} = lsp_position_to_ide params.position
in
1019 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
params.textDocument
1021 (filename, line
, column
)
1023 let rename_params_to_document_position (params : Lsp.Rename.params) :
1024 Lsp.TextDocumentPositionParams.t
=
1027 TextDocumentPositionParams.textDocument
= params.textDocument
;
1028 position
= params.position
;
1031 let hack_pos_to_lsp_range ~
(equal
: 'a
-> 'a
-> bool) (pos
: 'a
Pos.pos
) :
1033 (* .hhconfig errors are Positions with a filename, but dummy start/end
1034 * positions. Handle that case - and Pos.none - specially, as the LSP
1035 * specification requires line and character >= 0, and VSCode silently
1036 * drops diagnostics that violate the spec in this way *)
1037 if Pos.equal_pos equal pos
(Pos.make_from
(Pos.filename pos
)) then
1038 { start
= { line
= 0; character
= 0 }; end_
= { line
= 0; character
= 0 } }
1040 let (line1
, col1
, line2
, col2
) = Pos.destruct_range pos
in
1042 start
= { line
= line1
- 1; character
= col1
- 1 };
1043 end_
= { line
= line2
- 1; character
= col2
- 1 };
1046 let hack_pos_to_lsp_location (pos
: Pos.absolute
) ~
(default_path
: string) :
1050 uri
= path_to_lsp_uri (Pos.filename pos
) ~default_path
;
1051 range
= hack_pos_to_lsp_range ~equal
:String.equal pos
;
1054 let ide_range_to_lsp (range
: Ide_api_types.range
) : Lsp.range
=
1058 Lsp.line
= range
.Ide_api_types.st
.Ide_api_types.line
- 1;
1059 character
= range
.Ide_api_types.st
.Ide_api_types.column
- 1;
1063 Lsp.line
= range
.Ide_api_types.ed
.Ide_api_types.line
- 1;
1064 character
= range
.Ide_api_types.ed
.Ide_api_types.column
- 1;
1068 let lsp_range_to_ide (range
: Lsp.range
) : Ide_api_types.range
=
1071 st
= lsp_position_to_ide range
.start
;
1072 ed
= lsp_position_to_ide range
.end_
;
1075 let hack_symbol_definition_to_lsp_construct_location
1076 (symbol
: string SymbolDefinition.t
) ~
(default_path
: string) :
1078 let open SymbolDefinition
in
1079 hack_pos_to_lsp_location symbol
.span ~default_path
1081 let hack_pos_definition_to_lsp_identifier_location
1082 (sid
: Pos.absolute
* string) ~
(default_path
: string) :
1083 Lsp.DefinitionLocation.t
=
1084 let (pos
, title
) = sid
in
1085 let location = hack_pos_to_lsp_location pos ~default_path
in
1086 Lsp.DefinitionLocation.{ location; title
= Some title
}
1088 let hack_symbol_definition_to_lsp_identifier_location
1089 (symbol
: string SymbolDefinition.t
) ~
(default_path
: string) :
1090 Lsp.DefinitionLocation.t
=
1091 let open SymbolDefinition
in
1092 let location = hack_pos_to_lsp_location symbol
.pos ~default_path
in
1093 Lsp.DefinitionLocation.
1096 title
= Some
(Utils.strip_ns symbol
.SymbolDefinition.full_name
);
1099 let hack_errors_to_lsp_diagnostic
1100 (filename : string) (errors
: Errors.finalized_error list
) :
1101 PublishDiagnostics.params =
1102 let open Lsp.Location
in
1103 let location_message (message : Pos.absolute
* string) :
1104 Lsp.Location.t
* string =
1105 let (pos
, message) = message in
1106 let { uri
; range
} = hack_pos_to_lsp_location pos ~default_path
:filename in
1107 ({ Location.uri
; range
}, Markdown_lite.render
message)
1109 let hack_error_to_lsp_diagnostic (error : Errors.finalized_error
) =
1111 User_error.to_list
error |> List.map ~f
:location_message
1113 let (first_message
, additional_messages
) =
1114 match all_messages with
1115 | hd
:: tl
-> (hd
, tl
)
1116 | [] -> failwith
"Expected at least one error in the error list"
1121 (* This is the file of the first message of the error which is supposed to correspond to [filename] *)
1127 let relatedInformation =
1129 |> List.map ~f
:(fun (location, message) ->
1131 PublishDiagnostics.relatedLocation
= location;
1132 relatedMessage
= message;
1137 match get_severity
error with
1138 | Error
-> Some
PublishDiagnostics.Error
1139 | Warning
-> Some
PublishDiagnostics.Warning
)
1142 Lsp.PublishDiagnostics.range
;
1144 code
= PublishDiagnostics.IntCode
(User_error.get_code
error);
1145 source
= Some
"Hack";
1148 relatedLocations
= relatedInformation (* legacy FB extension *);
1151 (* The caller is required to give us a non-empty filename. If it is empty,
1152 the following path_to_lsp_uri will fall back to the default path - which
1153 is also empty - and throw, logging appropriate telemetry. *)
1155 Lsp.PublishDiagnostics.uri
= path_to_lsp_uri filename ~default_path
:"";
1157 diagnostics
= List.map errors ~f
:hack_error_to_lsp_diagnostic;
1160 let get_document_contents
1161 (editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
) (uri
: documentUri
) :
1163 match UriMap.find_opt uri editor_open_files
with
1164 | Some document
-> Some document
.TextDocumentItem.text
1167 let get_document_location
1168 (editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
)
1169 (params : Lsp.TextDocumentPositionParams.t
) :
1170 ClientIdeMessage.document_location
=
1171 let (file_path
, line
, column
) = lsp_file_position_to_hack params in
1173 params.TextDocumentPositionParams.textDocument
.TextDocumentIdentifier.uri
1175 let file_path = Path.make
file_path in
1176 let file_contents = get_document_contents editor_open_files
uri in
1177 { ClientIdeMessage.file_path; file_contents; line
; column
}
1179 (************************************************************************)
1180 (* Connection and rpc *)
1181 (************************************************************************)
1183 let start_server ~
(env
: env
) (root
: Path.t
) : unit =
1184 (* This basically does "hh_client start": a single attempt to open the *)
1185 (* socket, send+read version and compare for mismatch, send handoff and *)
1186 (* read response. It will print information to stderr. If the server is in *)
1187 (* an unresponsive or invalid state then it will kill the server. Next if *)
1188 (* necessary it tries to spawn the server and wait until the monitor is *)
1189 (* responsive enough to print "ready". It will do a hard program exit if *)
1190 (* there were spawn problems. *)
1196 watchman_debug_logging
= false;
1197 log_inference_constraints
= false;
1200 exit_on_failure
= false;
1201 ignore_hh_version
= false;
1202 saved_state_ignore_hhconfig
= false;
1205 save_human_readable_64bit_dep_map
= None
;
1207 config
= env
.args
.config
;
1208 custom_hhi_path
= None
;
1209 custom_telemetry_data
= [];
1210 allow_non_opt_build
= false;
1213 let _exit_status = ClientStart.main
env_start in
1216 let rec connect_client ~
(env
: env
) (root
: Path.t
) ~
(autostart
: bool) :
1218 log "connect_client";
1219 (* This basically does the same connection attempt as "hh_client check":
1220 * it makes repeated attempts to connect; it prints useful messages to
1221 * stderr; in case of failure it will raise an exception. Below we're
1222 * catching the main exceptions so we can give a good user-facing error
1223 * text. For other exceptions, they'll end up showing to the user just
1224 * "internal error" with the error code. *)
1230 local_config
= get_local_config_exn ();
1231 force_dormant_start
= false;
1232 watchman_debug_logging
= false;
1233 (* If you want this, start the server manually in terminal. *)
1234 deadline
= Some
(Unix.time
() +. 3.);
1235 (* limit to 3 seconds *)
1237 (* only relevant when autostart=true *)
1238 log_inference_constraints
= false;
1240 log_on_slow_monitor_connect
= false;
1241 (* Only used when running hh from terminal *)
1245 (* only relevant when autostart=true *)
1246 progress_callback
= None
;
1248 do_post_handoff_handshake
= false;
1249 ignore_hh_version
= false;
1250 saved_state_ignore_hhconfig
= false;
1253 save_human_readable_64bit_dep_map
= None
;
1254 (* priority_pipe delivers good experience for hh_server, but has a bug,
1255 and doesn't provide benefits in serverless-ide. *)
1256 use_priority_pipe
= not env
.use_serverless_ide
;
1258 config
= env
.args
.config
;
1259 custom_hhi_path
= None
;
1260 custom_telemetry_data
= [];
1261 allow_non_opt_build
= false;
1265 let%lwt
ClientConnect.{ channels
= (ic
, oc
); server_specific_files
; _
} =
1266 ClientConnect.connect
env_connect
1268 can_autostart_after_mismatch := false;
1269 let pending_messages = Queue.create
() in
1270 Lwt.return
{ ic
; oc
; pending_messages; server_specific_files
}
1272 | Exit_status.Exit_with
Exit_status.Build_id_mismatch
1273 when !can_autostart_after_mismatch ->
1274 (* Raised when the server was running an old version. We'll retry once. *)
1275 log "connect_client: build_id_mismatch";
1276 can_autostart_after_mismatch := false;
1277 connect_client ~env root ~autostart
:true
1279 (** Either connect to the monitor and leave in an
1280 In_init state waiting for the server hello, or fail to connect and
1281 leave in a Lost_server state. You might call this from Pre_init or
1282 Lost_server states, obviously. But you can also call it from In_init state
1283 if you want to give up on the prior attempt at connection and try again. *)
1284 let rec connect ~
(env
: env
) (state
: state
) : state
Lwt.t
=
1287 | In_init
{ In_init_env.conn
; _
} ->
1290 Timeout.shutdown_connection conn
.ic
;
1291 Timeout.close_in_noerr conn
.ic
1298 | _
-> failwith
"connect only in Pre_init, In_init or Lost_server state"
1301 let%lwt conn
= connect_client ~env
(get_root_exn ()) ~autostart
:false in
1302 set_hh_server_state Hh_server_initializing
;
1307 { ienv
with In_init_env.conn
; most_recent_start_time
= Unix.time
() })
1309 let state = dismiss_diagnostics state in
1314 first_start_time
= Unix.time
();
1315 most_recent_start_time
= Unix.time
();
1316 most_recent_file
= get_most_recent_file state;
1318 Option.value (get_editor_open_files state) ~default
:UriMap.empty
;
1319 (* uris_with_unsaved_changes should always be empty here: *)
1320 (* Pre_init will of course be empty; *)
1321 (* Lost_server will exit rather than reconnect with unsaved changes. *)
1322 uris_with_unsaved_changes
= get_uris_with_unsaved_changes state;
1323 hh_server_status_diagnostic
= None
;
1327 let exn = Exception.wrap
exn in
1328 (* Exit_with Out_of_retries, Exit_with Out_of_time: raised when we *)
1329 (* couldn't complete the handshake up to handoff within 3 attempts over *)
1330 (* 3 seconds. Maybe the informant is stopping anything from happening *)
1331 (* until a rebase has settled? *)
1332 (* Exit_with No_server_running: raised when (1) the server's simply not *)
1333 (* running, or there's some other reason why the connection was refused *)
1334 (* or timed-out and no lockfile is present; (2) the server was dormant *)
1335 (* and had already received too many pending connection requests; *)
1336 (* (3) server failed to load saved-state but was required to do so. *)
1337 (* Exit_with Monitor_connection_failure: raised when the lockfile is *)
1338 (* present but connection-attempt to the monitor times out - maybe it's *)
1339 (* under DDOS, or maybe it's declining to answer new connections. *)
1341 match Exception.unwrap
exn with
1342 | Exit_status.Exit_with code
-> Exit_status.show code
1343 | _
-> Exception.get_ctor_string
exn
1347 "connect failed: %s\n%s"
1349 (Exception.get_backtrace_string
exn |> Exception.clean_stack
)
1351 let () = Lsp_helpers.telemetry_error
to_stdout longMessage in
1352 let open Exit_status
in
1353 let new_hh_server_state =
1354 match Exception.unwrap
exn with
1355 | Exit_with Build_id_mismatch
1356 | Exit_with No_server_running_should_retry
1357 | Exit_with Server_hung_up_should_retry
1358 | Exit_with Server_hung_up_should_abort
->
1360 | Exit_with Out_of_retries
1361 | Exit_with Out_of_time
->
1362 Hh_server_denying_connection
1363 | _
-> Hh_server_unknown
1366 match Exception.unwrap
exn with
1367 | Exit_with Out_of_retries
1368 | Exit_with Out_of_time
->
1369 "hh_server is waiting for things to settle"
1370 | Exit_with No_server_running_should_retry
-> "hh_server: stopped."
1371 | _
-> "hh_server: " ^
message
1376 ~allow_immediate_reconnect
:false
1379 Lost_env.explanation;
1380 new_hh_server_state;
1381 start_on_click
= true;
1382 trigger_on_lock_file
= true;
1383 trigger_on_lsp
= false;
1388 and reconnect_from_lost_if_necessary
1389 ~
(env
: env
) (state : state) (reason
: [> `Event
of event
| `Force_regain
])
1392 let should_reconnect =
1393 match (state, reason
) with
1394 | (Lost_server _
, `Force_regain
) -> true
1395 | ( Lost_server
{ p
= { trigger_on_lsp
= true; _
}; _
},
1396 `Event
(Client_message
(_
, RequestMessage _
)) ) ->
1398 | ( Lost_server
{ p
= { trigger_on_lock_file
= true; _
}; lock_file
; _
},
1400 MonitorConnection.server_exists lock_file
1403 if should_reconnect then
1404 let%lwt current_version_and_switch
=
1405 read_hhconfig_version_and_switch ()
1407 let needs_to_terminate =
1409 (String.equal
!hhconfig_version_and_switch current_version_and_switch
)
1411 if needs_to_terminate then (
1412 (* In these cases we have to terminate our LSP server, and trust the *)
1413 (* client to restart us. Note that we can't do clientStart because that *)
1414 (* would start our (old) version of hh_server, not the new one! *)
1415 let unsaved = get_uris_with_unsaved_changes state |> UriSet.elements
in
1417 if List.is_empty
unsaved then
1420 unsaved |> List.map ~f
:string_of_uri
|> String.concat ~sep
:"\n"
1425 ^
"\nVersion in hhconfig and switch that spawned the current hh_client: "
1426 ^
!hhconfig_version_and_switch
1427 ^
"\nVersion in hhconfig and switch currently: "
1428 ^ current_version_and_switch
1431 Lsp_helpers.telemetry_log
to_stdout message;
1434 let%lwt
state = connect ~env
state in
1439 (* do_lost_server: handles the various ways we might lose hh_server. We keep *)
1440 (* the LSP server alive, and will (elsewhere) listen for the various triggers *)
1441 (* of getting the server back. *)
1445 ?
(allow_immediate_reconnect
= true)
1446 (p
: Lost_env.params) : state Lwt.t
=
1448 set_hh_server_state p
.new_hh_server_state;
1450 let state = dismiss_diagnostics state in
1451 let uris_with_unsaved_changes = get_uris_with_unsaved_changes state in
1452 let most_recent_file = get_most_recent_file state in
1453 let editor_open_files =
1454 Option.value (get_editor_open_files state) ~default
:UriMap.empty
1456 let lock_file = ServerFiles.lock_file (get_root_exn ()) in
1457 let reconnect_immediately =
1458 allow_immediate_reconnect
1459 && p
.trigger_on_lock_file
1460 && MonitorConnection.server_exists
lock_file
1462 if reconnect_immediately then (
1469 uris_with_unsaved_changes;
1471 hh_server_status_diagnostic
= None
;
1474 Lsp_helpers.telemetry_log
1476 "Reconnecting immediately to hh_server";
1478 reconnect_from_lost_if_necessary ~env
lost_state `Force_regain
1480 Lwt.return new_state
1488 uris_with_unsaved_changes;
1490 hh_server_status_diagnostic
= None
;
1493 let report_connect_end (ienv
: In_init_env.t
) : state =
1494 log "report_connect_end";
1496 let _state = dismiss_diagnostics (In_init ienv
) in
1499 Main_env.conn
= ienv
.In_init_env.conn
;
1501 most_recent_file = ienv
.most_recent_file;
1502 editor_open_files = ienv
.editor_open_files;
1503 uris_with_diagnostics
= UriSet.empty
;
1504 uris_with_unsaved_changes = ienv
.In_init_env.uris_with_unsaved_changes;
1507 ShowStatusFB.request =
1509 ShowMessageRequest.type_
= MessageType.InfoMessage
;
1510 message = "hh_server: ready.";
1515 shortMessage
= None
;
1522 let announce_ide_failure (error_data
: ClientIdeMessage.stopped_reason
) :
1524 let open ClientIdeMessage
in
1526 "IDE services could not be initialized.\n%s\n%s"
1527 error_data
.long_user_message
1528 error_data
.debug_details
;
1533 error_data
.long_user_message
1534 error_data
.debug_details
1536 let%lwt upload_result
=
1537 Clowder_paste.clowder_upload_and_get_url ~timeout
:10. input
1540 match upload_result
with
1541 | Ok url
-> Printf.sprintf
"\nMore details: %s" url
1544 "\n\nMore details:\n%s\n\nTried to upload those details but it didn't work...\n%s"
1545 error_data
.debug_details
1548 Lsp_helpers.log_error to_stdout (error_data
.long_user_message ^
append_to_log);
1549 if error_data
.is_actionable
then
1550 Lsp_helpers.showMessage_error
1552 (error_data
.medium_user_message ^
see_output_hack);
1555 (** Like all async methods, this method has a synchronous preamble up
1556 to its first await point, at which point it returns a promise to its
1557 caller; the rest of the method will be scheduled asynchronously.
1558 The synchronous preamble sends an "initialize" request to the ide_service.
1559 The asynchronous continuation is triggered when the response comes back;
1560 it then pumps messages to and from the ide service.
1561 Note: the fact that the request is sent in the synchronous preamble, is
1562 important for correctness - the rest of the codebase can send other requests
1563 to the ide_service at any time, safe in the knowledge that such requests will
1564 necessarily be delivered after the initialize request. *)
1567 (ide_service
: ClientIdeService.t
)
1568 (initialize_params : Lsp.Initialize.params)
1569 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
option) : unit Lwt.t
=
1570 let open Lsp.Initialize
in
1571 let root = Some
(Lsp_helpers.get_root
initialize_params) |> Wwwroot.get
in
1574 initialize_params.client_capabilities
.workspace
.didChangeWatchedFiles
1575 .dynamicRegistration
1577 log_error "client doesn't support file-watching";
1579 let naming_table_load_info =
1580 match initialize_params.initializationOptions
.namingTableSavedStatePath
with
1585 ClientIdeMessage.Initialize_from_saved_state.path = Path.make
path;
1587 initialize_params.initializationOptions
1588 .namingTableSavedStateTestDelay
;
1593 |> Option.value ~default
:UriMap.empty
1595 |> List.map ~f
:(fun uri -> uri |> lsp_uri_to_path |> Path.make
)
1597 log_debug "initialize_from_saved_state";
1599 ClientIdeService.initialize_from_saved_state
1602 ~
naming_table_load_info
1603 ~use_ranked_autocomplete
:env
.use_ranked_autocomplete
1604 ~config
:env
.args
.config
1607 log_debug "initialize_from_saved_state.done";
1610 let%lwt
() = ClientIdeService.serve ide_service
in
1612 | Error error_data
->
1613 let%lwt
() = announce_ide_failure error_data
in
1616 let stop_ide_service
1617 (ide_service
: ClientIdeService.t
)
1618 ~
(tracking_id : string)
1619 ~
(stop_reason
: ClientIdeService.Stop_reason.t
) : unit Lwt.t
=
1621 "Stopping IDE service process: %s"
1622 (ClientIdeService.Stop_reason.to_log_string stop_reason
);
1624 ClientIdeService.stop ide_service ~
tracking_id ~stop_reason ~
exn:None
1628 let on_status_restart_action
1630 ~
(ide_service
: ClientIdeService.t
ref option)
1631 (result : ShowStatusFB.result)
1632 (state : state) : state Lwt.t
=
1633 let open ShowMessageRequest
in
1634 match (result, state, ide_service
) with
1635 | (Some
{ title
}, Lost_server _
, _
)
1636 when String.equal title
hh_server_restart_button_text ->
1637 let root = get_root_exn () in
1638 (* Belt-and-braces kill the server. This is in case the server was *)
1639 (* stuck in some weird state. It's also what 'hh restart' does. *)
1640 if MonitorConnection.server_exists
(Path.to_string
root) then
1641 ClientStop.kill_server
root !from;
1643 (* After that it's safe to try to reconnect! *)
1644 start_server ~env
root;
1645 let%lwt
state = reconnect_from_lost_if_necessary ~env
state `Force_regain
in
1647 | (Some
{ title
}, _
, Some ide_service
)
1648 when String.equal title
client_ide_restart_button_text ->
1649 log "Restarting IDE service";
1651 (* It's possible that [destroy] takes a while to finish, so make
1652 sure to assign the new IDE service to the [ref] before attempting
1653 to do an asynchronous operation with the old one. *)
1656 ClientIdeMessage.init_id
= env
.init_id
;
1657 verbose_to_stderr
= env
.args
.verbose
;
1658 verbose_to_file = !verbose_to_file;
1661 let new_ide_service = ClientIdeService.make
ide_args in
1662 let old_ide_service = !ide_service
in
1663 ide_service
:= new_ide_service;
1664 (* Note: the env.verbose passed on init controls verbosity for stderr
1665 and is only ever controlled by --verbose command line, stored in env.
1666 But verbosity-to-file can be altered dynamically by the user. *)
1667 let (promise
: unit Lwt.t
) =
1671 (initialize_params_exc ())
1672 (get_editor_open_files state)
1674 ignore_promise_but_handle_failure
1676 ~desc
:"run-ide-after-restart"
1677 ~terminate_on_failure
:true;
1678 (* Invariant: at all times after InitializeRequest, ide_service has
1679 already been sent an "initialize" message. *)
1683 ~
tracking_id:"restart"
1684 ~stop_reason
:ClientIdeService.Stop_reason.Restarting
1687 | _
-> Lwt.return
state
1689 let get_client_ide_status (ide_service
: ClientIdeService.t
) :
1690 ShowStatusFB.params option =
1691 let (type_
, shortMessage
, message, actions, telemetry
) =
1692 match ClientIdeService.get_status ide_service
with
1693 | ClientIdeService.Status.Initializing
->
1694 ( MessageType.WarningMessage
,
1695 "Hack: initializing",
1696 "Hack IDE: initializing.",
1699 | ClientIdeService.Status.Processing_files p
->
1700 let open ClientIdeMessage.Processing_files
in
1701 ( MessageType.WarningMessage
,
1703 Printf.sprintf
"Hack IDE: processing %d files." p
.total
,
1706 | ClientIdeService.Status.Rpc requests
->
1708 Hh_json.JSON_Array
(List.map requests ~f
:Telemetry.to_json
)
1710 ( MessageType.WarningMessage
,
1712 "Hack IDE: working...",
1715 | ClientIdeService.Status.Ready
->
1716 (MessageType.InfoMessage
, "Hack: ready", "Hack IDE: ready.", [], None
)
1717 | ClientIdeService.Status.Stopped
s ->
1718 let open ClientIdeMessage
in
1719 ( MessageType.ErrorMessage
,
1720 "Hack: " ^
s.short_user_message
,
1721 s.medium_user_message ^
see_output_hack,
1722 [{ ShowMessageRequest.title
= client_ide_restart_button_text }],
1727 ShowStatusFB.shortMessage
= Some shortMessage
;
1728 request = { ShowMessageRequest.type_
; message; actions };
1734 (** This function blocks while it attempts to connect to the monitor to read status.
1735 It normally it gets status quickly, but has a 3s timeout just in case. *)
1736 let get_hh_server_status (state : state) : ShowStatusFB.params option =
1737 let open ShowStatusFB
in
1738 let open ShowMessageRequest
in
1744 let open In_init_env
in
1745 let time = Unix.time () in
1747 if Sys_utils.deterministic_behavior_for_tests
() then
1748 (* we avoid raciness in our tests by not showing a real time *)
1751 int_of_float
(time -. ienv
.first_start_time
) |> string_of_int
1753 (* TODO: better to report time that hh_server has spent initializing *)
1754 let (progress
, warning
) =
1755 let open ServerCommandTypes
in
1757 | In_init
{ In_init_env.conn
; _
}
1758 | Main_loop
{ Main_env.conn
; _
} ->
1759 let server_progress_file =
1760 conn
.server_specific_files
.ServerCommandTypes.server_progress_file
1762 let server_progress =
1763 ServerCommandTypesUtils.read_progress_file ~
server_progress_file
1765 (server_progress.server_progress, server_progress.server_warning
)
1766 | _
-> ("connecting", None
)
1768 (* [progress] comes from ServerProgress.ml, sent to the monitor, and now we've fetched
1769 it from the monitor. It's a string "op X/Y units (%)" e.g. "typechecking 5/16 files (78%)",
1770 or "connecting", if there is no relevant progress to show.
1771 [warning] comes from the same place, and if pressent is a human-readable string
1772 that warns about saved-state-init failure. *)
1774 if Option.is_some
warning then
1775 " (saved-state not found - will take a while)"
1781 "hh_server initializing%s: %s [%s seconds]"
1788 request = { type_
= MessageType.WarningMessage
; message; actions = [] };
1791 shortMessage
= Some
"Hack: initializing";
1794 | Main_loop
{ Main_env.hh_server_status
; _
} ->
1795 (* This shows whether the connected hh_server is busy or ready.
1796 It's produced in clientLsp.do_server_busy upon receipt of a status
1797 enum from the server. See comments on hh_server_status for invariants. *)
1798 Some hh_server_status
1799 | Lost_server
{ Lost_env.p
; _
} ->
1802 shortMessage
= Some
"Hack: stopped";
1805 type_
= MessageType.ErrorMessage
;
1806 message = p
.Lost_env.explanation;
1807 actions = [{ title
= hh_server_restart_button_text }];
1814 (** Makes a diagnostic messages for cases where the server status is not fully running. *)
1815 let hh_server_status_to_diagnostic
1816 (uri : documentUri
option) (hh_server_status
: ShowStatusFB.params) :
1817 PublishDiagnostics.params option =
1818 let open ShowStatusFB
in
1819 let open ShowMessageRequest
in
1820 let open PublishDiagnostics
in
1823 PublishDiagnostics.range
=
1825 start
= { line
= 0; character
= 0 };
1826 end_
= { line
= 0; character
= 1 };
1830 source
= Some
"hh_server";
1832 relatedInformation = [];
1833 relatedLocations
= [];
1836 match (uri, hh_server_status
.request.type_
) with
1838 | (_
, (MessageType.InfoMessage
| MessageType.LogMessage
)) ->
1840 | (Some
uri, MessageType.ErrorMessage
) ->
1850 "hh_server isn't running, so there may be undetected errors. Try `hh` at the command line... "
1851 ^ hh_server_status
.request.message;
1852 severity = Some Error
;
1856 | (Some
uri, MessageType.WarningMessage
) ->
1866 "hh_server isn't yet ready, so there may be undetected errors... "
1867 ^ hh_server_status
.request.message;
1868 severity = Some Warning
;
1873 (** Manage the state of which diagnostics have been shown to the user
1874 about hh_server status: removes the old one if necessary, and adds a new one
1875 if necessary. Note that we only display hh_server_status diagnostics
1876 during In_init and Lost_server states, neither of which have diagnostics
1878 let publish_hh_server_status_diagnostic
1879 (state : state) (hh_server_status
: ShowStatusFB.params option) : state =
1881 match (get_most_recent_file state, get_editor_open_files state) with
1882 | (Some
uri, Some
open_files) when UriMap.mem
uri open_files -> Some
uri
1883 | (_
, Some
open_files) when not
(UriMap.is_empty
open_files) ->
1884 Some
(UriMap.choose
open_files |> fst
)
1887 let desired_diagnostic =
1888 Option.bind hh_server_status ~f
:(hh_server_status_to_diagnostic uri)
1890 let get_existing_diagnostic state =
1892 | In_init ienv
-> ienv
.In_init_env.hh_server_status_diagnostic
1893 | Lost_server lenv
-> lenv
.Lost_env.hh_server_status_diagnostic
1896 let publish_and_update_diagnostic state diagnostic =
1897 let notification = PublishDiagnosticsNotification
diagnostic in
1898 notification |> print_lsp_notification
|> to_stdout;
1902 { ienv
with In_init_env.hh_server_status_diagnostic
= Some
diagnostic }
1903 | Lost_server lenv
->
1905 { lenv
with Lost_env.hh_server_status_diagnostic
= Some
diagnostic }
1908 let open PublishDiagnostics
in
1909 (* The following match emboodies these rules:
1910 (1) we only publish hh_server_status diagnostics in In_init and Lost_server states,
1911 (2) we'll remove the old PublishDiagnostic if necessary and add a new one if necessary
1912 (3) to avoid extra LSP messages, if the diagnostic hasn't changed then we won't send anything
1913 (4) to avoid flicker, if the diagnostic has changed but is still in the same file, then
1914 we refrain from sending an "erase old" message and it will be implied by sending "new". *)
1915 match (get_existing_diagnostic state, desired_diagnostic, state) with
1916 | (_
, _
, Main_loop _
)
1918 | (_
, _
, Post_shutdown
)
1919 | (None
, None
, _
) ->
1921 | (Some _
, None
, _
) -> dismiss_diagnostics state
1922 | (Some existing
, Some desired
, _
)
1923 when Lsp.equal_documentUri existing
.uri desired
.uri
1925 PublishDiagnostics.equal_diagnostic
1926 (List.hd existing
.diagnostics
)
1927 (List.hd desired
.diagnostics
) ->
1929 | (Some existing
, Some desired
, _
)
1930 when Lsp.equal_documentUri existing
.uri desired
.uri ->
1931 publish_and_update_diagnostic state desired
1932 | (Some _
, Some desired
, _
) ->
1933 let state = dismiss_diagnostics state in
1934 publish_and_update_diagnostic state desired
1935 | (None
, Some desired
, _
) -> publish_and_update_diagnostic state desired
1937 (** Here are the rules for merging status. They embody the principle that the spinner
1938 shows if initializing/typechecking is in progress, the error icon shows if error,
1939 and the status bar word is "Hack" if IDE services are available or "Hack: xyz" if not.
1940 Note that if Hack IDE is up but hh_server is down, then the hh_server failure message
1941 is conveyed via a publishDiagnostic; it's not conveyed via status.
1942 [ok] Hack -- if ide_service is up and hh_server is ready
1943 [spin] Hack -- if ide_service is processing-files or hh_server is initializing/typechecking
1944 [spin] Hack: initializing -- if ide_service is initializing
1945 [err] Hack: failure -- if ide_service is down
1946 If client_ide_service isn't enabled, then we show thing differently:
1947 [ok] Hack -- if hh_server is ready (Main_loop)
1948 [spin] Hack -- if hh_server is doing local or global typechecks (Main_loop)
1949 [spin] Hack: busy -- if hh_server is doing non-interruptible typechecks (Main_loop)
1950 [spin] Hack: initializing -- if hh_server is initializing (In_init)
1951 [err] hh_server: stopped -- hh_server is down (Lost_server)
1952 As for the tooltip and actions, they are combined from both ide_service and hh_server. *)
1954 ~
(client_ide_status
: ShowStatusFB.params option)
1955 ~
(hh_server_status
: ShowStatusFB.params option) :
1956 ShowStatusFB.params option =
1957 (* The correctness of the following match is a bit subtle. This is how to think of it.
1958 From the spec in the docblock, (1) if there's no client_ide_service, then the result
1959 of this function is simply the same as hh_server_status, since that's how it was constructed
1960 by get_hh_server_status (for In_init and Lost_server) and do_server_busy; (2) if there
1961 is a client_ide_service then the result is almost always simply the same as ide_service
1962 since that's how it was constructed by get_client_ide_status; (3) the only exception to
1963 rule 2 is that, if client_ide_status would have shown "[ok] Hack" and hh_server_status
1964 would have been a spinner, then we change to "[spin] Hack". *)
1965 match (client_ide_status
, hh_server_status
) with
1966 | (None
, None
) -> None
1967 | (None
, Some _
) -> hh_server_status
1968 | (Some _
, None
) -> client_ide_status
1969 | (Some client_ide_status
, Some hh_server_status
) ->
1970 let open Lsp.ShowStatusFB
in
1971 let open Lsp.ShowMessageRequest
in
1974 client_ide_status
.request with
1976 client_ide_status
.request.message
1978 ^ hh_server_status
.request.message;
1980 client_ide_status
.request.actions @ hh_server_status
.request.actions;
1984 MessageType.equal client_ide_status
.request.type_
MessageType.InfoMessage
1985 && MessageType.equal
1986 hh_server_status
.request.type_
1987 MessageType.WarningMessage
1989 let request = { request with type_
= MessageType.WarningMessage
} in
1990 Some
{ client_ide_status
with request; shortMessage
= Some
"Hack" }
1992 Some
{ client_ide_status
with request }
1994 let refresh_status ~
(env
: env
) ~
(ide_service
: ClientIdeService.t
ref option) :
1996 let client_ide_status =
1997 match ide_service
with
1999 | Some ide_service
-> get_client_ide_status !ide_service
2002 merge_statuses ~hh_server_status
:!latest_hh_server_status ~
client_ide_status
2007 (request_showStatusFB
2008 ~on_result
:(on_status_restart_action ~env ~ide_service
));
2011 let rpc_lock = Lwt_mutex.create
()
2014 (server_conn
: server_conn
)
2015 (ref_unblocked_time
: float ref)
2017 (command
: 'a
ServerCommandTypes.t
) : 'a
Lwt.t
=
2019 Lwt_mutex.with_lock
rpc_lock (fun () ->
2020 let callback () push
=
2021 update_hh_server_state_if_necessary
2022 (Server_message
{ push
; has_updated_server_state
= false });
2024 server_conn
.pending_messages
2025 { push
; has_updated_server_state
= true }
2027 let start_time = Unix.gettimeofday
() in
2029 ServerCommandLwt.rpc_persistent
2030 (server_conn
.ic
, server_conn
.oc
)
2036 let end_time = Unix.gettimeofday
() in
2037 let duration = end_time -. start_time in
2038 let msg = ServerCommandTypesUtils.debug_describe_t command
in
2039 log_debug "hh_server rpc: [%s] [%0.3f]" msg duration;
2041 | Ok
((), res
, tracker
) ->
2043 (Connection_tracker.get_server_unblocked_time tracker
)
2044 ~f
:(fun t
-> ref_unblocked_time
:= t
);
2049 ServerCommandLwt.Remote_fatal_exception remote_e_data
) ->
2050 raise
(Server_fatal_connection_exception remote_e_data
)
2054 ServerCommandLwt.Remote_nonfatal_exception
2055 { Marshal_tools.message; stack } ) ->
2056 raise
(Server_nonfatal_exception
(make_lsp_error message ~
stack))
2057 | Error
((), Utils.Callstack
stack, e) ->
2058 let message = Exn.to_string
e in
2060 (Server_fatal_connection_exception
{ Marshal_tools.message; stack }))
2064 let rpc_with_retry server_conn ref_unblocked_time ~desc command
=
2065 ServerCommandTypes.Done_or_retry.call ~f
:(fun () ->
2066 rpc server_conn ref_unblocked_time ~desc command
)
2068 (** A thin wrapper around ClientIdeMessage which turns errors into exceptions *)
2070 (ide_service
: ClientIdeService.t
ref)
2072 ~
(tracking_id : string)
2073 ~
(ref_unblocked_time
: float ref)
2074 (message : 'a
ClientIdeMessage.t
) : 'a
Lwt.t
=
2075 let progress () = refresh_status ~env ~ide_service
:(Some ide_service
) in
2077 ClientIdeService.rpc
2085 | Ok
result -> Lwt.return
result
2086 | Error error_data
-> raise
(Server_nonfatal_exception error_data
)
2088 (************************************************************************)
2090 (************************************************************************)
2094 (ide_service
: ClientIdeService.t
ref option)
2095 (tracking_id : string)
2096 (ref_unblocked_time
: float ref) : state Lwt.t
=
2097 log "Received shutdown request";
2098 let state = dismiss_diagnostics state in
2102 (* In Main_loop state, we're expected to unsubscribe diagnostics and tell *)
2103 (* server to disconnect so it can revert the state of its unsaved files. *)
2110 ServerCommandTypes.DISCONNECT
2114 (* In In_init state, even though we have a 'conn', it's still waiting for *)
2115 (* the server to become responsive, so there's no use sending any rpc *)
2116 (* messages to the server over it. *)
2119 (* No other states have a 'conn' to send any disconnect messages over. *)
2122 match ide_service
with
2123 | None
-> Lwt.return_unit
2124 | Some ide_service
->
2128 ~stop_reason
:ClientIdeService.Stop_reason.Editor_exited
2130 Lwt.return Post_shutdown
2132 let state_to_rage (state : state) : string =
2133 let uris_to_string uris
=
2134 List.map uris ~f
:(fun (DocumentUri
uri) -> uri) |> String.concat ~sep
:","
2139 | Post_shutdown
-> ""
2141 let open Main_env
in
2144 ^^
"editor_open_files: %s\n"
2145 ^^
"uris_with_diagnostics: %s\n"
2146 ^^
"uris_with_unsaved_changes: %s\n"
2147 ^^
"hh_server_status.message: %s\n"
2148 ^^
"hh_server_status.shortMessage: %s\n")
2150 (menv.editor_open_files |> UriMap.keys
|> uris_to_string)
2151 (menv.uris_with_diagnostics
|> UriSet.elements
|> uris_to_string)
2152 (menv.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2153 menv.hh_server_status
.ShowStatusFB.request.ShowMessageRequest.message
2155 menv.hh_server_status
.ShowStatusFB.shortMessage
2156 ~default
:"[absent]")
2158 let open In_init_env
in
2160 ("first_start_time: %f\n"
2161 ^^
"most_recent_sstart_time: %f\n"
2162 ^^
"editor_open_files: %s\n"
2163 ^^
"uris_with_unsaved_changes: %s\n")
2164 ienv
.first_start_time
2165 ienv
.most_recent_start_time
2166 (ienv
.editor_open_files |> UriMap.keys
|> uris_to_string)
2167 (ienv
.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2168 | Lost_server lenv
->
2169 let open Lost_env
in
2171 ("editor_open_files: %s\n"
2172 ^^
"uris_with_unsaved_changes: %s\n"
2173 ^^
"lock_file: %s\n"
2174 ^^
"explanation: %s\n"
2175 ^^
"new_hh_server_state: %s\n"
2176 ^^
"start_on_click: %b\n"
2177 ^^
"trigger_on_lsp: %b\n"
2178 ^^
"trigger_on_lock_file: %b\n")
2179 (lenv
.editor_open_files |> UriMap.keys
|> uris_to_string)
2180 (lenv
.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2183 (lenv
.p
.new_hh_server_state |> hh_server_state_to_string)
2184 lenv
.p
.start_on_click
2185 lenv
.p
.trigger_on_lsp
2186 lenv
.p
.trigger_on_lock_file
2188 Printf.sprintf
"clientLsp state: %s\n%s\n" (state_to_string state) details
2190 let do_rageFB (state : state) : RageFB.result Lwt.t
=
2191 (* clientLsp status *)
2192 let tnow = Unix.gettimeofday
() in
2193 let server_state_to_string (tstate
, state) =
2194 let tdiff = tnow -. tstate
in
2195 let state = hh_server_state_to_string state in
2196 let tm = Unix.localtime tstate
in
2197 let ms = int_of_float
(tstate
*. 1000.) mod 1000 in
2199 "[%02d:%02d:%02d.%03d] [%03.3fs ago] %s"
2208 !hh_server_state_log
2209 |> List.sort ~compare
:(fun (t1
, _
) (t2
, _
) -> Float.compare t1 t2
)
2210 |> List.map ~f
:server_state_to_string
2211 |> String.concat ~sep
:"\n"
2213 let%lwt current_version_and_switch
= read_hhconfig_version_and_switch () in
2219 ^^
"version previously read from .hhconfig and switch: %s\n"
2220 ^^
"version in .hhconfig and switch: %s\n\n"
2221 ^^
"clientLsp belief of hh_server_state:\n%s\n")
2222 (state_to_rage state)
2223 !hhconfig_version_and_switch
2224 current_version_and_switch
2227 Lwt.return
[{ RageFB.title
= None
; data }]
2230 (conn
: server_conn
)
2231 (ref_unblocked_time
: float ref)
2232 (params : DidOpen.params) : unit Lwt.t
=
2234 let open TextDocumentItem
in
2235 let filename = lsp_uri_to_path params.textDocument
.uri in
2236 let text = params.textDocument
.text in
2237 let command = ServerCommandTypes.OPEN_FILE
(filename, text) in
2238 rpc conn ref_unblocked_time ~desc
:"open" command
2241 (conn
: server_conn
)
2242 (ref_unblocked_time
: float ref)
2243 (params : DidClose.params) : unit Lwt.t
=
2244 let open DidClose
in
2245 let open TextDocumentIdentifier
in
2246 let filename = lsp_uri_to_path params.textDocument
.uri in
2247 let command = ServerCommandTypes.CLOSE_FILE
filename in
2248 rpc conn ref_unblocked_time ~desc
:"close" command
2251 (conn
: server_conn
)
2252 (ref_unblocked_time
: float ref)
2253 (params : DidChange.params) : unit Lwt.t
=
2254 let open VersionedTextDocumentIdentifier
in
2255 let open Lsp.DidChange
in
2256 let lsp_change_to_ide (lsp
: DidChange.textDocumentContentChangeEvent
) :
2257 Ide_api_types.text_edit
=
2259 Ide_api_types.range
= Option.map lsp
.range ~f
:lsp_range_to_ide;
2263 let filename = lsp_uri_to_path params.textDocument
.uri in
2264 let changes = List.map
params.contentChanges ~f
:lsp_change_to_ide in
2265 let command = ServerCommandTypes.EDIT_FILE
(filename, changes) in
2266 rpc conn ref_unblocked_time ~desc
:"change" command
2268 let do_hover_common (infos
: HoverService.hover_info list
) : Hover.result =
2271 |> List.map ~f
:(fun hoverInfo
->
2272 (* Hack server uses None to indicate absence of a result. *)
2273 (* We're also catching the non-result "" just in case... *)
2274 match hoverInfo
with
2275 | { HoverService.snippet
= ""; _
} -> []
2276 | { HoverService.snippet
; addendum
; _
} ->
2277 MarkedCode
("hack", snippet
)
2278 :: List.map ~f
:(fun s -> MarkedString
s) addendum
)
2281 (* We pull the position from the SymbolOccurrence.t record, so I would be
2282 surprised if there were any different ones in here. Just take the first
2286 |> List.filter_map ~f
:(fun { HoverService.pos
; _
} -> pos
)
2288 |> Option.map ~f
:(hack_pos_to_lsp_range ~equal
:Relative_path.equal
)
2290 if List.is_empty
contents then
2293 Some
{ Hover.contents; range }
2296 (conn
: server_conn
)
2297 (ref_unblocked_time
: float ref)
2298 (params : Hover.params) : Hover.result Lwt.t
=
2299 let (file, line
, column
) = lsp_file_position_to_hack params in
2300 let command = ServerCommandTypes.IDE_HOVER
(file, line
, column
) in
2301 let%lwt infos
= rpc conn ref_unblocked_time ~desc
:"hover" command in
2302 Lwt.return
(do_hover_common infos
)
2305 (ide_service
: ClientIdeService.t
ref)
2307 (tracking_id : string)
2308 (ref_unblocked_time
: float ref)
2309 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2310 (params : Hover.params) : Hover.result Lwt.t
=
2311 let document_location = get_document_location editor_open_files params in
2318 (ClientIdeMessage.Hover
document_location)
2320 Lwt.return
(do_hover_common infos
)
2322 let do_typeDefinition
2323 (conn
: server_conn
)
2324 (ref_unblocked_time
: float ref)
2325 (params : Definition.params) : TypeDefinition.result Lwt.t
=
2326 let (file, line
, column
) = lsp_file_position_to_hack params in
2328 ServerCommandTypes.(IDENTIFY_TYPES
(LabelledFileName
file, line
, column
))
2330 let%lwt results
= rpc conn ref_unblocked_time ~desc
:"go-to-typedef" command in
2332 (List.map results ~f
:(fun nast_sid
->
2333 hack_pos_definition_to_lsp_identifier_location
2335 ~default_path
:file))
2337 let do_typeDefinition_local
2338 (ide_service
: ClientIdeService.t
ref)
2340 (tracking_id : string)
2341 (ref_unblocked_time
: float ref)
2342 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2343 (params : Definition.params) : TypeDefinition.result Lwt.t
=
2344 let document_location = get_document_location editor_open_files params in
2351 (ClientIdeMessage.Type_definition
document_location)
2353 let file = Path.to_string
document_location.ClientIdeMessage.file_path in
2355 List.map
results ~f
:(fun nast_sid
->
2356 hack_pos_definition_to_lsp_identifier_location
2363 (conn
: server_conn
)
2364 (ref_unblocked_time
: float ref)
2365 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2366 (params : Definition.params) : (Definition.result * bool) Lwt.t
=
2367 let (filename, line
, column
) = lsp_file_position_to_hack params in
2369 params.TextDocumentPositionParams.textDocument
.TextDocumentIdentifier.uri
2372 match UriMap.find_opt
uri editor_open_files with
2374 ServerCommandTypes.(
2376 { filename; content
= document
.TextDocumentItem.text })
2377 | None
-> ServerCommandTypes.(LabelledFileName
filename)
2380 ServerCommandTypes.GO_TO_DEFINITION
(labelled_file, line
, column
)
2382 let%lwt
results = rpc conn ref_unblocked_time ~desc
:"go-to-def" command in
2384 List.map
results ~f
:(fun (_
, definition
) ->
2385 hack_symbol_definition_to_lsp_identifier_location
2387 ~default_path
:filename)
2389 let has_xhp_attribute =
2390 List.exists
results ~f
:(fun (occurence
, _
) ->
2391 SymbolOccurrence.is_xhp_literal_attr occurence
)
2393 Lwt.return
(locations, has_xhp_attribute)
2395 let do_definition_local
2396 (ide_service
: ClientIdeService.t
ref)
2398 (tracking_id : string)
2399 (ref_unblocked_time
: float ref)
2400 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2401 (params : Definition.params) : (Definition.result * bool) Lwt.t
=
2402 let document_location = get_document_location editor_open_files params in
2409 (ClientIdeMessage.Definition
document_location)
2412 List.map
results ~f
:(fun (_
, definition
) ->
2413 hack_symbol_definition_to_lsp_identifier_location
2416 (document_location.ClientIdeMessage.file_path |> Path.to_string
))
2418 let has_xhp_attribute =
2419 List.exists
results ~f
:(fun (occurence
, _
) ->
2420 SymbolOccurrence.is_xhp_literal_attr occurence
)
2422 Lwt.return
(locations, has_xhp_attribute)
2424 let snippet_re = Str.regexp
{|[\$
}]|} (* snippets must backslash-escape "$\}" *)
2426 let make_ide_completion_response
2427 (result : AutocompleteTypes.ide_result
) (filename : string) :
2428 Completion.completionList
Lwt.t
=
2429 let open AutocompleteTypes
in
2430 let open Completion
in
2431 (* We use snippets to provide parentheses+arguments when autocompleting *)
2432 (* method calls e.g. "$c->|" ==> "$c->foo($arg1)". But we'll only do this *)
2433 (* there's nothing after the caret: no "$c->|(1)" -> "$c->foo($arg1)(1)" *)
2434 let is_caret_followed_by_lparen = Char.equal
result.char_at_pos '
('
in
2435 let p = initialize_params_exc () in
2436 let hack_to_itemType (completion
: complete_autocomplete_result
) :
2438 (* TODO: we're using itemType (left column) for function return types, and *)
2439 (* the inlineDetail (right column) for variable/field types. Is that good? *)
2440 Option.map completion
.func_details ~f
:(fun details -> details.return_ty
)
2442 let hack_to_detail (completion
: complete_autocomplete_result
) : string =
2443 (* TODO: retrieve the actual signature including name+modifiers *)
2444 (* For now we just return the type of the completion. In the case *)
2445 (* of functions, their function-types have parentheses around them *)
2446 (* which we want to strip. In other cases like tuples, no strip. *)
2447 match completion
.func_details
with
2448 | None
-> completion
.res_ty
2450 String_utils.rstrip
(String_utils.lstrip completion
.res_ty
"(") ")"
2452 let hack_to_inline_detail (completion
: complete_autocomplete_result
) : string
2454 match completion
.func_details
with
2455 | None
-> hack_to_detail completion
2457 (* "(type1 $param1, ...)" *)
2458 let f param
= Printf.sprintf
"%s %s" param
.param_ty param
.param_name
in
2459 let params = String.concat ~sep
:", " (List.map
details.params ~
f) in
2460 Printf.sprintf
"(%s)" params
2461 (* Returns a tuple of (insertText, insertTextFormat, textEdits). *)
2463 let hack_to_insert (completion
: complete_autocomplete_result
) :
2464 [ `InsertText
of string | `TextEdit
of TextEdit.t list
]
2465 * Completion.insertTextFormat
=
2466 match completion
.func_details
with
2468 when Lsp_helpers.supports_snippets
p
2469 && (not
is_caret_followed_by_lparen)
2471 (SearchUtils.equal_si_kind
2473 SearchUtils.SI_LocalVariable
) ->
2474 (* "method(${1:arg1}, ...)" but for args we just use param names. *)
2476 let name = Str.global_replace
snippet_re "\\\\\\0" param
.param_name
in
2477 Printf.sprintf
"${%i:%s}" (i
+ 1) name
2479 let params = String.concat ~sep
:", " (List.mapi
details.params ~
f) in
2480 ( `InsertText
(Printf.sprintf
"%s(%s)" completion
.res_name
params),
2487 range = ide_range_to_lsp completion
.res_replace_pos
;
2488 newText
= completion
.res_name
;
2493 let hack_completion_to_lsp (completion
: complete_autocomplete_result
) :
2494 Completion.completionItem
=
2495 let (insertText
, insertTextFormat
, textEdits
) =
2496 match hack_to_insert completion
with
2497 | (`InsertText
text, format
) -> (Some
text, format
, [])
2498 | (`TextEdit edits
, format
) -> (None
, format
, edits
)
2501 if String.equal
(Pos.filename completion
.res_pos
) "" then
2502 Pos.set_file
filename completion
.res_pos
2507 let (line
, start
, _
) = Pos.info_pos
pos in
2508 let filename = Pos.filename pos in
2510 match completion
.res_base_class
with
2511 | Some
base_class -> [("base_class", Hh_json.JSON_String
base_class)]
2514 let ranking_detail =
2515 match completion
.ranking_details
with
2518 ("ranking_detail", Hh_json.JSON_String
details.detail
);
2519 ("ranking_source", Hh_json.JSON_Number
details.kind
);
2523 (* If we do not have a correct file position, skip sending that data *)
2524 if Int.equal line
0 && Int.equal start
0 then
2526 (Hh_json.JSON_Object
2527 ([("fullname", Hh_json.JSON_String completion
.res_fullname
)]
2532 (Hh_json.JSON_Object
2534 (* Fullname is needed for namespaces. We often trim namespaces to make
2535 * the results more readable, such as showing "ad__breaks" instead of
2536 * "Thrift\Packages\cf\ad__breaks".
2538 ("fullname", Hh_json.JSON_String completion
.res_fullname
);
2539 (* Filename/line/char/base_class are used to handle class methods.
2540 * We could unify this with fullname in the future.
2542 ("filename", Hh_json.JSON_String
filename);
2543 ("line", Hh_json.int_ line
);
2544 ("char", Hh_json.int_ start
);
2549 let hack_to_sort_text (completion
: complete_autocomplete_result
) :
2551 let label = completion
.res_name
in
2552 let should_downrank label =
2553 String.length
label > 2
2554 && String.equal
(Str.string_before
label 2) "__"
2555 || Str.string_match
(Str.regexp_case_fold
".*do_not_use.*") label 0
2557 let downranked_result_prefix_character = "~" in
2558 if should_downrank label then
2559 Some
(downranked_result_prefix_character ^
label)
2565 (completion
.res_name
2568 SearchUtils.equal_si_kind completion
.res_kind
SearchUtils.SI_Namespace
2574 (match completion
.ranking_details
with
2575 | Some _
-> Some
Completion.Event
2577 si_kind_to_completion_kind completion
.AutocompleteTypes.res_kind
);
2578 detail
= Some
(hack_to_detail completion
);
2579 inlineDetail
= Some
(hack_to_inline_detail completion
);
2580 itemType
= hack_to_itemType completion
;
2582 Option.map completion
.res_documentation ~
f:(fun s ->
2583 MarkedStringsDocumentation
[MarkedString
s]);
2584 (* This will be filled in by completionItem/resolve. *)
2586 (match completion
.ranking_details
with
2587 | Some detail
-> Some detail
.sort_text
2588 | None
-> hack_to_sort_text completion
);
2591 insertTextFormat
= Some insertTextFormat
;
2599 isIncomplete
= not
result.is_complete
;
2600 items
= List.map
result.completions ~
f:hack_completion_to_lsp;
2603 let do_completion_ffp
2604 (conn
: server_conn
)
2605 (ref_unblocked_time
: float ref)
2606 (params : Completion.params) : Completion.result Lwt.t
=
2607 let open Completion
in
2608 let open TextDocumentIdentifier
in
2610 lsp_position_to_ide params.loc
.TextDocumentPositionParams.position
2613 lsp_uri_to_path params.loc
.TextDocumentPositionParams.textDocument
.uri
2615 let command = ServerCommandTypes.IDE_FFP_AUTOCOMPLETE
(filename, pos) in
2616 let%lwt
result = rpc conn ref_unblocked_time ~desc
:"completion" command in
2617 make_ide_completion_response result filename
2619 let do_completion_legacy
2620 (conn
: server_conn
)
2621 (ref_unblocked_time
: float ref)
2622 (params : Completion.params) : Completion.result Lwt.t
=
2623 let open Completion
in
2624 let open TextDocumentIdentifier
in
2626 lsp_position_to_ide params.loc
.TextDocumentPositionParams.position
2629 lsp_uri_to_path params.loc
.TextDocumentPositionParams.textDocument
.uri
2631 let is_manually_invoked =
2632 match params.context
with
2634 | Some c
-> is_invoked c
.triggerKind
2637 ServerCommandTypes.IDE_AUTOCOMPLETE
(filename, pos, is_manually_invoked)
2639 let%lwt
result = rpc conn ref_unblocked_time ~desc
:"completion" command in
2640 make_ide_completion_response result filename
2642 let do_completion_local
2643 (ide_service
: ClientIdeService.t
ref)
2645 (tracking_id : string)
2646 (ref_unblocked_time
: float ref)
2647 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2648 (params : Completion.params) : Completion.result Lwt.t
=
2649 let open Completion
in
2650 let document_location = get_document_location editor_open_files params.loc
in
2651 (* Other parameters *)
2652 let is_manually_invoked =
2653 match params.context
with
2655 | Some c
-> is_invoked c
.triggerKind
2657 (* this is what I want to fix *)
2659 ClientIdeMessage.Completion
2660 { ClientIdeMessage.Completion.document_location; is_manually_invoked }
2663 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2666 document_location.ClientIdeMessage.file_path |> Path.to_string
2668 let%lwt response
= make_ide_completion_response infos
filename in
2671 exception NoLocationFound
2673 let docblock_to_markdown (raw_docblock
: DocblockService.result) :
2674 Completion.completionDocumentation
option =
2675 match raw_docblock
with
2679 (Completion.MarkedStringsDocumentation
2680 (Core_kernel.List.fold docblock ~init
:[] ~
f:(fun acc elt
->
2682 | DocblockService.Markdown txt
-> MarkedString txt
:: acc
2683 | DocblockService.HackSnippet txt
->
2684 MarkedCode
("hack", txt
) :: acc
2685 | DocblockService.XhpSnippet txt
->
2686 MarkedCode
("html", txt
) :: acc
)))
2688 let docblock_with_ranking_detail
2689 (raw_docblock
: DocblockService.result) (ranking_detail : string option) :
2690 DocblockService.result =
2691 match ranking_detail with
2692 | Some detail
-> raw_docblock
@ [DocblockService.Markdown detail
]
2693 | None
-> raw_docblock
2695 let resolve_ranking_source
2696 (kind
: SearchUtils.si_kind
) (ranking_source
: int option) :
2697 SearchUtils.si_kind
=
2698 match ranking_source
with
2699 | Some x
-> SearchUtils.int_to_kind x
2702 let do_completionItemResolve
2703 (conn
: server_conn
)
2704 (ref_unblocked_time
: float ref)
2705 (params : CompletionItemResolve.params) : CompletionItemResolve.result Lwt.t
2707 if Option.is_some
params.Completion.documentation
then
2710 (* No matter what, we need the kind *)
2711 let raw_kind = params.Completion.kind
in
2712 let kind = completion_kind_to_si_kind raw_kind in
2713 (* First try fetching position data from json *)
2714 let%lwt raw_docblock
=
2716 match params.Completion.data with
2717 | None
-> raise NoLocationFound
2719 (* Some docblocks are for class methods. Class methods need to know
2720 * file/line/column/base_class to find the docblock. *)
2721 let filename = Jget.string_exn
data "filename" in
2722 let line = Jget.int_exn
data "line" in
2723 let column = Jget.int_exn
data "char" in
2724 let base_class = Jget.string_opt
data "base_class" in
2725 let ranking_detail = Jget.string_opt
data "ranking_detail" in
2726 let ranking_source = Jget.int_opt
data "ranking_source" in
2727 (* If not found ... *)
2728 if line = 0 && column = 0 then (
2729 (* For global symbols such as functions, classes, enums, etc, we
2730 * need to know the full name INCLUDING all namespaces. Once
2731 * we know that, we can look up its file/line/column. *)
2732 let fullname = Jget.string_exn
data "fullname" in
2733 if String.equal
fullname "" then raise NoLocationFound
;
2734 let fullname = Utils.add_ns
fullname in
2736 ServerCommandTypes.DOCBLOCK_FOR_SYMBOL
2737 (fullname, resolve_ranking_source kind ranking_source)
2739 let%lwt raw_docblock
=
2740 rpc conn ref_unblocked_time ~desc
:"completion" command
2743 (docblock_with_ranking_detail raw_docblock
ranking_detail)
2745 (* Okay let's get a docblock for this specific location *)
2747 ServerCommandTypes.DOCBLOCK_AT
2752 resolve_ranking_source kind ranking_source )
2754 let%lwt raw_docblock
=
2755 rpc conn ref_unblocked_time ~desc
:"completion" command
2758 (docblock_with_ranking_detail raw_docblock
ranking_detail)
2759 (* If that failed, fetch docblock using just the symbol name *)
2762 let symbolname = params.Completion.label in
2763 let ranking_source =
2764 try Jget.int_opt
params.Completion.data "ranking_source" with
2768 ServerCommandTypes.DOCBLOCK_FOR_SYMBOL
2769 (symbolname, resolve_ranking_source kind ranking_source)
2771 let%lwt raw_docblock
=
2772 rpc conn ref_unblocked_time ~desc
:"completion" command
2774 Lwt.return raw_docblock
2776 (* Convert to markdown and return *)
2777 let documentation = docblock_to_markdown raw_docblock
in
2778 Lwt.return
{ params with Completion.documentation }
2781 * Note that resolve does not depend on having previously executed completion in
2782 * the same process. The LSP resolve request takes, as input, a single item
2783 * produced by any previously executed completion request. So it's okay for
2784 * one process to respond to another, because they'll both know the answers
2785 * to the same symbol requests.
2787 * And it's totally okay to mix and match requests to serverless IDE and
2790 let do_resolve_local
2791 (ide_service
: ClientIdeService.t
ref)
2793 (tracking_id : string)
2794 (ref_unblocked_time
: float ref)
2795 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2796 (params : CompletionItemResolve.params) : CompletionItemResolve.result Lwt.t
2798 if Option.is_some
params.Completion.documentation then
2801 let raw_kind = params.Completion.kind in
2802 let kind = completion_kind_to_si_kind raw_kind in
2803 (* Some docblocks are for class methods. Class methods need to know
2804 * file/line/column/base_class to find the docblock. *)
2807 match params.Completion.data with
2808 | None
-> raise NoLocationFound
2810 let filename = Jget.string_exn
data "filename" in
2811 let uri = File_url.create
filename |> Lsp.uri_of_string
in
2812 let file_path = Path.make
filename in
2813 let line = Jget.int_exn
data "line" in
2814 let column = Jget.int_exn
data "char" in
2815 let file_contents = get_document_contents editor_open_files uri in
2816 let ranking_detail = Jget.string_opt
data "ranking_detail" in
2817 let ranking_source = Jget.int_opt
data "ranking_source" in
2818 if line = 0 && column = 0 then failwith
"NoFileLineColumnData";
2820 ClientIdeMessage.Completion_resolve_location
2822 ClientIdeMessage.Completion_resolve_location.document_location =
2824 ClientIdeMessage.file_path;
2825 ClientIdeMessage.file_contents;
2826 ClientIdeMessage.line;
2827 ClientIdeMessage.column;
2829 kind = resolve_ranking_source kind ranking_source;
2832 let%lwt raw_docblock
=
2833 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2836 docblock_with_ranking_detail raw_docblock
ranking_detail
2837 |> docblock_to_markdown
2839 Lwt.return
{ params with Completion.documentation }
2840 (* If that fails, next try using symbol *)
2843 (* The "fullname" value includes the fully qualified namespace, so
2844 * we want to use that. However, if it's missing (it shouldn't be)
2845 * let's default to using the label which doesn't include the
2848 try Jget.string_exn
params.Completion.data "fullname" with
2849 | _
-> params.Completion.label
2851 let ranking_source =
2852 try Jget.int_opt
params.Completion.data "ranking_source" with
2856 ClientIdeMessage.Completion_resolve
2858 ClientIdeMessage.Completion_resolve.symbol
= symbolname;
2859 kind = resolve_ranking_source kind ranking_source;
2862 let%lwt raw_docblock
=
2863 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2865 let documentation = docblock_to_markdown raw_docblock
in
2866 Lwt.return
{ params with Completion.documentation }
2870 let hack_symbol_to_lsp (symbol
: SearchUtils.symbol
) =
2871 let open SearchUtils
in
2872 (* Hack sometimes gives us back items with an empty path, by which it
2873 intends "whichever path you asked me about". That would be meaningless
2874 here. If it does, then it'll pick up our default path (also empty),
2875 which will throw and go into our telemetry. That's the best we can do. *)
2876 let hack_to_lsp_kind = function
2877 | SearchUtils.SI_Class
-> SymbolInformation.Class
2878 | SearchUtils.SI_Interface
-> SymbolInformation.Interface
2879 | SearchUtils.SI_Trait
-> SymbolInformation.Interface
2880 (* LSP doesn't have traits, so we approximate with interface *)
2881 | SearchUtils.SI_Enum
-> SymbolInformation.Enum
2882 (* TODO(T36697624): Add SymbolInformation.Record *)
2883 | SearchUtils.SI_ClassMethod
-> SymbolInformation.Method
2884 | SearchUtils.SI_Function
-> SymbolInformation.Function
2885 | SearchUtils.SI_Typedef
-> SymbolInformation.Class
2886 (* LSP doesn't have typedef, so we approximate with class *)
2887 | SearchUtils.SI_GlobalConstant
-> SymbolInformation.Constant
2888 | SearchUtils.SI_Namespace
-> SymbolInformation.Namespace
2889 | SearchUtils.SI_Mixed
-> SymbolInformation.Variable
2890 | SearchUtils.SI_XHP
-> SymbolInformation.Class
2891 | SearchUtils.SI_Literal
-> SymbolInformation.Variable
2892 | SearchUtils.SI_ClassConstant
-> SymbolInformation.Constant
2893 | SearchUtils.SI_Property
-> SymbolInformation.Property
2894 | SearchUtils.SI_LocalVariable
-> SymbolInformation.Variable
2895 | SearchUtils.SI_Constructor
-> SymbolInformation.Constructor
2896 (* Do these happen in practice? *)
2897 | SearchUtils.SI_Keyword
2898 | SearchUtils.SI_Unknown
->
2899 failwith
"Unknown symbol kind"
2902 SymbolInformation.name = Utils.strip_ns symbol
.name;
2903 kind = hack_to_lsp_kind symbol
.result_type
;
2904 location = hack_pos_to_lsp_location symbol
.pos ~default_path
:"";
2905 containerName
= None
;
2908 let do_workspaceSymbol
2909 (conn
: server_conn
)
2910 (ref_unblocked_time
: float ref)
2911 (params : WorkspaceSymbol.params) : WorkspaceSymbol.result Lwt.t
=
2912 let query_type = "" in
2914 ServerCommandTypes.SEARCH
(params.WorkspaceSymbol.query
, query_type)
2916 let%lwt
results = rpc conn ref_unblocked_time ~desc
:"find-symbol" command in
2917 Lwt.return
(List.map
results ~
f:hack_symbol_to_lsp)
2919 let do_workspaceSymbol_local
2920 (ide_service
: ClientIdeService.t
ref)
2922 (tracking_id : string)
2923 (ref_unblocked_time
: float ref)
2924 (params : WorkspaceSymbol.params) : WorkspaceSymbol.result Lwt.t
=
2925 let query = params.WorkspaceSymbol.query in
2926 let request = ClientIdeMessage.Workspace_symbol
query in
2928 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2930 Lwt.return
(List.map
results ~
f:hack_symbol_to_lsp)
2932 let rec hack_symbol_tree_to_lsp
2933 ~
(filename : string)
2934 ~
(accu
: Lsp.SymbolInformation.t list
)
2935 ~
(container_name
: string option)
2936 (defs
: FileOutline.outline
) : Lsp.SymbolInformation.t list
=
2937 let open SymbolDefinition
in
2938 let hack_to_lsp_kind = function
2939 | SymbolDefinition.Function
-> SymbolInformation.Function
2940 | SymbolDefinition.Class
-> SymbolInformation.Class
2941 | SymbolDefinition.Method
-> SymbolInformation.Method
2942 | SymbolDefinition.Property
-> SymbolInformation.Property
2943 | SymbolDefinition.Const
-> SymbolInformation.Constant
2944 | SymbolDefinition.Enum
-> SymbolInformation.Enum
2945 | SymbolDefinition.Interface
-> SymbolInformation.Interface
2946 | SymbolDefinition.Trait
-> SymbolInformation.Interface
2947 (* LSP doesn't have traits, so we approximate with interface *)
2948 | SymbolDefinition.LocalVar
-> SymbolInformation.Variable
2949 | SymbolDefinition.TypeVar
-> SymbolInformation.TypeParameter
2950 | SymbolDefinition.Typeconst
-> SymbolInformation.Class
2951 (* e.g. "const type Ta = string;" -- absent from LSP *)
2952 | SymbolDefinition.Typedef
-> SymbolInformation.Class
2953 (* e.g. top level type alias -- absent from LSP *)
2954 | SymbolDefinition.Param
-> SymbolInformation.Variable
2955 (* We never return a param from a document-symbol-search *)
2957 let hack_symbol_to_lsp definition containerName
=
2959 SymbolInformation.name = definition
.name;
2960 kind = hack_to_lsp_kind definition
.kind;
2962 hack_symbol_definition_to_lsp_construct_location
2964 ~default_path
:filename;
2969 (* Flattens the recursive list of symbols *)
2970 | [] -> List.rev accu
2972 let children = Option.value def
.children ~default
:[] in
2973 let accu = hack_symbol_to_lsp def container_name
:: accu in
2975 hack_symbol_tree_to_lsp
2978 ~container_name
:(Some def
.name)
2981 hack_symbol_tree_to_lsp ~
filename ~
accu ~container_name defs
2983 let do_documentSymbol
2984 (conn
: server_conn
)
2985 (ref_unblocked_time
: float ref)
2986 (params : DocumentSymbol.params) : DocumentSymbol.result Lwt.t
=
2987 let open DocumentSymbol
in
2988 let open TextDocumentIdentifier
in
2989 let filename = lsp_uri_to_path params.textDocument
.uri in
2990 let command = ServerCommandTypes.OUTLINE
filename in
2991 let%lwt outline
= rpc conn ref_unblocked_time ~desc
:"outline" command in
2993 hack_symbol_tree_to_lsp ~
filename ~
accu:[] ~container_name
:None outline
2995 Lwt.return
converted
2997 (* for serverless ide *)
2998 let do_documentSymbol_local
2999 (ide_service
: ClientIdeService.t
ref)
3001 (tracking_id : string)
3002 (ref_unblocked_time
: float ref)
3003 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3004 (params : DocumentSymbol.params) : DocumentSymbol.result Lwt.t
=
3005 let open DocumentSymbol
in
3006 let open TextDocumentIdentifier
in
3007 let filename = lsp_uri_to_path params.textDocument
.uri in
3008 let document_location =
3010 ClientIdeMessage.file_path = Path.make
filename;
3012 get_document_contents editor_open_files params.textDocument
.uri;
3017 let request = ClientIdeMessage.Document_symbol
document_location in
3019 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
3022 hack_symbol_tree_to_lsp ~
filename ~
accu:[] ~container_name
:None outline
3024 Lwt.return
converted
3026 let do_findReferences
3027 (conn
: server_conn
)
3028 (ref_unblocked_time
: float ref)
3029 (params : FindReferences.params) : FindReferences.result Lwt.t
=
3030 let { Ide_api_types.line; column } =
3032 params.FindReferences.loc
.TextDocumentPositionParams.position
3035 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
3036 params.FindReferences.loc
.TextDocumentPositionParams.textDocument
3039 params.FindReferences.context
.FindReferences.includeDeclaration
3041 let labelled_file = ServerCommandTypes.LabelledFileName
filename in
3043 ServerCommandTypes.IDE_FIND_REFS
(labelled_file, line, column, include_defs)
3046 rpc_with_retry conn ref_unblocked_time ~desc
:"find-refs" command
3048 (* TODO: respect params.context.include_declaration *)
3050 | None
-> Lwt.return
[]
3051 | Some
(_name
, positions
) ->
3053 (List.map positions ~
f:(hack_pos_to_lsp_location ~default_path
:filename))
3055 let do_goToImplementation
3056 (conn
: server_conn
)
3057 (ref_unblocked_time
: float ref)
3058 (params : Implementation.params) : Implementation.result Lwt.t
=
3059 let { Ide_api_types.line; column } =
3060 lsp_position_to_ide params.TextDocumentPositionParams.position
3063 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
3064 params.TextDocumentPositionParams.textDocument
3066 let labelled_file = ServerCommandTypes.LabelledFileName
filename in
3068 ServerCommandTypes.IDE_GO_TO_IMPL
(labelled_file, line, column)
3071 rpc_with_retry conn ref_unblocked_time ~desc
:"go-to-impl" command
3074 | None
-> Lwt.return
[]
3075 | Some
(_name
, positions
) ->
3077 (List.map positions ~
f:(hack_pos_to_lsp_location ~default_path
:filename))
3079 (* Shared function for hack range conversion *)
3080 let hack_range_to_lsp_highlight range =
3081 { DocumentHighlight.range = ide_range_to_lsp range; kind = None
}
3083 let do_documentHighlight
3084 (conn
: server_conn
)
3085 (ref_unblocked_time
: float ref)
3086 (params : DocumentHighlight.params) : DocumentHighlight.result Lwt.t
=
3087 let (file, line, column) = lsp_file_position_to_hack params in
3089 ServerCommandTypes.(IDE_HIGHLIGHT_REFS
(file, FileName
file, line, column))
3092 rpc conn ref_unblocked_time ~desc
:"highlight-references" command
3094 Lwt.return
(List.map
results ~
f:hack_range_to_lsp_highlight)
3096 (* Serverless IDE implementation of highlight *)
3097 let do_highlight_local
3098 (ide_service
: ClientIdeService.t
ref)
3100 (tracking_id : string)
3101 (ref_unblocked_time
: float ref)
3102 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3103 (params : DocumentHighlight.params) : DocumentHighlight.result Lwt.t
=
3104 let document_location = get_document_location editor_open_files params in
3111 (ClientIdeMessage.Document_highlight
document_location)
3113 Lwt.return
(List.map ranges ~
f:hack_range_to_lsp_highlight)
3115 let format_typeCoverage_result ~
(equal
: 'a
-> 'a
-> bool) results counts
=
3117 let coveredPercent = Coverage_level.get_percent counts
in
3118 let hack_coverage_to_lsp (pos, level
) =
3119 let range = hack_pos_to_lsp_range ~equal
pos in
3121 (* We only show diagnostics for completely untypechecked code. *)
3122 | Ide_api_types.Checked
3123 | Ide_api_types.Partial
->
3125 | Ide_api_types.Unchecked
-> Some
{ range; message = None
}
3129 uncoveredRanges
= List.filter_map
results ~
f:hack_coverage_to_lsp;
3130 defaultMessage
= "Un-type checked code. Consider adding type annotations.";
3133 let do_typeCoverageFB
3134 (conn
: server_conn
)
3135 (ref_unblocked_time
: float ref)
3136 (params : TypeCoverageFB.params) : TypeCoverageFB.result Lwt.t
=
3139 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
params.textDocument
3142 ServerCommandTypes.COVERAGE_LEVELS
3143 (filename, ServerCommandTypes.FileName
filename)
3145 let%lwt
(results, counts
) : Coverage_level_defs.result =
3146 rpc conn ref_unblocked_time ~desc
:"coverage" command
3149 format_typeCoverage_result ~equal
:String.equal
results counts
3151 Lwt.return
formatted)
3153 let do_typeCoverage_localFB
3154 (ide_service
: ClientIdeService.t
ref)
3156 (tracking_id : string)
3157 (ref_unblocked_time
: float ref)
3158 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3159 (params : TypeCoverageFB.params) : TypeCoverageFB.result Lwt.t
=
3160 let open TypeCoverageFB
in
3161 let document_contents =
3162 get_document_contents
3164 params.textDocument
.TextDocumentIdentifier.uri
3166 match document_contents with
3167 | None
-> failwith
"Local type coverage failed, file could not be found."
3168 | Some
file_contents ->
3170 params.textDocument
.TextDocumentIdentifier.uri
3175 ClientIdeMessage.Type_coverage
3176 { ClientIdeMessage.file_path; ClientIdeMessage.file_contents }
3179 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
3181 let (results, counts
) = result in
3183 format_typeCoverage_result ~equal
:String.equal
results counts
3185 Lwt.return
formatted
3187 let do_formatting_common
3188 (uri : Lsp.documentUri
)
3189 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3190 (action
: ServerFormatTypes.ide_action
)
3191 (options
: DocumentFormatting.formattingOptions
) : TextEdit.t list
=
3192 let open ServerFormatTypes
in
3193 let filename_for_logging = lsp_uri_to_path uri in
3194 (* Following line will throw if the document isn't already open, so we'll *)
3195 (* return an error code to the LSP client. The spec doesn't spell out if we *)
3196 (* should be expected to handle formatting requests on unopened files. *)
3197 let lsp_doc = UriMap.find
uri editor_open_files in
3198 let content = lsp_doc.Lsp.TextDocumentItem.text in
3200 ServerFormat.go_ide ~
filename_for_logging ~
content ~action ~options
3203 | Error
"File failed to parse without errors" ->
3204 (* If LSP issues a formatting request at a given line+char, but we can't *)
3205 (* calculate a better format for the file due to syntax errors in it, *)
3206 (* then we should return "success and there are no edits to apply" *)
3207 (* rather than "error". *)
3208 (* TODO: let's eliminate hh_format, and incorporate hackfmt into the *)
3209 (* hh_client binary itself, and make make "hackfmt" just a wrapper for *)
3210 (* "hh_client format", and then make it return proper error that we can *)
3211 (* pattern-match upon, rather than hard-coding the string... *)
3216 { Error.code
= Error.UnknownErrorCode
; message; data = None
})
3218 let range = ide_range_to_lsp r
.range in
3219 let newText = r
.new_text
in
3220 [{ TextEdit.range; newText }]
3222 let do_documentRangeFormatting
3223 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3224 (params : DocumentRangeFormatting.params) : DocumentRangeFormatting.result =
3225 let open DocumentRangeFormatting
in
3226 let open TextDocumentIdentifier
in
3227 let action = ServerFormatTypes.Range
(lsp_range_to_ide params.range) in
3228 do_formatting_common
3229 params.textDocument
.uri
3234 let do_documentOnTypeFormatting
3235 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3236 (params : DocumentOnTypeFormatting.params) : DocumentOnTypeFormatting.result
3238 let open DocumentOnTypeFormatting
in
3239 let open TextDocumentIdentifier
in
3241 In LSP, positions do not point directly to characters, but to spaces in between characters.
3242 Thus, the LSP position that the cursor points to after typing a character is the space
3243 immediately after the character.
3246 Character positions: 0 1 2 3 4 5 6
3248 LSP positions: 0 1 2 3 4 5 6 7
3250 The cursor is at LSP position 7 after typing the "}" of "foo(){}"
3251 But the character position of "}" is 6.
3253 Nuclide currently sends positions according to LSP, but everything else in the server
3254 and in hack formatting assumes that positions point directly to characters.
3256 Thus, to send the position of the character itself for formatting,
3257 we must subtract one.
3260 { params.position with character
= params.position.character
- 1 }
3262 let action = ServerFormatTypes.Position
(lsp_position_to_ide position) in
3263 do_formatting_common
3264 params.textDocument
.uri
3269 let do_documentFormatting
3270 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3271 (params : DocumentFormatting.params) : DocumentFormatting.result =
3272 let open DocumentFormatting
in
3273 let open TextDocumentIdentifier
in
3274 let action = ServerFormatTypes.Document
in
3275 do_formatting_common
3276 params.textDocument
.uri
3281 let do_willSaveWaitUntil
3282 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3283 (params : WillSaveWaitUntil.params) : WillSaveWaitUntil.result =
3284 let uri = params.WillSaveWaitUntil.textDocument
.TextDocumentIdentifier.uri in
3285 let lsp_doc = UriMap.find
uri editor_open_files in
3286 let content = lsp_doc.Lsp.TextDocumentItem.text in
3287 match Formatting.is_formattable
content with
3289 let open DocumentFormatting
in
3290 do_documentFormatting
3293 textDocument
= params.WillSaveWaitUntil.textDocument
;
3294 options
= { tabSize
= 2; insertSpaces
= true };
3298 let do_codeAction_local
3299 (ide_service
: ClientIdeService.t
ref)
3301 (tracking_id : string)
3302 (ref_unblocked_time
: float ref)
3303 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3304 (params : CodeActionRequest.params) :
3305 CodeAction.command_or_action list
Lwt.t
=
3309 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri)
3312 get_document_contents
3314 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri
3316 let range = lsp_range_to_ide params.CodeActionRequest.range in
3323 (ClientIdeMessage.Code_action
3324 { ClientIdeMessage.Code_action.file_path; file_contents; range })
3329 (conn
: server_conn
)
3330 (ref_unblocked_time
: float ref)
3331 (params : CodeActionRequest.params) :
3332 CodeAction.command_or_action list
Lwt.t
=
3335 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri
3337 let range = lsp_range_to_ide params.CodeActionRequest.range in
3338 let command = ServerCommandTypes.CODE_ACTIONS
(filename, range) in
3339 rpc conn ref_unblocked_time ~desc
:"code_actions" command
3341 let do_signatureHelp
3342 (conn
: server_conn
)
3343 (ref_unblocked_time
: float ref)
3344 (params : SignatureHelp.params) : SignatureHelp.result Lwt.t
=
3345 let (file, line, column) = lsp_file_position_to_hack params in
3346 let command = ServerCommandTypes.IDE_SIGNATURE_HELP
(file, line, column) in
3347 rpc conn ref_unblocked_time ~desc
:"tooltip" command
3349 (* Serverless IDE version of signature help *)
3350 let do_signatureHelp_local
3351 (ide_service
: ClientIdeService.t
ref)
3353 (tracking_id : string)
3354 (ref_unblocked_time
: float ref)
3355 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3356 (params : SignatureHelp.params) : SignatureHelp.result Lwt.t
=
3357 let document_location = get_document_location editor_open_files params in
3358 let%lwt signatures
=
3364 (ClientIdeMessage.Signature_help
document_location)
3366 Lwt.return signatures
3368 let patch_to_workspace_edit_change (patch
: ServerRefactorTypes.patch
) :
3369 string * TextEdit.t
=
3370 let open ServerRefactorTypes
in
3374 | Insert insert_patch
3375 | Replace insert_patch
->
3378 hack_pos_to_lsp_range ~equal
:String.equal insert_patch
.pos;
3379 newText = insert_patch
.text;
3383 TextEdit.range = hack_pos_to_lsp_range ~equal
:String.equal
pos;
3389 | Insert insert_patch
3390 | Replace insert_patch
->
3391 File_url.create
(filename insert_patch
.pos)
3392 | Remove
pos -> File_url.create
(filename pos)
3396 let patches_to_workspace_edit (patches
: ServerRefactorTypes.patch list
) :
3398 let changes = List.map patches ~
f:patch_to_workspace_edit_change in
3400 List.fold
changes ~init
:SMap.empty ~
f:(fun acc
(uri, text_edit) ->
3401 let current_edits = Option.value ~default
:[] (SMap.find_opt
uri acc
) in
3402 let new_edits = text_edit :: current_edits in
3403 SMap.add
uri new_edits acc
)
3405 { WorkspaceEdit.changes }
3407 let do_documentRename
3408 (conn
: server_conn
)
3409 (ref_unblocked_time
: float ref)
3410 (params : Rename.params) : WorkspaceEdit.t
Lwt.t
=
3411 let (filename, line, char
) =
3412 lsp_file_position_to_hack (rename_params_to_document_position params)
3415 let new_name = params.newName
in
3417 ServerCommandTypes.IDE_REFACTOR
3418 { ServerCommandTypes.Ide_refactor_type.filename; line; char
; new_name }
3421 rpc_with_retry conn ref_unblocked_time ~desc
:"rename" command
3425 | Ok
patches -> patches
3429 { Error.code
= Error.InvalidRequest
; message; data = None
})
3431 Lwt.return
(patches_to_workspace_edit patches)
3433 (** This updates Main_env.hh_server_status according to the status message
3434 we just received from hh_server. See comments on hh_server_status for
3435 the invariants on its fields. *)
3436 let do_server_busy (state : state) (status : ServerCommandTypes.busy_status
) :
3438 let open Main_env
in
3439 let open ServerCommandTypes
in
3440 let (type_
, shortMessage
, message) =
3442 | Needs_local_typecheck
->
3443 ( MessageType.InfoMessage
,
3445 "hh_server is preparing to check edits" )
3446 | Doing_local_typecheck
->
3447 (MessageType.WarningMessage
, "Hack", "hh_server is checking edits")
3448 | Done_local_typecheck
->
3449 ( MessageType.InfoMessage
,
3451 "hh_server is initialized and running correctly." )
3452 | Doing_global_typecheck Blocking
->
3453 ( MessageType.WarningMessage
,
3455 "hh_server is typechecking the entire project (blocking)" )
3456 | Doing_global_typecheck Interruptible
->
3457 ( MessageType.WarningMessage
,
3459 "hh_server is typechecking entire project" )
3460 | Doing_global_typecheck
(Remote_blocking
message) ->
3461 ( MessageType.WarningMessage
,
3463 "hh_server is remote-typechecking the entire project - " ^
message )
3464 | Done_global_typecheck
->
3465 ( MessageType.InfoMessage
,
3467 "hh_server is initialized and running correctly." )
3471 let hh_server_status =
3473 ShowStatusFB.shortMessage
= Some shortMessage
;
3474 request = { ShowMessageRequest.type_
; message; actions = [] };
3480 Main_loop
{ menv with hh_server_status }
3483 let warn_truncated_diagnostic_list is_truncated
=
3484 Option.iter is_truncated ~
f:(fun total_error_count
->
3487 "Hack produced %d errors in total. Showing only a limited number to preserve performance."
3490 Lsp_helpers.showMessage_warning
to_stdout msg)
3492 (** Hack sometimes reports a diagnostic on an empty file path when it can't
3493 figure out which file to report. In this case we'll report on the root.
3494 Nuclide and VSCode both display this fine, though they obviously don't
3495 let you click-to-go-to-file on it. *)
3496 let fix_empty_paths_in_error_map errors_per_file
=
3497 let default_path = get_root_exn () |> Path.to_string
in
3498 match SMap.find_opt
"" errors_per_file
with
3499 | None
-> errors_per_file
3501 SMap.remove
"" errors_per_file
3502 |> SMap.add ~combine
:( @ ) default_path errors
3504 let update_uris_with_diagnostics uris_with_diagnostics errors_per_file
=
3505 let default_path = get_root_exn () |> Path.to_string
in
3506 let is_error_free _uri errors
= List.is_empty errors
in
3507 (* reports_without/reports_with are maps of filename->ErrorList. *)
3508 let (reports_without
, reports_with
) =
3509 SMap.partition
is_error_free errors_per_file
3511 (* files_without/files_with are sets of filenames *)
3512 let files_without = SMap.bindings reports_without
|> List.map ~
f:fst
in
3513 let files_with = SMap.bindings reports_with
|> List.map ~
f:fst
in
3514 (* uris_without/uris_with are sets of uris *)
3516 List.map
files_without ~
f:(path_to_lsp_uri ~
default_path) |> UriSet.of_list
3519 List.map
files_with ~
f:(path_to_lsp_uri ~
default_path) |> UriSet.of_list
3521 (* this is "(uris_with_diagnostics \ uris_without) U uris_with" *)
3522 UriSet.union
(UriSet.diff uris_with_diagnostics
uris_without) uris_with
3524 (** Send notifications for all reported diagnostics.
3525 Returns an updated "uris_with_diagnostics" set of all files for which
3526 our client currently has non-empty diagnostic reports. *)
3528 (uris_with_diagnostics
: UriSet.t
)
3529 (errors_per_file
: Errors.finalized_error list
SMap.t
)
3530 ~
(is_truncated
: int option) : UriSet.t
=
3531 let errors_per_file = fix_empty_paths_in_error_map errors_per_file in
3532 let send_diagnostic_notification file errors
=
3533 let params = hack_errors_to_lsp_diagnostic file errors
in
3534 let notification = PublishDiagnosticsNotification
params in
3535 notify_jsonrpc ~powered_by
:Hh_server
notification
3537 SMap.iter
send_diagnostic_notification errors_per_file;
3538 warn_truncated_diagnostic_list is_truncated
;
3539 update_uris_with_diagnostics uris_with_diagnostics
errors_per_file
3541 let do_initialize (local_config
: ServerLocalConfig.t
) : Initialize.result =
3544 server_capabilities
=
3548 want_openClose
= true;
3549 want_change
= IncrementalSync
;
3550 want_willSave
= false;
3551 want_willSaveWaitUntil
= true;
3552 want_didSave
= Some
{ includeText
= false };
3554 hoverProvider
= true;
3555 completionProvider
=
3558 resolveProvider
= true;
3559 completion_triggerCharacters
=
3560 ["$"; ">"; "\\"; ":"; "<"; "["; "'"; "\""; "{"; "#"];
3562 signatureHelpProvider
=
3563 Some
{ sighelp_triggerCharacters
= ["("; ","] };
3564 definitionProvider
= true;
3565 typeDefinitionProvider
= true;
3566 referencesProvider
= true;
3567 documentHighlightProvider
= true;
3568 documentSymbolProvider
= true;
3569 workspaceSymbolProvider
= true;
3570 codeActionProvider
= true;
3571 codeLensProvider
= None
;
3572 documentFormattingProvider
= true;
3573 documentRangeFormattingProvider
= true;
3574 documentOnTypeFormattingProvider
=
3575 Some
{ firstTriggerCharacter
= ";"; moreTriggerCharacter
= ["}"] };
3576 renameProvider
= true;
3577 documentLinkProvider
= None
;
3578 executeCommandProvider
= None
;
3579 implementationProvider
=
3580 local_config
.ServerLocalConfig.go_to_implementation
;
3581 typeCoverageProviderFB
= true;
3582 rageProviderFB
= true;
3586 let do_didChangeWatchedFiles_registerCapability () : Lsp.lsp_request
=
3587 (* We want a glob-pattern like "**/*.{php,phpt,hack,hackpartial,hck,hh,hhi,xhp}".
3588 I'm constructing it from FindUtils.extensions so our glob-pattern doesn't get out
3589 of sync with FindUtils.file_filter. *)
3591 List.map
FindUtils.extensions ~
f:(fun s -> String_utils.lstrip
s ".")
3594 Printf.sprintf
"**/*.{%s}" (extensions |> String.concat ~sep
:",")
3596 let registration_options =
3597 DidChangeWatchedFilesRegistrationOptions
3599 DidChangeWatchedFiles.watchers
= [{ DidChangeWatchedFiles.globPattern }];
3603 Lsp.RegisterCapability.make_registration
registration_options
3605 Lsp.RegisterCapabilityRequest
3606 { RegisterCapability.registrations
= [registration] }
3608 let handle_idle_if_necessary (state : state) (event
: event
) : state =
3610 | Main_loop
menv when not
(is_tick event
) ->
3611 Main_loop
{ menv with Main_env.needs_idle
= true }
3614 let track_open_and_recent_files (state : state) (event
: event
) : state =
3615 (* We'll keep track of which files are opened by the editor. *)
3616 let prev_opened_files =
3617 Option.value (get_editor_open_files state) ~default
:UriMap.empty
3619 let editor_open_files =
3621 | Client_message
(_
, NotificationMessage
(DidOpenNotification
params)) ->
3622 let doc = params.DidOpen.textDocument
in
3623 let uri = params.DidOpen.textDocument
.TextDocumentItem.uri in
3624 UriMap.add
uri doc prev_opened_files
3625 | Client_message
(_
, NotificationMessage
(DidChangeNotification
params)) ->
3627 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3629 let doc = UriMap.find_opt
uri prev_opened_files in
3630 let open Lsp.TextDocumentItem
in
3637 params.DidChange.textDocument
3638 .VersionedTextDocumentIdentifier.version;
3640 Lsp_helpers.apply_changes_unsafe
3642 params.DidChange.contentChanges
;
3645 UriMap.add
uri doc'
prev_opened_files
3646 | None
-> prev_opened_files)
3647 | Client_message
(_
, NotificationMessage
(DidCloseNotification
params)) ->
3648 let uri = params.DidClose.textDocument
.TextDocumentIdentifier.uri in
3649 UriMap.remove
uri prev_opened_files
3650 | _
-> prev_opened_files
3652 (* We'll track which was the most recent file to have an event *)
3653 let most_recent_file =
3655 | Client_message
(_metadata
, message) ->
3656 let uri = Lsp_fmt.get_uri_opt
message in
3657 if Option.is_some
uri then
3660 get_most_recent_file state
3661 | _
-> get_most_recent_file state
3665 Main_loop
{ menv with Main_env.editor_open_files; most_recent_file }
3667 In_init
{ ienv
with In_init_env.editor_open_files; most_recent_file }
3668 | Lost_server lenv
->
3669 Lost_server
{ lenv
with Lost_env.editor_open_files; most_recent_file }
3672 let track_edits_if_necessary (state : state) (event
: event
) : state =
3673 (* We'll keep track of which files have unsaved edits. Note that not all
3674 * clients send didSave messages; for those we only rely on didClose. *)
3675 let previous = get_uris_with_unsaved_changes state in
3676 let uris_with_unsaved_changes =
3678 | Client_message
(_
, NotificationMessage
(DidChangeNotification
params)) ->
3680 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3682 UriSet.add
uri previous
3683 | Client_message
(_
, NotificationMessage
(DidCloseNotification
params)) ->
3684 let uri = params.DidClose.textDocument
.TextDocumentIdentifier.uri in
3685 UriSet.remove
uri previous
3686 | Client_message
(_
, NotificationMessage
(DidSaveNotification
params)) ->
3687 let uri = params.DidSave.textDocument
.TextDocumentIdentifier.uri in
3688 UriSet.remove
uri previous
3692 | Main_loop
menv -> Main_loop
{ menv with Main_env.uris_with_unsaved_changes }
3693 | In_init ienv
-> In_init
{ ienv
with In_init_env.uris_with_unsaved_changes }
3694 | Lost_server lenv
->
3695 Lost_server
{ lenv
with Lost_env.uris_with_unsaved_changes }
3698 let get_filename_in_message_for_logging (message : lsp_message
) :
3699 Relative_path.t
option =
3700 let uri_opt = Lsp_fmt.get_uri_opt
message in
3705 let path = Lsp_helpers.lsp_uri_to_path uri in
3706 Some
(Relative_path.create_detect_prefix
path)
3709 Some
(Relative_path.create
Relative_path.Dummy
(Lsp.string_of_uri
uri)))
3711 (* Historical quirk: we log kind and method-name a bit idiosyncratically... *)
3712 let get_message_kind_and_method_for_logging (message : lsp_message
) :
3715 | ResponseMessage
(_
, _
) -> ("Response", "[response]")
3716 | RequestMessage
(_
, r
) -> ("Request", Lsp_fmt.request_name_to_string r
)
3717 | NotificationMessage n
->
3718 ("Notification", Lsp_fmt.notification_name_to_string n
)
3720 let log_response_if_necessary
3723 (result_telemetry_opt
: result_telemetry
option)
3724 (unblocked_time
: float) : unit =
3726 | Client_message
(metadata
, message) ->
3727 let (kind, method_
) = get_message_kind_and_method_for_logging message in
3728 let t = Unix.gettimeofday
() in
3730 "lsp-message [%s] queue time [%0.3f] execution time [%0.3f]"
3732 (unblocked_time
-. metadata
.timestamp
)
3733 (t -. unblocked_time
);
3734 let (result_count
, result_extra_telemetry
) =
3735 match result_telemetry_opt
with
3736 | None
-> (None
, None
)
3737 | Some
{ result_count
; result_extra_telemetry
} ->
3738 (Some result_count
, result_extra_telemetry
)
3740 HackEventLogger.client_lsp_method_handled
3741 ~
root:(get_root_opt ())
3744 ~path_opt
:(get_filename_in_message_for_logging message)
3746 ~result_extra_telemetry
3747 ~
tracking_id:metadata
.tracking_id
3748 ~start_queue_time
:metadata
.timestamp
3749 ~start_hh_server_state
:
3750 (get_older_hh_server_state metadata
.timestamp
3751 |> hh_server_state_to_string)
3752 ~start_handle_time
:unblocked_time
3753 ~serverless_ide_flag
:env
.use_serverless_ide
3757 | Error_from_server_fatal
3758 | Error_from_client_fatal
3759 | Error_from_client_recoverable
3760 | Error_from_server_recoverable
3761 | Error_from_lsp_cancelled
3762 | Error_from_lsp_misc
3765 (event
: event
option)
3767 (source
: error_source
)
3768 (unblocked_time
: float)
3769 (env
: env
) : unit =
3770 let root = get_root_opt () in
3773 | Error_from_lsp_cancelled
-> true
3774 | Error_from_server_fatal
3775 | Error_from_client_fatal
3776 | Error_from_client_recoverable
3777 | Error_from_server_recoverable
3778 | Error_from_lsp_misc
->
3783 | Error_from_server_fatal
-> "server_fatal"
3784 | Error_from_client_fatal
-> "client_fatal"
3785 | Error_from_client_recoverable
-> "client_recoverable"
3786 | Error_from_server_recoverable
-> "server_recoverable"
3787 | Error_from_lsp_cancelled
-> "lsp_cancelled"
3788 | Error_from_lsp_misc
-> "lsp_misc"
3790 if not
is_expected then log "%s" (Lsp_fmt.error_to_log_string
e);
3792 | Some
(Client_message
(metadata
, message)) ->
3793 let start_hh_server_state =
3794 get_older_hh_server_state metadata
.timestamp
|> hh_server_state_to_string
3796 let (kind, method_
) = get_message_kind_and_method_for_logging message in
3797 HackEventLogger.client_lsp_method_exception
3801 ~path_opt
:(get_filename_in_message_for_logging message)
3802 ~
tracking_id:metadata
.tracking_id
3803 ~start_queue_time
:metadata
.timestamp
3804 ~
start_hh_server_state
3805 ~start_handle_time
:unblocked_time
3806 ~serverless_ide_flag
:env
.use_serverless_ide
3807 ~
message:e.Error.message
3808 ~data_opt
:e.Error.data
3811 HackEventLogger.client_lsp_exception
3813 ~
message:e.Error.message
3814 ~data_opt
:e.Error.data
3817 (* cancel_if_stale: If a message is stale, throw the necessary exception to
3818 cancel it. A message is considered stale if it's sufficiently old and there
3819 are other messages in the queue that are newer than it. *)
3820 let short_timeout = 2.5
3822 let long_timeout = 15.0
3824 let cancel_if_stale (client : Jsonrpc.t) (timestamp
: float) (timeout
: float) :
3826 let time_elapsed = Unix.gettimeofday
() -. timestamp
in
3828 Float.(time_elapsed >= timeout
)
3829 && Jsonrpc.has_message
client
3830 && not
(Sys_utils.deterministic_behavior_for_tests
())
3835 Error.code
= Error.RequestCancelled
;
3836 message = "request timed out";
3842 (** This is called before we even start processing a message. Its purpose:
3843 if the Jsonrpc queue has already previously read off stdin a cancellation
3844 request for the message we're about to handle, then throw an exception.
3845 There are races, e.g. we might start handling this request because we haven't
3846 yet gotten around to reading a cancellation message off stdin. But
3847 that's inevitable. Think of this only as best-effort. *)
3848 let cancel_if_has_pending_cancel_request
3849 (client : Jsonrpc.t) (message : lsp_message
) : unit =
3851 | ResponseMessage _
-> ()
3852 | NotificationMessage _
-> ()
3853 | RequestMessage
(id, _request
) ->
3854 (* Scan the queue for any pending (future) cancellation messages that are requesting
3855 cancellation of the same id as our current request *)
3856 let pending_cancel_request_opt =
3857 Jsonrpc.find_already_queued_message
client ~
f:(fun { Jsonrpc.json; _
} ->
3860 Lsp_fmt.parse_lsp
json (fun _
->
3861 failwith
"not resolving responses")
3864 | NotificationMessage
3865 (CancelRequestNotification
{ Lsp.CancelRequest.id = peek_id
})
3867 Lsp.IdKey.compare
id peek_id
= 0
3872 (* If there is a future cancellation request, we won't even embark upon this message *)
3873 if Option.is_some
pending_cancel_request_opt then
3877 Error.code
= Error.RequestCancelled
;
3878 message = "request cancelled";
3884 (************************************************************************)
3885 (* Message handling *)
3886 (************************************************************************)
3888 (** send DidOpen/Close/Change/Save to hh_server and ide_service as needed *)
3889 let handle_editor_buffer_message
3891 ~
(ide_service
: ClientIdeService.t ref option)
3893 ~
(metadata
: incoming_metadata
)
3894 ~
(ref_unblocked_time
: float ref)
3895 ~
(message : lsp_message
) : unit Lwt.t =
3896 let uri_to_path uri = uri |> lsp_uri_to_path |> Path.make
in
3897 let ref_hh_unblocked_time = ref 0. in
3898 let ref_ide_unblocked_time = ref 0. in
3900 (* send to hh_server as necessary *)
3901 let (hh_server_promise
: unit Lwt.t) =
3902 let open Main_env
in
3903 match (state, message) with
3904 (* textDocument/didOpen notification *)
3905 | (Main_loop
menv, NotificationMessage
(DidOpenNotification
params)) ->
3906 let%lwt
() = do_didOpen menv.conn
ref_hh_unblocked_time params in
3908 (* textDocument/didClose notification *)
3909 | (Main_loop
menv, NotificationMessage
(DidCloseNotification
params)) ->
3910 let%lwt
() = do_didClose menv.conn
ref_hh_unblocked_time params in
3912 (* textDocument/didChange notification *)
3913 | (Main_loop
menv, NotificationMessage
(DidChangeNotification
params)) ->
3914 let%lwt
() = do_didChange menv.conn
ref_hh_unblocked_time params in
3916 (* textDocument/didSave notification *)
3917 | (Main_loop _menv
, NotificationMessage
(DidSaveNotification _params
)) ->
3919 | (_
, _
) -> Lwt.return_unit
3922 (* send to ide_service as necessary *)
3923 (* For now 'ide_service_promise' is immediately fulfilled, but in future it will
3924 be fulfilled only when the ide_service has finished processing the message. *)
3925 let (ide_service_promise
: unit Lwt.t) =
3926 match (ide_service
, message) with
3927 | (Some ide_service
, NotificationMessage
(DidOpenNotification
params)) ->
3929 uri_to_path params.DidOpen.textDocument
.TextDocumentItem.uri
3931 let file_contents = params.DidOpen.textDocument
.TextDocumentItem.text in
3932 (* The ClientIdeDaemon only delivers answers for open files, which is why it's vital
3933 never to let is miss a DidOpen. *)
3938 ~
tracking_id:metadata
.tracking_id
3939 ~ref_unblocked_time
:ref_ide_unblocked_time
3940 ClientIdeMessage.(Ide_file_opened
{ file_path; file_contents })
3943 | (Some ide_service
, NotificationMessage
(DidChangeNotification
params)) ->
3946 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3952 ~
tracking_id:metadata
.tracking_id
3953 ~ref_unblocked_time
:ref_ide_unblocked_time
3954 ClientIdeMessage.(Ide_file_changed
{ Ide_file_changed.file_path })
3957 | (Some ide_service
, NotificationMessage
(DidCloseNotification
params)) ->
3959 uri_to_path params.DidClose.textDocument
.TextDocumentIdentifier.uri
3965 ~
tracking_id:metadata
.tracking_id
3966 ~ref_unblocked_time
:ref_ide_unblocked_time
3967 ClientIdeMessage.(Ide_file_closed
file_path)
3971 (* Don't handle other events for now. When we show typechecking errors for
3972 the open file, we'll start handling them. *)
3976 (* Our asynchrony deal is (1) we want to kick off notifications to
3977 hh_server and ide_service at the same time, (2) we want to wait until
3978 both are done, (3) an exception in one shouldn't jeapordize the other,
3979 (4) our failure model only allows us to record at most one exception
3980 so we'll pick one arbitrarily. *)
3981 let%lwt
(hh_server_e
: Exception.t option) =
3983 let%lwt
() = hh_server_promise
in
3986 | e -> Lwt.return_some
(Exception.wrap
e)
3987 and (ide_service_e
: Exception.t option) =
3989 let%lwt
() = ide_service_promise
in
3992 | e -> Lwt.return_some
(Exception.wrap
e)
3994 ref_unblocked_time
:= Float.max
!ref_hh_unblocked_time !ref_ide_unblocked_time;
3995 match (hh_server_e
, ide_service_e
) with
3999 | _
-> Lwt.return_unit
4001 let set_verbose_to_file
4002 ~
(ide_service
: ClientIdeService.t ref option)
4004 ~
(tracking_id : string)
4005 (value : bool) : unit =
4006 verbose_to_file := value;
4007 if !verbose_to_file then
4008 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Debug
4010 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Info
;
4011 match ide_service
with
4012 | Some ide_service
->
4013 let ref_unblocked_time = ref 0. in
4014 let (promise
: unit Lwt.t) =
4020 (ClientIdeMessage.Verbose_to_file
!verbose_to_file)
4022 ignore_promise_but_handle_failure
4024 ~desc
:"verbose-ide-rpc"
4025 ~terminate_on_failure
:false
4028 (* handle_event: Process and respond to a message, and update the LSP state
4029 machine accordingly. In case the message was a request, it returns the
4030 json it responded with, so the caller can log it. *)
4031 let handle_client_message
4033 ~
(state : state ref)
4034 ~
(client : Jsonrpc.t)
4035 ~
(ide_service
: ClientIdeService.t ref option)
4036 ~
(metadata
: incoming_metadata
)
4037 ~
(message : lsp_message
)
4038 ~
(ref_unblocked_time : float ref) : result_telemetry
option Lwt.t =
4039 let open Main_env
in
4040 cancel_if_has_pending_cancel_request client message;
4041 let%lwt result_telemetry_opt
=
4042 (* make sure to wrap any exceptions below in the promise *)
4043 let tracking_id = metadata
.tracking_id in
4044 let timestamp = metadata
.timestamp in
4045 let editor_open_files =
4046 match get_editor_open_files !state with
4047 | Some files
-> files
4048 | None
-> UriMap.empty
4050 match (!state, ide_service
, message) with
4052 | (_
, _
, ResponseMessage
(id, response)) ->
4053 let (_
, handler) = IdMap.find
id !requests_outstanding in
4054 let%lwt new_state
= handler response !state in
4057 (* shutdown request *)
4058 | (_
, _
, RequestMessage
(id, ShutdownRequest
)) ->
4060 do_shutdown !state ide_service
tracking_id ref_unblocked_time
4063 respond_jsonrpc ~powered_by
:Language_server
id ShutdownResult
;
4065 (* cancel notification *)
4066 | (_
, _
, NotificationMessage
(CancelRequestNotification _
)) ->
4067 (* In [cancel_if_has_pending_cancel_request] above, when we received request ID "x",
4068 then at that time then we scanned through the queue for any CancelRequestNotification
4069 of the same ID. We didn't remove that CancelRequestNotification though.
4070 If we worked through the queue long enough to handle a CancelRequestNotification,
4071 it means that either we've earlier cancelled it, or that processing was done
4072 before the cancel request got into the queue. Either way, there's nothing to do now! *)
4074 (* exit notification *)
4075 | (_
, _
, NotificationMessage ExitNotification
) ->
4076 if is_post_shutdown !state then
4080 (* setTrace notification *)
4081 | (_
, _
, NotificationMessage
(SetTraceNotification
params)) ->
4084 | SetTraceNotification.Verbose
-> true
4085 | SetTraceNotification.Off
-> false
4087 set_verbose_to_file ~ide_service ~env ~
tracking_id value;
4089 (* test entrypoint: shutdown client_ide_service *)
4092 RequestMessage
(id, HackTestShutdownServerlessRequestFB
) ) ->
4097 ~stop_reason
:ClientIdeService.Stop_reason.Testing
4100 ~powered_by
:Serverless_ide
4102 HackTestShutdownServerlessResultFB
;
4104 (* test entrypoint: stop hh_server *)
4105 | (_
, _
, RequestMessage
(id, HackTestStopServerRequestFB
)) ->
4107 Path.make
(Relative_path.path_of_prefix
Relative_path.Root
)
4109 ClientStop.kill_server
root_folder !from;
4110 respond_jsonrpc ~powered_by
:Serverless_ide
id HackTestStopServerResultFB
;
4112 (* test entrypoint: start hh_server *)
4113 | (_
, _
, RequestMessage
(id, HackTestStartServerRequestFB
)) ->
4115 Path.make
(Relative_path.path_of_prefix
Relative_path.Root
)
4117 start_server ~env
root_folder;
4118 respond_jsonrpc ~powered_by
:Serverless_ide
id HackTestStartServerResultFB
;
4120 (* initialize request *)
4121 | (Pre_init
, _
, RequestMessage
(id, InitializeRequest
initialize_params)) ->
4122 let open Initialize
in
4123 initialize_params_ref := Some
initialize_params;
4125 (* There's a lot of global-mutable-variable initialization we can only do after
4126 we get root, here in the handler of the initialize request. The function
4127 [get_root_exn] becomes available after we've set up initialize_params_ref, above. *)
4128 let root = get_root_exn () in
4129 Relative_path.set_path_prefix
Relative_path.Root
root;
4130 set_up_hh_logger_for_client_lsp root;
4132 (* Following is a hack. Atom incorrectly passes '--from vscode', rendering us
4133 unable to distinguish Atom from VSCode. But Atom is now frozen at vscode client
4134 v3.14. So by looking at the version, we can at least distinguish that it's old. *)
4137 initialize_params.client_capabilities
.textDocument
.declaration
4138 .declarationLinkSupport
)
4139 && String.equal env
.args
.from "vscode"
4141 from := "vscode_pre314";
4142 HackEventLogger.set_from
!from
4145 (* The function [get_local_config_exn] becomes available after we've set ref_local_config. *)
4147 ServerArgs.default_options ~
root:(Path.to_string
root)
4149 let server_args = ServerArgs.set_config
server_args env
.args
.config
in
4151 snd
@@ ServerConfig.load ~silent
:true ServerConfig.filename server_args
4153 ref_local_config := Some
local_config;
4154 HackEventLogger.set_rollout_flags
4155 (ServerLocalConfig.to_rollout_flags
local_config);
4156 HackEventLogger.set_rollout_group
4157 local_config.ServerLocalConfig.rollout_group
;
4158 HackEventLogger.set_machine_class
4159 local_config.ServerLocalConfig.machine_class
;
4161 let%lwt
version = read_hhconfig_version () in
4162 HackEventLogger.set_hhconfig_version
4163 (Some
(String_utils.lstrip
version "^"));
4164 let%lwt version_and_switch
= read_hhconfig_version_and_switch () in
4165 hhconfig_version_and_switch := version_and_switch
;
4166 let%lwt new_state
= connect ~env
!state in
4168 (* If editor sent 'trace: on' then that will turn on verbose_to_file. But we won't turn off
4169 verbose here, since the command-line argument --verbose trumps initialization params. *)
4171 match initialize_params.Initialize.trace
with
4172 | Initialize.Off
-> ()
4173 | Initialize.Messages
4174 | Initialize.Verbose
->
4175 set_verbose_to_file ~ide_service ~env ~
tracking_id true
4177 let result = do_initialize local_config in
4178 respond_jsonrpc ~powered_by
:Language_server
id (InitializeResult
result);
4181 match ide_service
with
4183 | Some ide_service
->
4184 let (promise
: unit Lwt.t) =
4185 run_ide_service env
!ide_service
initialize_params None
4187 ignore_promise_but_handle_failure
4189 ~desc
:"run-ide-after-init"
4190 ~terminate_on_failure
:true;
4191 (* Invariant: at all times after InitializeRequest, ide_service has
4192 already been sent an "initialize" message. *)
4193 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
4194 let request = do_didChangeWatchedFiles_registerCapability () in
4195 to_stdout (print_lsp_request
id request);
4196 (* TODO: our handler should really handle an error response properly *)
4197 let handler _response
state = Lwt.return
state in
4198 requests_outstanding :=
4199 IdMap.add
id (request, handler) !requests_outstanding
4202 if not
(Sys_utils.deterministic_behavior_for_tests
()) then
4203 Lsp_helpers.telemetry_log
4205 ("Version in hhconfig and switch=" ^
!hhconfig_version_and_switch);
4206 Lwt.return_some
{ result_count
= 0; result_extra_telemetry
= None
}
4207 (* any request/notification if we haven't yet initialized *)
4208 | (Pre_init
, _
, _
) ->
4212 Error.code
= Error.ServerNotInitialized
;
4213 message = "Server not yet initialized";
4216 | (Post_shutdown
, _
, _c
) ->
4220 Error.code
= Error.InvalidRequest
;
4221 message = "already received shutdown request";
4224 (* initialized notification *)
4225 | (_
, _
, NotificationMessage InitializedNotification
) -> Lwt.return_none
4227 | (_
, _
, RequestMessage
(id, RageRequestFB
)) ->
4228 let%lwt
result = do_rageFB !state in
4229 respond_jsonrpc ~powered_by
:Language_server
id (RageResultFB
result);
4231 { result_count
= List.length
result; result_extra_telemetry
= None
}
4234 NotificationMessage
(DidChangeWatchedFilesNotification
notification) )
4236 let open DidChangeWatchedFiles
in
4238 List.map
notification.changes ~
f:(fun change
->
4239 ClientIdeMessage.Changed_file
(lsp_uri_to_path change
.uri))
4247 ClientIdeMessage.(Disk_files_changed
changes)
4250 (* Text document completion: "AutoComplete!" *)
4251 | (_
, Some ide_service
, RequestMessage
(id, CompletionRequest
params)) ->
4252 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4262 respond_jsonrpc ~powered_by
:Serverless_ide
id (CompletionResult
result);
4265 result_count
= List.length
result.Completion.items
;
4266 result_extra_telemetry
= None
;
4268 (* Resolve documentation for a symbol: "Autocomplete Docblock!" *)
4271 RequestMessage
(id, CompletionItemResolveRequest
params) ) ->
4272 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4283 ~powered_by
:Serverless_ide
4285 (CompletionItemResolveResult
result);
4286 Lwt.return_some
{ result_count
= 1; result_extra_telemetry
= None
}
4287 (* Document highlighting in serverless IDE *)
4288 | (_
, Some ide_service
, RequestMessage
(id, DocumentHighlightRequest
params))
4290 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4301 ~powered_by
:Serverless_ide
4303 (DocumentHighlightResult
result);
4305 { result_count
= List.length
result; result_extra_telemetry
= None
}
4306 (* Type coverage in serverless IDE *)
4307 | (_
, Some ide_service
, RequestMessage
(id, TypeCoverageRequestFB
params))
4309 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4311 do_typeCoverage_localFB
4320 ~powered_by
:Serverless_ide
4322 (TypeCoverageResultFB
result);
4325 result_count
= List.length
result.TypeCoverageFB.uncoveredRanges
;
4326 result_extra_telemetry
= None
;
4328 (* Hover docblocks in serverless IDE *)
4329 | (_
, Some ide_service
, RequestMessage
(id, HoverRequest
params)) ->
4330 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4340 respond_jsonrpc ~powered_by
:Serverless_ide
id (HoverResult
result);
4344 | Some
{ Hover.contents; _
} -> List.length
contents
4346 Lwt.return_some
{ result_count; result_extra_telemetry
= None
}
4347 | (_
, Some ide_service
, RequestMessage
(id, DocumentSymbolRequest
params))
4349 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4351 do_documentSymbol_local
4360 ~powered_by
:Serverless_ide
4362 (DocumentSymbolResult
result);
4364 { result_count = List.length
result; result_extra_telemetry
= None
}
4365 | (_
, Some ide_service
, RequestMessage
(id, WorkspaceSymbolRequest
params))
4368 do_workspaceSymbol_local
4376 ~powered_by
:Serverless_ide
4378 (WorkspaceSymbolResult
result);
4380 { result_count = List.length
result; result_extra_telemetry
= None
}
4381 | (_
, Some ide_service
, RequestMessage
(id, DefinitionRequest
params)) ->
4382 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4383 let%lwt
(result, has_xhp_attribute) =
4392 let result_extra_telemetry =
4395 (Telemetry.create
()
4396 |> Telemetry.bool_ ~key
:"has_xhp_attribute" ~
value:true)
4398 respond_jsonrpc ~powered_by
:Serverless_ide
id (DefinitionResult
result);
4400 { result_count = List.length
result; result_extra_telemetry }
4401 | (_
, Some ide_service
, RequestMessage
(id, TypeDefinitionRequest
params))
4403 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4405 do_typeDefinition_local
4414 ~powered_by
:Serverless_ide
4416 (TypeDefinitionResult
result);
4418 { result_count = List.length
result; result_extra_telemetry = None
}
4419 (* Resolve documentation for a symbol: "Autocomplete Docblock!" *)
4420 | (_
, Some ide_service
, RequestMessage
(id, SignatureHelpRequest
params)) ->
4421 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4423 do_signatureHelp_local
4431 respond_jsonrpc ~powered_by
:Serverless_ide
id (SignatureHelpResult
result);
4435 | Some
{ SignatureHelp.signatures
; _
} -> List.length signatures
4437 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4438 (* textDocument/codeAction request *)
4439 | (_
, Some ide_service
, RequestMessage
(id, CodeActionRequest
params)) ->
4440 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4450 respond_jsonrpc ~powered_by
:Serverless_ide
id (CodeActionResult
result);
4452 { result_count = List.length
result; result_extra_telemetry = None
}
4453 (* textDocument/codeAction request, when not in serverless IDE mode *)
4454 | (Main_loop
menv, None
, RequestMessage
(id, CodeActionRequest
params)) ->
4455 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4456 let%lwt
result = do_codeAction menv.conn
ref_unblocked_time params in
4457 respond_jsonrpc ~powered_by
:Hh_server
id (CodeActionResult
result);
4459 { result_count = List.length
result; result_extra_telemetry = None
}
4460 (* textDocument/formatting *)
4461 | (_
, _
, RequestMessage
(id, DocumentFormattingRequest
params)) ->
4462 let result = do_documentFormatting editor_open_files params in
4464 ~powered_by
:Language_server
4466 (DocumentFormattingResult
result);
4468 { result_count = List.length
result; result_extra_telemetry = None
}
4469 (* textDocument/rangeFormatting *)
4470 | (_
, _
, RequestMessage
(id, DocumentRangeFormattingRequest
params)) ->
4471 let result = do_documentRangeFormatting editor_open_files params in
4473 ~powered_by
:Language_server
4475 (DocumentRangeFormattingResult
result);
4477 { result_count = List.length
result; result_extra_telemetry = None
}
4478 (* textDocument/onTypeFormatting *)
4479 | (_
, _
, RequestMessage
(id, DocumentOnTypeFormattingRequest
params)) ->
4480 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4481 let result = do_documentOnTypeFormatting editor_open_files params in
4483 ~powered_by
:Language_server
4485 (DocumentOnTypeFormattingResult
result);
4487 { result_count = List.length
result; result_extra_telemetry = None
}
4488 (* textDocument/willSaveWaitUntil request *)
4489 | (_
, _
, RequestMessage
(id, WillSaveWaitUntilRequest
params)) ->
4490 let result = do_willSaveWaitUntil editor_open_files params in
4492 ~powered_by
:Language_server
4494 (WillSaveWaitUntilResult
result);
4496 { result_count = List.length
result; result_extra_telemetry = None
}
4497 (* editor buffer events *)
4501 ( DidOpenNotification _
| DidChangeNotification _
4502 | DidCloseNotification _
| DidSaveNotification _
) ) ->
4504 handle_editor_buffer_message
4513 (* any request/notification that we can't handle yet *)
4514 | (In_init _
, _
, message) ->
4515 (* we respond with Operation_cancelled so that clients don't produce *)
4516 (* user-visible logs/warnings. *)
4520 Error.code
= Error.RequestCancelled
;
4521 message = Hh_server_initializing
|> hh_server_state_to_string;
4524 (Hh_json.JSON_Object
4526 ("state", !state |> state_to_string |> Hh_json.string_
);
4529 (Lsp_fmt.denorm_message_to_string
message) );
4532 (* textDocument/hover request *)
4533 | (Main_loop
menv, _
, RequestMessage
(id, HoverRequest
params)) ->
4534 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4535 let%lwt
result = do_hover menv.conn
ref_unblocked_time params in
4536 respond_jsonrpc ~powered_by
:Hh_server
id (HoverResult
result);
4540 | Some
{ Hover.contents; _
} -> List.length
contents
4542 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4543 (* textDocument/typeDefinition request *)
4544 | (Main_loop
menv, _
, RequestMessage
(id, TypeDefinitionRequest
params)) ->
4545 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4546 let%lwt
result = do_typeDefinition menv.conn
ref_unblocked_time params in
4547 respond_jsonrpc ~powered_by
:Hh_server
id (TypeDefinitionResult
result);
4549 { result_count = List.length
result; result_extra_telemetry = None
}
4550 (* textDocument/definition request *)
4551 | (Main_loop
menv, _
, RequestMessage
(id, DefinitionRequest
params)) ->
4552 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4553 let%lwt
(result, has_xhp_attribute) =
4554 do_definition menv.conn
ref_unblocked_time editor_open_files params
4556 let result_extra_telemetry =
4559 (Telemetry.create
()
4560 |> Telemetry.bool_ ~key
:"has_xhp_attribute" ~
value:true)
4562 respond_jsonrpc ~powered_by
:Hh_server
id (DefinitionResult
result);
4564 { result_count = List.length
result; result_extra_telemetry }
4565 (* textDocument/completion request *)
4566 | (Main_loop
menv, _
, RequestMessage
(id, CompletionRequest
params)) ->
4568 if env
.use_ffp_autocomplete
then
4571 do_completion_legacy
4573 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4574 let%lwt
result = do_completion menv.conn
ref_unblocked_time params in
4575 respond_jsonrpc ~powered_by
:Hh_server
id (CompletionResult
result);
4578 result_count = List.length
result.Completion.items
;
4579 result_extra_telemetry = None
;
4581 (* completionItem/resolve request *)
4584 RequestMessage
(id, CompletionItemResolveRequest
params) ) ->
4585 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4587 do_completionItemResolve menv.conn
ref_unblocked_time params
4590 ~powered_by
:Hh_server
4592 (CompletionItemResolveResult
result);
4593 Lwt.return_some
{ result_count = 1; result_extra_telemetry = None
}
4594 (* workspace/symbol request *)
4595 | (Main_loop
menv, _
, RequestMessage
(id, WorkspaceSymbolRequest
params)) ->
4596 let%lwt
result = do_workspaceSymbol menv.conn
ref_unblocked_time params in
4597 respond_jsonrpc ~powered_by
:Hh_server
id (WorkspaceSymbolResult
result);
4599 { result_count = List.length
result; result_extra_telemetry = None
}
4600 (* textDocument/documentSymbol request *)
4601 | (Main_loop
menv, _
, RequestMessage
(id, DocumentSymbolRequest
params)) ->
4602 let%lwt
result = do_documentSymbol menv.conn
ref_unblocked_time params in
4603 respond_jsonrpc ~powered_by
:Hh_server
id (DocumentSymbolResult
result);
4605 { result_count = List.length
result; result_extra_telemetry = None
}
4606 (* textDocument/references request *)
4607 | (Main_loop
menv, _
, RequestMessage
(id, FindReferencesRequest
params)) ->
4608 let%lwt
() = cancel_if_stale client timestamp long_timeout in
4609 let%lwt
result = do_findReferences menv.conn
ref_unblocked_time params in
4610 respond_jsonrpc ~powered_by
:Hh_server
id (FindReferencesResult
result);
4612 { result_count = List.length
result; result_extra_telemetry = None
}
4613 (* textDocument/implementation request *)
4614 | (Main_loop
menv, _
, RequestMessage
(id, ImplementationRequest
params)) ->
4615 let%lwt
() = cancel_if_stale client timestamp long_timeout in
4617 do_goToImplementation menv.conn
ref_unblocked_time params
4619 respond_jsonrpc ~powered_by
:Hh_server
id (ImplementationResult
result);
4621 { result_count = List.length
result; result_extra_telemetry = None
}
4622 (* textDocument/rename *)
4623 | (Main_loop
menv, _
, RequestMessage
(id, RenameRequest
params)) ->
4624 let%lwt
result = do_documentRename menv.conn
ref_unblocked_time params in
4625 respond_jsonrpc ~powered_by
:Hh_server
id (RenameResult
result);
4628 (fun _file
changes tot
-> tot
+ List.length
changes)
4629 result.WorkspaceEdit.changes
4632 let result_extra_telemetry =
4636 ~
value:(SMap.cardinal
result.WorkspaceEdit.changes)
4639 { result_count; result_extra_telemetry = Some
result_extra_telemetry }
4640 (* textDocument/documentHighlight *)
4641 | (Main_loop
menv, _
, RequestMessage
(id, DocumentHighlightRequest
params))
4643 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4645 do_documentHighlight menv.conn
ref_unblocked_time params
4647 respond_jsonrpc ~powered_by
:Hh_server
id (DocumentHighlightResult
result);
4649 { result_count = List.length
result; result_extra_telemetry = None
}
4650 (* textDocument/typeCoverage *)
4651 | (Main_loop
menv, _
, RequestMessage
(id, TypeCoverageRequestFB
params)) ->
4652 let%lwt
result = do_typeCoverageFB menv.conn
ref_unblocked_time params in
4653 respond_jsonrpc ~powered_by
:Hh_server
id (TypeCoverageResultFB
result);
4656 result_count = List.length
result.TypeCoverageFB.uncoveredRanges
;
4657 result_extra_telemetry = None
;
4659 (* textDocument/signatureHelp notification *)
4660 | (Main_loop
menv, _
, RequestMessage
(id, SignatureHelpRequest
params)) ->
4661 let%lwt
result = do_signatureHelp menv.conn
ref_unblocked_time params in
4662 respond_jsonrpc ~powered_by
:Hh_server
id (SignatureHelpResult
result);
4666 | Some
result -> List.length
result.SignatureHelp.signatures
4668 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4669 (* catch-all for client reqs/notifications we haven't yet implemented *)
4670 | (Main_loop _menv
, _
, message) ->
4671 let method_ = Lsp_fmt.message_name_to_string
message in
4675 Error.code
= Error.MethodNotFound
;
4676 message = Printf.sprintf
"not implemented: %s" method_;
4679 (* catch-all for requests/notifications after shutdown request *)
4680 (* client message when we've lost the server *)
4681 | (Lost_server lenv
, _
, _
) ->
4682 let open Lost_env
in
4683 (* if trigger_on_lsp_method is set, our caller should already have *)
4684 (* transitioned away from this state. *)
4685 assert (not lenv
.p.trigger_on_lsp
);
4687 (* We deny all other requests. This is the only response that won't *)
4688 (* produce logs/warnings on most clients... *)
4692 Error.code
= Error.RequestCancelled
;
4693 message = lenv
.p.new_hh_server_state |> hh_server_state_to_string;
4696 (Hh_json.JSON_Object
4698 ("state", !state |> state_to_string |> Hh_json.string_
);
4701 (Lsp_fmt.denorm_message_to_string
message) );
4705 Lwt.return result_telemetry_opt
4707 let handle_server_message
4708 ~
(env
: env
) ~
(state : state ref) ~
(message : server_message
) :
4709 result_telemetry
option Lwt.t =
4711 match (!state, message) with
4712 (* server busy status *)
4713 | (_
, { push
= ServerCommandTypes.BUSY_STATUS
status; _
}) ->
4714 state := do_server_busy !state status;
4716 (* textDocument/publishDiagnostics notification *)
4718 { push
= ServerCommandTypes.DIAGNOSTIC
{ errors
; is_truncated
}; _
} )
4720 let uris_with_diagnostics =
4721 do_diagnostics menv.Main_env.uris_with_diagnostics errors ~is_truncated
4723 state := Main_loop
{ menv with Main_env.uris_with_diagnostics };
4725 (* any server diagnostics that come after we've shut down *)
4726 | (_
, { push
= ServerCommandTypes.DIAGNOSTIC _
; _
}) -> Lwt.return_unit
4727 (* server shut-down request *)
4728 | (Main_loop _menv
, { push
= ServerCommandTypes.NEW_CLIENT_CONNECTED
; _
})
4735 Lost_env.explanation = "hh_server is active in another window.";
4736 new_hh_server_state = Hh_server_stolen
;
4737 start_on_click
= false;
4738 trigger_on_lock_file
= false;
4739 trigger_on_lsp
= true;
4744 (* server shut-down request, unexpected *)
4745 | (_
, { push
= ServerCommandTypes.NEW_CLIENT_CONNECTED
; _
}) ->
4746 let message = "unexpected close of absent server" in
4748 raise
(Server_fatal_connection_exception
{ Marshal_tools.message; stack })
4749 (* server fatal shutdown *)
4750 | (_
, { push
= ServerCommandTypes.FATAL_EXCEPTION
e; _
}) ->
4751 raise
(Server_fatal_connection_exception
e)
4752 (* server non-fatal exception *)
4756 ServerCommandTypes.NONFATAL_EXCEPTION
4757 { Marshal_tools.message; stack };
4760 raise
(Server_nonfatal_exception
(make_lsp_error message ~
stack))
4764 (** The server sending 'hello' means that it is ready to establish a persistent
4765 connection. Establish that connection and send our backlog of file-edits to the server. *)
4766 let connect_after_hello (server_conn
: server_conn
) (state : state) : unit Lwt.t
4768 log "connect_after_hello";
4771 (* tell server we want persistent connection *)
4772 let oc = server_conn
.oc in
4773 ServerCommandLwt.send_connection_type
oc ServerCommandTypes.Persistent
;
4774 let fd = oc |> Unix.descr_of_out_channel
|> Lwt_unix.of_unix_file_descr
in
4775 let%lwt
(response : 'a
ServerCommandTypes.message_type
) =
4776 Marshal_tools_lwt.from_fd_with_preamble
fd
4780 | ServerCommandTypes.Response
(ServerCommandTypes.Connected
, _
) ->
4781 set_hh_server_state Hh_server_handling_or_ready
4782 | _
-> failwith
"Didn't get server Connected response"
4785 (* Extract the list of file changes we're tracking *)
4786 let editor_open_files =
4789 | Main_loop
menv -> Main_env.(menv.editor_open_files)
4790 | In_init ienv
-> In_init_env.(ienv
.editor_open_files)
4791 | Lost_server lenv
-> Lost_env.(lenv
.editor_open_files)
4792 | _
-> UriMap.empty
)
4794 (* send open files and unsaved buffers to server *)
4795 let float_unblocked_time = ref 0.0 in
4796 (* Note: do serially since these involve RPC calls. *)
4799 (fun (uri, textDocument
) ->
4800 let filename = lsp_uri_to_path uri in
4802 ServerCommandTypes.OPEN_FILE
4803 (filename, textDocument
.TextDocumentItem.text)
4805 rpc server_conn
float_unblocked_time ~desc
:"open" command)
4811 let e = Exception.wrap
exn in
4812 log "connect_after_hello exception %s" (Exception.to_string
e);
4813 raise
(Server_fatal_connection_exception
(Marshal_tools.of_exception
e))
4817 let handle_server_hello ~
(state : state ref) : result_telemetry
option Lwt.t =
4820 (* server completes initialization *)
4822 let%lwt
() = connect_after_hello ienv
.In_init_env.conn
!state in
4823 state := report_connect_end ienv
;
4825 (* any "hello" from the server when we weren't expecting it. This is so *)
4826 (* egregious that we can't trust anything more from the server. *)
4828 let message = "Unexpected hello" in
4830 raise
(Server_fatal_connection_exception
{ Marshal_tools.message; stack })
4834 let handle_client_ide_notification
4835 ~
(notification : ClientIdeMessage.notification) :
4836 result_telemetry
option Lwt.t =
4837 (* In response to ide_service notifications we have three goals:
4838 (1) in case of Done_init, we might have to announce the failure to the user
4839 (2) in a few other cases, we send telemetry events so that test harnesses
4840 get insight into the internal state of the ide_service
4841 (3) after every single event, includinng client_ide_notification events,
4842 our caller queries the ide_service for what status it wants to display to
4843 the user, so these notifications have the goal of triggering that refresh. *)
4844 match notification with
4845 | ClientIdeMessage.Done_init
(Ok
p) ->
4846 Lsp_helpers.telemetry_log
to_stdout "[client-ide] Finished init: ok";
4847 Lsp_helpers.telemetry_log
4850 "[client-ide] Initialized; %d file changes to process"
4851 p.ClientIdeMessage.Processing_files.total
);
4853 | ClientIdeMessage.Done_init
(Error error_data
) ->
4854 log_debug "<-- done_init";
4855 Lsp_helpers.telemetry_log
to_stdout "[client-ide] Finished init: failure";
4856 let%lwt
() = announce_ide_failure error_data
in
4858 | ClientIdeMessage.Processing_files _
->
4859 (* used solely for triggering a refresh of status by our caller; nothing
4860 for us to do here. *)
4862 | ClientIdeMessage.Done_processing
->
4863 Lsp_helpers.telemetry_log
4865 "[client-ide] Done processing file changes";
4869 ~
(env
: env
) ~
(state : state ref) ~
(ref_unblocked_time : float ref) :
4870 result_telemetry
option Lwt.t =
4871 EventLogger.recheck_disk_files
();
4872 HackEventLogger.Memory.profile_if_needed
();
4873 (* Update the hh_server_status global variable, either by asking the monitor
4874 during In_init, or reading it from Main_env: *)
4875 latest_hh_server_status := get_hh_server_status !state;
4878 (* idle tick while waiting for server to complete initialization *)
4880 let open In_init_env
in
4881 let time = Unix.time () in
4882 let delay_in_secs = int_of_float
(time -. ienv
.most_recent_start_time
) in
4884 if delay_in_secs <= 10 then
4887 (* terminate + retry the connection *)
4888 let%lwt new_state
= connect ~env
!state in
4893 (* Tick when we're connected to the server *)
4895 let open Main_env
in
4897 if menv.needs_idle
then begin
4898 (* If we're connected to a server and have no more messages in the queue, *)
4899 (* then we must let the server know we're idle, so it will be free to *)
4900 (* handle command-line requests. *)
4901 state := Main_loop
{ menv with needs_idle
= false };
4907 ServerCommandTypes.IDE_IDLE
4914 (* idle tick. No-op. *)
4915 | _
-> Lwt.return_unit
4917 let (promise
: unit Lwt.t) = EventLoggerLwt.flush
() in
4918 ignore_promise_but_handle_failure
4920 ~desc
:"tick-event-flush"
4921 ~terminate_on_failure
:false;
4924 let main (args
: args
) ~
(init_id
: string) : Exit_status.t Lwt.t =
4925 Printexc.record_backtrace
true;
4927 HackEventLogger.set_from
!from;
4929 (* The hh.conf can't fully be loaded without root, since it has flags like "foo=^4.53" that
4930 depend on the version= line we read from root/.hhconfig. But nevertheless we need right now
4931 a few hh.conf flags that control clientLsp and which aren't done that way. So we'll read
4932 those flags right now. *)
4933 let versionless_local_config =
4934 ServerLocalConfig.load
4936 ~current_version
:(Config_file.parse_version None
)
4937 (Config_file.of_list args
.config
)
4943 use_ffp_autocomplete
=
4944 versionless_local_config.ServerLocalConfig.ide_ffp_autocomplete
;
4945 use_ranked_autocomplete
=
4946 versionless_local_config.ServerLocalConfig.ide_ranked_autocomplete
;
4947 use_serverless_ide
=
4948 versionless_local_config.ServerLocalConfig.ide_serverless
;
4952 if env.args
.verbose
then begin
4953 Hh_logger.Level.set_min_level_stderr
Hh_logger.Level.Debug
;
4954 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Debug
4956 Hh_logger.Level.set_min_level_stderr
Hh_logger.Level.Error
;
4957 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Info
4959 (* The --verbose flag in env.verbose is the only thing that controls verbosity
4960 to stderr. Meanwhile, verbosity-to-file can be altered dynamically by the user.
4961 Why are they different? because we should write to stderr under a test harness,
4962 but we should never write to stderr when invoked by VSCode - it's not even guaranteed
4963 to drain the stderr pipe. *)
4965 if env.use_serverless_ide
then
4968 (ClientIdeService.make
4970 ClientIdeMessage.init_id
= env.init_id
;
4971 verbose_to_stderr
= env.args
.verbose
;
4972 verbose_to_file = env.args
.verbose
;
4978 let client = Jsonrpc.make_t
() in
4979 let deferred_action : (unit -> unit Lwt.t) option ref = ref None
in
4980 let state = ref Pre_init
in
4981 let ref_event = ref None
in
4982 let ref_unblocked_time = ref (Unix.gettimeofday
()) in
4983 (* ref_unblocked_time is the time at which we're no longer blocked on either
4984 * clientLsp message-loop or hh_server, and can start actually handling.
4985 * Everything that blocks will update this variable. *)
4986 let process_next_event () : unit Lwt.t =
4989 match !deferred_action with
4990 | Some
deferred_action ->
4991 let%lwt
() = deferred_action () in
4993 | None
-> Lwt.return_unit
4995 deferred_action := None
;
4996 let%lwt event
= get_next_event !state client ide_service in
4997 if not
(is_tick event
) then
4998 log_debug "next event: %s" (event_to_string event
);
4999 ref_event := Some event
;
5000 ref_unblocked_time := Unix.gettimeofday
();
5002 (* maybe set a flag to indicate that we'll need to send an idle message *)
5003 state := handle_idle_if_necessary !state event
;
5005 (* if we're in a lost-server state, some triggers cause us to reconnect *)
5007 reconnect_from_lost_if_necessary ~
env !state (`Event event
)
5011 (* we keep track of all open files and their contents *)
5012 state := track_open_and_recent_files !state event
;
5014 (* we keep track of all files that have unsaved changes in them *)
5015 state := track_edits_if_necessary !state event
;
5017 (* if a message comes from the server, maybe update our record of server state *)
5018 update_hh_server_state_if_necessary event
;
5020 (* update status immediately if warranted *)
5021 if not
(is_pre_init !state || is_post_shutdown !state) then begin
5023 publish_hh_server_status_diagnostic !state !latest_hh_server_status;
5024 refresh_status ~
env ~
ide_service
5027 (* this is the main handler for each message*)
5028 let%lwt result_telemetry_opt
=
5030 | Client_message
(metadata
, message) ->
5031 handle_client_message
5039 | Client_ide_notification
notification ->
5040 handle_client_ide_notification ~
notification
5041 | Server_message
message -> handle_server_message ~
env ~
state ~
message
5042 | Server_hello
-> handle_server_hello ~
state
5043 | Tick
-> handle_tick ~
env ~
state ~
ref_unblocked_time
5045 (* for LSP requests and notifications, we keep a log of what+when we responded.
5046 INVARIANT: every LSP request gets either a response logged here,
5047 or an error logged by one of the handlers below. *)
5048 log_response_if_necessary
5051 result_telemetry_opt
5052 !ref_unblocked_time;
5055 | Server_fatal_connection_exception
{ Marshal_tools.stack; message } ->
5056 if not
(is_post_shutdown !state) then (
5057 (* The server never tells us why it closed the connection - it simply *)
5058 (* closes. We don't have privilege to inspect its exit status. *)
5059 (* But in some cases of a controlled exit, the server does write to a *)
5060 (* "finale file" to explain its reason for exit... *)
5061 let server_finale_data =
5063 | Main_loop
{ Main_env.conn
; _
}
5064 | In_init
{ In_init_env.conn
; _
} ->
5065 Exit.get_finale_data
5066 conn
.server_specific_files
.ServerCommandTypes.server_finale_file
5069 let server_finale_stack =
5070 match server_finale_data with
5071 | Some
{ Exit.stack = Utils.Callstack
s; _
} ->
5072 s |> Exception.clean_stack
5077 (Hh_json.JSON_Object
5078 [("server_finale_stack", Hh_json.string_
server_finale_stack)])
5080 let e = make_lsp_error ~
stack ~
data message in
5081 (* Log all the things! *)
5085 Error_from_server_fatal
5088 Lsp_helpers.telemetry_error
5090 (message ^
", from_server\n" ^
stack);
5092 (* The monitor is responsible for detecting server closure and exit *)
5093 (* status, and restarting the server if necessary (that's not our job). *)
5094 (* All we'll do is put up a dialog telling the user that the server is *)
5095 (* down and giving them a button to restart. *)
5097 match server_finale_data with
5098 | Some
{ Exit.msg = Some
msg; _
} -> msg
5099 | Some
{ Exit.msg = None
; exit_status
; _
} ->
5101 "hh_server: stopped [%s]"
5102 (Exit_status.show exit_status
)
5103 | _
-> "hh_server: stopped."
5105 (* When would be a good time to auto-dismiss the dialog and attempt *)
5106 (* a proper re-connection? it's not our job to ascertain with certainty *)
5107 (* whether that re-connection will succeed - it's impossible to know, *)
5108 (* but also our re-connection attempt is pretty forceful. *)
5109 (* First: if the server determined in its finale that there shouldn't *)
5110 (* be automatic retry then we won't. Otherwise, we'll sleep for 1 sec *)
5111 (* and then look for the presence of the lock file. The sleep is *)
5112 (* because typically if you do "hh stop" then the persistent connection *)
5113 (* shuts down instantly but the monitor takes a short time to release *)
5115 let trigger_on_lock_file =
5116 match server_finale_data with
5118 { Exit.exit_status
= Exit_status.Failed_to_load_should_abort
; _
}
5125 (* We're right now inside an exception handler. We don't want to do *)
5126 (* work that might itself throw. So instead we'll leave that to the *)
5127 (* next time around the loop. *)
5136 Lost_env.explanation;
5137 new_hh_server_state = Hh_server_stopped
;
5138 start_on_click
= true;
5139 trigger_on_lock_file;
5140 trigger_on_lsp
= false;
5147 | Client_fatal_connection_exception
{ Marshal_tools.stack; message } ->
5148 let e = make_lsp_error ~
stack message in
5152 Error_from_client_fatal
5155 Lsp_helpers.telemetry_error
to_stdout (message ^
", from_client\n" ^
stack);
5156 let () = exit_fail () in
5158 | Client_recoverable_connection_exception
{ Marshal_tools.stack; message }
5160 let e = make_lsp_error ~
stack message in
5164 Error_from_client_recoverable
5167 Lsp_helpers.telemetry_error
to_stdout (message ^
", from_client\n" ^
stack);
5169 | (Server_nonfatal_exception
e | Error.LspException
e) as exn ->
5170 let exn = Exception.wrap
exn in
5172 match (e.Error.code
, Exception.unwrap
exn) with
5173 | (Error.RequestCancelled
, _
) -> Error_from_lsp_cancelled
5174 | (_
, Server_nonfatal_exception _
) -> Error_from_server_recoverable
5175 | (_
, _
) -> Error_from_lsp_misc
5178 make_lsp_error ~
data:e.Error.data ~code
:e.Error.code
e.Error.message
5180 respond_to_error !ref_event e;
5181 hack_log_error !ref_event e error_source !ref_unblocked_time env;
5184 let exn = Exception.wrap
exn in
5187 ~
stack:(Exception.get_backtrace_string
exn)
5188 ~current_stack
:false
5189 (Exception.get_ctor_string
exn)
5191 respond_to_error !ref_event e;
5192 hack_log_error !ref_event e Error_from_lsp_misc
!ref_unblocked_time env;
5195 let rec main_loop () : unit Lwt.t =
5196 let%lwt
() = process_next_event () in
5199 let%lwt
() = main_loop () in
5200 Lwt.return
Exit_status.No_error