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
102 most_recent_file
: documentUri
option;
103 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
104 uris_with_diagnostics
: UriSet.t
;
105 uris_with_unsaved_changes
: UriSet.t
;
106 (** see comment in get_uris_with_unsaved_changes *)
107 hh_server_status
: ShowStatusFB.params
;
108 (** is updated by [handle_server_message] > [do_server_busy]. Shows status of
109 a connected hh_server, whether it's busy typechecking or ready:
110 (1) type_=InfoMessage when done typechecking, or WarningMessage during.
111 (2) shortMessage="Hack" if IDE is available, or "Hack: busy" if not
112 (3) message is a descriptive status about what it's doing. *)
116 module In_init_env
= struct
119 first_start_time
: float; (** our first attempt to connect *)
120 most_recent_start_time
: float; (** for subsequent retries *)
121 most_recent_file
: documentUri
option;
122 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
123 uris_with_unsaved_changes
: UriSet.t
;
124 (** see comment in get_uris_with_unsaved_changes *)
125 hh_server_status_diagnostic
: PublishDiagnostics.params
option;
126 (** Diagnostic messages warning about server not fully running. *)
130 module Lost_env
= struct
133 most_recent_file
: documentUri
option;
134 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
135 uris_with_unsaved_changes
: UriSet.t
;
136 (** see comment in get_uris_with_unsaved_changes *)
138 hh_server_status_diagnostic
: PublishDiagnostics.params
option;
139 (** Diagnostic messages warning about server not fully running. *)
144 new_hh_server_state
: hh_server_state
;
145 start_on_click
: bool;
146 (** if user clicks Restart, do we ClientStart before reconnecting? *)
147 trigger_on_lsp
: bool;
148 (** reconnect if we receive any LSP request/notification *)
149 trigger_on_lock_file
: bool; (** reconnect if lockfile is created *)
154 | Pre_init
(** Pre_init: we haven't yet received the initialize request. *)
155 | In_init
of In_init_env.t
156 (** In_init: we did respond to the initialize request, and now we're
157 waiting for a "Hello" from the server. When that comes we'll
158 request a permanent connection from the server, and process the
159 file_changes backlog, and switch to Main_loop. *)
160 | Main_loop
of Main_env.t
161 (** Main_loop: we have a working connection to both server and client. *)
162 | Lost_server
of Lost_env.t
163 (** Lost_server: someone stole the persistent connection from us.
164 We might choose to grab it back if prompted... *)
166 (** Post_shutdown: we received a shutdown request from the client, and
167 therefore shut down our connection to the server. We can't handle
168 any more requests from the client and will close as soon as it
169 notifies us that we can exit. *)
171 let is_post_shutdown (state
: state
) : bool =
173 | Post_shutdown
-> true
180 let is_pre_init (state
: state
) : bool =
189 type result_handler
= lsp_result
-> state
-> state
Lwt.t
191 type result_telemetry
= {
192 (* how many results did we send back to the user? *)
194 (* other message-specific data *)
195 result_extra_telemetry
: Telemetry.t
option;
198 let initialize_params_ref : Lsp.Initialize.params
option ref = ref None
200 let initialize_params_exc () : Lsp.Initialize.params
=
201 match !initialize_params_ref with
202 | None
-> failwith
"initialize_params not yet received"
203 | Some initialize_params
-> initialize_params
205 (** root only becomes available after the initialize message *)
206 let get_root_opt () : Path.t
option =
207 match !initialize_params_ref with
209 | Some initialize_params
->
210 let path = Some
(Lsp_helpers.get_root initialize_params
) in
211 Some
(Wwwroot.get
path)
213 (** root only becomes available after the initialize message *)
214 let get_root_exn () : Path.t
= Option.value_exn
(get_root_opt ())
216 (** local_config only becomes available after the initialize message *)
217 let get_local_config_exn () : ServerLocalConfig.t
=
218 Option.value_exn
!ref_local_config
220 (** We remember the last version of .hhconfig, and hack_rc_mode switch,
221 so that if they change then we know we must terminate and be restarted. *)
222 let hhconfig_version_and_switch : string ref = ref "[NotYetInitialized]"
224 (** This flag is used to control how much will be written
225 to log-files. It can be turned on initially by --verbose at the command-line or
226 setting "trace:Verbose" in initializationParams. Thereafter, it can
227 be changed by the user dynamically via $/setTraceNotification.
228 Don't alter this reference directly; instead use [set_verbose_to_file]
229 so as to pass the message on to ide_service as well.
230 Note: control for how much will be written to stderr is solely
231 controlled by --verbose at the command-line, stored in env.verbose. *)
232 let verbose_to_file : bool ref = ref false
234 let can_autostart_after_mismatch : bool ref = ref true
236 let requests_outstanding : (lsp_request
* result_handler
) IdMap.t
ref =
239 let get_outstanding_request_exn (id
: lsp_id
) : lsp_request
=
240 match IdMap.find_opt id
!requests_outstanding with
241 | Some
(request
, _
) -> request
242 | None
-> failwith
"response id doesn't correspond to an outstanding request"
244 (** hh_server pushes BUSY_STATUS messages over the persistent connection
245 to mark key milestones like "begin typechecking". We handle them in two
246 ways. First, update_hh_server_state_if_necessary updates a historical
247 record of state transitions over the past two minutes, called both from
248 the main message loop and also during rpc progress callbacks. It's
249 stored in a global variable because we don't want rpc callbacks to have
250 to be part of the state monad. It's kept as an ordered list of states
251 over the past two minutes (head is newest) so that if we were busy at
252 the time a jsonrpc request arrived on stdin, we can still know what was
253 the server state at the time. The second way we handle them is inside
254 handle_server_message, called as part of the main message loop, whose
255 job is to update the Main_env representation of current hh_server status. *)
256 let hh_server_state_log : (float * hh_server_state
) list
ref = ref []
258 (** The behavior of hh_server is that, if ever it receives an RPC, then it
259 expects an IDLE to be sent once the LSP queue is empty and it won't do
260 any typechecks until then. This flag is set to true by [rpc], and reset
261 to false in the [main] loop after we send the IDLE.
262 I'm sorry to store this as a global mutable ref, but it was easier than
263 storing it in Main_env and threading Main_env down through everything
265 let hh_server_needs_idle : bool ref = ref true
267 (** hh_server pushes a different form of its state to the monitor e.g.
268 "busy typechecking 1/50 files" or "init is slow due to lack of saved state".
269 It does this for the sake of clients who don't have a persistent connection;
270 they can ask the monitor what was the latest that hh_server pushed. We use
271 this during In_init when we don't have a persistent connection; other
272 command-line clients of hh_client do this when they're waiting their turn.
273 On idle, i.e. during [Tick] events, we update the following global
274 variable which synthesizes our best knowledge about the current hh_server
275 state; during Main_loop it's obtained from the latest Main_env representation
276 of the current hh_server state, and during In_init it's obtained by
277 asking the monitor. We store this in a global value so we can access
278 it during rpc callbacks, without requiring them to have the state monad. *)
279 let latest_hh_server_status : ShowStatusFB.params
option ref = ref None
281 (** Have we already sent a status message over LSP? If so, and our new
282 status will be just the same as the previous one, we won't need to send it
283 again. This stores the most recent status that the LSP client has. *)
284 let showStatus_outstanding : string ref = ref ""
286 let log s
= Hh_logger.log ("[client-lsp] " ^^ s
)
288 let log_debug s
= Hh_logger.debug
("[client-lsp] " ^^ s
)
290 let log_error s
= Hh_logger.error
("[client-lsp] " ^^ s
)
292 let set_up_hh_logger_for_client_lsp (root
: Path.t
) : unit =
293 (* Log to a file on disk. Note that calls to `Hh_logger` will always write to
294 `stderr`; this is in addition to that. *)
295 let client_lsp_log_fn = ServerFiles.client_lsp_log root
in
297 try Sys.rename
client_lsp_log_fn (client_lsp_log_fn ^
".old") with
300 Hh_logger.set_log
client_lsp_log_fn;
301 log "Starting clientLsp at %s" client_lsp_log_fn
303 let to_stdout (json
: Hh_json.json
) : unit =
304 let s = Hh_json.json_to_string json ^
"\r\n\r\n" in
305 Http_lite.write_message stdout
s
307 let get_editor_open_files (state
: state
) :
308 Lsp.TextDocumentItem.t
UriMap.t
option =
313 | Main_loop menv
-> Some menv
.Main_env.editor_open_files
314 | In_init ienv
-> Some ienv
.In_init_env.editor_open_files
315 | Lost_server lenv
-> Some lenv
.Lost_env.editor_open_files
317 (** This is the most recent file that was subject of an LSP request
318 from the client. There's no guarantee that the file is still open. *)
319 let get_most_recent_file (state
: state
) : documentUri
option =
324 | Main_loop menv
-> menv
.Main_env.most_recent_file
325 | In_init ienv
-> ienv
.In_init_env.most_recent_file
326 | Lost_server lenv
-> lenv
.Lost_env.most_recent_file
330 | Server_message
of server_message
331 | Client_message
of incoming_metadata
* lsp_message
332 (** Client_message stores raw json, and the parsed form of it *)
333 | Client_ide_notification
of ClientIdeMessage.notification
334 | Tick
(** once per second, on idle *)
336 let event_to_string (event
: event
) : string =
338 | Server_hello
-> "Server_hello"
339 | Server_message _
-> "Server_message(_)"
340 | Client_message
(metadata
, m
) ->
342 "Client_message(#%s: %s)"
344 (Lsp_fmt.denorm_message_to_string m
)
345 | Client_ide_notification n
->
347 "Client_ide_notification(%s)"
348 (ClientIdeMessage.notification_to_string n
)
351 let is_tick (event
: event
) : bool =
357 | Client_ide_notification _
->
360 (* Here are some exit points. *)
361 let exit_ok () = exit
0
363 let exit_fail () = exit
1
365 (* The following connection exceptions inform the main LSP event loop how to
366 respond to an exception: was the exception a connection-related exception
367 (one of these) or did it arise during other logic (not one of these)? Can
368 we report the exception to the LSP client? Can we continue handling
369 further LSP messages or must we quit? If we quit, can we do so immediately
370 or must we delay? -- Separately, they also help us marshal callstacks
371 across daemon- and process-boundaries. *)
374 Client_fatal_connection_exception
of Marshal_tools.remote_exception_data
377 Client_recoverable_connection_exception
of Marshal_tools.remote_exception_data
380 Server_fatal_connection_exception
of Marshal_tools.remote_exception_data
382 exception Server_nonfatal_exception
of Lsp.Error.t
384 (** Helper function to construct an Lsp.Error. Its goal is to gather
385 useful information in the optional freeform 'data' field. It assembles
386 that data out of any data already provided, the provided stack, and the
387 current stack. A typical scenario is that we got an error marshalled
388 from a remote server with its remote stack where the error was generated,
389 and we also want to record the stack where we received it. *)
391 ?
(data
: Hh_json.json
option = None
)
392 ?
(stack
: string option)
393 ?
(current_stack
: bool = true)
394 ?
(code
: Lsp.Error.code
= Lsp.Error.UnknownErrorCode
)
395 (message
: string) : Lsp.Error.t
=
399 | Some
(Hh_json.JSON_Object
elems) -> elems
400 | Some json
-> [("data", json
)]
404 | Some stack
when not
(List.Assoc.mem ~equal
:String.equal
elems "stack") ->
405 ("stack", stack
|> Exception.clean_stack
|> Hh_json.string_
) :: elems
409 match current_stack
with
410 | true when not
(List.Assoc.mem ~equal
:String.equal
elems "current_stack")
413 Exception.get_current_callstack_string
99
414 |> Exception.clean_stack
419 { Lsp.Error.code
; message
; data
= Some
(Hh_json.JSON_Object
elems) }
421 (** Use ignore_promise_but_handle_failure when you want don't care about awaiting
422 results of an async piece of work, but still want any exceptions to be logged.
423 This is similar to Lwt.async except (1) it logs to our HackEventLogger and
424 Hh_logger rather than stderr, (2) it you can decide on a case-by-case basis what
425 should happen to exceptions rather than having them all share the same
426 Lwt.async_exception_hook, (3) while Lwt.async takes a lambda for creating the
427 promise and so catches exceptions during promise creation, this function takes
428 an already-existing promise and so the caller has to handle such exceptions
429 themselves - I resent using lambdas as a control-flow primitive.
431 You can think of this function as similar to [ignore], but enhanced because
432 it's poor practice to ignore a promise. *)
433 let ignore_promise_but_handle_failure
434 ~
(desc
: string) ~
(terminate_on_failure
: bool) (promise
: unit Lwt.t
) :
438 let%lwt
() = promise
in
443 let exn = Exception.wrap
exn in
444 let message = "Unhandled exception: " ^
Exception.get_ctor_string
exn in
446 Exception.get_backtrace_string
exn |> Exception.clean_stack
451 ("description", string_ desc
);
452 ("message", string_
message);
453 ("stack", string_
stack);
456 HackEventLogger.client_lsp_exception
457 ~root
:(get_root_opt ())
458 ~
message:"Unhandled exception"
459 ~data_opt
:(Some
data)
461 log_error "%s\n%s\n%s" message desc
stack;
462 if terminate_on_failure
then
463 (* exit 2 is the same as used by Lwt.async *)
468 let state_to_string (state
: state
) : string =
470 | Pre_init
-> "Pre_init"
471 | In_init _ienv
-> "In_init"
472 | Main_loop _menv
-> "Main_loop"
473 | Lost_server _lenv
-> "Lost_server"
474 | Post_shutdown
-> "Post_shutdown"
476 let hh_server_state_to_string (hh_server_state
: hh_server_state
) : string =
477 match hh_server_state
with
478 | Hh_server_denying_connection
-> "hh_server denying connection"
479 | Hh_server_initializing
-> "hh_server initializing"
480 | Hh_server_stopped
-> "hh_server stopped"
481 | Hh_server_stolen
-> "hh_server stolen"
482 | Hh_server_typechecking_local
-> "hh_server typechecking (local)"
483 | Hh_server_typechecking_global_blocking
->
484 "hh_server typechecking (global, blocking)"
485 | Hh_server_typechecking_global_interruptible
->
486 "hh_server typechecking (global, interruptible)"
487 | Hh_server_typechecking_global_remote_blocking
->
488 "hh_server typechecking (global remote, blocking)"
489 | Hh_server_handling_or_ready
-> "hh_server ready"
490 | Hh_server_unknown
-> "hh_server unknown state"
491 | Hh_server_forgot
-> "hh_server forgotten state"
493 (** This conversion is imprecise. Comments indicate potential gaps *)
494 let completion_kind_to_si_kind
495 (completion_kind
: Completion.completionItemKind
option) :
496 SearchUtils.si_kind
=
498 let open SearchUtils
in
499 match completion_kind
with
500 | Some
Completion.Class
-> SI_Class
501 | Some
Completion.Method
-> SI_ClassMethod
502 | Some
Completion.Function
-> SI_Function
503 | Some
Completion.Variable
->
504 SI_LocalVariable
(* or SI_Mixed, but that's never used *)
505 | Some
Completion.Property
-> SI_Property
506 | Some
Completion.Constant
-> SI_GlobalConstant
(* or SI_ClassConstant *)
507 | Some
Completion.Interface
-> SI_Interface
(* or SI_Trait *)
508 | Some
Completion.Enum
-> SI_Enum
509 | Some
Completion.Module
-> SI_Namespace
510 | Some
Completion.Constructor
-> SI_Constructor
511 | Some
Completion.Keyword
-> SI_Keyword
512 | Some
Completion.Value
-> SI_Literal
513 | Some
Completion.TypeParameter
-> SI_Typedef
514 (* The completion enum includes things we don't really support *)
517 let si_kind_to_completion_kind (kind
: SearchUtils.si_kind
) :
518 Completion.completionItemKind
option =
521 | SearchUtils.SI_Class
->
522 Some
Completion.Class
523 | SearchUtils.SI_ClassMethod
-> Some
Completion.Method
524 | SearchUtils.SI_Function
-> Some
Completion.Function
525 | SearchUtils.SI_Mixed
526 | SearchUtils.SI_LocalVariable
->
527 Some
Completion.Variable
528 | SearchUtils.SI_Property
-> Some
Completion.Field
529 | SearchUtils.SI_ClassConstant
-> Some
Completion.Constant
530 | SearchUtils.SI_Interface
531 | SearchUtils.SI_Trait
->
532 Some
Completion.Interface
533 | SearchUtils.SI_Enum
-> Some
Completion.Enum
534 | SearchUtils.SI_Namespace
-> Some
Completion.Module
535 | SearchUtils.SI_Constructor
-> Some
Completion.Constructor
536 | SearchUtils.SI_Keyword
-> Some
Completion.Keyword
537 | SearchUtils.SI_Literal
-> Some
Completion.Value
538 | SearchUtils.SI_GlobalConstant
-> Some
Completion.Constant
539 | SearchUtils.SI_Typedef
-> Some
Completion.TypeParameter
540 | SearchUtils.SI_Unknown
-> None
542 (** We keep a log of server state over the past 2mins. When adding a new server
543 state: if this state is the same as the current one, then ignore it. Also,
544 retain only states younger than 2min plus the first one older than 2min.
545 Newest state is at head of list. *)
546 let set_hh_server_state (new_hh_server_state
: hh_server_state
) : unit =
547 let new_time = Unix.gettimeofday
() in
548 let rec retain rest
=
551 | (time
, state
) :: rest
when Float.(time
>= new_time -. 120.0) ->
552 (time
, state
) :: retain rest
553 | (time
, state
) :: _rest
-> [(time
, state
)]
554 (* retain only the first that's older *)
556 hh_server_state_log :=
557 match !hh_server_state_log with
558 | (prev_time
, prev_hh_server_state
) :: rest
559 when equal_hh_server_state prev_hh_server_state new_hh_server_state
->
560 (prev_time
, prev_hh_server_state
) :: retain rest
561 | rest
-> (new_time, new_hh_server_state
) :: retain rest
563 let get_older_hh_server_state (requested_time
: float) : hh_server_state
=
564 (* find the first item which is older than the specified time. *)
566 List.find
!hh_server_state_log ~f
:(fun (time
, _
) ->
567 Float.(time
<= requested_time
))
569 | None
-> Hh_server_forgot
570 | Some
(_
, hh_server_state
) -> hh_server_state
572 let read_hhconfig_version () : string Lwt.t
=
573 match get_root_opt () with
574 | None
-> Lwt.return
"[NoRoot]"
576 let file = Filename.concat
(Path.to_string root
) ".hhconfig" in
577 let%lwt config
= Config_file_lwt.parse_hhconfig
file in
579 | Ok
(_hash
, config
) ->
582 |> Config_file.Getters.string_opt
"version"
583 |> Config_file_lwt.parse_version
584 |> Config_file_lwt.version_to_string_opt
585 |> Option.value ~default
:"[NoVersion]"
588 | Error
message -> Lwt.return
(Printf.sprintf
"[NoHhconfig:%s]" message))
590 let read_hhconfig_version_and_switch () : string Lwt.t
=
591 let%lwt hack_rc_mode_result
=
592 Lwt_utils.read_all
(Sys_utils.expanduser
"~/.hack_rc_mode")
595 match hack_rc_mode_result
with
596 | Ok
s -> " hack_rc_mode=" ^
s
600 match Sys.getenv_opt
"HH_HOME" with
601 | Some
s -> " HH_HOME=" ^
s
604 let%lwt hhconfig_version
= read_hhconfig_version () in
605 Lwt.return
(hhconfig_version ^
hack_rc_mode ^
hh_home)
607 (** get_uris_with_unsaved_changes is the set of files for which we've
608 received didChange but haven't yet received didSave/didOpen. It is purely
609 a description of what we've heard of the editor, and is independent of
610 whether or not they've yet been synced with hh_server.
611 As it happens: in Main_loop state all these files will already have been
612 sent to hh_server; in In_init state all these files will have been queued
613 up inside editor_open_files ready to be sent when we receive the hello; in
614 Lost_server state they're not even queued up, and if ever we see hh_server
615 ready then we'll terminate the LSP server and trust the client to relaunch
616 us and resend a load of didOpen/didChange events. *)
617 let get_uris_with_unsaved_changes (state
: state
) : UriSet.t
=
619 | Main_loop menv
-> menv
.Main_env.uris_with_unsaved_changes
620 | In_init ienv
-> ienv
.In_init_env.uris_with_unsaved_changes
621 | Lost_server lenv
-> lenv
.Lost_env.uris_with_unsaved_changes
624 let update_hh_server_state_if_necessary (event
: event
) : unit =
625 let open ServerCommandTypes
in
628 | BUSY_STATUS Needs_local_typecheck
629 | BUSY_STATUS Done_local_typecheck
630 | BUSY_STATUS Done_global_typecheck
->
631 set_hh_server_state Hh_server_handling_or_ready
632 | BUSY_STATUS Doing_local_typecheck
->
633 set_hh_server_state Hh_server_typechecking_local
634 | BUSY_STATUS
(Doing_global_typecheck global_typecheck_kind
) ->
636 (match global_typecheck_kind
with
637 | Blocking
-> Hh_server_typechecking_global_blocking
638 | Interruptible
-> Hh_server_typechecking_global_interruptible
639 | Remote_blocking _
-> Hh_server_typechecking_global_remote_blocking
)
640 | NEW_CLIENT_CONNECTED
-> set_hh_server_state Hh_server_stolen
643 | NONFATAL_EXCEPTION _
->
647 | Server_message
{ push
; has_updated_server_state
= false } -> helper push
650 (** This cancellable async function will block indefinitely until a notification is
651 available from ide_service, and return. If there's no ide_service then it awaits indefinitely. *)
652 let pop_from_ide_service (ide_service
: ClientIdeService.t
ref option) :
654 match ide_service
with
655 | None
-> Lwt.task
() |> fst
(* a never-fulfilled, cancellable promise *)
656 | Some ide_service
->
657 let%lwt notification_opt
=
658 Lwt_message_queue.pop
(ClientIdeService.get_notifications
!ide_service
)
660 (match notification_opt
with
661 | None
-> Lwt.task
() |> fst
(* a never-fulfilled, cancellable promise *)
662 | Some notification
-> Lwt.return
(Client_ide_notification notification
))
664 (** This cancellable async function will block indefinitely until
665 data is available from the server, but won't read from it. *)
666 let wait_until_server_has_data (server
: server_conn
) : unit Lwt.t
=
667 let fd = Unix.descr_of_out_channel server
.oc
|> Lwt_unix.of_unix_file_descr
in
668 let%lwt
() = Lwt_unix.wait_read
fd in
671 (** This cancellable async function will block indefinitely until data is
672 available from the client, but won't read from it. If there's no client
673 then it awaits indefinitely. *)
674 let wait_until_client_has_data (client
: Jsonrpc.t
option) : unit Lwt.t
=
676 | None
-> Lwt.task
() |> fst
(* a never-fulfilled, cancellable promise *)
679 match Jsonrpc.await_until_message client
with
680 | `Already_has_message
-> Lwt.return_unit
681 | `Wait_for_data_here
fd ->
682 let fd = Lwt_unix.of_unix_file_descr
fd in
683 let%lwt
() = Lwt_unix.wait_read
fd in
688 (** Determine whether to read a message from the client (the editor) or the
689 server (hh_server), or whether neither is ready within 1s. *)
690 let get_message_source
691 (server
: server_conn
)
692 (client
: Jsonrpc.t
option)
693 (ide_service
: ClientIdeService.t
ref option) :
694 [ `From_server
| `From_client
| `From_ide_service
of event
| `No_source
]
696 (* Take action on server messages in preference to client messages, because
697 server messages are very easy and quick to service (just send a message to
698 the client), while client messages require us to launch a potentially
699 long-running RPC command. *)
700 let has_server_messages = not
(Queue.is_empty server
.pending_messages
) in
701 if has_server_messages then
702 Lwt.return `From_server
703 else if Option.value_map client ~default
:false ~f
:Jsonrpc.has_message
then
704 Lwt.return `From_client
706 (* If no immediate messages are available, then wait up to 1 second. *)
707 let%lwt message_source
=
710 (let%lwt
() = Lwt_unix.sleep
1.0 in
711 Lwt.return `No_source
);
712 (let%lwt
() = wait_until_server_has_data server
in
713 Lwt.return `From_server
);
714 (let%lwt
() = wait_until_client_has_data client
in
715 Lwt.return `From_client
);
716 (let%lwt notification
= pop_from_ide_service ide_service
in
717 Lwt.return
(`From_ide_service notification
));
720 Lwt.return message_source
722 (** A simplified version of get_message_source which only looks at client *)
723 let get_client_message_source
724 (client
: Jsonrpc.t
option) (ide_service
: ClientIdeService.t
ref option) :
725 [ `From_client
| `From_ide_service
of event
| `No_source
] Lwt.t
=
726 if Option.value_map client ~default
:false ~f
:Jsonrpc.has_message
then
727 Lwt.return `From_client
729 let%lwt message_source
=
732 (let%lwt
() = Lwt_unix.sleep
1.0 in
733 Lwt.return `No_source
);
734 (let%lwt
() = wait_until_client_has_data client
in
735 Lwt.return `From_client
);
736 (let%lwt notification
= pop_from_ide_service ide_service
in
737 Lwt.return
(`From_ide_service notification
));
740 Lwt.return message_source
742 (** Read a message unmarshaled from the server's out_channel. *)
743 let read_message_from_server (server
: server_conn
) : event
Lwt.t
=
744 let open ServerCommandTypes
in
747 Unix.descr_of_out_channel server
.oc
|> Lwt_unix.of_unix_file_descr
749 let%lwt
(message : 'a
ServerCommandTypes.message_type
) =
750 Marshal_tools_lwt.from_fd_with_preamble
fd
753 | Response _
-> failwith
"unexpected response without request"
755 Lwt.return
(Server_message
{ push
; has_updated_server_state
= false })
756 | Hello
-> Lwt.return Server_hello
757 | Ping
-> failwith
"unexpected ping on persistent connection"
758 | Monitor_failed_to_handoff
->
759 failwith
"unexpected monitor_failed_to_handoff on persistent connection"
762 let e = Exception.wrap
exn in
763 raise
(Server_fatal_connection_exception
(Marshal_tools.of_exception
e))
765 (** get_next_event: picks up the next available message from either client or
766 server. The way it's implemented, at the first character of a message
767 from either client or server, we block until that message is completely
768 received. Note: if server is None (meaning we haven't yet established
769 connection with server) then we'll just block waiting for client. *)
773 (ide_service
: ClientIdeService.t
ref option) : event
Lwt.t
=
775 match (ide_service
, !initialize_params_ref) with
776 | (Some ide_service
, Some
{ Initialize.initializationOptions
; _
})
777 when initializationOptions
.Initialize.delayUntilDoneInit
->
779 match ClientIdeService.get_status
!ide_service
with
780 | ClientIdeService.Status.(Initializing
| Processing_files _
| Rpc _
) ->
782 | ClientIdeService.Status.(Ready
| Stopped _
) -> true
786 let client = Option.some_if
can_use_client client in
787 let from_server (server
: server_conn
) : event
Lwt.t
=
788 if Queue.is_empty server
.pending_messages
then
789 read_message_from_server server
791 Lwt.return
(Server_message
(Queue.dequeue_exn server
.pending_messages
))
793 let from_client (client : Jsonrpc.t
) : event
Lwt.t
=
794 let%lwt
message = Jsonrpc.get_message
client in
796 | `Message
{ Jsonrpc.json
; timestamp
} ->
799 let message = Lsp_fmt.parse_lsp json
get_outstanding_request_exn in
800 let rnd = Random_id.short_string
() in
803 | RequestMessage
(id
, _
) -> rnd ^
"." ^
Lsp_fmt.id_to_string id
806 Lwt.return
(Client_message
({ tracking_id; timestamp
}, message))
809 let e = Exception.wrap
e in
812 Marshal_tools.stack = Exception.get_backtrace_string
e;
813 message = Exception.get_ctor_string
e;
816 raise
(Client_recoverable_connection_exception
edata)
818 | `Fatal_exception
edata -> raise
(Client_fatal_connection_exception
edata)
819 | `Recoverable_exception
edata ->
820 raise
(Client_recoverable_connection_exception
edata)
823 | Main_loop
{ Main_env.conn
; _
}
824 | In_init
{ In_init_env.conn
; _
} ->
825 let%lwt message_source
= get_message_source conn
client ide_service
in
826 (match message_source
with
828 let%lwt
message = from_client (Option.value_exn
client) in
831 let%lwt
message = from_server conn
in
833 | `From_ide_service
message -> Lwt.return
message
834 | `No_source
-> Lwt.return Tick
)
838 let%lwt message_source
= get_client_message_source client ide_service
in
839 (match message_source
with
841 let%lwt
message = from_client (Option.value_exn
client) in
843 | `From_ide_service
message -> Lwt.return
message
844 | `No_source
-> Lwt.return Tick
)
851 let add_powered_by ~
(powered_by
: powered_by
) (json
: Hh_json.json
) :
854 match (json
, powered_by
) with
855 | (JSON_Object props
, Serverless_ide
) ->
856 JSON_Object
(("powered_by", JSON_String
"serverless_ide") :: props
)
860 ~
(powered_by
: powered_by
) (id
: lsp_id
) (result
: lsp_result
) : unit =
861 print_lsp_response id result
|> add_powered_by ~powered_by
|> to_stdout
863 let notify_jsonrpc ~
(powered_by
: powered_by
) (notification
: lsp_notification
)
865 print_lsp_notification notification
|> add_powered_by ~powered_by
|> to_stdout
867 (** respond_to_error: if we threw an exception during the handling of a request,
868 report the exception to the client as the response to their request. *)
869 let respond_to_error (event
: event
option) (e : Lsp.Error.t
) : unit =
870 let result = ErrorResult
e in
872 | Some
(Client_message
(_
, RequestMessage
(id
, _request
))) ->
873 respond_jsonrpc ~powered_by
:Language_server id
result
875 (* We want to report LSP error 'e' over jsonrpc. But jsonrpc only allows
876 errors to be reported in response to requests. So we'll stick the information
877 in a telemetry/event. The format of this event isn't defined. We're going to
878 roll our own, using ad-hoc json fields to emit all the data out of 'e' *)
879 let open Lsp.Error
in
881 ("code", e.code
|> Error.show_code
|> Hh_json.string_
)
882 :: Option.value_map
e.data ~default
:[] ~f
:(fun data -> [("data", data)])
884 Lsp_helpers.telemetry_error
to_stdout e.message ~
extras
886 (** request_showStatusFB: pops up a dialog *)
887 let request_showStatusFB
888 ?
(on_result
: ShowStatusFB.result -> state
-> state
Lwt.t
=
889 (fun _ state
-> Lwt.return state
))
890 ?
(on_error
: Error.t
-> state
-> state
Lwt.t
=
891 (fun _ state
-> Lwt.return state
))
892 (params
: ShowStatusFB.params
) : unit =
893 let initialize_params = initialize_params_exc () in
894 if not
(Lsp_helpers.supports_status
initialize_params) then
897 (* We try not to send duplicate statuses.
898 That means: if you call request_showStatus but your message is the same as
899 what's already up, then you won't be shown, and your callbacks won't be shown. *)
900 let msg = params
.ShowStatusFB.request
.ShowMessageRequest.message in
901 if String.equal
msg !showStatus_outstanding then
904 showStatus_outstanding := msg;
905 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
906 let request = ShowStatusRequestFB params
in
907 to_stdout (print_lsp_request
id request);
909 let handler (result : lsp_result
) (state
: state
) : state
Lwt.t
=
910 if String.equal
msg !showStatus_outstanding then
911 showStatus_outstanding := "";
913 | ShowStatusResultFB
result -> on_result
result state
914 | ErrorResult error
-> on_error error state
918 Error.code
= Error.ParseError
;
919 message = "expected ShowStatusResult";
925 requests_outstanding :=
926 IdMap.add
id (request, handler) !requests_outstanding
929 (** request_showMessage: pops up a dialog *)
930 let request_showMessage
931 (on_result
: ShowMessageRequest.result -> state
-> state
Lwt.t
)
932 (on_error
: Error.t
-> state
-> state
Lwt.t
)
933 (type_
: MessageType.t
)
935 (titles
: string list
) : ShowMessageRequest.t
=
936 (* send the request *)
937 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
939 List.map titles ~f
:(fun title
-> { ShowMessageRequest.title
})
942 ShowMessageRequestRequest
{ ShowMessageRequest.type_
; message; actions }
944 to_stdout (print_lsp_request
id request);
946 let handler (result : lsp_result
) (state
: state
) : state
Lwt.t
=
948 | ShowMessageRequestResult
result -> on_result
result state
949 | ErrorResult
error -> on_error
error state
953 Error.code
= Error.ParseError
;
954 message = "expected ShowMessageRequestResult";
960 requests_outstanding := IdMap.add
id (request, handler) !requests_outstanding;
963 ShowMessageRequest.Present
{ id }
965 (** dismiss_showMessageRequest: sends a cancellation-request for the dialog *)
966 let dismiss_showMessageRequest (dialog
: ShowMessageRequest.t
) :
967 ShowMessageRequest.t
=
970 | ShowMessageRequest.Absent
-> ()
971 | ShowMessageRequest.Present
{ id; _
} ->
972 let notification = CancelRequestNotification
{ CancelRequest.id } in
973 let json = Lsp_fmt.print_lsp
(NotificationMessage
notification) in
976 ShowMessageRequest.Absent
978 (** These functions are not currently used, but may be useful in the future. *)
979 let (_
: 'a
-> 'b
) = request_showMessage
981 and (_
: 'c
-> 'd
) = dismiss_showMessageRequest
983 (** Dismiss all diagnostics from a state,
984 both the error diagnostics in Main_loop and the hh_server_status
985 diagnostics in In_init and Lost_server. *)
986 let dismiss_diagnostics (state
: state
) : state
=
987 let dismiss_one ~isStatusFB uri
=
988 let params = { PublishDiagnostics.uri
; diagnostics
= []; isStatusFB
} in
989 let notification = PublishDiagnosticsNotification
params in
990 notification |> print_lsp_notification
|> to_stdout
992 let dismiss_status diagnostic
=
993 dismiss_one ~isStatusFB
:true diagnostic
.PublishDiagnostics.uri
997 let open In_init_env
in
998 Option.iter ienv
.hh_server_status_diagnostic ~f
:dismiss_status;
999 In_init
{ ienv
with hh_server_status_diagnostic
= None
}
1001 let open Main_env
in
1002 UriSet.iter
(dismiss_one ~isStatusFB
:false) menv
.uris_with_diagnostics
;
1003 Main_loop
{ menv
with uris_with_diagnostics
= UriSet.empty
}
1004 | Lost_server lenv
->
1005 let open Lost_env
in
1006 Option.iter lenv
.hh_server_status_diagnostic ~f
:dismiss_status;
1007 Lost_server
{ lenv
with hh_server_status_diagnostic
= None
}
1008 | Pre_init
-> Pre_init
1009 | Post_shutdown
-> Post_shutdown
1011 (************************************************************************)
1012 (* Conversions - ad-hoc ones written as needed them, not systematic *)
1013 (************************************************************************)
1015 let lsp_uri_to_path = Lsp_helpers.lsp_uri_to_path
1017 let path_to_lsp_uri = Lsp_helpers.path_to_lsp_uri
1019 let lsp_position_to_ide (position
: Lsp.position
) : Ide_api_types.position
=
1020 { Ide_api_types.line
= position
.line
+ 1; column
= position
.character
+ 1 }
1022 let lsp_file_position_to_hack (params : Lsp.TextDocumentPositionParams.t
) :
1023 string * int * int =
1024 let open Lsp.TextDocumentPositionParams
in
1025 let { Ide_api_types.line
; column
} = lsp_position_to_ide params.position
in
1027 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
params.textDocument
1029 (filename, line
, column
)
1031 let rename_params_to_document_position (params : Lsp.Rename.params) :
1032 Lsp.TextDocumentPositionParams.t
=
1035 TextDocumentPositionParams.textDocument
= params.textDocument
;
1036 position
= params.position
;
1039 let hack_pos_to_lsp_range ~
(equal
: 'a
-> 'a
-> bool) (pos
: 'a
Pos.pos
) :
1041 (* .hhconfig errors are Positions with a filename, but dummy start/end
1042 * positions. Handle that case - and Pos.none - specially, as the LSP
1043 * specification requires line and character >= 0, and VSCode silently
1044 * drops diagnostics that violate the spec in this way *)
1045 if Pos.equal_pos equal pos
(Pos.make_from
(Pos.filename pos
)) then
1046 { start
= { line
= 0; character
= 0 }; end_
= { line
= 0; character
= 0 } }
1048 let (line1
, col1
, line2
, col2
) = Pos.destruct_range pos
in
1050 start
= { line
= line1
- 1; character
= col1
- 1 };
1051 end_
= { line
= line2
- 1; character
= col2
- 1 };
1054 let hack_pos_to_lsp_location (pos
: Pos.absolute
) ~
(default_path
: string) :
1058 uri
= path_to_lsp_uri (Pos.filename pos
) ~default_path
;
1059 range
= hack_pos_to_lsp_range ~equal
:String.equal pos
;
1062 let ide_range_to_lsp (range
: Ide_api_types.range
) : Lsp.range
=
1066 Lsp.line
= range
.Ide_api_types.st
.Ide_api_types.line
- 1;
1067 character
= range
.Ide_api_types.st
.Ide_api_types.column
- 1;
1071 Lsp.line
= range
.Ide_api_types.ed
.Ide_api_types.line
- 1;
1072 character
= range
.Ide_api_types.ed
.Ide_api_types.column
- 1;
1076 let lsp_range_to_ide (range
: Lsp.range
) : Ide_api_types.range
=
1079 st
= lsp_position_to_ide range
.start
;
1080 ed
= lsp_position_to_ide range
.end_
;
1083 let hack_symbol_definition_to_lsp_construct_location
1084 (symbol
: string SymbolDefinition.t
) ~
(default_path
: string) :
1086 let open SymbolDefinition
in
1087 hack_pos_to_lsp_location symbol
.span ~default_path
1089 let hack_pos_definition_to_lsp_identifier_location
1090 (sid
: Pos.absolute
* string) ~
(default_path
: string) :
1091 Lsp.DefinitionLocation.t
=
1092 let (pos
, title
) = sid
in
1093 let location = hack_pos_to_lsp_location pos ~default_path
in
1094 Lsp.DefinitionLocation.{ location; title
= Some title
}
1096 let hack_symbol_definition_to_lsp_identifier_location
1097 (symbol
: string SymbolDefinition.t
) ~
(default_path
: string) :
1098 Lsp.DefinitionLocation.t
=
1099 let open SymbolDefinition
in
1100 let location = hack_pos_to_lsp_location symbol
.pos ~default_path
in
1101 Lsp.DefinitionLocation.
1104 title
= Some
(Utils.strip_ns symbol
.SymbolDefinition.full_name
);
1107 let hack_errors_to_lsp_diagnostic
1108 (filename : string) (errors
: Errors.finalized_error list
) :
1109 PublishDiagnostics.params =
1110 let open Lsp.Location
in
1111 let location_message (message : Pos.absolute
* string) :
1112 Lsp.Location.t
* string =
1113 let (pos
, message) = message in
1114 let { uri
; range
} = hack_pos_to_lsp_location pos ~default_path
:filename in
1115 ({ Location.uri
; range
}, Markdown_lite.render
message)
1117 let hack_error_to_lsp_diagnostic (error : Errors.finalized_error
) =
1119 User_error.to_list
error |> List.map ~f
:location_message
1121 let (first_message
, additional_messages
) =
1122 match all_messages with
1123 | hd
:: tl
-> (hd
, tl
)
1124 | [] -> failwith
"Expected at least one error in the error list"
1129 (* This is the file of the first message of the error which is supposed to correspond to [filename] *)
1135 let relatedInformation =
1137 |> List.map ~f
:(fun (location, message) ->
1139 PublishDiagnostics.relatedLocation
= location;
1140 relatedMessage
= message;
1145 match get_severity
error with
1146 | Error
-> Some
PublishDiagnostics.Error
1147 | Warning
-> Some
PublishDiagnostics.Warning
)
1150 Lsp.PublishDiagnostics.range
;
1152 code
= PublishDiagnostics.IntCode
(User_error.get_code
error);
1153 source
= Some
"Hack";
1156 relatedLocations
= relatedInformation (* legacy FB extension *);
1159 (* The caller is required to give us a non-empty filename. If it is empty,
1160 the following path_to_lsp_uri will fall back to the default path - which
1161 is also empty - and throw, logging appropriate telemetry. *)
1163 Lsp.PublishDiagnostics.uri
= path_to_lsp_uri filename ~default_path
:"";
1165 diagnostics
= List.map errors ~f
:hack_error_to_lsp_diagnostic;
1168 let get_document_contents
1169 (editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
) (uri
: documentUri
) :
1171 match UriMap.find_opt uri editor_open_files
with
1172 | Some document
-> Some document
.TextDocumentItem.text
1175 let get_document_location
1176 (editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
)
1177 (params : Lsp.TextDocumentPositionParams.t
) :
1178 ClientIdeMessage.document_location
=
1179 let (file_path
, line
, column
) = lsp_file_position_to_hack params in
1181 params.TextDocumentPositionParams.textDocument
.TextDocumentIdentifier.uri
1183 let file_path = Path.make
file_path in
1184 let file_contents = get_document_contents editor_open_files
uri in
1185 { ClientIdeMessage.file_path; file_contents; line
; column
}
1187 (************************************************************************)
1188 (* Connection and rpc *)
1189 (************************************************************************)
1191 let start_server ~
(env
: env
) (root
: Path.t
) : unit =
1192 (* This basically does "hh_client start": a single attempt to open the *)
1193 (* socket, send+read version and compare for mismatch, send handoff and *)
1194 (* read response. It will print information to stderr. If the server is in *)
1195 (* an unresponsive or invalid state then it will kill the server. Next if *)
1196 (* necessary it tries to spawn the server and wait until the monitor is *)
1197 (* responsive enough to print "ready". It will do a hard program exit if *)
1198 (* there were spawn problems. *)
1204 watchman_debug_logging
= false;
1205 log_inference_constraints
= false;
1208 exit_on_failure
= false;
1209 ignore_hh_version
= false;
1210 saved_state_ignore_hhconfig
= false;
1213 save_human_readable_64bit_dep_map
= None
;
1215 config
= env
.args
.config
;
1216 custom_hhi_path
= None
;
1217 custom_telemetry_data
= [];
1218 allow_non_opt_build
= false;
1221 let _exit_status = ClientStart.main
env_start in
1224 let rec connect_client ~
(env
: env
) (root
: Path.t
) ~
(autostart
: bool) :
1226 log "connect_client";
1227 (* This basically does the same connection attempt as "hh_client check":
1228 * it makes repeated attempts to connect; it prints useful messages to
1229 * stderr; in case of failure it will raise an exception. Below we're
1230 * catching the main exceptions so we can give a good user-facing error
1231 * text. For other exceptions, they'll end up showing to the user just
1232 * "internal error" with the error code. *)
1238 local_config
= get_local_config_exn ();
1239 force_dormant_start
= false;
1240 watchman_debug_logging
= false;
1241 (* If you want this, start the server manually in terminal. *)
1242 deadline
= Some
(Unix.time
() +. 3.);
1243 (* limit to 3 seconds *)
1245 (* only relevant when autostart=true *)
1246 log_inference_constraints
= false;
1248 log_on_slow_monitor_connect
= false;
1249 (* Only used when running hh from terminal *)
1253 (* only relevant when autostart=true *)
1254 progress_callback
= None
;
1256 do_post_handoff_handshake
= false;
1257 ignore_hh_version
= false;
1258 saved_state_ignore_hhconfig
= false;
1261 save_human_readable_64bit_dep_map
= None
;
1262 (* priority_pipe delivers good experience for hh_server, but has a bug,
1263 and doesn't provide benefits in serverless-ide. *)
1264 use_priority_pipe
= not env
.use_serverless_ide
;
1266 config
= env
.args
.config
;
1267 custom_hhi_path
= None
;
1268 custom_telemetry_data
= [];
1269 allow_non_opt_build
= false;
1273 let%lwt
ClientConnect.{ channels
= (ic
, oc
); server_specific_files
; _
} =
1274 ClientConnect.connect
env_connect
1276 can_autostart_after_mismatch := false;
1277 let pending_messages = Queue.create
() in
1278 Lwt.return
{ ic
; oc
; pending_messages; server_specific_files
}
1280 | Exit_status.Exit_with
Exit_status.Build_id_mismatch
1281 when !can_autostart_after_mismatch ->
1282 (* Raised when the server was running an old version. We'll retry once. *)
1283 log "connect_client: build_id_mismatch";
1284 can_autostart_after_mismatch := false;
1285 connect_client ~env root ~autostart
:true
1287 (** Either connect to the monitor and leave in an
1288 In_init state waiting for the server hello, or fail to connect and
1289 leave in a Lost_server state. You might call this from Pre_init or
1290 Lost_server states, obviously. But you can also call it from In_init state
1291 if you want to give up on the prior attempt at connection and try again. *)
1292 let rec connect ~
(env
: env
) (state
: state
) : state
Lwt.t
=
1295 | In_init
{ In_init_env.conn
; _
} ->
1298 Timeout.shutdown_connection conn
.ic
;
1299 Timeout.close_in_noerr conn
.ic
1306 | _
-> failwith
"connect only in Pre_init, In_init or Lost_server state"
1309 let%lwt conn
= connect_client ~env
(get_root_exn ()) ~autostart
:false in
1310 set_hh_server_state Hh_server_initializing
;
1315 { ienv
with In_init_env.conn
; most_recent_start_time
= Unix.time
() })
1317 let state = dismiss_diagnostics state in
1322 first_start_time
= Unix.time
();
1323 most_recent_start_time
= Unix.time
();
1324 most_recent_file
= get_most_recent_file state;
1326 Option.value (get_editor_open_files state) ~default
:UriMap.empty
;
1327 (* uris_with_unsaved_changes should always be empty here: *)
1328 (* Pre_init will of course be empty; *)
1329 (* Lost_server will exit rather than reconnect with unsaved changes. *)
1330 uris_with_unsaved_changes
= get_uris_with_unsaved_changes state;
1331 hh_server_status_diagnostic
= None
;
1335 let exn = Exception.wrap
exn in
1336 (* Exit_with Out_of_retries, Exit_with Out_of_time: raised when we *)
1337 (* couldn't complete the handshake up to handoff within 3 attempts over *)
1338 (* 3 seconds. Maybe the informant is stopping anything from happening *)
1339 (* until a rebase has settled? *)
1340 (* Exit_with No_server_running: raised when (1) the server's simply not *)
1341 (* running, or there's some other reason why the connection was refused *)
1342 (* or timed-out and no lockfile is present; (2) the server was dormant *)
1343 (* and had already received too many pending connection requests; *)
1344 (* (3) server failed to load saved-state but was required to do so. *)
1345 (* Exit_with Monitor_connection_failure: raised when the lockfile is *)
1346 (* present but connection-attempt to the monitor times out - maybe it's *)
1347 (* under DDOS, or maybe it's declining to answer new connections. *)
1349 match Exception.unwrap
exn with
1350 | Exit_status.Exit_with code
-> Exit_status.show code
1351 | _
-> Exception.get_ctor_string
exn
1355 "connect failed: %s\n%s"
1357 (Exception.get_backtrace_string
exn |> Exception.clean_stack
)
1359 let () = Lsp_helpers.telemetry_error
to_stdout longMessage in
1360 let open Exit_status
in
1361 let new_hh_server_state =
1362 match Exception.unwrap
exn with
1363 | Exit_with Build_id_mismatch
1364 | Exit_with No_server_running_should_retry
1365 | Exit_with Server_hung_up_should_retry
1366 | Exit_with Server_hung_up_should_abort
->
1368 | Exit_with Out_of_retries
1369 | Exit_with Out_of_time
->
1370 Hh_server_denying_connection
1371 | _
-> Hh_server_unknown
1374 match Exception.unwrap
exn with
1375 | Exit_with Out_of_retries
1376 | Exit_with Out_of_time
->
1377 "hh_server is waiting for things to settle"
1378 | Exit_with No_server_running_should_retry
-> "hh_server: stopped."
1379 | _
-> "hh_server: " ^
message
1384 ~allow_immediate_reconnect
:false
1387 Lost_env.explanation;
1388 new_hh_server_state;
1389 start_on_click
= true;
1390 trigger_on_lock_file
= true;
1391 trigger_on_lsp
= false;
1396 and reconnect_from_lost_if_necessary
1397 ~
(env
: env
) (state : state) (reason
: [> `Event
of event
| `Force_regain
])
1400 let should_reconnect =
1401 match (state, reason
) with
1402 | (Lost_server _
, `Force_regain
) -> true
1403 | ( Lost_server
{ p
= { trigger_on_lsp
= true; _
}; _
},
1404 `Event
(Client_message
(_
, RequestMessage _
)) ) ->
1406 | ( Lost_server
{ p
= { trigger_on_lock_file
= true; _
}; lock_file
; _
},
1408 MonitorConnection.server_exists lock_file
1411 if should_reconnect then
1412 let%lwt current_version_and_switch
=
1413 read_hhconfig_version_and_switch ()
1415 let needs_to_terminate =
1417 (String.equal
!hhconfig_version_and_switch current_version_and_switch
)
1419 if needs_to_terminate then (
1420 (* In these cases we have to terminate our LSP server, and trust the *)
1421 (* client to restart us. Note that we can't do clientStart because that *)
1422 (* would start our (old) version of hh_server, not the new one! *)
1423 let unsaved = get_uris_with_unsaved_changes state |> UriSet.elements
in
1425 if List.is_empty
unsaved then
1428 unsaved |> List.map ~f
:string_of_uri
|> String.concat ~sep
:"\n"
1433 ^
"\nVersion in hhconfig and switch that spawned the current hh_client: "
1434 ^
!hhconfig_version_and_switch
1435 ^
"\nVersion in hhconfig and switch currently: "
1436 ^ current_version_and_switch
1439 Lsp_helpers.telemetry_log
to_stdout message;
1442 let%lwt
state = connect ~env
state in
1447 (* do_lost_server: handles the various ways we might lose hh_server. We keep *)
1448 (* the LSP server alive, and will (elsewhere) listen for the various triggers *)
1449 (* of getting the server back. *)
1453 ?
(allow_immediate_reconnect
= true)
1454 (p
: Lost_env.params) : state Lwt.t
=
1456 set_hh_server_state p
.new_hh_server_state;
1458 let state = dismiss_diagnostics state in
1459 let uris_with_unsaved_changes = get_uris_with_unsaved_changes state in
1460 let most_recent_file = get_most_recent_file state in
1461 let editor_open_files =
1462 Option.value (get_editor_open_files state) ~default
:UriMap.empty
1464 let lock_file = ServerFiles.lock_file (get_root_exn ()) in
1465 let reconnect_immediately =
1466 allow_immediate_reconnect
1467 && p
.trigger_on_lock_file
1468 && MonitorConnection.server_exists
lock_file
1470 if reconnect_immediately then (
1477 uris_with_unsaved_changes;
1479 hh_server_status_diagnostic
= None
;
1482 Lsp_helpers.telemetry_log
1484 "Reconnecting immediately to hh_server";
1486 reconnect_from_lost_if_necessary ~env
lost_state `Force_regain
1488 Lwt.return new_state
1496 uris_with_unsaved_changes;
1498 hh_server_status_diagnostic
= None
;
1501 let report_connect_end (ienv
: In_init_env.t
) : state =
1502 log "report_connect_end";
1504 let _state = dismiss_diagnostics (In_init ienv
) in
1505 hh_server_needs_idle := true;
1508 Main_env.conn
= ienv
.In_init_env.conn
;
1509 most_recent_file = ienv
.most_recent_file;
1510 editor_open_files = ienv
.editor_open_files;
1511 uris_with_diagnostics
= UriSet.empty
;
1512 uris_with_unsaved_changes = ienv
.In_init_env.uris_with_unsaved_changes;
1515 ShowStatusFB.request =
1517 ShowMessageRequest.type_
= MessageType.InfoMessage
;
1518 message = "hh_server: ready.";
1523 shortMessage
= None
;
1530 let announce_ide_failure (error_data
: ClientIdeMessage.stopped_reason
) :
1532 let open ClientIdeMessage
in
1534 "IDE services could not be initialized.\n%s\n%s"
1535 error_data
.long_user_message
1536 error_data
.debug_details
;
1541 error_data
.long_user_message
1542 error_data
.debug_details
1544 let%lwt upload_result
=
1545 Clowder_paste.clowder_upload_and_get_url ~timeout
:10. input
1548 match upload_result
with
1549 | Ok url
-> Printf.sprintf
"\nMore details: %s" url
1552 "\n\nMore details:\n%s\n\nTried to upload those details but it didn't work...\n%s"
1553 error_data
.debug_details
1556 Lsp_helpers.log_error to_stdout (error_data
.long_user_message ^
append_to_log);
1557 if error_data
.is_actionable
then
1558 Lsp_helpers.showMessage_error
1560 (error_data
.medium_user_message ^
see_output_hack);
1563 (** Like all async methods, this method has a synchronous preamble up
1564 to its first await point, at which point it returns a promise to its
1565 caller; the rest of the method will be scheduled asynchronously.
1566 The synchronous preamble sends an "initialize" request to the ide_service.
1567 The asynchronous continuation is triggered when the response comes back;
1568 it then pumps messages to and from the ide service.
1569 Note: the fact that the request is sent in the synchronous preamble, is
1570 important for correctness - the rest of the codebase can send other requests
1571 to the ide_service at any time, safe in the knowledge that such requests will
1572 necessarily be delivered after the initialize request. *)
1575 (ide_service
: ClientIdeService.t
)
1576 (initialize_params : Lsp.Initialize.params)
1577 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
option) : unit Lwt.t
=
1578 let open Lsp.Initialize
in
1579 let root = Some
(Lsp_helpers.get_root
initialize_params) |> Wwwroot.get
in
1582 initialize_params.client_capabilities
.workspace
.didChangeWatchedFiles
1583 .dynamicRegistration
1585 log_error "client doesn't support file-watching";
1587 let naming_table_load_info =
1588 match initialize_params.initializationOptions
.namingTableSavedStatePath
with
1593 ClientIdeMessage.Initialize_from_saved_state.path = Path.make
path;
1595 initialize_params.initializationOptions
1596 .namingTableSavedStateTestDelay
;
1601 |> Option.value ~default
:UriMap.empty
1603 |> List.map ~f
:(fun uri -> uri |> lsp_uri_to_path |> Path.make
)
1605 log_debug "initialize_from_saved_state";
1607 ClientIdeService.initialize_from_saved_state
1610 ~
naming_table_load_info
1611 ~use_ranked_autocomplete
:env
.use_ranked_autocomplete
1612 ~config
:env
.args
.config
1615 log_debug "initialize_from_saved_state.done";
1618 let%lwt
() = ClientIdeService.serve ide_service
in
1620 | Error error_data
->
1621 let%lwt
() = announce_ide_failure error_data
in
1624 let stop_ide_service
1625 (ide_service
: ClientIdeService.t
)
1626 ~
(tracking_id : string)
1627 ~
(stop_reason
: ClientIdeService.Stop_reason.t
) : unit Lwt.t
=
1629 "Stopping IDE service process: %s"
1630 (ClientIdeService.Stop_reason.to_log_string stop_reason
);
1632 ClientIdeService.stop ide_service ~
tracking_id ~stop_reason ~
exn:None
1636 let on_status_restart_action
1638 ~
(ide_service
: ClientIdeService.t
ref option)
1639 (result : ShowStatusFB.result)
1640 (state : state) : state Lwt.t
=
1641 let open ShowMessageRequest
in
1642 match (result, state, ide_service
) with
1643 | (Some
{ title
}, Lost_server _
, _
)
1644 when String.equal title
hh_server_restart_button_text ->
1645 let root = get_root_exn () in
1646 (* Belt-and-braces kill the server. This is in case the server was *)
1647 (* stuck in some weird state. It's also what 'hh restart' does. *)
1648 if MonitorConnection.server_exists
(Path.to_string
root) then
1649 ClientStop.kill_server
root !from;
1651 (* After that it's safe to try to reconnect! *)
1652 start_server ~env
root;
1653 let%lwt
state = reconnect_from_lost_if_necessary ~env
state `Force_regain
in
1655 | (Some
{ title
}, _
, Some ide_service
)
1656 when String.equal title
client_ide_restart_button_text ->
1657 log "Restarting IDE service";
1659 (* It's possible that [destroy] takes a while to finish, so make
1660 sure to assign the new IDE service to the [ref] before attempting
1661 to do an asynchronous operation with the old one. *)
1664 ClientIdeMessage.init_id
= env
.init_id
;
1665 verbose_to_stderr
= env
.args
.verbose
;
1666 verbose_to_file = !verbose_to_file;
1669 let new_ide_service = ClientIdeService.make
ide_args in
1670 let old_ide_service = !ide_service
in
1671 ide_service
:= new_ide_service;
1672 (* Note: the env.verbose passed on init controls verbosity for stderr
1673 and is only ever controlled by --verbose command line, stored in env.
1674 But verbosity-to-file can be altered dynamically by the user. *)
1675 let (promise
: unit Lwt.t
) =
1679 (initialize_params_exc ())
1680 (get_editor_open_files state)
1682 ignore_promise_but_handle_failure
1684 ~desc
:"run-ide-after-restart"
1685 ~terminate_on_failure
:true;
1686 (* Invariant: at all times after InitializeRequest, ide_service has
1687 already been sent an "initialize" message. *)
1691 ~
tracking_id:"restart"
1692 ~stop_reason
:ClientIdeService.Stop_reason.Restarting
1695 | _
-> Lwt.return
state
1697 let get_client_ide_status (ide_service
: ClientIdeService.t
) :
1698 ShowStatusFB.params option =
1699 let (type_
, shortMessage
, message, actions, telemetry
) =
1700 match ClientIdeService.get_status ide_service
with
1701 | ClientIdeService.Status.Initializing
->
1702 ( MessageType.WarningMessage
,
1703 "Hack: initializing",
1704 "Hack IDE: initializing.",
1707 | ClientIdeService.Status.Processing_files p
->
1708 let open ClientIdeMessage.Processing_files
in
1709 ( MessageType.WarningMessage
,
1711 Printf.sprintf
"Hack IDE: processing %d files." p
.total
,
1714 | ClientIdeService.Status.Rpc requests
->
1716 Hh_json.JSON_Array
(List.map requests ~f
:Telemetry.to_json
)
1718 ( MessageType.WarningMessage
,
1720 "Hack IDE: working...",
1723 | ClientIdeService.Status.Ready
->
1724 (MessageType.InfoMessage
, "Hack: ready", "Hack IDE: ready.", [], None
)
1725 | ClientIdeService.Status.Stopped
s ->
1726 let open ClientIdeMessage
in
1727 ( MessageType.ErrorMessage
,
1728 "Hack: " ^
s.short_user_message
,
1729 s.medium_user_message ^
see_output_hack,
1730 [{ ShowMessageRequest.title
= client_ide_restart_button_text }],
1735 ShowStatusFB.shortMessage
= Some shortMessage
;
1736 request = { ShowMessageRequest.type_
; message; actions };
1742 (** This function blocks while it attempts to connect to the monitor to read status.
1743 It normally it gets status quickly, but has a 3s timeout just in case. *)
1744 let get_hh_server_status (state : state) : ShowStatusFB.params option =
1745 let open ShowStatusFB
in
1746 let open ShowMessageRequest
in
1752 let open In_init_env
in
1753 let time = Unix.time () in
1755 if Sys_utils.deterministic_behavior_for_tests
() then
1756 (* we avoid raciness in our tests by not showing a real time *)
1759 int_of_float
(time -. ienv
.first_start_time
) |> string_of_int
1761 (* TODO: better to report time that hh_server has spent initializing *)
1762 let (progress
, warning
) =
1763 let open ServerCommandTypes
in
1765 | In_init
{ In_init_env.conn
; _
}
1766 | Main_loop
{ Main_env.conn
; _
} ->
1767 let server_progress_file =
1768 conn
.server_specific_files
.ServerCommandTypes.server_progress_file
1770 let server_progress =
1771 ServerCommandTypesUtils.read_progress_file ~
server_progress_file
1773 (server_progress.server_progress, server_progress.server_warning
)
1774 | _
-> ("connecting", None
)
1776 (* [progress] comes from ServerProgress.ml, sent to the monitor, and now we've fetched
1777 it from the monitor. It's a string "op X/Y units (%)" e.g. "typechecking 5/16 files (78%)",
1778 or "connecting", if there is no relevant progress to show.
1779 [warning] comes from the same place, and if present is a human-readable string
1780 that warns about saved-state-init failure. *)
1782 if Option.is_some
warning then
1783 " (saved-state not found - will take a while)"
1789 "hh_server initializing%s: %s [%s seconds]"
1796 request = { type_
= MessageType.WarningMessage
; message; actions = [] };
1799 shortMessage
= Some
"Hack: initializing";
1802 | Main_loop
{ Main_env.hh_server_status
; _
} ->
1803 (* This shows whether the connected hh_server is busy or ready.
1804 It's produced in clientLsp.do_server_busy upon receipt of a status
1805 enum from the server. See comments on hh_server_status for invariants. *)
1806 Some hh_server_status
1807 | Lost_server
{ Lost_env.p
; _
} ->
1810 shortMessage
= Some
"Hack: stopped";
1813 type_
= MessageType.ErrorMessage
;
1814 message = p
.Lost_env.explanation;
1815 actions = [{ title
= hh_server_restart_button_text }];
1822 (** Makes a diagnostic messages for cases where the server status is not fully running. *)
1823 let hh_server_status_to_diagnostic
1824 (uri : documentUri
option) (hh_server_status
: ShowStatusFB.params) :
1825 PublishDiagnostics.params option =
1826 let open ShowStatusFB
in
1827 let open ShowMessageRequest
in
1828 let open PublishDiagnostics
in
1831 PublishDiagnostics.range
=
1833 start
= { line
= 0; character
= 0 };
1834 end_
= { line
= 0; character
= 1 };
1838 source
= Some
"hh_server";
1840 relatedInformation = [];
1841 relatedLocations
= [];
1844 match (uri, hh_server_status
.request.type_
) with
1846 | (_
, (MessageType.InfoMessage
| MessageType.LogMessage
)) ->
1848 | (Some
uri, MessageType.ErrorMessage
) ->
1858 "hh_server isn't running, so there may be undetected errors. Try `hh` at the command line... "
1859 ^ hh_server_status
.request.message;
1860 severity = Some Error
;
1864 | (Some
uri, MessageType.WarningMessage
) ->
1874 "hh_server isn't yet ready, so there may be undetected errors... "
1875 ^ hh_server_status
.request.message;
1876 severity = Some Warning
;
1881 (** Manage the state of which diagnostics have been shown to the user
1882 about hh_server status: removes the old one if necessary, and adds a new one
1883 if necessary. Note that we only display hh_server_status diagnostics
1884 during In_init and Lost_server states, neither of which have diagnostics
1886 let publish_hh_server_status_diagnostic
1887 (state : state) (hh_server_status
: ShowStatusFB.params option) : state =
1889 match (get_most_recent_file state, get_editor_open_files state) with
1890 | (Some
uri, Some
open_files) when UriMap.mem
uri open_files -> Some
uri
1891 | (_
, Some
open_files) when not
(UriMap.is_empty
open_files) ->
1892 Some
(UriMap.choose
open_files |> fst
)
1895 let desired_diagnostic =
1896 Option.bind hh_server_status ~f
:(hh_server_status_to_diagnostic uri)
1898 let get_existing_diagnostic state =
1900 | In_init ienv
-> ienv
.In_init_env.hh_server_status_diagnostic
1901 | Lost_server lenv
-> lenv
.Lost_env.hh_server_status_diagnostic
1904 let publish_and_update_diagnostic state diagnostic =
1905 let notification = PublishDiagnosticsNotification
diagnostic in
1906 notification |> print_lsp_notification
|> to_stdout;
1910 { ienv
with In_init_env.hh_server_status_diagnostic
= Some
diagnostic }
1911 | Lost_server lenv
->
1913 { lenv
with Lost_env.hh_server_status_diagnostic
= Some
diagnostic }
1916 let open PublishDiagnostics
in
1917 (* The following match emboodies these rules:
1918 (1) we only publish hh_server_status diagnostics in In_init and Lost_server states,
1919 (2) we'll remove the old PublishDiagnostic if necessary and add a new one if necessary
1920 (3) to avoid extra LSP messages, if the diagnostic hasn't changed then we won't send anything
1921 (4) to avoid flicker, if the diagnostic has changed but is still in the same file, then
1922 we refrain from sending an "erase old" message and it will be implied by sending "new". *)
1923 match (get_existing_diagnostic state, desired_diagnostic, state) with
1924 | (_
, _
, Main_loop _
)
1926 | (_
, _
, Post_shutdown
)
1927 | (None
, None
, _
) ->
1929 | (Some _
, None
, _
) -> dismiss_diagnostics state
1930 | (Some existing
, Some desired
, _
)
1931 when Lsp.equal_documentUri existing
.uri desired
.uri
1933 PublishDiagnostics.equal_diagnostic
1934 (List.hd existing
.diagnostics
)
1935 (List.hd desired
.diagnostics
) ->
1937 | (Some existing
, Some desired
, _
)
1938 when Lsp.equal_documentUri existing
.uri desired
.uri ->
1939 publish_and_update_diagnostic state desired
1940 | (Some _
, Some desired
, _
) ->
1941 let state = dismiss_diagnostics state in
1942 publish_and_update_diagnostic state desired
1943 | (None
, Some desired
, _
) -> publish_and_update_diagnostic state desired
1945 (** Here are the rules for merging status. They embody the principle that the spinner
1946 shows if initializing/typechecking is in progress, the error icon shows if error,
1947 and the status bar word is "Hack" if IDE services are available or "Hack: xyz" if not.
1948 Note that if Hack IDE is up but hh_server is down, then the hh_server failure message
1949 is conveyed via a publishDiagnostic; it's not conveyed via status.
1950 [ok] Hack -- if ide_service is up and hh_server is ready
1951 [spin] Hack -- if ide_service is processing-files or hh_server is initializing/typechecking
1952 [spin] Hack: initializing -- if ide_service is initializing
1953 [err] Hack: failure -- if ide_service is down
1954 If client_ide_service isn't enabled, then we show thing differently:
1955 [ok] Hack -- if hh_server is ready (Main_loop)
1956 [spin] Hack -- if hh_server is doing local or global typechecks (Main_loop)
1957 [spin] Hack: busy -- if hh_server is doing non-interruptible typechecks (Main_loop)
1958 [spin] Hack: initializing -- if hh_server is initializing (In_init)
1959 [err] hh_server: stopped -- hh_server is down (Lost_server)
1960 As for the tooltip and actions, they are combined from both ide_service and hh_server. *)
1962 ~
(client_ide_status
: ShowStatusFB.params option)
1963 ~
(hh_server_status
: ShowStatusFB.params option) :
1964 ShowStatusFB.params option =
1965 (* The correctness of the following match is a bit subtle. This is how to think of it.
1966 From the spec in the docblock, (1) if there's no client_ide_service, then the result
1967 of this function is simply the same as hh_server_status, since that's how it was constructed
1968 by get_hh_server_status (for In_init and Lost_server) and do_server_busy; (2) if there
1969 is a client_ide_service then the result is almost always simply the same as ide_service
1970 since that's how it was constructed by get_client_ide_status; (3) the only exception to
1971 rule 2 is that, if client_ide_status would have shown "[ok] Hack" and hh_server_status
1972 would have been a spinner, then we change to "[spin] Hack". *)
1973 match (client_ide_status
, hh_server_status
) with
1974 | (None
, None
) -> None
1975 | (None
, Some _
) -> hh_server_status
1976 | (Some _
, None
) -> client_ide_status
1977 | (Some client_ide_status
, Some hh_server_status
) ->
1978 let open Lsp.ShowStatusFB
in
1979 let open Lsp.ShowMessageRequest
in
1982 client_ide_status
.request with
1984 client_ide_status
.request.message
1986 ^ hh_server_status
.request.message;
1988 client_ide_status
.request.actions @ hh_server_status
.request.actions;
1992 MessageType.equal client_ide_status
.request.type_
MessageType.InfoMessage
1993 && MessageType.equal
1994 hh_server_status
.request.type_
1995 MessageType.WarningMessage
1997 let request = { request with type_
= MessageType.WarningMessage
} in
1998 Some
{ client_ide_status
with request; shortMessage
= Some
"Hack" }
2000 Some
{ client_ide_status
with request }
2002 let refresh_status ~
(env
: env
) ~
(ide_service
: ClientIdeService.t
ref option) :
2004 let client_ide_status =
2005 match ide_service
with
2007 | Some ide_service
-> get_client_ide_status !ide_service
2010 merge_statuses ~hh_server_status
:!latest_hh_server_status ~
client_ide_status
2015 (request_showStatusFB
2016 ~on_result
:(on_status_restart_action ~env ~ide_service
));
2019 let rpc_lock = Lwt_mutex.create
()
2022 (server_conn
: server_conn
)
2023 (ref_unblocked_time
: float ref)
2025 (command
: 'a
ServerCommandTypes.t
) : 'a
Lwt.t
=
2027 Lwt_mutex.with_lock
rpc_lock (fun () ->
2028 let callback () push
=
2029 update_hh_server_state_if_necessary
2030 (Server_message
{ push
; has_updated_server_state
= false });
2032 server_conn
.pending_messages
2033 { push
; has_updated_server_state
= true }
2035 let start_time = Unix.gettimeofday
() in
2037 ServerCommandLwt.rpc_persistent
2038 (server_conn
.ic
, server_conn
.oc
)
2044 let end_time = Unix.gettimeofday
() in
2045 let duration = end_time -. start_time in
2046 let msg = ServerCommandTypesUtils.debug_describe_t command
in
2047 hh_server_needs_idle := not
(ServerCommandTypes.is_idle_rpc command
);
2048 log_debug "hh_server rpc: [%s] [%0.3f]" msg duration;
2050 | Ok
((), res
, tracker
) ->
2052 (Connection_tracker.get_server_unblocked_time tracker
)
2053 ~f
:(fun t
-> ref_unblocked_time
:= t
);
2058 ServerCommandLwt.Remote_fatal_exception remote_e_data
) ->
2059 raise
(Server_fatal_connection_exception remote_e_data
)
2063 ServerCommandLwt.Remote_nonfatal_exception
2064 { Marshal_tools.message; stack } ) ->
2065 raise
(Server_nonfatal_exception
(make_lsp_error message ~
stack))
2066 | Error
((), Utils.Callstack
stack, e) ->
2067 let message = Exn.to_string
e in
2069 (Server_fatal_connection_exception
{ Marshal_tools.message; stack }))
2073 let rpc_with_retry server_conn ref_unblocked_time ~desc command
=
2074 ServerCommandTypes.Done_or_retry.call ~f
:(fun () ->
2075 rpc server_conn ref_unblocked_time ~desc command
)
2077 (** A thin wrapper around ClientIdeMessage which turns errors into exceptions *)
2079 (ide_service
: ClientIdeService.t
ref)
2081 ~
(tracking_id : string)
2082 ~
(ref_unblocked_time
: float ref)
2083 (message : 'a
ClientIdeMessage.t
) : 'a
Lwt.t
=
2084 let progress () = refresh_status ~env ~ide_service
:(Some ide_service
) in
2086 ClientIdeService.rpc
2094 | Ok
result -> Lwt.return
result
2095 | Error error_data
-> raise
(Server_nonfatal_exception error_data
)
2097 (************************************************************************)
2099 (************************************************************************)
2103 (ide_service
: ClientIdeService.t
ref option)
2104 (tracking_id : string)
2105 (ref_unblocked_time
: float ref) : state Lwt.t
=
2106 log "Received shutdown request";
2107 let state = dismiss_diagnostics state in
2111 (* In Main_loop state, we're expected to unsubscribe diagnostics and tell *)
2112 (* server to disconnect so it can revert the state of its unsaved files. *)
2119 ServerCommandTypes.DISCONNECT
2123 (* In In_init state, even though we have a 'conn', it's still waiting for *)
2124 (* the server to become responsive, so there's no use sending any rpc *)
2125 (* messages to the server over it. *)
2128 (* No other states have a 'conn' to send any disconnect messages over. *)
2131 match ide_service
with
2132 | None
-> Lwt.return_unit
2133 | Some ide_service
->
2137 ~stop_reason
:ClientIdeService.Stop_reason.Editor_exited
2139 Lwt.return Post_shutdown
2141 let state_to_rage (state : state) : string =
2142 let uris_to_string uris
=
2143 List.map uris ~f
:(fun (DocumentUri
uri) -> uri) |> String.concat ~sep
:","
2148 | Post_shutdown
-> ""
2150 let open Main_env
in
2153 ^^
"editor_open_files: %s\n"
2154 ^^
"uris_with_diagnostics: %s\n"
2155 ^^
"uris_with_unsaved_changes: %s\n"
2156 ^^
"hh_server_status.message: %s\n"
2157 ^^
"hh_server_status.shortMessage: %s\n")
2158 !hh_server_needs_idle
2159 (menv.editor_open_files |> UriMap.keys
|> uris_to_string)
2160 (menv.uris_with_diagnostics
|> UriSet.elements
|> uris_to_string)
2161 (menv.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2162 menv.hh_server_status
.ShowStatusFB.request.ShowMessageRequest.message
2164 menv.hh_server_status
.ShowStatusFB.shortMessage
2165 ~default
:"[absent]")
2167 let open In_init_env
in
2169 ("first_start_time: %f\n"
2170 ^^
"most_recent_sstart_time: %f\n"
2171 ^^
"editor_open_files: %s\n"
2172 ^^
"uris_with_unsaved_changes: %s\n")
2173 ienv
.first_start_time
2174 ienv
.most_recent_start_time
2175 (ienv
.editor_open_files |> UriMap.keys
|> uris_to_string)
2176 (ienv
.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2177 | Lost_server lenv
->
2178 let open Lost_env
in
2180 ("editor_open_files: %s\n"
2181 ^^
"uris_with_unsaved_changes: %s\n"
2182 ^^
"lock_file: %s\n"
2183 ^^
"explanation: %s\n"
2184 ^^
"new_hh_server_state: %s\n"
2185 ^^
"start_on_click: %b\n"
2186 ^^
"trigger_on_lsp: %b\n"
2187 ^^
"trigger_on_lock_file: %b\n")
2188 (lenv
.editor_open_files |> UriMap.keys
|> uris_to_string)
2189 (lenv
.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2192 (lenv
.p
.new_hh_server_state |> hh_server_state_to_string)
2193 lenv
.p
.start_on_click
2194 lenv
.p
.trigger_on_lsp
2195 lenv
.p
.trigger_on_lock_file
2197 Printf.sprintf
"clientLsp state: %s\n%s\n" (state_to_string state) details
2199 let do_rageFB (state : state) : RageFB.result Lwt.t
=
2200 (* clientLsp status *)
2201 let tnow = Unix.gettimeofday
() in
2202 let server_state_to_string (tstate
, state) =
2203 let tdiff = tnow -. tstate
in
2204 let state = hh_server_state_to_string state in
2205 let tm = Unix.localtime tstate
in
2206 let ms = int_of_float
(tstate
*. 1000.) mod 1000 in
2208 "[%02d:%02d:%02d.%03d] [%03.3fs ago] %s"
2217 !hh_server_state_log
2218 |> List.sort ~compare
:(fun (t1
, _
) (t2
, _
) -> Float.compare t1 t2
)
2219 |> List.map ~f
:server_state_to_string
2220 |> String.concat ~sep
:"\n"
2222 let%lwt current_version_and_switch
= read_hhconfig_version_and_switch () in
2228 ^^
"version previously read from .hhconfig and switch: %s\n"
2229 ^^
"version in .hhconfig and switch: %s\n\n"
2230 ^^
"clientLsp belief of hh_server_state:\n%s\n")
2231 (state_to_rage state)
2232 !hhconfig_version_and_switch
2233 current_version_and_switch
2236 Lwt.return
[{ RageFB.title
= None
; data }]
2239 (conn
: server_conn
)
2240 (ref_unblocked_time
: float ref)
2241 (params : DidOpen.params) : unit Lwt.t
=
2243 let open TextDocumentItem
in
2244 let filename = lsp_uri_to_path params.textDocument
.uri in
2245 let text = params.textDocument
.text in
2246 let command = ServerCommandTypes.OPEN_FILE
(filename, text) in
2247 rpc conn ref_unblocked_time ~desc
:"open" command
2250 (conn
: server_conn
)
2251 (ref_unblocked_time
: float ref)
2252 (params : DidClose.params) : unit Lwt.t
=
2253 let open DidClose
in
2254 let open TextDocumentIdentifier
in
2255 let filename = lsp_uri_to_path params.textDocument
.uri in
2256 let command = ServerCommandTypes.CLOSE_FILE
filename in
2257 rpc conn ref_unblocked_time ~desc
:"close" command
2260 (conn
: server_conn
)
2261 (ref_unblocked_time
: float ref)
2262 (params : DidChange.params) : unit Lwt.t
=
2263 let open VersionedTextDocumentIdentifier
in
2264 let open Lsp.DidChange
in
2265 let lsp_change_to_ide (lsp
: DidChange.textDocumentContentChangeEvent
) :
2266 Ide_api_types.text_edit
=
2268 Ide_api_types.range
= Option.map lsp
.range ~f
:lsp_range_to_ide;
2272 let filename = lsp_uri_to_path params.textDocument
.uri in
2273 let changes = List.map
params.contentChanges ~f
:lsp_change_to_ide in
2274 let command = ServerCommandTypes.EDIT_FILE
(filename, changes) in
2275 rpc conn ref_unblocked_time ~desc
:"change" command
2277 let do_hover_common (infos
: HoverService.hover_info list
) : Hover.result =
2280 |> List.map ~f
:(fun hoverInfo
->
2281 (* Hack server uses None to indicate absence of a result. *)
2282 (* We're also catching the non-result "" just in case... *)
2283 match hoverInfo
with
2284 | { HoverService.snippet
= ""; _
} -> []
2285 | { HoverService.snippet
; addendum
; _
} ->
2286 MarkedCode
("hack", snippet
)
2287 :: List.map ~f
:(fun s -> MarkedString
s) addendum
)
2290 (* We pull the position from the SymbolOccurrence.t record, so I would be
2291 surprised if there were any different ones in here. Just take the first
2295 |> List.filter_map ~f
:(fun { HoverService.pos
; _
} -> pos
)
2297 |> Option.map ~f
:(hack_pos_to_lsp_range ~equal
:Relative_path.equal
)
2299 if List.is_empty
contents then
2302 Some
{ Hover.contents; range }
2305 (conn
: server_conn
)
2306 (ref_unblocked_time
: float ref)
2307 (params : Hover.params) : Hover.result Lwt.t
=
2308 let (file, line
, column
) = lsp_file_position_to_hack params in
2309 let command = ServerCommandTypes.IDE_HOVER
(file, line
, column
) in
2310 let%lwt infos
= rpc conn ref_unblocked_time ~desc
:"hover" command in
2311 Lwt.return
(do_hover_common infos
)
2314 (ide_service
: ClientIdeService.t
ref)
2316 (tracking_id : string)
2317 (ref_unblocked_time
: float ref)
2318 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2319 (params : Hover.params) : Hover.result Lwt.t
=
2320 let document_location = get_document_location editor_open_files params in
2327 (ClientIdeMessage.Hover
document_location)
2329 Lwt.return
(do_hover_common infos
)
2331 let do_typeDefinition
2332 (conn
: server_conn
)
2333 (ref_unblocked_time
: float ref)
2334 (params : Definition.params) : TypeDefinition.result Lwt.t
=
2335 let (file, line
, column
) = lsp_file_position_to_hack params in
2337 ServerCommandTypes.(IDENTIFY_TYPES
(LabelledFileName
file, line
, column
))
2339 let%lwt results
= rpc conn ref_unblocked_time ~desc
:"go-to-typedef" command in
2341 (List.map results ~f
:(fun nast_sid
->
2342 hack_pos_definition_to_lsp_identifier_location
2344 ~default_path
:file))
2346 let do_typeDefinition_local
2347 (ide_service
: ClientIdeService.t
ref)
2349 (tracking_id : string)
2350 (ref_unblocked_time
: float ref)
2351 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2352 (params : Definition.params) : TypeDefinition.result Lwt.t
=
2353 let document_location = get_document_location editor_open_files params in
2360 (ClientIdeMessage.Type_definition
document_location)
2362 let file = Path.to_string
document_location.ClientIdeMessage.file_path in
2364 List.map
results ~f
:(fun nast_sid
->
2365 hack_pos_definition_to_lsp_identifier_location
2372 (conn
: server_conn
)
2373 (ref_unblocked_time
: float ref)
2374 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2375 (params : Definition.params) : (Definition.result * bool) Lwt.t
=
2376 let (filename, line
, column
) = lsp_file_position_to_hack params in
2378 params.TextDocumentPositionParams.textDocument
.TextDocumentIdentifier.uri
2381 match UriMap.find_opt
uri editor_open_files with
2383 ServerCommandTypes.(
2385 { filename; content
= document
.TextDocumentItem.text })
2386 | None
-> ServerCommandTypes.(LabelledFileName
filename)
2389 ServerCommandTypes.GO_TO_DEFINITION
(labelled_file, line
, column
)
2391 let%lwt
results = rpc conn ref_unblocked_time ~desc
:"go-to-def" command in
2393 List.map
results ~f
:(fun (_
, definition
) ->
2394 hack_symbol_definition_to_lsp_identifier_location
2396 ~default_path
:filename)
2398 let has_xhp_attribute =
2399 List.exists
results ~f
:(fun (occurence
, _
) ->
2400 SymbolOccurrence.is_xhp_literal_attr occurence
)
2402 Lwt.return
(locations, has_xhp_attribute)
2404 let do_definition_local
2405 (ide_service
: ClientIdeService.t
ref)
2407 (tracking_id : string)
2408 (ref_unblocked_time
: float ref)
2409 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2410 (params : Definition.params) : (Definition.result * bool) Lwt.t
=
2411 let document_location = get_document_location editor_open_files params in
2418 (ClientIdeMessage.Definition
document_location)
2421 List.map
results ~f
:(fun (_
, definition
) ->
2422 hack_symbol_definition_to_lsp_identifier_location
2425 (document_location.ClientIdeMessage.file_path |> Path.to_string
))
2427 let has_xhp_attribute =
2428 List.exists
results ~f
:(fun (occurence
, _
) ->
2429 SymbolOccurrence.is_xhp_literal_attr occurence
)
2431 Lwt.return
(locations, has_xhp_attribute)
2433 let snippet_re = Str.regexp
{|[\$
}]|} (* snippets must backslash-escape "$\}" *)
2435 let make_ide_completion_response
2436 (result : AutocompleteTypes.ide_result
) (filename : string) :
2437 Completion.completionList
Lwt.t
=
2438 let open AutocompleteTypes
in
2439 let open Completion
in
2440 (* We use snippets to provide parentheses+arguments when autocompleting *)
2441 (* method calls e.g. "$c->|" ==> "$c->foo($arg1)". But we'll only do this *)
2442 (* there's nothing after the caret: no "$c->|(1)" -> "$c->foo($arg1)(1)" *)
2443 let is_caret_followed_by_lparen = Char.equal
result.char_at_pos '
('
in
2444 let p = initialize_params_exc () in
2445 let hack_to_itemType (completion
: complete_autocomplete_result
) :
2447 (* TODO: we're using itemType (left column) for function return types, and *)
2448 (* the inlineDetail (right column) for variable/field types. Is that good? *)
2449 Option.map completion
.func_details ~f
:(fun details -> details.return_ty
)
2451 let hack_to_detail (completion
: complete_autocomplete_result
) : string =
2452 (* TODO: retrieve the actual signature including name+modifiers *)
2453 (* For now we just return the type of the completion. In the case *)
2454 (* of functions, their function-types have parentheses around them *)
2455 (* which we want to strip. In other cases like tuples, no strip. *)
2456 match completion
.func_details
with
2457 | None
-> completion
.res_ty
2459 String_utils.rstrip
(String_utils.lstrip completion
.res_ty
"(") ")"
2461 let hack_to_inline_detail (completion
: complete_autocomplete_result
) : string
2463 match completion
.func_details
with
2464 | None
-> hack_to_detail completion
2466 (* "(type1 $param1, ...)" *)
2467 let f param
= Printf.sprintf
"%s %s" param
.param_ty param
.param_name
in
2468 let params = String.concat ~sep
:", " (List.map
details.params ~
f) in
2469 Printf.sprintf
"(%s)" params
2470 (* Returns a tuple of (insertText, insertTextFormat, textEdits). *)
2472 let hack_to_insert (completion
: complete_autocomplete_result
) :
2473 [ `InsertText
of string | `TextEdit
of TextEdit.t list
]
2474 * Completion.insertTextFormat
=
2475 match completion
.func_details
with
2477 when Lsp_helpers.supports_snippets
p
2478 && (not
is_caret_followed_by_lparen)
2480 (SearchUtils.equal_si_kind
2482 SearchUtils.SI_LocalVariable
) ->
2483 (* "method(${1:arg1}, ...)" but for args we just use param names. *)
2485 let name = Str.global_replace
snippet_re "\\\\\\0" param
.param_name
in
2486 Printf.sprintf
"${%i:%s}" (i
+ 1) name
2488 let params = String.concat ~sep
:", " (List.mapi
details.params ~
f) in
2489 ( `InsertText
(Printf.sprintf
"%s(%s)" completion
.res_name
params),
2496 range = ide_range_to_lsp completion
.res_replace_pos
;
2497 newText
= completion
.res_name
;
2502 let hack_completion_to_lsp (completion
: complete_autocomplete_result
) :
2503 Completion.completionItem
=
2504 let (insertText
, insertTextFormat
, textEdits
) =
2505 match hack_to_insert completion
with
2506 | (`InsertText
text, format
) -> (Some
text, format
, [])
2507 | (`TextEdit edits
, format
) -> (None
, format
, edits
)
2510 if String.equal
(Pos.filename completion
.res_pos
) "" then
2511 Pos.set_file
filename completion
.res_pos
2516 let (line
, start
, _
) = Pos.info_pos
pos in
2517 let filename = Pos.filename pos in
2519 match completion
.res_base_class
with
2520 | Some
base_class -> [("base_class", Hh_json.JSON_String
base_class)]
2523 let ranking_detail =
2524 match completion
.ranking_details
with
2527 ("ranking_detail", Hh_json.JSON_String
details.detail
);
2528 ("ranking_source", Hh_json.JSON_Number
details.kind
);
2532 (* If we do not have a correct file position, skip sending that data *)
2533 if Int.equal line
0 && Int.equal start
0 then
2535 (Hh_json.JSON_Object
2536 ([("fullname", Hh_json.JSON_String completion
.res_fullname
)]
2541 (Hh_json.JSON_Object
2543 (* Fullname is needed for namespaces. We often trim namespaces to make
2544 * the results more readable, such as showing "ad__breaks" instead of
2545 * "Thrift\Packages\cf\ad__breaks".
2547 ("fullname", Hh_json.JSON_String completion
.res_fullname
);
2548 (* Filename/line/char/base_class are used to handle class methods.
2549 * We could unify this with fullname in the future.
2551 ("filename", Hh_json.JSON_String
filename);
2552 ("line", Hh_json.int_ line
);
2553 ("char", Hh_json.int_ start
);
2558 let hack_to_sort_text (completion
: complete_autocomplete_result
) :
2560 let label = completion
.res_name
in
2561 let should_downrank label =
2562 String.length
label > 2
2563 && String.equal
(Str.string_before
label 2) "__"
2564 || Str.string_match
(Str.regexp_case_fold
".*do_not_use.*") label 0
2566 let downranked_result_prefix_character = "~" in
2567 if should_downrank label then
2568 Some
(downranked_result_prefix_character ^
label)
2574 (completion
.res_name
2577 SearchUtils.equal_si_kind completion
.res_kind
SearchUtils.SI_Namespace
2583 (match completion
.ranking_details
with
2584 | Some _
-> Some
Completion.Event
2586 si_kind_to_completion_kind completion
.AutocompleteTypes.res_kind
);
2587 detail
= Some
(hack_to_detail completion
);
2588 inlineDetail
= Some
(hack_to_inline_detail completion
);
2589 itemType
= hack_to_itemType completion
;
2591 Option.map completion
.res_documentation ~
f:(fun s ->
2592 MarkedStringsDocumentation
[MarkedString
s]);
2593 (* This will be filled in by completionItem/resolve. *)
2595 (match completion
.ranking_details
with
2596 | Some detail
-> Some detail
.sort_text
2597 | None
-> hack_to_sort_text completion
);
2600 insertTextFormat
= Some insertTextFormat
;
2608 isIncomplete
= not
result.is_complete
;
2609 items
= List.map
result.completions ~
f:hack_completion_to_lsp;
2612 let do_completion_ffp
2613 (conn
: server_conn
)
2614 (ref_unblocked_time
: float ref)
2615 (params : Completion.params) : Completion.result Lwt.t
=
2616 let open Completion
in
2617 let open TextDocumentIdentifier
in
2619 lsp_position_to_ide params.loc
.TextDocumentPositionParams.position
2622 lsp_uri_to_path params.loc
.TextDocumentPositionParams.textDocument
.uri
2624 let command = ServerCommandTypes.IDE_FFP_AUTOCOMPLETE
(filename, pos) in
2625 let%lwt
result = rpc conn ref_unblocked_time ~desc
:"completion" command in
2626 make_ide_completion_response result filename
2628 let do_completion_legacy
2629 (conn
: server_conn
)
2630 (ref_unblocked_time
: float ref)
2631 (params : Completion.params) : Completion.result Lwt.t
=
2632 let open Completion
in
2633 let open TextDocumentIdentifier
in
2635 lsp_position_to_ide params.loc
.TextDocumentPositionParams.position
2638 lsp_uri_to_path params.loc
.TextDocumentPositionParams.textDocument
.uri
2640 let is_manually_invoked =
2641 match params.context
with
2643 | Some c
-> is_invoked c
.triggerKind
2646 ServerCommandTypes.IDE_AUTOCOMPLETE
(filename, pos, is_manually_invoked)
2648 let%lwt
result = rpc conn ref_unblocked_time ~desc
:"completion" command in
2649 make_ide_completion_response result filename
2651 let do_completion_local
2652 (ide_service
: ClientIdeService.t
ref)
2654 (tracking_id : string)
2655 (ref_unblocked_time
: float ref)
2656 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2657 (params : Completion.params) : Completion.result Lwt.t
=
2658 let open Completion
in
2659 let document_location = get_document_location editor_open_files params.loc
in
2660 (* Other parameters *)
2661 let is_manually_invoked =
2662 match params.context
with
2664 | Some c
-> is_invoked c
.triggerKind
2666 (* this is what I want to fix *)
2668 ClientIdeMessage.Completion
2669 { ClientIdeMessage.Completion.document_location; is_manually_invoked }
2672 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2675 document_location.ClientIdeMessage.file_path |> Path.to_string
2677 let%lwt response
= make_ide_completion_response infos
filename in
2680 exception NoLocationFound
2682 let docblock_to_markdown (raw_docblock
: DocblockService.result) :
2683 Completion.completionDocumentation
option =
2684 match raw_docblock
with
2688 (Completion.MarkedStringsDocumentation
2689 (Core_kernel.List.fold docblock ~init
:[] ~
f:(fun acc elt
->
2691 | DocblockService.Markdown txt
-> MarkedString txt
:: acc
2692 | DocblockService.HackSnippet txt
->
2693 MarkedCode
("hack", txt
) :: acc
2694 | DocblockService.XhpSnippet txt
->
2695 MarkedCode
("html", txt
) :: acc
)))
2697 let docblock_with_ranking_detail
2698 (raw_docblock
: DocblockService.result) (ranking_detail : string option) :
2699 DocblockService.result =
2700 match ranking_detail with
2701 | Some detail
-> raw_docblock
@ [DocblockService.Markdown detail
]
2702 | None
-> raw_docblock
2704 let resolve_ranking_source
2705 (kind
: SearchUtils.si_kind
) (ranking_source
: int option) :
2706 SearchUtils.si_kind
=
2707 match ranking_source
with
2708 | Some x
-> SearchUtils.int_to_kind x
2711 let do_completionItemResolve
2712 (conn
: server_conn
)
2713 (ref_unblocked_time
: float ref)
2714 (params : CompletionItemResolve.params) : CompletionItemResolve.result Lwt.t
2716 if Option.is_some
params.Completion.documentation
then
2719 (* No matter what, we need the kind *)
2720 let raw_kind = params.Completion.kind
in
2721 let kind = completion_kind_to_si_kind raw_kind in
2722 (* First try fetching position data from json *)
2723 let%lwt raw_docblock
=
2725 match params.Completion.data with
2726 | None
-> raise NoLocationFound
2728 (* Some docblocks are for class methods. Class methods need to know
2729 * file/line/column/base_class to find the docblock. *)
2730 let filename = Jget.string_exn
data "filename" in
2731 let line = Jget.int_exn
data "line" in
2732 let column = Jget.int_exn
data "char" in
2733 let base_class = Jget.string_opt
data "base_class" in
2734 let ranking_detail = Jget.string_opt
data "ranking_detail" in
2735 let ranking_source = Jget.int_opt
data "ranking_source" in
2736 (* If not found ... *)
2737 if line = 0 && column = 0 then (
2738 (* For global symbols such as functions, classes, enums, etc, we
2739 * need to know the full name INCLUDING all namespaces. Once
2740 * we know that, we can look up its file/line/column. *)
2741 let fullname = Jget.string_exn
data "fullname" in
2742 if String.equal
fullname "" then raise NoLocationFound
;
2743 let fullname = Utils.add_ns
fullname in
2745 ServerCommandTypes.DOCBLOCK_FOR_SYMBOL
2746 (fullname, resolve_ranking_source kind ranking_source)
2748 let%lwt raw_docblock
=
2749 rpc conn ref_unblocked_time ~desc
:"completion" command
2752 (docblock_with_ranking_detail raw_docblock
ranking_detail)
2754 (* Okay let's get a docblock for this specific location *)
2756 ServerCommandTypes.DOCBLOCK_AT
2761 resolve_ranking_source kind ranking_source )
2763 let%lwt raw_docblock
=
2764 rpc conn ref_unblocked_time ~desc
:"completion" command
2767 (docblock_with_ranking_detail raw_docblock
ranking_detail)
2768 (* If that failed, fetch docblock using just the symbol name *)
2771 let symbolname = params.Completion.label in
2772 let ranking_source =
2773 try Jget.int_opt
params.Completion.data "ranking_source" with
2777 ServerCommandTypes.DOCBLOCK_FOR_SYMBOL
2778 (symbolname, resolve_ranking_source kind ranking_source)
2780 let%lwt raw_docblock
=
2781 rpc conn ref_unblocked_time ~desc
:"completion" command
2783 Lwt.return raw_docblock
2785 (* Convert to markdown and return *)
2786 let documentation = docblock_to_markdown raw_docblock
in
2787 Lwt.return
{ params with Completion.documentation }
2790 * Note that resolve does not depend on having previously executed completion in
2791 * the same process. The LSP resolve request takes, as input, a single item
2792 * produced by any previously executed completion request. So it's okay for
2793 * one process to respond to another, because they'll both know the answers
2794 * to the same symbol requests.
2796 * And it's totally okay to mix and match requests to serverless IDE and
2799 let do_resolve_local
2800 (ide_service
: ClientIdeService.t
ref)
2802 (tracking_id : string)
2803 (ref_unblocked_time
: float ref)
2804 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2805 (params : CompletionItemResolve.params) : CompletionItemResolve.result Lwt.t
2807 if Option.is_some
params.Completion.documentation then
2810 let raw_kind = params.Completion.kind in
2811 let kind = completion_kind_to_si_kind raw_kind in
2812 (* Some docblocks are for class methods. Class methods need to know
2813 * file/line/column/base_class to find the docblock. *)
2816 match params.Completion.data with
2817 | None
-> raise NoLocationFound
2819 let filename = Jget.string_exn
data "filename" in
2820 let uri = File_url.create
filename |> Lsp.uri_of_string
in
2821 let file_path = Path.make
filename in
2822 let line = Jget.int_exn
data "line" in
2823 let column = Jget.int_exn
data "char" in
2824 let file_contents = get_document_contents editor_open_files uri in
2825 let ranking_detail = Jget.string_opt
data "ranking_detail" in
2826 let ranking_source = Jget.int_opt
data "ranking_source" in
2827 if line = 0 && column = 0 then failwith
"NoFileLineColumnData";
2829 ClientIdeMessage.Completion_resolve_location
2831 ClientIdeMessage.Completion_resolve_location.document_location =
2833 ClientIdeMessage.file_path;
2834 ClientIdeMessage.file_contents;
2835 ClientIdeMessage.line;
2836 ClientIdeMessage.column;
2838 kind = resolve_ranking_source kind ranking_source;
2841 let%lwt raw_docblock
=
2842 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2845 docblock_with_ranking_detail raw_docblock
ranking_detail
2846 |> docblock_to_markdown
2848 Lwt.return
{ params with Completion.documentation }
2849 (* If that fails, next try using symbol *)
2852 (* The "fullname" value includes the fully qualified namespace, so
2853 * we want to use that. However, if it's missing (it shouldn't be)
2854 * let's default to using the label which doesn't include the
2857 try Jget.string_exn
params.Completion.data "fullname" with
2858 | _
-> params.Completion.label
2860 let ranking_source =
2861 try Jget.int_opt
params.Completion.data "ranking_source" with
2865 ClientIdeMessage.Completion_resolve
2867 ClientIdeMessage.Completion_resolve.symbol
= symbolname;
2868 kind = resolve_ranking_source kind ranking_source;
2871 let%lwt raw_docblock
=
2872 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2874 let documentation = docblock_to_markdown raw_docblock
in
2875 Lwt.return
{ params with Completion.documentation }
2879 let hack_symbol_to_lsp (symbol
: SearchUtils.symbol
) =
2880 let open SearchUtils
in
2881 (* Hack sometimes gives us back items with an empty path, by which it
2882 intends "whichever path you asked me about". That would be meaningless
2883 here. If it does, then it'll pick up our default path (also empty),
2884 which will throw and go into our telemetry. That's the best we can do. *)
2885 let hack_to_lsp_kind = function
2886 | SearchUtils.SI_Class
-> SymbolInformation.Class
2887 | SearchUtils.SI_Interface
-> SymbolInformation.Interface
2888 | SearchUtils.SI_Trait
-> SymbolInformation.Interface
2889 (* LSP doesn't have traits, so we approximate with interface *)
2890 | SearchUtils.SI_Enum
-> SymbolInformation.Enum
2891 (* TODO(T36697624): Add SymbolInformation.Record *)
2892 | SearchUtils.SI_ClassMethod
-> SymbolInformation.Method
2893 | SearchUtils.SI_Function
-> SymbolInformation.Function
2894 | SearchUtils.SI_Typedef
-> SymbolInformation.Class
2895 (* LSP doesn't have typedef, so we approximate with class *)
2896 | SearchUtils.SI_GlobalConstant
-> SymbolInformation.Constant
2897 | SearchUtils.SI_Namespace
-> SymbolInformation.Namespace
2898 | SearchUtils.SI_Mixed
-> SymbolInformation.Variable
2899 | SearchUtils.SI_XHP
-> SymbolInformation.Class
2900 | SearchUtils.SI_Literal
-> SymbolInformation.Variable
2901 | SearchUtils.SI_ClassConstant
-> SymbolInformation.Constant
2902 | SearchUtils.SI_Property
-> SymbolInformation.Property
2903 | SearchUtils.SI_LocalVariable
-> SymbolInformation.Variable
2904 | SearchUtils.SI_Constructor
-> SymbolInformation.Constructor
2905 (* Do these happen in practice? *)
2906 | SearchUtils.SI_Keyword
2907 | SearchUtils.SI_Unknown
->
2908 failwith
"Unknown symbol kind"
2911 SymbolInformation.name = Utils.strip_ns symbol
.name;
2912 kind = hack_to_lsp_kind symbol
.result_type
;
2913 location = hack_pos_to_lsp_location symbol
.pos ~default_path
:"";
2914 containerName
= None
;
2917 let do_workspaceSymbol
2918 (conn
: server_conn
)
2919 (ref_unblocked_time
: float ref)
2920 (params : WorkspaceSymbol.params) : WorkspaceSymbol.result Lwt.t
=
2921 let query_type = "" in
2923 ServerCommandTypes.SEARCH
(params.WorkspaceSymbol.query
, query_type)
2925 let%lwt
results = rpc conn ref_unblocked_time ~desc
:"find-symbol" command in
2926 Lwt.return
(List.map
results ~
f:hack_symbol_to_lsp)
2928 let do_workspaceSymbol_local
2929 (ide_service
: ClientIdeService.t
ref)
2931 (tracking_id : string)
2932 (ref_unblocked_time
: float ref)
2933 (params : WorkspaceSymbol.params) : WorkspaceSymbol.result Lwt.t
=
2934 let query = params.WorkspaceSymbol.query in
2935 let request = ClientIdeMessage.Workspace_symbol
query in
2937 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2939 Lwt.return
(List.map
results ~
f:hack_symbol_to_lsp)
2941 let rec hack_symbol_tree_to_lsp
2942 ~
(filename : string)
2943 ~
(accu
: Lsp.SymbolInformation.t list
)
2944 ~
(container_name
: string option)
2945 (defs
: FileOutline.outline
) : Lsp.SymbolInformation.t list
=
2946 let open SymbolDefinition
in
2947 let hack_to_lsp_kind = function
2948 | SymbolDefinition.Function
-> SymbolInformation.Function
2949 | SymbolDefinition.Class
-> SymbolInformation.Class
2950 | SymbolDefinition.Method
-> SymbolInformation.Method
2951 | SymbolDefinition.Property
-> SymbolInformation.Property
2952 | SymbolDefinition.Const
-> SymbolInformation.Constant
2953 | SymbolDefinition.Enum
-> SymbolInformation.Enum
2954 | SymbolDefinition.Interface
-> SymbolInformation.Interface
2955 | SymbolDefinition.Trait
-> SymbolInformation.Interface
2956 (* LSP doesn't have traits, so we approximate with interface *)
2957 | SymbolDefinition.LocalVar
-> SymbolInformation.Variable
2958 | SymbolDefinition.TypeVar
-> SymbolInformation.TypeParameter
2959 | SymbolDefinition.Typeconst
-> SymbolInformation.Class
2960 (* e.g. "const type Ta = string;" -- absent from LSP *)
2961 | SymbolDefinition.Typedef
-> SymbolInformation.Class
2962 (* e.g. top level type alias -- absent from LSP *)
2963 | SymbolDefinition.Param
-> SymbolInformation.Variable
2964 (* We never return a param from a document-symbol-search *)
2966 let hack_symbol_to_lsp definition containerName
=
2968 SymbolInformation.name = definition
.name;
2969 kind = hack_to_lsp_kind definition
.kind;
2971 hack_symbol_definition_to_lsp_construct_location
2973 ~default_path
:filename;
2978 (* Flattens the recursive list of symbols *)
2979 | [] -> List.rev accu
2981 let children = Option.value def
.children ~default
:[] in
2982 let accu = hack_symbol_to_lsp def container_name
:: accu in
2984 hack_symbol_tree_to_lsp
2987 ~container_name
:(Some def
.name)
2990 hack_symbol_tree_to_lsp ~
filename ~
accu ~container_name defs
2992 let do_documentSymbol
2993 (conn
: server_conn
)
2994 (ref_unblocked_time
: float ref)
2995 (params : DocumentSymbol.params) : DocumentSymbol.result Lwt.t
=
2996 let open DocumentSymbol
in
2997 let open TextDocumentIdentifier
in
2998 let filename = lsp_uri_to_path params.textDocument
.uri in
2999 let command = ServerCommandTypes.OUTLINE
filename in
3000 let%lwt outline
= rpc conn ref_unblocked_time ~desc
:"outline" command in
3002 hack_symbol_tree_to_lsp ~
filename ~
accu:[] ~container_name
:None outline
3004 Lwt.return
converted
3006 (* for serverless ide *)
3007 let do_documentSymbol_local
3008 (ide_service
: ClientIdeService.t
ref)
3010 (tracking_id : string)
3011 (ref_unblocked_time
: float ref)
3012 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3013 (params : DocumentSymbol.params) : DocumentSymbol.result Lwt.t
=
3014 let open DocumentSymbol
in
3015 let open TextDocumentIdentifier
in
3016 let filename = lsp_uri_to_path params.textDocument
.uri in
3017 let document_location =
3019 ClientIdeMessage.file_path = Path.make
filename;
3021 get_document_contents editor_open_files params.textDocument
.uri;
3026 let request = ClientIdeMessage.Document_symbol
document_location in
3028 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
3031 hack_symbol_tree_to_lsp ~
filename ~
accu:[] ~container_name
:None outline
3033 Lwt.return
converted
3035 let do_findReferences
3036 (conn
: server_conn
)
3037 (ref_unblocked_time
: float ref)
3038 (params : FindReferences.params) : FindReferences.result Lwt.t
=
3039 let { Ide_api_types.line; column } =
3041 params.FindReferences.loc
.TextDocumentPositionParams.position
3044 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
3045 params.FindReferences.loc
.TextDocumentPositionParams.textDocument
3048 params.FindReferences.context
.FindReferences.includeDeclaration
3050 let labelled_file = ServerCommandTypes.LabelledFileName
filename in
3052 ServerCommandTypes.IDE_FIND_REFS
(labelled_file, line, column, include_defs)
3055 rpc_with_retry conn ref_unblocked_time ~desc
:"find-refs" command
3057 (* TODO: respect params.context.include_declaration *)
3059 | None
-> Lwt.return
[]
3060 | Some
(_name
, positions
) ->
3062 (List.map positions ~
f:(hack_pos_to_lsp_location ~default_path
:filename))
3064 let do_goToImplementation
3065 (conn
: server_conn
)
3066 (ref_unblocked_time
: float ref)
3067 (params : Implementation.params) : Implementation.result Lwt.t
=
3068 let { Ide_api_types.line; column } =
3069 lsp_position_to_ide params.TextDocumentPositionParams.position
3072 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
3073 params.TextDocumentPositionParams.textDocument
3075 let labelled_file = ServerCommandTypes.LabelledFileName
filename in
3077 ServerCommandTypes.IDE_GO_TO_IMPL
(labelled_file, line, column)
3080 rpc_with_retry conn ref_unblocked_time ~desc
:"go-to-impl" command
3083 | None
-> Lwt.return
[]
3084 | Some
(_name
, positions
) ->
3086 (List.map positions ~
f:(hack_pos_to_lsp_location ~default_path
:filename))
3088 (* Shared function for hack range conversion *)
3089 let hack_range_to_lsp_highlight range =
3090 { DocumentHighlight.range = ide_range_to_lsp range; kind = None
}
3092 let do_documentHighlight
3093 (conn
: server_conn
)
3094 (ref_unblocked_time
: float ref)
3095 (params : DocumentHighlight.params) : DocumentHighlight.result Lwt.t
=
3096 let (file, line, column) = lsp_file_position_to_hack params in
3098 ServerCommandTypes.(IDE_HIGHLIGHT_REFS
(file, FileName
file, line, column))
3101 rpc conn ref_unblocked_time ~desc
:"highlight-references" command
3103 Lwt.return
(List.map
results ~
f:hack_range_to_lsp_highlight)
3105 (* Serverless IDE implementation of highlight *)
3106 let do_highlight_local
3107 (ide_service
: ClientIdeService.t
ref)
3109 (tracking_id : string)
3110 (ref_unblocked_time
: float ref)
3111 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3112 (params : DocumentHighlight.params) : DocumentHighlight.result Lwt.t
=
3113 let document_location = get_document_location editor_open_files params in
3120 (ClientIdeMessage.Document_highlight
document_location)
3122 Lwt.return
(List.map ranges ~
f:hack_range_to_lsp_highlight)
3124 let format_typeCoverage_result ~
(equal
: 'a
-> 'a
-> bool) results counts
=
3126 let coveredPercent = Coverage_level.get_percent counts
in
3127 let hack_coverage_to_lsp (pos, level
) =
3128 let range = hack_pos_to_lsp_range ~equal
pos in
3130 (* We only show diagnostics for completely untypechecked code. *)
3131 | Ide_api_types.Checked
3132 | Ide_api_types.Partial
->
3134 | Ide_api_types.Unchecked
-> Some
{ range; message = None
}
3138 uncoveredRanges
= List.filter_map
results ~
f:hack_coverage_to_lsp;
3139 defaultMessage
= "Un-type checked code. Consider adding type annotations.";
3142 let do_typeCoverageFB
3143 (conn
: server_conn
)
3144 (ref_unblocked_time
: float ref)
3145 (params : TypeCoverageFB.params) : TypeCoverageFB.result Lwt.t
=
3148 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
params.textDocument
3151 ServerCommandTypes.COVERAGE_LEVELS
3152 (filename, ServerCommandTypes.FileName
filename)
3154 let%lwt
(results, counts
) : Coverage_level_defs.result =
3155 rpc conn ref_unblocked_time ~desc
:"coverage" command
3158 format_typeCoverage_result ~equal
:String.equal
results counts
3160 Lwt.return
formatted)
3162 let do_typeCoverage_localFB
3163 (ide_service
: ClientIdeService.t
ref)
3165 (tracking_id : string)
3166 (ref_unblocked_time
: float ref)
3167 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3168 (params : TypeCoverageFB.params) : TypeCoverageFB.result Lwt.t
=
3169 let open TypeCoverageFB
in
3170 let document_contents =
3171 get_document_contents
3173 params.textDocument
.TextDocumentIdentifier.uri
3175 match document_contents with
3176 | None
-> failwith
"Local type coverage failed, file could not be found."
3177 | Some
file_contents ->
3179 params.textDocument
.TextDocumentIdentifier.uri
3184 ClientIdeMessage.Type_coverage
3185 { ClientIdeMessage.file_path; ClientIdeMessage.file_contents }
3188 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
3190 let (results, counts
) = result in
3192 format_typeCoverage_result ~equal
:String.equal
results counts
3194 Lwt.return
formatted
3196 let do_formatting_common
3197 (uri : Lsp.documentUri
)
3198 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3199 (action
: ServerFormatTypes.ide_action
)
3200 (options
: DocumentFormatting.formattingOptions
) : TextEdit.t list
=
3201 let open ServerFormatTypes
in
3202 let filename_for_logging = lsp_uri_to_path uri in
3203 (* Following line will throw if the document isn't already open, so we'll *)
3204 (* return an error code to the LSP client. The spec doesn't spell out if we *)
3205 (* should be expected to handle formatting requests on unopened files. *)
3206 let lsp_doc = UriMap.find
uri editor_open_files in
3207 let content = lsp_doc.Lsp.TextDocumentItem.text in
3209 ServerFormat.go_ide ~
filename_for_logging ~
content ~action ~options
3212 | Error
"File failed to parse without errors" ->
3213 (* If LSP issues a formatting request at a given line+char, but we can't *)
3214 (* calculate a better format for the file due to syntax errors in it, *)
3215 (* then we should return "success and there are no edits to apply" *)
3216 (* rather than "error". *)
3217 (* TODO: let's eliminate hh_format, and incorporate hackfmt into the *)
3218 (* hh_client binary itself, and make make "hackfmt" just a wrapper for *)
3219 (* "hh_client format", and then make it return proper error that we can *)
3220 (* pattern-match upon, rather than hard-coding the string... *)
3225 { Error.code
= Error.UnknownErrorCode
; message; data = None
})
3227 let range = ide_range_to_lsp r
.range in
3228 let newText = r
.new_text
in
3229 [{ TextEdit.range; newText }]
3231 let do_documentRangeFormatting
3232 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3233 (params : DocumentRangeFormatting.params) : DocumentRangeFormatting.result =
3234 let open DocumentRangeFormatting
in
3235 let open TextDocumentIdentifier
in
3236 let action = ServerFormatTypes.Range
(lsp_range_to_ide params.range) in
3237 do_formatting_common
3238 params.textDocument
.uri
3243 let do_documentOnTypeFormatting
3244 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3245 (params : DocumentOnTypeFormatting.params) : DocumentOnTypeFormatting.result
3247 let open DocumentOnTypeFormatting
in
3248 let open TextDocumentIdentifier
in
3250 In LSP, positions do not point directly to characters, but to spaces in between characters.
3251 Thus, the LSP position that the cursor points to after typing a character is the space
3252 immediately after the character.
3255 Character positions: 0 1 2 3 4 5 6
3257 LSP positions: 0 1 2 3 4 5 6 7
3259 The cursor is at LSP position 7 after typing the "}" of "foo(){}"
3260 But the character position of "}" is 6.
3262 Nuclide currently sends positions according to LSP, but everything else in the server
3263 and in hack formatting assumes that positions point directly to characters.
3265 Thus, to send the position of the character itself for formatting,
3266 we must subtract one.
3269 { params.position with character
= params.position.character
- 1 }
3271 let action = ServerFormatTypes.Position
(lsp_position_to_ide position) in
3272 do_formatting_common
3273 params.textDocument
.uri
3278 let do_documentFormatting
3279 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3280 (params : DocumentFormatting.params) : DocumentFormatting.result =
3281 let open DocumentFormatting
in
3282 let open TextDocumentIdentifier
in
3283 let action = ServerFormatTypes.Document
in
3284 do_formatting_common
3285 params.textDocument
.uri
3290 let do_willSaveWaitUntil
3291 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3292 (params : WillSaveWaitUntil.params) : WillSaveWaitUntil.result =
3293 let uri = params.WillSaveWaitUntil.textDocument
.TextDocumentIdentifier.uri in
3294 let lsp_doc = UriMap.find
uri editor_open_files in
3295 let content = lsp_doc.Lsp.TextDocumentItem.text in
3296 match Formatting.is_formattable
content with
3298 let open DocumentFormatting
in
3299 do_documentFormatting
3302 textDocument
= params.WillSaveWaitUntil.textDocument
;
3303 options
= { tabSize
= 2; insertSpaces
= true };
3307 let do_codeAction_local
3308 (ide_service
: ClientIdeService.t
ref)
3310 (tracking_id : string)
3311 (ref_unblocked_time
: float ref)
3312 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3313 (params : CodeActionRequest.params) :
3314 CodeAction.command_or_action list
Lwt.t
=
3318 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri)
3321 get_document_contents
3323 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri
3325 let range = lsp_range_to_ide params.CodeActionRequest.range in
3332 (ClientIdeMessage.Code_action
3333 { ClientIdeMessage.Code_action.file_path; file_contents; range })
3338 (conn
: server_conn
)
3339 (ref_unblocked_time
: float ref)
3340 (params : CodeActionRequest.params) :
3341 CodeAction.command_or_action list
Lwt.t
=
3344 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri
3346 let range = lsp_range_to_ide params.CodeActionRequest.range in
3347 let command = ServerCommandTypes.CODE_ACTIONS
(filename, range) in
3348 rpc conn ref_unblocked_time ~desc
:"code_actions" command
3350 let do_signatureHelp
3351 (conn
: server_conn
)
3352 (ref_unblocked_time
: float ref)
3353 (params : SignatureHelp.params) : SignatureHelp.result Lwt.t
=
3354 let (file, line, column) = lsp_file_position_to_hack params in
3355 let command = ServerCommandTypes.IDE_SIGNATURE_HELP
(file, line, column) in
3356 rpc conn ref_unblocked_time ~desc
:"tooltip" command
3358 (* Serverless IDE version of signature help *)
3359 let do_signatureHelp_local
3360 (ide_service
: ClientIdeService.t
ref)
3362 (tracking_id : string)
3363 (ref_unblocked_time
: float ref)
3364 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3365 (params : SignatureHelp.params) : SignatureHelp.result Lwt.t
=
3366 let document_location = get_document_location editor_open_files params in
3367 let%lwt signatures
=
3373 (ClientIdeMessage.Signature_help
document_location)
3375 Lwt.return signatures
3377 let patch_to_workspace_edit_change (patch
: ServerRefactorTypes.patch
) :
3378 string * TextEdit.t
=
3379 let open ServerRefactorTypes
in
3383 | Insert insert_patch
3384 | Replace insert_patch
->
3387 hack_pos_to_lsp_range ~equal
:String.equal insert_patch
.pos;
3388 newText = insert_patch
.text;
3392 TextEdit.range = hack_pos_to_lsp_range ~equal
:String.equal
pos;
3398 | Insert insert_patch
3399 | Replace insert_patch
->
3400 File_url.create
(filename insert_patch
.pos)
3401 | Remove
pos -> File_url.create
(filename pos)
3405 let patches_to_workspace_edit (patches
: ServerRefactorTypes.patch list
) :
3407 let changes = List.map patches ~
f:patch_to_workspace_edit_change in
3409 List.fold
changes ~init
:SMap.empty ~
f:(fun acc
(uri, text_edit) ->
3410 let current_edits = Option.value ~default
:[] (SMap.find_opt
uri acc
) in
3411 let new_edits = text_edit :: current_edits in
3412 SMap.add
uri new_edits acc
)
3414 { WorkspaceEdit.changes }
3416 let do_documentRename
3417 (conn
: server_conn
)
3418 (ref_unblocked_time
: float ref)
3419 (params : Rename.params) : WorkspaceEdit.t
Lwt.t
=
3420 let (filename, line, char
) =
3421 lsp_file_position_to_hack (rename_params_to_document_position params)
3424 let new_name = params.newName
in
3426 ServerCommandTypes.IDE_REFACTOR
3427 { ServerCommandTypes.Ide_refactor_type.filename; line; char
; new_name }
3430 rpc_with_retry conn ref_unblocked_time ~desc
:"rename" command
3434 | Ok
patches -> patches
3438 { Error.code
= Error.InvalidRequest
; message; data = None
})
3440 Lwt.return
(patches_to_workspace_edit patches)
3442 (** This updates Main_env.hh_server_status according to the status message
3443 we just received from hh_server. See comments on hh_server_status for
3444 the invariants on its fields. *)
3445 let do_server_busy (state : state) (status : ServerCommandTypes.busy_status
) :
3447 let open Main_env
in
3448 let open ServerCommandTypes
in
3449 let (type_
, shortMessage
, message) =
3451 | Needs_local_typecheck
->
3452 ( MessageType.InfoMessage
,
3454 "hh_server is preparing to check edits" )
3455 | Doing_local_typecheck
->
3456 (MessageType.WarningMessage
, "Hack", "hh_server is checking edits")
3457 | Done_local_typecheck
->
3458 ( MessageType.InfoMessage
,
3460 "hh_server is initialized and running correctly." )
3461 | Doing_global_typecheck Blocking
->
3462 ( MessageType.WarningMessage
,
3464 "hh_server is typechecking the entire project (blocking)" )
3465 | Doing_global_typecheck Interruptible
->
3466 ( MessageType.WarningMessage
,
3468 "hh_server is typechecking entire project" )
3469 | Doing_global_typecheck
(Remote_blocking
message) ->
3470 ( MessageType.WarningMessage
,
3472 "hh_server is remote-typechecking the entire project - " ^
message )
3473 | Done_global_typecheck
->
3474 ( MessageType.InfoMessage
,
3476 "hh_server is initialized and running correctly." )
3480 let hh_server_status =
3482 ShowStatusFB.shortMessage
= Some shortMessage
;
3483 request = { ShowMessageRequest.type_
; message; actions = [] };
3489 Main_loop
{ menv with hh_server_status }
3492 let warn_truncated_diagnostic_list is_truncated
=
3493 Option.iter is_truncated ~
f:(fun total_error_count
->
3496 "Hack produced %d errors in total. Showing only a limited number to preserve performance."
3499 Lsp_helpers.showMessage_warning
to_stdout msg)
3501 (** Hack sometimes reports a diagnostic on an empty file path when it can't
3502 figure out which file to report. In this case we'll report on the root.
3503 Nuclide and VSCode both display this fine, though they obviously don't
3504 let you click-to-go-to-file on it. *)
3505 let fix_empty_paths_in_error_map errors_per_file
=
3506 let default_path = get_root_exn () |> Path.to_string
in
3507 match SMap.find_opt
"" errors_per_file
with
3508 | None
-> errors_per_file
3510 SMap.remove
"" errors_per_file
3511 |> SMap.add ~combine
:( @ ) default_path errors
3513 let update_uris_with_diagnostics uris_with_diagnostics errors_per_file
=
3514 let default_path = get_root_exn () |> Path.to_string
in
3515 let is_error_free _uri errors
= List.is_empty errors
in
3516 (* reports_without/reports_with are maps of filename->ErrorList. *)
3517 let (reports_without
, reports_with
) =
3518 SMap.partition
is_error_free errors_per_file
3520 (* files_without/files_with are sets of filenames *)
3521 let files_without = SMap.bindings reports_without
|> List.map ~
f:fst
in
3522 let files_with = SMap.bindings reports_with
|> List.map ~
f:fst
in
3523 (* uris_without/uris_with are sets of uris *)
3525 List.map
files_without ~
f:(path_to_lsp_uri ~
default_path) |> UriSet.of_list
3528 List.map
files_with ~
f:(path_to_lsp_uri ~
default_path) |> UriSet.of_list
3530 (* this is "(uris_with_diagnostics \ uris_without) U uris_with" *)
3531 UriSet.union
(UriSet.diff uris_with_diagnostics
uris_without) uris_with
3533 (** Send notifications for all reported diagnostics.
3534 Returns an updated "uris_with_diagnostics" set of all files for which
3535 our client currently has non-empty diagnostic reports. *)
3537 (uris_with_diagnostics
: UriSet.t
)
3538 (errors_per_file
: Errors.finalized_error list
SMap.t
)
3539 ~
(is_truncated
: int option) : UriSet.t
=
3540 let errors_per_file = fix_empty_paths_in_error_map errors_per_file in
3541 let send_diagnostic_notification file errors
=
3542 let params = hack_errors_to_lsp_diagnostic file errors
in
3543 let notification = PublishDiagnosticsNotification
params in
3544 notify_jsonrpc ~powered_by
:Hh_server
notification
3546 SMap.iter
send_diagnostic_notification errors_per_file;
3547 warn_truncated_diagnostic_list is_truncated
;
3548 update_uris_with_diagnostics uris_with_diagnostics
errors_per_file
3550 let do_initialize (local_config
: ServerLocalConfig.t
) : Initialize.result =
3553 server_capabilities
=
3557 want_openClose
= true;
3558 want_change
= IncrementalSync
;
3559 want_willSave
= false;
3560 want_willSaveWaitUntil
= true;
3561 want_didSave
= Some
{ includeText
= false };
3563 hoverProvider
= true;
3564 completionProvider
=
3567 resolveProvider
= true;
3568 completion_triggerCharacters
=
3569 ["$"; ">"; "\\"; ":"; "<"; "["; "'"; "\""; "{"; "#"];
3571 signatureHelpProvider
=
3572 Some
{ sighelp_triggerCharacters
= ["("; ","] };
3573 definitionProvider
= true;
3574 typeDefinitionProvider
= true;
3575 referencesProvider
= true;
3576 documentHighlightProvider
= true;
3577 documentSymbolProvider
= true;
3578 workspaceSymbolProvider
= true;
3579 codeActionProvider
= true;
3580 codeLensProvider
= None
;
3581 documentFormattingProvider
= true;
3582 documentRangeFormattingProvider
= true;
3583 documentOnTypeFormattingProvider
=
3584 Some
{ firstTriggerCharacter
= ";"; moreTriggerCharacter
= ["}"] };
3585 renameProvider
= true;
3586 documentLinkProvider
= None
;
3587 executeCommandProvider
= None
;
3588 implementationProvider
=
3589 local_config
.ServerLocalConfig.go_to_implementation
;
3590 typeCoverageProviderFB
= true;
3591 rageProviderFB
= true;
3595 let do_didChangeWatchedFiles_registerCapability () : Lsp.lsp_request
=
3596 (* We want a glob-pattern like "**/*.{php,phpt,hack,hackpartial,hck,hh,hhi,xhp}".
3597 I'm constructing it from FindUtils.extensions so our glob-pattern doesn't get out
3598 of sync with FindUtils.file_filter. *)
3600 List.map
FindUtils.extensions ~
f:(fun s -> String_utils.lstrip
s ".")
3603 Printf.sprintf
"**/*.{%s}" (extensions |> String.concat ~sep
:",")
3605 let registration_options =
3606 DidChangeWatchedFilesRegistrationOptions
3608 DidChangeWatchedFiles.watchers
= [{ DidChangeWatchedFiles.globPattern }];
3612 Lsp.RegisterCapability.make_registration
registration_options
3614 Lsp.RegisterCapabilityRequest
3615 { RegisterCapability.registrations
= [registration] }
3617 let track_open_and_recent_files (state : state) (event
: event
) : state =
3618 (* We'll keep track of which files are opened by the editor. *)
3619 let prev_opened_files =
3620 Option.value (get_editor_open_files state) ~default
:UriMap.empty
3622 let editor_open_files =
3624 | Client_message
(_
, NotificationMessage
(DidOpenNotification
params)) ->
3625 let doc = params.DidOpen.textDocument
in
3626 let uri = params.DidOpen.textDocument
.TextDocumentItem.uri in
3627 UriMap.add
uri doc prev_opened_files
3628 | Client_message
(_
, NotificationMessage
(DidChangeNotification
params)) ->
3630 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3632 let doc = UriMap.find_opt
uri prev_opened_files in
3633 let open Lsp.TextDocumentItem
in
3640 params.DidChange.textDocument
3641 .VersionedTextDocumentIdentifier.version;
3643 Lsp_helpers.apply_changes_unsafe
3645 params.DidChange.contentChanges
;
3648 UriMap.add
uri doc'
prev_opened_files
3649 | None
-> prev_opened_files)
3650 | Client_message
(_
, NotificationMessage
(DidCloseNotification
params)) ->
3651 let uri = params.DidClose.textDocument
.TextDocumentIdentifier.uri in
3652 UriMap.remove
uri prev_opened_files
3653 | _
-> prev_opened_files
3655 (* We'll track which was the most recent file to have an event *)
3656 let most_recent_file =
3658 | Client_message
(_metadata
, message) ->
3659 let uri = Lsp_fmt.get_uri_opt
message in
3660 if Option.is_some
uri then
3663 get_most_recent_file state
3664 | _
-> get_most_recent_file state
3668 Main_loop
{ menv with Main_env.editor_open_files; most_recent_file }
3670 In_init
{ ienv
with In_init_env.editor_open_files; most_recent_file }
3671 | Lost_server lenv
->
3672 Lost_server
{ lenv
with Lost_env.editor_open_files; most_recent_file }
3675 let track_edits_if_necessary (state : state) (event
: event
) : state =
3676 (* We'll keep track of which files have unsaved edits. Note that not all
3677 * clients send didSave messages; for those we only rely on didClose. *)
3678 let previous = get_uris_with_unsaved_changes state in
3679 let uris_with_unsaved_changes =
3681 | Client_message
(_
, NotificationMessage
(DidChangeNotification
params)) ->
3683 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3685 UriSet.add
uri previous
3686 | Client_message
(_
, NotificationMessage
(DidCloseNotification
params)) ->
3687 let uri = params.DidClose.textDocument
.TextDocumentIdentifier.uri in
3688 UriSet.remove
uri previous
3689 | Client_message
(_
, NotificationMessage
(DidSaveNotification
params)) ->
3690 let uri = params.DidSave.textDocument
.TextDocumentIdentifier.uri in
3691 UriSet.remove
uri previous
3695 | Main_loop
menv -> Main_loop
{ menv with Main_env.uris_with_unsaved_changes }
3696 | In_init ienv
-> In_init
{ ienv
with In_init_env.uris_with_unsaved_changes }
3697 | Lost_server lenv
->
3698 Lost_server
{ lenv
with Lost_env.uris_with_unsaved_changes }
3701 let get_filename_in_message_for_logging (message : lsp_message
) :
3702 Relative_path.t
option =
3703 let uri_opt = Lsp_fmt.get_uri_opt
message in
3708 let path = Lsp_helpers.lsp_uri_to_path uri in
3709 Some
(Relative_path.create_detect_prefix
path)
3712 Some
(Relative_path.create
Relative_path.Dummy
(Lsp.string_of_uri
uri)))
3714 (* Historical quirk: we log kind and method-name a bit idiosyncratically... *)
3715 let get_message_kind_and_method_for_logging (message : lsp_message
) :
3718 | ResponseMessage
(_
, _
) -> ("Response", "[response]")
3719 | RequestMessage
(_
, r
) -> ("Request", Lsp_fmt.request_name_to_string r
)
3720 | NotificationMessage n
->
3721 ("Notification", Lsp_fmt.notification_name_to_string n
)
3723 let log_response_if_necessary
3726 (result_telemetry_opt
: result_telemetry
option)
3727 (unblocked_time
: float) : unit =
3729 | Client_message
(metadata
, message) ->
3730 let (kind, method_
) = get_message_kind_and_method_for_logging message in
3731 let t = Unix.gettimeofday
() in
3733 "lsp-message [%s] queue time [%0.3f] execution time [%0.3f]"
3735 (unblocked_time
-. metadata
.timestamp
)
3736 (t -. unblocked_time
);
3737 let (result_count
, result_extra_telemetry
) =
3738 match result_telemetry_opt
with
3739 | None
-> (None
, None
)
3740 | Some
{ result_count
; result_extra_telemetry
} ->
3741 (Some result_count
, result_extra_telemetry
)
3743 HackEventLogger.client_lsp_method_handled
3744 ~
root:(get_root_opt ())
3747 ~path_opt
:(get_filename_in_message_for_logging message)
3749 ~result_extra_telemetry
3750 ~
tracking_id:metadata
.tracking_id
3751 ~start_queue_time
:metadata
.timestamp
3752 ~start_hh_server_state
:
3753 (get_older_hh_server_state metadata
.timestamp
3754 |> hh_server_state_to_string)
3755 ~start_handle_time
:unblocked_time
3756 ~serverless_ide_flag
:env
.use_serverless_ide
3760 | Error_from_server_fatal
3761 | Error_from_client_fatal
3762 | Error_from_client_recoverable
3763 | Error_from_server_recoverable
3764 | Error_from_lsp_cancelled
3765 | Error_from_lsp_misc
3768 (event
: event
option)
3770 (source
: error_source
)
3771 (unblocked_time
: float)
3772 (env
: env
) : unit =
3773 let root = get_root_opt () in
3776 | Error_from_lsp_cancelled
-> true
3777 | Error_from_server_fatal
3778 | Error_from_client_fatal
3779 | Error_from_client_recoverable
3780 | Error_from_server_recoverable
3781 | Error_from_lsp_misc
->
3786 | Error_from_server_fatal
-> "server_fatal"
3787 | Error_from_client_fatal
-> "client_fatal"
3788 | Error_from_client_recoverable
-> "client_recoverable"
3789 | Error_from_server_recoverable
-> "server_recoverable"
3790 | Error_from_lsp_cancelled
-> "lsp_cancelled"
3791 | Error_from_lsp_misc
-> "lsp_misc"
3793 if not
is_expected then log "%s" (Lsp_fmt.error_to_log_string
e);
3795 | Some
(Client_message
(metadata
, message)) ->
3796 let start_hh_server_state =
3797 get_older_hh_server_state metadata
.timestamp
|> hh_server_state_to_string
3799 let (kind, method_
) = get_message_kind_and_method_for_logging message in
3800 HackEventLogger.client_lsp_method_exception
3804 ~path_opt
:(get_filename_in_message_for_logging message)
3805 ~
tracking_id:metadata
.tracking_id
3806 ~start_queue_time
:metadata
.timestamp
3807 ~
start_hh_server_state
3808 ~start_handle_time
:unblocked_time
3809 ~serverless_ide_flag
:env
.use_serverless_ide
3810 ~
message:e.Error.message
3811 ~data_opt
:e.Error.data
3814 HackEventLogger.client_lsp_exception
3816 ~
message:e.Error.message
3817 ~data_opt
:e.Error.data
3820 (* cancel_if_stale: If a message is stale, throw the necessary exception to
3821 cancel it. A message is considered stale if it's sufficiently old and there
3822 are other messages in the queue that are newer than it. *)
3823 let short_timeout = 2.5
3825 let long_timeout = 15.0
3827 let cancel_if_stale (client : Jsonrpc.t) (timestamp
: float) (timeout
: float) :
3829 let time_elapsed = Unix.gettimeofday
() -. timestamp
in
3831 Float.(time_elapsed >= timeout
)
3832 && Jsonrpc.has_message
client
3833 && not
(Sys_utils.deterministic_behavior_for_tests
())
3838 Error.code
= Error.RequestCancelled
;
3839 message = "request timed out";
3845 (** This is called before we even start processing a message. Its purpose:
3846 if the Jsonrpc queue has already previously read off stdin a cancellation
3847 request for the message we're about to handle, then throw an exception.
3848 There are races, e.g. we might start handling this request because we haven't
3849 yet gotten around to reading a cancellation message off stdin. But
3850 that's inevitable. Think of this only as best-effort. *)
3851 let cancel_if_has_pending_cancel_request
3852 (client : Jsonrpc.t) (message : lsp_message
) : unit =
3854 | ResponseMessage _
-> ()
3855 | NotificationMessage _
-> ()
3856 | RequestMessage
(id, _request
) ->
3857 (* Scan the queue for any pending (future) cancellation messages that are requesting
3858 cancellation of the same id as our current request *)
3859 let pending_cancel_request_opt =
3860 Jsonrpc.find_already_queued_message
client ~
f:(fun { Jsonrpc.json; _
} ->
3863 Lsp_fmt.parse_lsp
json (fun _
->
3864 failwith
"not resolving responses")
3867 | NotificationMessage
3868 (CancelRequestNotification
{ Lsp.CancelRequest.id = peek_id
})
3870 Lsp.IdKey.compare
id peek_id
= 0
3875 (* If there is a future cancellation request, we won't even embark upon this message *)
3876 if Option.is_some
pending_cancel_request_opt then
3880 Error.code
= Error.RequestCancelled
;
3881 message = "request cancelled";
3887 (************************************************************************)
3888 (* Message handling *)
3889 (************************************************************************)
3891 (** send DidOpen/Close/Change/Save to hh_server and ide_service as needed *)
3892 let handle_editor_buffer_message
3894 ~
(ide_service
: ClientIdeService.t ref option)
3896 ~
(metadata
: incoming_metadata
)
3897 ~
(ref_unblocked_time
: float ref)
3898 ~
(message : lsp_message
) : unit Lwt.t =
3899 let uri_to_path uri = uri |> lsp_uri_to_path |> Path.make
in
3900 let ref_hh_unblocked_time = ref 0. in
3901 let ref_ide_unblocked_time = ref 0. in
3903 (* send to hh_server as necessary *)
3904 let (hh_server_promise
: unit Lwt.t) =
3905 let open Main_env
in
3906 match (state, message) with
3907 (* textDocument/didOpen notification *)
3908 | (Main_loop
menv, NotificationMessage
(DidOpenNotification
params)) ->
3909 let%lwt
() = do_didOpen menv.conn
ref_hh_unblocked_time params in
3911 (* textDocument/didClose notification *)
3912 | (Main_loop
menv, NotificationMessage
(DidCloseNotification
params)) ->
3913 let%lwt
() = do_didClose menv.conn
ref_hh_unblocked_time params in
3915 (* textDocument/didChange notification *)
3916 | (Main_loop
menv, NotificationMessage
(DidChangeNotification
params)) ->
3917 let%lwt
() = do_didChange menv.conn
ref_hh_unblocked_time params in
3919 (* textDocument/didSave notification *)
3920 | (Main_loop _menv
, NotificationMessage
(DidSaveNotification _params
)) ->
3922 | (_
, _
) -> Lwt.return_unit
3925 (* send to ide_service as necessary *)
3926 (* For now 'ide_service_promise' is immediately fulfilled, but in future it will
3927 be fulfilled only when the ide_service has finished processing the message. *)
3928 let (ide_service_promise
: unit Lwt.t) =
3929 match (ide_service
, message) with
3930 | (Some ide_service
, NotificationMessage
(DidOpenNotification
params)) ->
3932 uri_to_path params.DidOpen.textDocument
.TextDocumentItem.uri
3934 let file_contents = params.DidOpen.textDocument
.TextDocumentItem.text in
3935 (* The ClientIdeDaemon only delivers answers for open files, which is why it's vital
3936 never to let is miss a DidOpen. *)
3941 ~
tracking_id:metadata
.tracking_id
3942 ~ref_unblocked_time
:ref_ide_unblocked_time
3943 ClientIdeMessage.(Ide_file_opened
{ file_path; file_contents })
3946 | (Some ide_service
, NotificationMessage
(DidChangeNotification
params)) ->
3949 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3955 ~
tracking_id:metadata
.tracking_id
3956 ~ref_unblocked_time
:ref_ide_unblocked_time
3957 ClientIdeMessage.(Ide_file_changed
{ Ide_file_changed.file_path })
3960 | (Some ide_service
, NotificationMessage
(DidCloseNotification
params)) ->
3962 uri_to_path params.DidClose.textDocument
.TextDocumentIdentifier.uri
3968 ~
tracking_id:metadata
.tracking_id
3969 ~ref_unblocked_time
:ref_ide_unblocked_time
3970 ClientIdeMessage.(Ide_file_closed
file_path)
3974 (* Don't handle other events for now. When we show typechecking errors for
3975 the open file, we'll start handling them. *)
3979 (* Our asynchrony deal is (1) we want to kick off notifications to
3980 hh_server and ide_service at the same time, (2) we want to wait until
3981 both are done, (3) an exception in one shouldn't jeapordize the other,
3982 (4) our failure model only allows us to record at most one exception
3983 so we'll pick one arbitrarily. *)
3984 let%lwt
(hh_server_e
: Exception.t option) =
3986 let%lwt
() = hh_server_promise
in
3989 | e -> Lwt.return_some
(Exception.wrap
e)
3990 and (ide_service_e
: Exception.t option) =
3992 let%lwt
() = ide_service_promise
in
3995 | e -> Lwt.return_some
(Exception.wrap
e)
3997 ref_unblocked_time
:= Float.max
!ref_hh_unblocked_time !ref_ide_unblocked_time;
3998 match (hh_server_e
, ide_service_e
) with
4002 | _
-> Lwt.return_unit
4004 let set_verbose_to_file
4005 ~
(ide_service
: ClientIdeService.t ref option)
4007 ~
(tracking_id : string)
4008 (value : bool) : unit =
4009 verbose_to_file := value;
4010 if !verbose_to_file then
4011 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Debug
4013 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Info
;
4014 match ide_service
with
4015 | Some ide_service
->
4016 let ref_unblocked_time = ref 0. in
4017 let (promise
: unit Lwt.t) =
4023 (ClientIdeMessage.Verbose_to_file
!verbose_to_file)
4025 ignore_promise_but_handle_failure
4027 ~desc
:"verbose-ide-rpc"
4028 ~terminate_on_failure
:false
4031 (* handle_event: Process and respond to a message, and update the LSP state
4032 machine accordingly. In case the message was a request, it returns the
4033 json it responded with, so the caller can log it. *)
4034 let handle_client_message
4036 ~
(state : state ref)
4037 ~
(client : Jsonrpc.t)
4038 ~
(ide_service
: ClientIdeService.t ref option)
4039 ~
(metadata
: incoming_metadata
)
4040 ~
(message : lsp_message
)
4041 ~
(ref_unblocked_time : float ref) : result_telemetry
option Lwt.t =
4042 let open Main_env
in
4043 cancel_if_has_pending_cancel_request client message;
4044 let%lwt result_telemetry_opt
=
4045 (* make sure to wrap any exceptions below in the promise *)
4046 let tracking_id = metadata
.tracking_id in
4047 let timestamp = metadata
.timestamp in
4048 let editor_open_files =
4049 match get_editor_open_files !state with
4050 | Some files
-> files
4051 | None
-> UriMap.empty
4053 match (!state, ide_service
, message) with
4055 | (_
, _
, ResponseMessage
(id, response)) ->
4056 let (_
, handler) = IdMap.find
id !requests_outstanding in
4057 let%lwt new_state
= handler response !state in
4060 (* shutdown request *)
4061 | (_
, _
, RequestMessage
(id, ShutdownRequest
)) ->
4063 do_shutdown !state ide_service
tracking_id ref_unblocked_time
4066 respond_jsonrpc ~powered_by
:Language_server
id ShutdownResult
;
4068 (* cancel notification *)
4069 | (_
, _
, NotificationMessage
(CancelRequestNotification _
)) ->
4070 (* In [cancel_if_has_pending_cancel_request] above, when we received request ID "x",
4071 then at that time then we scanned through the queue for any CancelRequestNotification
4072 of the same ID. We didn't remove that CancelRequestNotification though.
4073 If we worked through the queue long enough to handle a CancelRequestNotification,
4074 it means that either we've earlier cancelled it, or that processing was done
4075 before the cancel request got into the queue. Either way, there's nothing to do now! *)
4077 (* exit notification *)
4078 | (_
, _
, NotificationMessage ExitNotification
) ->
4079 if is_post_shutdown !state then
4083 (* setTrace notification *)
4084 | (_
, _
, NotificationMessage
(SetTraceNotification
params)) ->
4087 | SetTraceNotification.Verbose
-> true
4088 | SetTraceNotification.Off
-> false
4090 set_verbose_to_file ~ide_service ~env ~
tracking_id value;
4092 (* test entrypoint: shutdown client_ide_service *)
4095 RequestMessage
(id, HackTestShutdownServerlessRequestFB
) ) ->
4100 ~stop_reason
:ClientIdeService.Stop_reason.Testing
4103 ~powered_by
:Serverless_ide
4105 HackTestShutdownServerlessResultFB
;
4107 (* test entrypoint: stop hh_server *)
4108 | (_
, _
, RequestMessage
(id, HackTestStopServerRequestFB
)) ->
4110 Path.make
(Relative_path.path_of_prefix
Relative_path.Root
)
4112 ClientStop.kill_server
root_folder !from;
4113 respond_jsonrpc ~powered_by
:Serverless_ide
id HackTestStopServerResultFB
;
4115 (* test entrypoint: start hh_server *)
4116 | (_
, _
, RequestMessage
(id, HackTestStartServerRequestFB
)) ->
4118 Path.make
(Relative_path.path_of_prefix
Relative_path.Root
)
4120 start_server ~env
root_folder;
4121 respond_jsonrpc ~powered_by
:Serverless_ide
id HackTestStartServerResultFB
;
4123 (* initialize request *)
4124 | (Pre_init
, _
, RequestMessage
(id, InitializeRequest
initialize_params)) ->
4125 let open Initialize
in
4126 initialize_params_ref := Some
initialize_params;
4128 (* There's a lot of global-mutable-variable initialization we can only do after
4129 we get root, here in the handler of the initialize request. The function
4130 [get_root_exn] becomes available after we've set up initialize_params_ref, above. *)
4131 let root = get_root_exn () in
4132 Relative_path.set_path_prefix
Relative_path.Root
root;
4133 set_up_hh_logger_for_client_lsp root;
4135 (* Following is a hack. Atom incorrectly passes '--from vscode', rendering us
4136 unable to distinguish Atom from VSCode. But Atom is now frozen at vscode client
4137 v3.14. So by looking at the version, we can at least distinguish that it's old. *)
4140 initialize_params.client_capabilities
.textDocument
.declaration
4141 .declarationLinkSupport
)
4142 && String.equal env
.args
.from "vscode"
4144 from := "vscode_pre314";
4145 HackEventLogger.set_from
!from
4148 (* The function [get_local_config_exn] becomes available after we've set ref_local_config. *)
4150 ServerArgs.default_options ~
root:(Path.to_string
root)
4152 let server_args = ServerArgs.set_config
server_args env
.args
.config
in
4154 snd
@@ ServerConfig.load ~silent
:true ServerConfig.filename server_args
4156 ref_local_config := Some
local_config;
4157 HackEventLogger.set_rollout_flags
4158 (ServerLocalConfig.to_rollout_flags
local_config);
4159 HackEventLogger.set_rollout_group
4160 local_config.ServerLocalConfig.rollout_group
;
4162 let%lwt
version = read_hhconfig_version () in
4163 HackEventLogger.set_hhconfig_version
4164 (Some
(String_utils.lstrip
version "^"));
4165 let%lwt version_and_switch
= read_hhconfig_version_and_switch () in
4166 hhconfig_version_and_switch := version_and_switch
;
4167 let%lwt new_state
= connect ~env
!state in
4169 (* If editor sent 'trace: on' then that will turn on verbose_to_file. But we won't turn off
4170 verbose here, since the command-line argument --verbose trumps initialization params. *)
4172 match initialize_params.Initialize.trace
with
4173 | Initialize.Off
-> ()
4174 | Initialize.Messages
4175 | Initialize.Verbose
->
4176 set_verbose_to_file ~ide_service ~env ~
tracking_id true
4178 let result = do_initialize local_config in
4179 respond_jsonrpc ~powered_by
:Language_server
id (InitializeResult
result);
4182 match ide_service
with
4184 | Some ide_service
->
4185 let (promise
: unit Lwt.t) =
4186 run_ide_service env
!ide_service
initialize_params None
4188 ignore_promise_but_handle_failure
4190 ~desc
:"run-ide-after-init"
4191 ~terminate_on_failure
:true;
4192 (* Invariant: at all times after InitializeRequest, ide_service has
4193 already been sent an "initialize" message. *)
4194 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
4195 let request = do_didChangeWatchedFiles_registerCapability () in
4196 to_stdout (print_lsp_request
id request);
4197 (* TODO: our handler should really handle an error response properly *)
4198 let handler _response
state = Lwt.return
state in
4199 requests_outstanding :=
4200 IdMap.add
id (request, handler) !requests_outstanding
4203 if not
(Sys_utils.deterministic_behavior_for_tests
()) then
4204 Lsp_helpers.telemetry_log
4206 ("Version in hhconfig and switch=" ^
!hhconfig_version_and_switch);
4207 Lwt.return_some
{ result_count
= 0; result_extra_telemetry
= None
}
4208 (* any request/notification if we haven't yet initialized *)
4209 | (Pre_init
, _
, _
) ->
4213 Error.code
= Error.ServerNotInitialized
;
4214 message = "Server not yet initialized";
4217 | (Post_shutdown
, _
, _c
) ->
4221 Error.code
= Error.InvalidRequest
;
4222 message = "already received shutdown request";
4225 (* initialized notification *)
4226 | (_
, _
, NotificationMessage InitializedNotification
) -> Lwt.return_none
4228 | (_
, _
, RequestMessage
(id, RageRequestFB
)) ->
4229 let%lwt
result = do_rageFB !state in
4230 respond_jsonrpc ~powered_by
:Language_server
id (RageResultFB
result);
4232 { result_count
= List.length
result; result_extra_telemetry
= None
}
4235 NotificationMessage
(DidChangeWatchedFilesNotification
notification) )
4237 let open DidChangeWatchedFiles
in
4239 List.map
notification.changes ~
f:(fun change
->
4240 ClientIdeMessage.Changed_file
(lsp_uri_to_path change
.uri))
4248 ClientIdeMessage.(Disk_files_changed
changes)
4251 (* Text document completion: "AutoComplete!" *)
4252 | (_
, Some ide_service
, RequestMessage
(id, CompletionRequest
params)) ->
4253 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4263 respond_jsonrpc ~powered_by
:Serverless_ide
id (CompletionResult
result);
4266 result_count
= List.length
result.Completion.items
;
4267 result_extra_telemetry
= None
;
4269 (* Resolve documentation for a symbol: "Autocomplete Docblock!" *)
4272 RequestMessage
(id, CompletionItemResolveRequest
params) ) ->
4273 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4284 ~powered_by
:Serverless_ide
4286 (CompletionItemResolveResult
result);
4287 Lwt.return_some
{ result_count
= 1; result_extra_telemetry
= None
}
4288 (* Document highlighting in serverless IDE *)
4289 | (_
, Some ide_service
, RequestMessage
(id, DocumentHighlightRequest
params))
4291 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4302 ~powered_by
:Serverless_ide
4304 (DocumentHighlightResult
result);
4306 { result_count
= List.length
result; result_extra_telemetry
= None
}
4307 (* Type coverage in serverless IDE *)
4308 | (_
, Some ide_service
, RequestMessage
(id, TypeCoverageRequestFB
params))
4310 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4312 do_typeCoverage_localFB
4321 ~powered_by
:Serverless_ide
4323 (TypeCoverageResultFB
result);
4326 result_count
= List.length
result.TypeCoverageFB.uncoveredRanges
;
4327 result_extra_telemetry
= None
;
4329 (* Hover docblocks in serverless IDE *)
4330 | (_
, Some ide_service
, RequestMessage
(id, HoverRequest
params)) ->
4331 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4341 respond_jsonrpc ~powered_by
:Serverless_ide
id (HoverResult
result);
4345 | Some
{ Hover.contents; _
} -> List.length
contents
4347 Lwt.return_some
{ result_count; result_extra_telemetry
= None
}
4348 | (_
, Some ide_service
, RequestMessage
(id, DocumentSymbolRequest
params))
4350 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4352 do_documentSymbol_local
4361 ~powered_by
:Serverless_ide
4363 (DocumentSymbolResult
result);
4365 { result_count = List.length
result; result_extra_telemetry
= None
}
4366 | (_
, Some ide_service
, RequestMessage
(id, WorkspaceSymbolRequest
params))
4369 do_workspaceSymbol_local
4377 ~powered_by
:Serverless_ide
4379 (WorkspaceSymbolResult
result);
4381 { result_count = List.length
result; result_extra_telemetry
= None
}
4382 | (_
, Some ide_service
, RequestMessage
(id, DefinitionRequest
params)) ->
4383 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4384 let%lwt
(result, has_xhp_attribute) =
4393 let result_extra_telemetry =
4396 (Telemetry.create
()
4397 |> Telemetry.bool_ ~key
:"has_xhp_attribute" ~
value:true)
4399 respond_jsonrpc ~powered_by
:Serverless_ide
id (DefinitionResult
result);
4401 { result_count = List.length
result; result_extra_telemetry }
4402 | (_
, Some ide_service
, RequestMessage
(id, TypeDefinitionRequest
params))
4404 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4406 do_typeDefinition_local
4415 ~powered_by
:Serverless_ide
4417 (TypeDefinitionResult
result);
4419 { result_count = List.length
result; result_extra_telemetry = None
}
4420 (* Resolve documentation for a symbol: "Autocomplete Docblock!" *)
4421 | (_
, Some ide_service
, RequestMessage
(id, SignatureHelpRequest
params)) ->
4422 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4424 do_signatureHelp_local
4432 respond_jsonrpc ~powered_by
:Serverless_ide
id (SignatureHelpResult
result);
4436 | Some
{ SignatureHelp.signatures
; _
} -> List.length signatures
4438 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4439 (* textDocument/codeAction request *)
4440 | (_
, Some ide_service
, RequestMessage
(id, CodeActionRequest
params)) ->
4441 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4451 respond_jsonrpc ~powered_by
:Serverless_ide
id (CodeActionResult
result);
4453 { result_count = List.length
result; result_extra_telemetry = None
}
4454 (* textDocument/codeAction request, when not in serverless IDE mode *)
4455 | (Main_loop
menv, None
, RequestMessage
(id, CodeActionRequest
params)) ->
4456 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4457 let%lwt
result = do_codeAction menv.conn
ref_unblocked_time params in
4458 respond_jsonrpc ~powered_by
:Hh_server
id (CodeActionResult
result);
4460 { result_count = List.length
result; result_extra_telemetry = None
}
4461 (* textDocument/formatting *)
4462 | (_
, _
, RequestMessage
(id, DocumentFormattingRequest
params)) ->
4463 let result = do_documentFormatting editor_open_files params in
4465 ~powered_by
:Language_server
4467 (DocumentFormattingResult
result);
4469 { result_count = List.length
result; result_extra_telemetry = None
}
4470 (* textDocument/rangeFormatting *)
4471 | (_
, _
, RequestMessage
(id, DocumentRangeFormattingRequest
params)) ->
4472 let result = do_documentRangeFormatting editor_open_files params in
4474 ~powered_by
:Language_server
4476 (DocumentRangeFormattingResult
result);
4478 { result_count = List.length
result; result_extra_telemetry = None
}
4479 (* textDocument/onTypeFormatting *)
4480 | (_
, _
, RequestMessage
(id, DocumentOnTypeFormattingRequest
params)) ->
4481 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4482 let result = do_documentOnTypeFormatting editor_open_files params in
4484 ~powered_by
:Language_server
4486 (DocumentOnTypeFormattingResult
result);
4488 { result_count = List.length
result; result_extra_telemetry = None
}
4489 (* textDocument/willSaveWaitUntil request *)
4490 | (_
, _
, RequestMessage
(id, WillSaveWaitUntilRequest
params)) ->
4491 let result = do_willSaveWaitUntil editor_open_files params in
4493 ~powered_by
:Language_server
4495 (WillSaveWaitUntilResult
result);
4497 { result_count = List.length
result; result_extra_telemetry = None
}
4498 (* editor buffer events *)
4502 ( DidOpenNotification _
| DidChangeNotification _
4503 | DidCloseNotification _
| DidSaveNotification _
) ) ->
4505 handle_editor_buffer_message
4514 (* any request/notification that we can't handle yet *)
4515 | (In_init _
, _
, message) ->
4516 (* we respond with Operation_cancelled so that clients don't produce *)
4517 (* user-visible logs/warnings. *)
4521 Error.code
= Error.RequestCancelled
;
4522 message = Hh_server_initializing
|> hh_server_state_to_string;
4525 (Hh_json.JSON_Object
4527 ("state", !state |> state_to_string |> Hh_json.string_
);
4530 (Lsp_fmt.denorm_message_to_string
message) );
4533 (* textDocument/hover request *)
4534 | (Main_loop
menv, _
, RequestMessage
(id, HoverRequest
params)) ->
4535 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4536 let%lwt
result = do_hover menv.conn
ref_unblocked_time params in
4537 respond_jsonrpc ~powered_by
:Hh_server
id (HoverResult
result);
4541 | Some
{ Hover.contents; _
} -> List.length
contents
4543 let pos = params.Lsp.TextDocumentPositionParams.position in
4544 let result_extra_telemetry =
4546 |> Telemetry.int_ ~key
:"line" ~
value:pos.line
4547 |> Telemetry.int_ ~key
:"character" ~
value:pos.character
4550 { result_count; result_extra_telemetry = Some
result_extra_telemetry }
4551 (* textDocument/typeDefinition request *)
4552 | (Main_loop
menv, _
, RequestMessage
(id, TypeDefinitionRequest
params)) ->
4553 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4554 let%lwt
result = do_typeDefinition menv.conn
ref_unblocked_time params in
4555 respond_jsonrpc ~powered_by
:Hh_server
id (TypeDefinitionResult
result);
4557 { result_count = List.length
result; result_extra_telemetry = None
}
4558 (* textDocument/definition request *)
4559 | (Main_loop
menv, _
, RequestMessage
(id, DefinitionRequest
params)) ->
4560 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4561 let%lwt
(result, has_xhp_attribute) =
4562 do_definition menv.conn
ref_unblocked_time editor_open_files params
4564 let result_extra_telemetry =
4567 (Telemetry.create
()
4568 |> Telemetry.bool_ ~key
:"has_xhp_attribute" ~
value:true)
4570 respond_jsonrpc ~powered_by
:Hh_server
id (DefinitionResult
result);
4572 { result_count = List.length
result; result_extra_telemetry }
4573 (* textDocument/completion request *)
4574 | (Main_loop
menv, _
, RequestMessage
(id, CompletionRequest
params)) ->
4576 if env
.use_ffp_autocomplete
then
4579 do_completion_legacy
4581 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4582 let%lwt
result = do_completion menv.conn
ref_unblocked_time params in
4583 respond_jsonrpc ~powered_by
:Hh_server
id (CompletionResult
result);
4586 result_count = List.length
result.Completion.items
;
4587 result_extra_telemetry = None
;
4589 (* completionItem/resolve request *)
4592 RequestMessage
(id, CompletionItemResolveRequest
params) ) ->
4593 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4595 do_completionItemResolve menv.conn
ref_unblocked_time params
4598 ~powered_by
:Hh_server
4600 (CompletionItemResolveResult
result);
4601 Lwt.return_some
{ result_count = 1; result_extra_telemetry = None
}
4602 (* workspace/symbol request *)
4603 | (Main_loop
menv, _
, RequestMessage
(id, WorkspaceSymbolRequest
params)) ->
4604 let%lwt
result = do_workspaceSymbol menv.conn
ref_unblocked_time params in
4605 respond_jsonrpc ~powered_by
:Hh_server
id (WorkspaceSymbolResult
result);
4607 { result_count = List.length
result; result_extra_telemetry = None
}
4608 (* textDocument/documentSymbol request *)
4609 | (Main_loop
menv, _
, RequestMessage
(id, DocumentSymbolRequest
params)) ->
4610 let%lwt
result = do_documentSymbol menv.conn
ref_unblocked_time params in
4611 respond_jsonrpc ~powered_by
:Hh_server
id (DocumentSymbolResult
result);
4613 { result_count = List.length
result; result_extra_telemetry = None
}
4614 (* textDocument/references request *)
4615 | (Main_loop
menv, _
, RequestMessage
(id, FindReferencesRequest
params)) ->
4616 let%lwt
() = cancel_if_stale client timestamp long_timeout in
4617 let%lwt
result = do_findReferences menv.conn
ref_unblocked_time params in
4618 respond_jsonrpc ~powered_by
:Hh_server
id (FindReferencesResult
result);
4620 { result_count = List.length
result; result_extra_telemetry = None
}
4621 (* textDocument/implementation request *)
4622 | (Main_loop
menv, _
, RequestMessage
(id, ImplementationRequest
params)) ->
4623 let%lwt
() = cancel_if_stale client timestamp long_timeout in
4625 do_goToImplementation menv.conn
ref_unblocked_time params
4627 respond_jsonrpc ~powered_by
:Hh_server
id (ImplementationResult
result);
4629 { result_count = List.length
result; result_extra_telemetry = None
}
4630 (* textDocument/rename *)
4631 | (Main_loop
menv, _
, RequestMessage
(id, RenameRequest
params)) ->
4632 let%lwt
result = do_documentRename menv.conn
ref_unblocked_time params in
4633 respond_jsonrpc ~powered_by
:Hh_server
id (RenameResult
result);
4636 (fun _file
changes tot
-> tot
+ List.length
changes)
4637 result.WorkspaceEdit.changes
4640 let result_extra_telemetry =
4644 ~
value:(SMap.cardinal
result.WorkspaceEdit.changes)
4647 { result_count; result_extra_telemetry = Some
result_extra_telemetry }
4648 (* textDocument/documentHighlight *)
4649 | (Main_loop
menv, _
, RequestMessage
(id, DocumentHighlightRequest
params))
4651 let%lwt
() = cancel_if_stale client timestamp short_timeout in
4653 do_documentHighlight menv.conn
ref_unblocked_time params
4655 respond_jsonrpc ~powered_by
:Hh_server
id (DocumentHighlightResult
result);
4657 { result_count = List.length
result; result_extra_telemetry = None
}
4658 (* textDocument/typeCoverage *)
4659 | (Main_loop
menv, _
, RequestMessage
(id, TypeCoverageRequestFB
params)) ->
4660 let%lwt
result = do_typeCoverageFB menv.conn
ref_unblocked_time params in
4661 respond_jsonrpc ~powered_by
:Hh_server
id (TypeCoverageResultFB
result);
4664 result_count = List.length
result.TypeCoverageFB.uncoveredRanges
;
4665 result_extra_telemetry = None
;
4667 (* textDocument/signatureHelp notification *)
4668 | (Main_loop
menv, _
, RequestMessage
(id, SignatureHelpRequest
params)) ->
4669 let%lwt
result = do_signatureHelp menv.conn
ref_unblocked_time params in
4670 respond_jsonrpc ~powered_by
:Hh_server
id (SignatureHelpResult
result);
4674 | Some
result -> List.length
result.SignatureHelp.signatures
4676 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4677 (* catch-all for client reqs/notifications we haven't yet implemented *)
4678 | (Main_loop _menv
, _
, message) ->
4679 let method_ = Lsp_fmt.message_name_to_string
message in
4683 Error.code
= Error.MethodNotFound
;
4684 message = Printf.sprintf
"not implemented: %s" method_;
4687 (* catch-all for requests/notifications after shutdown request *)
4688 (* client message when we've lost the server *)
4689 | (Lost_server lenv
, _
, _
) ->
4690 let open Lost_env
in
4691 (* if trigger_on_lsp_method is set, our caller should already have *)
4692 (* transitioned away from this state. *)
4693 assert (not lenv
.p.trigger_on_lsp
);
4695 (* We deny all other requests. This is the only response that won't *)
4696 (* produce logs/warnings on most clients... *)
4700 Error.code
= Error.RequestCancelled
;
4701 message = lenv
.p.new_hh_server_state |> hh_server_state_to_string;
4704 (Hh_json.JSON_Object
4706 ("state", !state |> state_to_string |> Hh_json.string_
);
4709 (Lsp_fmt.denorm_message_to_string
message) );
4713 Lwt.return result_telemetry_opt
4715 let handle_server_message
4716 ~
(env
: env
) ~
(state : state ref) ~
(message : server_message
) :
4717 result_telemetry
option Lwt.t =
4719 match (!state, message) with
4720 (* server busy status *)
4721 | (_
, { push
= ServerCommandTypes.BUSY_STATUS
status; _
}) ->
4722 state := do_server_busy !state status;
4724 (* textDocument/publishDiagnostics notification *)
4726 { push
= ServerCommandTypes.DIAGNOSTIC
{ errors
; is_truncated
}; _
} )
4728 let uris_with_diagnostics =
4729 do_diagnostics menv.Main_env.uris_with_diagnostics errors ~is_truncated
4731 state := Main_loop
{ menv with Main_env.uris_with_diagnostics };
4733 (* any server diagnostics that come after we've shut down *)
4734 | (_
, { push
= ServerCommandTypes.DIAGNOSTIC _
; _
}) -> Lwt.return_unit
4735 (* server shut-down request *)
4736 | (Main_loop _menv
, { push
= ServerCommandTypes.NEW_CLIENT_CONNECTED
; _
})
4743 Lost_env.explanation = "hh_server is active in another window.";
4744 new_hh_server_state = Hh_server_stolen
;
4745 start_on_click
= false;
4746 trigger_on_lock_file
= false;
4747 trigger_on_lsp
= true;
4752 (* server shut-down request, unexpected *)
4753 | (_
, { push
= ServerCommandTypes.NEW_CLIENT_CONNECTED
; _
}) ->
4754 let message = "unexpected close of absent server" in
4756 raise
(Server_fatal_connection_exception
{ Marshal_tools.message; stack })
4757 (* server fatal shutdown *)
4758 | (_
, { push
= ServerCommandTypes.FATAL_EXCEPTION
e; _
}) ->
4759 raise
(Server_fatal_connection_exception
e)
4760 (* server non-fatal exception *)
4764 ServerCommandTypes.NONFATAL_EXCEPTION
4765 { Marshal_tools.message; stack };
4768 raise
(Server_nonfatal_exception
(make_lsp_error message ~
stack))
4772 (** The server sending 'hello' means that it is ready to establish a persistent
4773 connection. Establish that connection and send our backlog of file-edits to the server. *)
4774 let connect_after_hello (server_conn
: server_conn
) (state : state) : unit Lwt.t
4776 log "connect_after_hello";
4779 (* tell server we want persistent connection *)
4780 let oc = server_conn
.oc in
4781 ServerCommandLwt.send_connection_type
oc ServerCommandTypes.Persistent
;
4782 let fd = oc |> Unix.descr_of_out_channel
|> Lwt_unix.of_unix_file_descr
in
4783 let%lwt
(response : 'a
ServerCommandTypes.message_type
) =
4784 Marshal_tools_lwt.from_fd_with_preamble
fd
4788 | ServerCommandTypes.Response
(ServerCommandTypes.Connected
, _
) ->
4789 set_hh_server_state Hh_server_handling_or_ready
4790 | _
-> failwith
"Didn't get server Connected response"
4793 (* Extract the list of file changes we're tracking *)
4794 let editor_open_files =
4797 | Main_loop
menv -> Main_env.(menv.editor_open_files)
4798 | In_init ienv
-> In_init_env.(ienv
.editor_open_files)
4799 | Lost_server lenv
-> Lost_env.(lenv
.editor_open_files)
4800 | _
-> UriMap.empty
)
4802 (* send open files and unsaved buffers to server *)
4803 let float_unblocked_time = ref 0.0 in
4804 (* Note: do serially since these involve RPC calls. *)
4807 (fun (uri, textDocument
) ->
4808 let filename = lsp_uri_to_path uri in
4810 ServerCommandTypes.OPEN_FILE
4811 (filename, textDocument
.TextDocumentItem.text)
4813 rpc server_conn
float_unblocked_time ~desc
:"open" command)
4819 let e = Exception.wrap
exn in
4820 log "connect_after_hello exception %s" (Exception.to_string
e);
4821 raise
(Server_fatal_connection_exception
(Marshal_tools.of_exception
e))
4825 let handle_server_hello ~
(state : state ref) : result_telemetry
option Lwt.t =
4828 (* server completes initialization *)
4830 let%lwt
() = connect_after_hello ienv
.In_init_env.conn
!state in
4831 state := report_connect_end ienv
;
4833 (* any "hello" from the server when we weren't expecting it. This is so *)
4834 (* egregious that we can't trust anything more from the server. *)
4836 let message = "Unexpected hello" in
4838 raise
(Server_fatal_connection_exception
{ Marshal_tools.message; stack })
4842 let handle_client_ide_notification
4843 ~
(notification : ClientIdeMessage.notification) :
4844 result_telemetry
option Lwt.t =
4845 (* In response to ide_service notifications we have three goals:
4846 (1) in case of Done_init, we might have to announce the failure to the user
4847 (2) in a few other cases, we send telemetry events so that test harnesses
4848 get insight into the internal state of the ide_service
4849 (3) after every single event, includinng client_ide_notification events,
4850 our caller queries the ide_service for what status it wants to display to
4851 the user, so these notifications have the goal of triggering that refresh. *)
4852 match notification with
4853 | ClientIdeMessage.Done_init
(Ok
p) ->
4854 Lsp_helpers.telemetry_log
to_stdout "[client-ide] Finished init: ok";
4855 Lsp_helpers.telemetry_log
4858 "[client-ide] Initialized; %d file changes to process"
4859 p.ClientIdeMessage.Processing_files.total
);
4861 | ClientIdeMessage.Done_init
(Error error_data
) ->
4862 log_debug "<-- done_init";
4863 Lsp_helpers.telemetry_log
to_stdout "[client-ide] Finished init: failure";
4864 let%lwt
() = announce_ide_failure error_data
in
4866 | ClientIdeMessage.Processing_files _
->
4867 (* used solely for triggering a refresh of status by our caller; nothing
4868 for us to do here. *)
4870 | ClientIdeMessage.Done_processing
->
4871 Lsp_helpers.telemetry_log
4873 "[client-ide] Done processing file changes";
4876 (** Called once a second but only when there are no pending messages from client,
4877 hh_server, or clientIdeDaemon. *)
4879 ~
(env
: env
) ~
(state : state ref) ~
(ref_unblocked_time : float ref) :
4880 result_telemetry
option Lwt.t =
4881 EventLogger.recheck_disk_files
();
4882 HackEventLogger.Memory.profile_if_needed
();
4883 (* Update the hh_server_status global variable, either by asking the monitor
4884 during In_init, or reading it from Main_env: *)
4885 latest_hh_server_status := get_hh_server_status !state;
4888 (* idle tick while waiting for server to complete initialization *)
4890 let open In_init_env
in
4891 let time = Unix.time () in
4892 let delay_in_secs = int_of_float
(time -. ienv
.most_recent_start_time
) in
4894 if delay_in_secs <= 10 then
4897 (* terminate + retry the connection *)
4898 let%lwt new_state
= connect ~env
!state in
4903 (* Tick when we're connected to the server *)
4905 let open Main_env
in
4907 if !hh_server_needs_idle then
4908 (* If we're connected to a server and have no more messages in the queue, *)
4909 (* then we must let the server know we're idle, so it will be free to *)
4910 (* handle command-line requests. *)
4916 ServerCommandTypes.IDE_IDLE
4923 (* idle tick. No-op. *)
4924 | _
-> Lwt.return_unit
4926 let (promise
: unit Lwt.t) = EventLoggerLwt.flush
() in
4927 ignore_promise_but_handle_failure
4929 ~desc
:"tick-event-flush"
4930 ~terminate_on_failure
:false;
4933 let main (args
: args
) ~
(init_id
: string) : Exit_status.t Lwt.t =
4934 Printexc.record_backtrace
true;
4936 HackEventLogger.set_from
!from;
4938 (* The hh.conf can't fully be loaded without root, since it has flags like "foo=^4.53" that
4939 depend on the version= line we read from root/.hhconfig. But nevertheless we need right now
4940 a few hh.conf flags that control clientLsp and which aren't done that way. So we'll read
4941 those flags right now. *)
4942 let versionless_local_config =
4943 ServerLocalConfig.load
4945 ~current_version
:(Config_file.parse_version None
)
4946 (Config_file.of_list args
.config
)
4952 use_ffp_autocomplete
=
4953 versionless_local_config.ServerLocalConfig.ide_ffp_autocomplete
;
4954 use_ranked_autocomplete
=
4955 versionless_local_config.ServerLocalConfig.ide_ranked_autocomplete
;
4956 use_serverless_ide
=
4957 versionless_local_config.ServerLocalConfig.ide_serverless
;
4961 if env.args
.verbose
then begin
4962 Hh_logger.Level.set_min_level_stderr
Hh_logger.Level.Debug
;
4963 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Debug
4965 Hh_logger.Level.set_min_level_stderr
Hh_logger.Level.Error
;
4966 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Info
4968 (* The --verbose flag in env.verbose is the only thing that controls verbosity
4969 to stderr. Meanwhile, verbosity-to-file can be altered dynamically by the user.
4970 Why are they different? because we should write to stderr under a test harness,
4971 but we should never write to stderr when invoked by VSCode - it's not even guaranteed
4972 to drain the stderr pipe. *)
4974 if env.use_serverless_ide
then
4977 (ClientIdeService.make
4979 ClientIdeMessage.init_id
= env.init_id
;
4980 verbose_to_stderr
= env.args
.verbose
;
4981 verbose_to_file = env.args
.verbose
;
4987 let client = Jsonrpc.make_t
() in
4988 let deferred_action : (unit -> unit Lwt.t) option ref = ref None
in
4989 let state = ref Pre_init
in
4990 let ref_event = ref None
in
4991 let ref_unblocked_time = ref (Unix.gettimeofday
()) in
4992 (* ref_unblocked_time is the time at which we're no longer blocked on either
4993 * clientLsp message-loop or hh_server, and can start actually handling.
4994 * Everything that blocks will update this variable. *)
4995 let process_next_event () : unit Lwt.t =
4998 match !deferred_action with
4999 | Some
deferred_action ->
5000 let%lwt
() = deferred_action () in
5002 | None
-> Lwt.return_unit
5004 deferred_action := None
;
5005 let%lwt event
= get_next_event !state client ide_service in
5006 if not
(is_tick event
) then
5007 log_debug "next event: %s" (event_to_string event
);
5008 ref_event := Some event
;
5009 ref_unblocked_time := Unix.gettimeofday
();
5011 (* if we're in a lost-server state, some triggers cause us to reconnect *)
5013 reconnect_from_lost_if_necessary ~
env !state (`Event event
)
5017 (* we keep track of all open files and their contents *)
5018 state := track_open_and_recent_files !state event
;
5020 (* we keep track of all files that have unsaved changes in them *)
5021 state := track_edits_if_necessary !state event
;
5023 (* if a message comes from the server, maybe update our record of server state *)
5024 update_hh_server_state_if_necessary event
;
5026 (* update status immediately if warranted *)
5027 if not
(is_pre_init !state || is_post_shutdown !state) then begin
5029 publish_hh_server_status_diagnostic !state !latest_hh_server_status;
5030 refresh_status ~
env ~
ide_service
5033 (* this is the main handler for each message*)
5034 let%lwt result_telemetry_opt
=
5036 | Client_message
(metadata
, message) ->
5037 handle_client_message
5045 | Client_ide_notification
notification ->
5046 handle_client_ide_notification ~
notification
5047 | Server_message
message -> handle_server_message ~
env ~
state ~
message
5048 | Server_hello
-> handle_server_hello ~
state
5049 | Tick
-> handle_tick ~
env ~
state ~
ref_unblocked_time
5051 (* for LSP requests and notifications, we keep a log of what+when we responded.
5052 INVARIANT: every LSP request gets either a response logged here,
5053 or an error logged by one of the handlers below. *)
5054 log_response_if_necessary
5057 result_telemetry_opt
5058 !ref_unblocked_time;
5061 | Server_fatal_connection_exception
{ Marshal_tools.stack; message } ->
5062 if not
(is_post_shutdown !state) then (
5063 (* The server never tells us why it closed the connection - it simply *)
5064 (* closes. We don't have privilege to inspect its exit status. *)
5065 (* But in some cases of a controlled exit, the server does write to a *)
5066 (* "finale file" to explain its reason for exit... *)
5067 let server_finale_data =
5069 | Main_loop
{ Main_env.conn
; _
}
5070 | In_init
{ In_init_env.conn
; _
} ->
5071 Exit.get_finale_data
5072 conn
.server_specific_files
.ServerCommandTypes.server_finale_file
5075 let server_finale_stack =
5076 match server_finale_data with
5077 | Some
{ Exit.stack = Utils.Callstack
s; _
} ->
5078 s |> Exception.clean_stack
5083 (Hh_json.JSON_Object
5084 [("server_finale_stack", Hh_json.string_
server_finale_stack)])
5086 let e = make_lsp_error ~
stack ~
data message in
5087 (* Log all the things! *)
5091 Error_from_server_fatal
5094 Lsp_helpers.telemetry_error
5096 (message ^
", from_server\n" ^
stack);
5098 (* The monitor is responsible for detecting server closure and exit *)
5099 (* status, and restarting the server if necessary (that's not our job). *)
5100 (* All we'll do is put up a dialog telling the user that the server is *)
5101 (* down and giving them a button to restart. *)
5103 match server_finale_data with
5104 | Some
{ Exit.msg = Some
msg; _
} -> msg
5105 | Some
{ Exit.msg = None
; exit_status
; _
} ->
5107 "hh_server: stopped [%s]"
5108 (Exit_status.show exit_status
)
5109 | _
-> "hh_server: stopped."
5111 (* When would be a good time to auto-dismiss the dialog and attempt *)
5112 (* a proper re-connection? it's not our job to ascertain with certainty *)
5113 (* whether that re-connection will succeed - it's impossible to know, *)
5114 (* but also our re-connection attempt is pretty forceful. *)
5115 (* First: if the server determined in its finale that there shouldn't *)
5116 (* be automatic retry then we won't. Otherwise, we'll sleep for 1 sec *)
5117 (* and then look for the presence of the lock file. The sleep is *)
5118 (* because typically if you do "hh stop" then the persistent connection *)
5119 (* shuts down instantly but the monitor takes a short time to release *)
5121 let trigger_on_lock_file =
5122 match server_finale_data with
5124 { Exit.exit_status
= Exit_status.Failed_to_load_should_abort
; _
}
5131 (* We're right now inside an exception handler. We don't want to do *)
5132 (* work that might itself throw. So instead we'll leave that to the *)
5133 (* next time around the loop. *)
5142 Lost_env.explanation;
5143 new_hh_server_state = Hh_server_stopped
;
5144 start_on_click
= true;
5145 trigger_on_lock_file;
5146 trigger_on_lsp
= false;
5153 | Client_fatal_connection_exception
{ Marshal_tools.stack; message } ->
5154 let e = make_lsp_error ~
stack message in
5158 Error_from_client_fatal
5161 Lsp_helpers.telemetry_error
to_stdout (message ^
", from_client\n" ^
stack);
5162 let () = exit_fail () in
5164 | Client_recoverable_connection_exception
{ Marshal_tools.stack; message }
5166 let e = make_lsp_error ~
stack message in
5170 Error_from_client_recoverable
5173 Lsp_helpers.telemetry_error
to_stdout (message ^
", from_client\n" ^
stack);
5175 | (Server_nonfatal_exception
e | Error.LspException
e) as exn ->
5176 let exn = Exception.wrap
exn in
5178 match (e.Error.code
, Exception.unwrap
exn) with
5179 | (Error.RequestCancelled
, _
) -> Error_from_lsp_cancelled
5180 | (_
, Server_nonfatal_exception _
) -> Error_from_server_recoverable
5181 | (_
, _
) -> Error_from_lsp_misc
5184 make_lsp_error ~
data:e.Error.data ~code
:e.Error.code
e.Error.message
5186 respond_to_error !ref_event e;
5187 hack_log_error !ref_event e error_source !ref_unblocked_time env;
5190 let exn = Exception.wrap
exn in
5193 ~
stack:(Exception.get_backtrace_string
exn)
5194 ~current_stack
:false
5195 (Exception.get_ctor_string
exn)
5197 respond_to_error !ref_event e;
5198 hack_log_error !ref_event e Error_from_lsp_misc
!ref_unblocked_time env;
5201 let rec main_loop () : unit Lwt.t =
5202 let%lwt
() = process_next_event () in
5205 let%lwt
() = main_loop () in
5206 Lwt.return
Exit_status.No_error