2 * Copyright (c) 2015, Facebook, Inc.
5 * This source code is licensed under the MIT license found in the
6 * LICENSE file in the "hack" directory of this source tree.
15 (* All hack-specific code relating to LSP goes in here. *)
19 config
: (string * string) list
;
26 use_serverless_ide
: bool;
27 use_ffp_autocomplete
: bool;
28 use_ranked_autocomplete
: bool;
31 (** This gets initialized to env.from, but maybe modified in the light of the initialize request *)
32 let from = ref "[init]"
34 (** This gets initialized in the initialize request *)
35 let ref_local_config : ServerLocalConfig.t
option ref = ref None
37 (************************************************************************)
38 (* Protocol orchestration & helpers *)
39 (************************************************************************)
41 (** We have an idea of server state based on what we hear from the server:
42 When we attempt a connection, we hear hopefully hear back that it's
43 INITIALIZING, and when we eventually receive "hello" that means it's
44 HANDLING_OR_READY, i.e. either handling a message, or ready to accept one.
45 But at connection attempt, we might see that it's STOPPED, or hear from it
46 that it's DENYING_CONNECTION (typically due to rebase).
47 When the server's running normally, we sometimes here push notifications to
48 tell us that it's TYPECHECKING, or has been STOLEN by another editor.
49 At any point of communication we might hear from the server that it
50 encountered a fatal exception, i.e. shutting down the pipe, so presumably
51 it has been STOPPED. When we reattempt to connect once a second, maybe we'll
53 type hh_server_state
=
55 | Hh_server_initializing
56 | Hh_server_handling_or_ready
57 | Hh_server_denying_connection
59 | Hh_server_typechecking_local
60 | Hh_server_typechecking_global_blocking
61 | Hh_server_typechecking_global_interruptible
62 | Hh_server_typechecking_global_remote_blocking
67 let hh_server_restart_button_text = "Restart hh_server"
69 let client_ide_restart_button_text = "Restart Hack IDE"
71 let see_output_hack = " See Output\xE2\x80\xBAHack for details." (* chevron *)
73 type incoming_metadata
= {
74 timestamp
: float; (** time this message arrived at stdin *)
76 (** a unique random string of our own creation, which we can use for logging *)
79 (** A push message from the server might come while we're waiting for a server-rpc
80 response, or while we're free. The current architecture allows us to have
81 arbitrary responses to push messages while we're free, but only a limited set
82 of responses while we're waiting for a server-rpc - e.g. we can update our
83 notion of the server_state, or send a message to the client, but we can't
84 update our own state monad. The has_* fields are ad-hoc push-specific indicators
85 of whether we've done some part of the response during the rpc. *)
86 type server_message
= {
87 push
: ServerCommandTypes.push
;
88 has_updated_server_state
: bool;
92 ic
: Timeout.in_channel
;
94 server_specific_files
: ServerCommandTypes.server_specific_files
;
95 pending_messages
: server_message
Queue.t
;
96 (** ones that arrived during current rpc *)
99 module Main_env
= struct
103 most_recent_file
: documentUri
option;
104 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
105 uris_with_diagnostics
: UriSet.t
;
106 uris_with_unsaved_changes
: UriSet.t
;
107 (** see comment in get_uris_with_unsaved_changes *)
108 hh_server_status
: ShowStatusFB.params
;
109 (** is updated by [handle_server_message] > [do_server_busy]. Shows status of
110 a connected hh_server, whether it's busy typechecking or ready:
111 (1) type_=InfoMessage when done typechecking, or WarningMessage during.
112 (2) shortMessage="Hack" if IDE is available, or "Hack: busy" if not
113 (3) message is a descriptive status about what it's doing. *)
117 module In_init_env
= struct
120 first_start_time
: float; (** our first attempt to connect *)
121 most_recent_start_time
: float; (** for subsequent retries *)
122 most_recent_file
: documentUri
option;
123 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
124 uris_with_unsaved_changes
: UriSet.t
;
125 (** see comment in get_uris_with_unsaved_changes *)
126 hh_server_status_diagnostic
: PublishDiagnostics.params
option;
127 (** Diagnostic messages warning about server not fully running. *)
131 module Lost_env
= struct
134 most_recent_file
: documentUri
option;
135 editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
;
136 uris_with_unsaved_changes
: UriSet.t
;
137 (** see comment in get_uris_with_unsaved_changes *)
139 hh_server_status_diagnostic
: PublishDiagnostics.params
option;
140 (** Diagnostic messages warning about server not fully running. *)
145 new_hh_server_state
: hh_server_state
;
146 start_on_click
: bool;
147 (** if user clicks Restart, do we ClientStart before reconnecting? *)
148 trigger_on_lsp
: bool;
149 (** reconnect if we receive any LSP request/notification *)
150 trigger_on_lock_file
: bool; (** reconnect if lockfile is created *)
155 | Pre_init
(** Pre_init: we haven't yet received the initialize request. *)
156 | In_init
of In_init_env.t
157 (** In_init: we did respond to the initialize request, and now we're
158 waiting for a "Hello" from the server. When that comes we'll
159 request a permanent connection from the server, and process the
160 file_changes backlog, and switch to Main_loop. *)
161 | Main_loop
of Main_env.t
162 (** Main_loop: we have a working connection to both server and client. *)
163 | Lost_server
of Lost_env.t
164 (** Lost_server: someone stole the persistent connection from us.
165 We might choose to grab it back if prompted... *)
167 (** Post_shutdown: we received a shutdown request from the client, and
168 therefore shut down our connection to the server. We can't handle
169 any more requests from the client and will close as soon as it
170 notifies us that we can exit. *)
172 let is_post_shutdown (state
: state
) : bool =
174 | Post_shutdown
-> true
181 let is_pre_init (state
: state
) : bool =
190 type result_handler
= lsp_result
-> state
-> state
Lwt.t
192 type result_telemetry
= {
193 (* how many results did we send back to the user? *)
195 (* other message-specific data *)
196 result_extra_telemetry
: Telemetry.t
option;
199 let initialize_params_ref : Lsp.Initialize.params
option ref = ref None
201 let initialize_params_exc () : Lsp.Initialize.params
=
202 match !initialize_params_ref with
203 | None
-> failwith
"initialize_params not yet received"
204 | Some initialize_params
-> initialize_params
206 (** root only becomes available after the initialize message *)
207 let get_root_opt () : Path.t
option =
208 match !initialize_params_ref with
210 | Some initialize_params
->
211 let path = Some
(Lsp_helpers.get_root initialize_params
) in
212 Some
(Wwwroot.get
path)
214 (** root only becomes available after the initialize message *)
215 let get_root_exn () : Path.t
= Option.value_exn
(get_root_opt ())
217 (** local_config only becomes available after the initialize message *)
218 let get_local_config_exn () : ServerLocalConfig.t
=
219 Option.value_exn
!ref_local_config
221 (** We remember the last version of .hhconfig, and hack_rc_mode switch,
222 so that if they change then we know we must terminate and be restarted. *)
223 let hhconfig_version_and_switch : string ref = ref "[NotYetInitialized]"
225 (** This flag is used to control how much will be written
226 to log-files. It can be turned on initially by --verbose at the command-line or
227 setting "trace:Verbose" in initializationParams. Thereafter, it can
228 be changed by the user dynamically via $/setTraceNotification.
229 Don't alter this reference directly; instead use [set_verbose_to_file]
230 so as to pass the message on to ide_service as well.
231 Note: control for how much will be written to stderr is solely
232 controlled by --verbose at the command-line, stored in env.verbose. *)
233 let verbose_to_file : bool ref = ref false
235 let can_autostart_after_mismatch : bool ref = ref true
237 let requests_outstanding : (lsp_request
* result_handler
) IdMap.t
ref =
240 let get_outstanding_request_exn (id
: lsp_id
) : lsp_request
=
241 match IdMap.find_opt id
!requests_outstanding with
242 | Some
(request
, _
) -> request
243 | None
-> failwith
"response id doesn't correspond to an outstanding request"
245 (** hh_server pushes BUSY_STATUS messages over the persistent connection
246 to mark key milestones like "begin typechecking". We handle them in two
247 ways. First, update_hh_server_state_if_necessary updates a historical
248 record of state transitions over the past two minutes, called both from
249 the main message loop and also during rpc progress callbacks. It's
250 stored in a global variable because we don't want rpc callbacks to have
251 to be part of the state monad. It's kept as an ordered list of states
252 over the past two minutes (head is newest) so that if we were busy at
253 the time a jsonrpc request arrived on stdin, we can still know what was
254 the server state at the time. The second way we handle them is inside
255 handle_server_message, called as part of the main message loop, whose
256 job is to update the Main_env representation of current hh_server status. *)
257 let hh_server_state_log : (float * hh_server_state
) list
ref = ref []
259 (** hh_server pushes a different form of its state to the monitor e.g.
260 "busy typechecking 1/50 files" or "init is slow due to lack of saved state".
261 It does this for the sake of clients who don't have a persistent connection;
262 they can ask the monitor what was the latest that hh_server pushed. We use
263 this during In_init when we don't have a persistent connection; other
264 command-line clients of hh_client do this when they're waiting their turn.
265 On idle, i.e. during [Tick] events, we update the following global
266 variable which synthesizes our best knowledge about the current hh_server
267 state; during Main_loop it's obtained from the latest Main_env representation
268 of the current hh_server state, and during In_init it's obtained by
269 asking the monitor. We store this in a global value so we can access
270 it during rpc callbacks, without requiring them to have the state monad. *)
271 let latest_hh_server_status : ShowStatusFB.params
option ref = ref None
273 (** Have we already sent a status message over LSP? If so, and our new
274 status will be just the same as the previous one, we won't need to send it
275 again. This stores the most recent status that the LSP client has. *)
276 let showStatus_outstanding : string ref = ref ""
278 let log s
= Hh_logger.log ("[client-lsp] " ^^ s
)
280 let log_debug s
= Hh_logger.debug
("[client-lsp] " ^^ s
)
282 let log_error s
= Hh_logger.error
("[client-lsp] " ^^ s
)
284 let set_up_hh_logger_for_client_lsp (root
: Path.t
) : unit =
285 (* Log to a file on disk. Note that calls to `Hh_logger` will always write to
286 `stderr`; this is in addition to that. *)
287 let client_lsp_log_fn = ServerFiles.client_lsp_log root
in
289 try Sys.rename
client_lsp_log_fn (client_lsp_log_fn ^
".old") with
292 Hh_logger.set_log
client_lsp_log_fn;
293 log "Starting clientLsp at %s" client_lsp_log_fn
295 let to_stdout (json
: Hh_json.json
) : unit =
296 let s = Hh_json.json_to_string json ^
"\r\n\r\n" in
297 Http_lite.write_message stdout
s
299 let get_editor_open_files (state
: state
) :
300 Lsp.TextDocumentItem.t
UriMap.t
option =
305 | Main_loop menv
-> Some menv
.Main_env.editor_open_files
306 | In_init ienv
-> Some ienv
.In_init_env.editor_open_files
307 | Lost_server lenv
-> Some lenv
.Lost_env.editor_open_files
309 (** This is the most recent file that was subject of an LSP request
310 from the client. There's no guarantee that the file is still open. *)
311 let get_most_recent_file (state
: state
) : documentUri
option =
316 | Main_loop menv
-> menv
.Main_env.most_recent_file
317 | In_init ienv
-> ienv
.In_init_env.most_recent_file
318 | Lost_server lenv
-> lenv
.Lost_env.most_recent_file
322 | Server_message
of server_message
323 | Client_message
of incoming_metadata
* lsp_message
324 (** Client_message stores raw json, and the parsed form of it *)
325 | Client_ide_notification
of ClientIdeMessage.notification
326 | Tick
(** once per second, on idle *)
328 let event_to_string (event
: event
) : string =
330 | Server_hello
-> "Server_hello"
331 | Server_message _
-> "Server_message(_)"
332 | Client_message
(metadata
, m
) ->
334 "Client_message(#%s: %s)"
336 (Lsp_fmt.denorm_message_to_string m
)
337 | Client_ide_notification n
->
339 "Client_ide_notification(%s)"
340 (ClientIdeMessage.notification_to_string n
)
343 let is_tick (event
: event
) : bool =
349 | Client_ide_notification _
->
352 (* Here are some exit points. *)
353 let exit_ok () = exit
0
355 let exit_fail () = exit
1
357 (* The following connection exceptions inform the main LSP event loop how to
358 respond to an exception: was the exception a connection-related exception
359 (one of these) or did it arise during other logic (not one of these)? Can
360 we report the exception to the LSP client? Can we continue handling
361 further LSP messages or must we quit? If we quit, can we do so immediately
362 or must we delay? -- Separately, they also help us marshal callstacks
363 across daemon- and process-boundaries. *)
366 Client_fatal_connection_exception
of Marshal_tools.remote_exception_data
369 Client_recoverable_connection_exception
of Marshal_tools.remote_exception_data
372 Server_fatal_connection_exception
of Marshal_tools.remote_exception_data
374 exception Server_nonfatal_exception
of Lsp.Error.t
376 (** Helper function to construct an Lsp.Error. Its goal is to gather
377 useful information in the optional freeform 'data' field. It assembles
378 that data out of any data already provided, the provided stack, and the
379 current stack. A typical scenario is that we got an error marshalled
380 from a remote server with its remote stack where the error was generated,
381 and we also want to record the stack where we received it. *)
383 ?
(data
: Hh_json.json
option = None
)
384 ?
(stack
: string option)
385 ?
(current_stack
: bool = true)
386 ?
(code
: Lsp.Error.code
= Lsp.Error.UnknownErrorCode
)
387 (message
: string) : Lsp.Error.t
=
391 | Some
(Hh_json.JSON_Object
elems) -> elems
392 | Some json
-> [("data", json
)]
396 | Some stack
when not
(List.Assoc.mem ~equal
:String.equal
elems "stack") ->
397 ("stack", stack
|> Exception.clean_stack
|> Hh_json.string_
) :: elems
401 match current_stack
with
402 | true when not
(List.Assoc.mem ~equal
:String.equal
elems "current_stack")
405 Exception.get_current_callstack_string
99
406 |> Exception.clean_stack
411 { Lsp.Error.code
; message
; data
= Some
(Hh_json.JSON_Object
elems) }
413 (** Use ignore_promise_but_handle_failure when you want don't care about awaiting
414 results of an async piece of work, but still want any exceptions to be logged.
415 This is similar to Lwt.async except (1) it logs to our HackEventLogger and
416 Hh_logger rather than stderr, (2) it you can decide on a case-by-case basis what
417 should happen to exceptions rather than having them all share the same
418 Lwt.async_exception_hook, (3) while Lwt.async takes a lambda for creating the
419 promise and so catches exceptions during promise creation, this function takes
420 an already-existing promise and so the caller has to handle such exceptions
421 themselves - I resent using lambdas as a control-flow primitive.
423 You can think of this function as similar to [ignore], but enhanced because
424 it's poor practice to ignore a promise. *)
425 let ignore_promise_but_handle_failure
426 ~
(desc
: string) ~
(terminate_on_failure
: bool) (promise
: unit Lwt.t
) :
430 let%lwt
() = promise
in
435 let exn = Exception.wrap
exn in
436 let message = "Unhandled exception: " ^
Exception.get_ctor_string
exn in
438 Exception.get_backtrace_string
exn |> Exception.clean_stack
443 ("description", string_ desc
);
444 ("message", string_
message);
445 ("stack", string_
stack);
448 HackEventLogger.client_lsp_exception
449 ~root
:(get_root_opt ())
450 ~
message:"Unhandled exception"
451 ~data_opt
:(Some
data)
453 log_error "%s\n%s\n%s" message desc
stack;
454 if terminate_on_failure
then
455 (* exit 2 is the same as used by Lwt.async *)
460 let state_to_string (state
: state
) : string =
462 | Pre_init
-> "Pre_init"
463 | In_init _ienv
-> "In_init"
464 | Main_loop _menv
-> "Main_loop"
465 | Lost_server _lenv
-> "Lost_server"
466 | Post_shutdown
-> "Post_shutdown"
468 let hh_server_state_to_string (hh_server_state
: hh_server_state
) : string =
469 match hh_server_state
with
470 | Hh_server_denying_connection
-> "hh_server denying connection"
471 | Hh_server_initializing
-> "hh_server initializing"
472 | Hh_server_stopped
-> "hh_server stopped"
473 | Hh_server_stolen
-> "hh_server stolen"
474 | Hh_server_typechecking_local
-> "hh_server typechecking (local)"
475 | Hh_server_typechecking_global_blocking
->
476 "hh_server typechecking (global, blocking)"
477 | Hh_server_typechecking_global_interruptible
->
478 "hh_server typechecking (global, interruptible)"
479 | Hh_server_typechecking_global_remote_blocking
->
480 "hh_server typechecking (global remote, blocking)"
481 | Hh_server_handling_or_ready
-> "hh_server ready"
482 | Hh_server_unknown
-> "hh_server unknown state"
483 | Hh_server_forgot
-> "hh_server forgotten state"
485 (** This conversion is imprecise. Comments indicate potential gaps *)
486 let completion_kind_to_si_kind
487 (completion_kind
: Completion.completionItemKind
option) :
488 SearchUtils.si_kind
=
490 let open SearchUtils
in
491 match completion_kind
with
492 | Some
Completion.Class
-> SI_Class
493 | Some
Completion.Method
-> SI_ClassMethod
494 | Some
Completion.Function
-> SI_Function
495 | Some
Completion.Variable
->
496 SI_LocalVariable
(* or SI_Mixed, but that's never used *)
497 | Some
Completion.Property
-> SI_Property
498 | Some
Completion.Constant
-> SI_GlobalConstant
(* or SI_ClassConstant *)
499 | Some
Completion.Interface
-> SI_Interface
(* or SI_Trait *)
500 | Some
Completion.Enum
-> SI_Enum
501 | Some
Completion.Module
-> SI_Namespace
502 | Some
Completion.Constructor
-> SI_Constructor
503 | Some
Completion.Keyword
-> SI_Keyword
504 | Some
Completion.Value
-> SI_Literal
505 | Some
Completion.TypeParameter
-> SI_Typedef
506 (* The completion enum includes things we don't really support *)
509 let si_kind_to_completion_kind (kind
: SearchUtils.si_kind
) :
510 Completion.completionItemKind
option =
513 | SearchUtils.SI_Class
->
514 Some
Completion.Class
515 | SearchUtils.SI_ClassMethod
-> Some
Completion.Method
516 | SearchUtils.SI_Function
-> Some
Completion.Function
517 | SearchUtils.SI_Mixed
518 | SearchUtils.SI_LocalVariable
->
519 Some
Completion.Variable
520 | SearchUtils.SI_Property
-> Some
Completion.Property
521 | SearchUtils.SI_ClassConstant
-> Some
Completion.Constant
522 | SearchUtils.SI_Interface
523 | SearchUtils.SI_Trait
->
524 Some
Completion.Interface
525 | SearchUtils.SI_Enum
-> Some
Completion.Enum
526 | SearchUtils.SI_Namespace
-> Some
Completion.Module
527 | SearchUtils.SI_Constructor
-> Some
Completion.Constructor
528 | SearchUtils.SI_Keyword
-> Some
Completion.Keyword
529 | SearchUtils.SI_Literal
-> Some
Completion.Value
530 | SearchUtils.SI_GlobalConstant
-> Some
Completion.Constant
531 | SearchUtils.SI_Typedef
-> Some
Completion.TypeParameter
532 | SearchUtils.SI_Unknown
-> None
534 (** We keep a log of server state over the past 2mins. When adding a new server
535 state: if this state is the same as the current one, then ignore it. Also,
536 retain only states younger than 2min plus the first one older than 2min.
537 Newest state is at head of list. *)
538 let set_hh_server_state (new_hh_server_state
: hh_server_state
) : unit =
539 let new_time = Unix.gettimeofday
() in
540 let rec retain rest
=
543 | (time
, state
) :: rest
when Float.(time
>= new_time -. 120.0) ->
544 (time
, state
) :: retain rest
545 | (time
, state
) :: _rest
-> [(time
, state
)]
546 (* retain only the first that's older *)
548 hh_server_state_log :=
549 match !hh_server_state_log with
550 | (prev_time
, prev_hh_server_state
) :: rest
551 when equal_hh_server_state prev_hh_server_state new_hh_server_state
->
552 (prev_time
, prev_hh_server_state
) :: retain rest
553 | rest
-> (new_time, new_hh_server_state
) :: retain rest
555 let get_older_hh_server_state (requested_time
: float) : hh_server_state
=
556 (* find the first item which is older than the specified time. *)
558 List.find
!hh_server_state_log ~f
:(fun (time
, _
) ->
559 Float.(time
<= requested_time
))
561 | None
-> Hh_server_forgot
562 | Some
(_
, hh_server_state
) -> hh_server_state
564 let read_hhconfig_version () : string Lwt.t
=
565 match get_root_opt () with
566 | None
-> Lwt.return
"[NoRoot]"
568 let file = Filename.concat
(Path.to_string root
) ".hhconfig" in
569 let%lwt config
= Config_file_lwt.parse_hhconfig
file in
571 | Ok
(_hash
, config
) ->
574 |> Config_file.Getters.string_opt
"version"
575 |> Config_file_lwt.parse_version
576 |> Config_file_lwt.version_to_string_opt
577 |> Option.value ~default
:"[NoVersion]"
580 | Error
message -> Lwt.return
(Printf.sprintf
"[NoHhconfig:%s]" message))
582 let read_hhconfig_version_and_switch () : string Lwt.t
=
583 let%lwt hack_rc_mode_result
=
584 Lwt_utils.read_all
(Sys_utils.expanduser
"~/.hack_rc_mode")
587 match hack_rc_mode_result
with
588 | Ok
s -> " hack_rc_mode=" ^
s
592 match Sys.getenv_opt
"HH_HOME" with
593 | Some
s -> " HH_HOME=" ^
s
596 let%lwt hhconfig_version
= read_hhconfig_version () in
597 Lwt.return
(hhconfig_version ^
hack_rc_mode ^
hh_home)
599 (** get_uris_with_unsaved_changes is the set of files for which we've
600 received didChange but haven't yet received didSave/didOpen. It is purely
601 a description of what we've heard of the editor, and is independent of
602 whether or not they've yet been synced with hh_server.
603 As it happens: in Main_loop state all these files will already have been
604 sent to hh_server; in In_init state all these files will have been queued
605 up inside editor_open_files ready to be sent when we receive the hello; in
606 Lost_server state they're not even queued up, and if ever we see hh_server
607 ready then we'll terminate the LSP server and trust the client to relaunch
608 us and resend a load of didOpen/didChange events. *)
609 let get_uris_with_unsaved_changes (state
: state
) : UriSet.t
=
611 | Main_loop menv
-> menv
.Main_env.uris_with_unsaved_changes
612 | In_init ienv
-> ienv
.In_init_env.uris_with_unsaved_changes
613 | Lost_server lenv
-> lenv
.Lost_env.uris_with_unsaved_changes
616 let update_hh_server_state_if_necessary (event
: event
) : unit =
617 let open ServerCommandTypes
in
620 | BUSY_STATUS Needs_local_typecheck
621 | BUSY_STATUS Done_local_typecheck
622 | BUSY_STATUS Done_global_typecheck
->
623 set_hh_server_state Hh_server_handling_or_ready
624 | BUSY_STATUS Doing_local_typecheck
->
625 set_hh_server_state Hh_server_typechecking_local
626 | BUSY_STATUS
(Doing_global_typecheck global_typecheck_kind
) ->
628 (match global_typecheck_kind
with
629 | Blocking
-> Hh_server_typechecking_global_blocking
630 | Interruptible
-> Hh_server_typechecking_global_interruptible
631 | Remote_blocking _
-> Hh_server_typechecking_global_remote_blocking
)
632 | NEW_CLIENT_CONNECTED
-> set_hh_server_state Hh_server_stolen
635 | NONFATAL_EXCEPTION _
->
639 | Server_message
{ push
; has_updated_server_state
= false } -> helper push
642 (** This cancellable async function will block indefinitely until a notification is
643 available from ide_service. *)
644 let pop_from_ide_service (ide_service
: ClientIdeService.t
ref option) :
646 match ide_service
with
647 | None
-> Lwt.wait
() |> fst
(* a never-fulfilled promise *)
648 | Some ide_service
->
649 let%lwt notification_opt
=
650 Lwt_message_queue.pop
(ClientIdeService.get_notifications
!ide_service
)
652 (match notification_opt
with
653 | None
-> Lwt.wait
() |> fst
(* a never-fulfilled promise *)
654 | Some notification
-> Lwt.return
(Client_ide_notification notification
))
656 (** Determine whether to read a message from the client (the editor) or the
657 server (hh_server), or whether neither is ready within 1s. *)
658 let get_message_source
659 (server
: server_conn
)
661 (ide_service
: ClientIdeService.t
ref option) :
662 [ `From_server
| `From_client
| `From_ide_service
of event
| `No_source
]
664 (* Take action on server messages in preference to client messages, because
665 server messages are very easy and quick to service (just send a message to
666 the client), while client messages require us to launch a potentially
667 long-running RPC command. *)
668 let has_server_messages = not
(Queue.is_empty server
.pending_messages
) in
669 if has_server_messages then
670 Lwt.return `From_server
671 else if Jsonrpc.has_message client
then
672 Lwt.return `From_client
674 (* If no immediate messages are available, then wait up to 1 second. *)
676 Unix.descr_of_out_channel server
.oc
|> Lwt_unix.of_unix_file_descr
679 Jsonrpc.get_read_fd client
|> Lwt_unix.of_unix_file_descr
681 let%lwt message_source
=
684 (let%lwt
() = Lwt_unix.sleep
1.0 in
685 Lwt.return `No_source
);
686 (let%lwt
() = Lwt_unix.wait_read
server_read_fd in
687 Lwt.return `From_server
);
688 (let%lwt
() = Lwt_unix.wait_read
client_read_fd in
689 Lwt.return `From_client
);
690 (let%lwt notification
= pop_from_ide_service ide_service
in
691 Lwt.return
(`From_ide_service notification
));
694 Lwt.return message_source
696 (** A simplified version of get_message_source which only looks at client *)
697 let get_client_message_source
698 (client
: Jsonrpc.t
) (ide_service
: ClientIdeService.t
ref option) :
699 [ `From_client
| `From_ide_service
of event
| `No_source
] Lwt.t
=
700 if Jsonrpc.has_message client
then
701 Lwt.return `From_client
704 Jsonrpc.get_read_fd client
|> Lwt_unix.of_unix_file_descr
706 let%lwt message_source
=
709 (let%lwt
() = Lwt_unix.sleep
1.0 in
710 Lwt.return `No_source
);
711 (let%lwt
() = Lwt_unix.wait_read
client_read_fd in
712 Lwt.return `From_client
);
713 (let%lwt notification
= pop_from_ide_service ide_service
in
714 Lwt.return
(`From_ide_service notification
));
717 Lwt.return message_source
719 (** Read a message unmarshaled from the server's out_channel. *)
720 let read_message_from_server (server
: server_conn
) : event
Lwt.t
=
721 let open ServerCommandTypes
in
724 Unix.descr_of_out_channel server
.oc
|> Lwt_unix.of_unix_file_descr
726 let%lwt
(message : 'a
ServerCommandTypes.message_type
) =
727 Marshal_tools_lwt.from_fd_with_preamble
fd
730 | Response _
-> failwith
"unexpected response without request"
732 Lwt.return
(Server_message
{ push
; has_updated_server_state
= false })
733 | Hello
-> Lwt.return Server_hello
734 | Ping
-> failwith
"unexpected ping on persistent connection"
735 | Monitor_failed_to_handoff
->
736 failwith
"unexpected monitor_failed_to_handoff on persistent connection"
739 let e = Exception.wrap
exn in
740 raise
(Server_fatal_connection_exception
(Marshal_tools.of_exception
e))
742 (** get_next_event: picks up the next available message from either client or
743 server. The way it's implemented, at the first character of a message
744 from either client or server, we block until that message is completely
745 received. Note: if server is None (meaning we haven't yet established
746 connection with server) then we'll just block waiting for client. *)
750 (ide_service
: ClientIdeService.t
ref option) : event
Lwt.t
=
751 let from_server (server
: server_conn
) : event
Lwt.t
=
752 if Queue.is_empty server
.pending_messages
then
753 read_message_from_server server
755 Lwt.return
(Server_message
(Queue.dequeue_exn server
.pending_messages
))
757 let from_client (client
: Jsonrpc.t
) : event
Lwt.t
=
758 let%lwt
message = Jsonrpc.get_message client
in
760 | `Message
{ Jsonrpc.json
; timestamp
} ->
763 let message = Lsp_fmt.parse_lsp json
get_outstanding_request_exn in
764 let rnd = Random_id.short_string
() in
767 | RequestMessage
(id
, _
) -> rnd ^
"." ^
Lsp_fmt.id_to_string id
770 Lwt.return
(Client_message
({ tracking_id; timestamp
}, message))
773 let e = Exception.wrap
e in
776 Marshal_tools.stack = Exception.get_backtrace_string
e;
777 message = Exception.get_ctor_string
e;
780 raise
(Client_recoverable_connection_exception
edata)
782 | `Fatal_exception
edata -> raise
(Client_fatal_connection_exception
edata)
783 | `Recoverable_exception
edata ->
784 raise
(Client_recoverable_connection_exception
edata)
787 | Main_loop
{ Main_env.conn
; _
}
788 | In_init
{ In_init_env.conn
; _
} ->
789 let%lwt message_source
= get_message_source conn client ide_service
in
790 (match message_source
with
792 let%lwt
message = from_client client
in
795 let%lwt
message = from_server conn
in
797 | `From_ide_service
message -> Lwt.return
message
798 | `No_source
-> Lwt.return Tick
)
800 let%lwt message_source
= get_client_message_source client ide_service
in
801 (match message_source
with
803 let%lwt
message = from_client client
in
805 | `From_ide_service
message -> Lwt.return
message
806 | `No_source
-> Lwt.return Tick
)
813 let add_powered_by ~
(powered_by
: powered_by
) (json
: Hh_json.json
) :
816 match (json
, powered_by
) with
817 | (JSON_Object props
, Serverless_ide
) ->
818 JSON_Object
(("powered_by", JSON_String
"serverless_ide") :: props
)
822 ~
(powered_by
: powered_by
) (id
: lsp_id
) (result
: lsp_result
) : unit =
823 print_lsp_response id result
|> add_powered_by ~powered_by
|> to_stdout
825 let notify_jsonrpc ~
(powered_by
: powered_by
) (notification
: lsp_notification
)
827 print_lsp_notification notification
|> add_powered_by ~powered_by
|> to_stdout
829 (** respond_to_error: if we threw an exception during the handling of a request,
830 report the exception to the client as the response to their request. *)
831 let respond_to_error (event
: event
option) (e : Lsp.Error.t
) : unit =
832 let result = ErrorResult
e in
834 | Some
(Client_message
(_
, RequestMessage
(id
, _request
))) ->
835 respond_jsonrpc ~powered_by
:Language_server id
result
837 (* We want to report LSP error 'e' over jsonrpc. But jsonrpc only allows
838 errors to be reported in response to requests. So we'll stick the information
839 in a telemetry/event. The format of this event isn't defined. We're going to
840 roll our own, using ad-hoc json fields to emit all the data out of 'e' *)
841 let open Lsp.Error
in
843 ("code", e.code
|> Error.show_code
|> Hh_json.string_
)
844 :: Option.value_map
e.data ~default
:[] ~f
:(fun data -> [("data", data)])
846 Lsp_helpers.telemetry_error
to_stdout e.message ~
extras
848 (** request_showStatusFB: pops up a dialog *)
849 let request_showStatusFB
850 ?
(on_result
: ShowStatusFB.result -> state
-> state
Lwt.t
=
851 (fun _ state
-> Lwt.return state
))
852 ?
(on_error
: Error.t
-> state
-> state
Lwt.t
=
853 (fun _ state
-> Lwt.return state
))
854 (params
: ShowStatusFB.params
) : unit =
855 let initialize_params = initialize_params_exc () in
856 if not
(Lsp_helpers.supports_status
initialize_params) then
859 (* We try not to send duplicate statuses.
860 That means: if you call request_showStatus but your message is the same as
861 what's already up, then you won't be shown, and your callbacks won't be shown. *)
862 let msg = params
.ShowStatusFB.request
.ShowMessageRequest.message in
863 if String.equal
msg !showStatus_outstanding then
866 showStatus_outstanding := msg;
867 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
868 let request = ShowStatusRequestFB params
in
869 to_stdout (print_lsp_request
id request);
871 let handler (result : lsp_result
) (state
: state
) : state
Lwt.t
=
872 if String.equal
msg !showStatus_outstanding then
873 showStatus_outstanding := "";
875 | ShowStatusResultFB
result -> on_result
result state
876 | ErrorResult error
-> on_error error state
880 Error.code
= Error.ParseError
;
881 message = "expected ShowStatusResult";
887 requests_outstanding :=
888 IdMap.add
id (request, handler) !requests_outstanding
891 (** request_showMessage: pops up a dialog *)
892 let request_showMessage
893 (on_result
: ShowMessageRequest.result -> state
-> state
Lwt.t
)
894 (on_error
: Error.t
-> state
-> state
Lwt.t
)
895 (type_
: MessageType.t
)
897 (titles
: string list
) : ShowMessageRequest.t
=
898 (* send the request *)
899 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
901 List.map titles ~f
:(fun title
-> { ShowMessageRequest.title
})
904 ShowMessageRequestRequest
{ ShowMessageRequest.type_
; message; actions }
906 to_stdout (print_lsp_request
id request);
908 let handler (result : lsp_result
) (state
: state
) : state
Lwt.t
=
910 | ShowMessageRequestResult
result -> on_result
result state
911 | ErrorResult
error -> on_error
error state
915 Error.code
= Error.ParseError
;
916 message = "expected ShowMessageRequestResult";
922 requests_outstanding := IdMap.add
id (request, handler) !requests_outstanding;
925 ShowMessageRequest.Present
{ id }
927 (** dismiss_showMessageRequest: sends a cancellation-request for the dialog *)
928 let dismiss_showMessageRequest (dialog
: ShowMessageRequest.t
) :
929 ShowMessageRequest.t
=
932 | ShowMessageRequest.Absent
-> ()
933 | ShowMessageRequest.Present
{ id; _
} ->
934 let notification = CancelRequestNotification
{ CancelRequest.id } in
935 let json = Lsp_fmt.print_lsp
(NotificationMessage
notification) in
938 ShowMessageRequest.Absent
940 (** These functions are not currently used, but may be useful in the future. *)
941 let (_
: 'a
-> 'b
) = request_showMessage
943 and (_
: 'c
-> 'd
) = dismiss_showMessageRequest
945 (** Dismiss all diagnostics from a state,
946 both the error diagnostics in Main_loop and the hh_server_status
947 diagnostics in In_init and Lost_server. *)
948 let dismiss_diagnostics (state
: state
) : state
=
949 let dismiss_one ~isStatusFB uri
=
950 let params = { PublishDiagnostics.uri
; diagnostics
= []; isStatusFB
} in
951 let notification = PublishDiagnosticsNotification
params in
952 notification |> print_lsp_notification
|> to_stdout
954 let dismiss_status diagnostic
=
955 dismiss_one ~isStatusFB
:true diagnostic
.PublishDiagnostics.uri
959 let open In_init_env
in
960 Option.iter ienv
.hh_server_status_diagnostic ~f
:dismiss_status;
961 In_init
{ ienv
with hh_server_status_diagnostic
= None
}
964 UriSet.iter
(dismiss_one ~isStatusFB
:false) menv
.uris_with_diagnostics
;
965 Main_loop
{ menv
with uris_with_diagnostics
= UriSet.empty
}
966 | Lost_server lenv
->
968 Option.iter lenv
.hh_server_status_diagnostic ~f
:dismiss_status;
969 Lost_server
{ lenv
with hh_server_status_diagnostic
= None
}
970 | Pre_init
-> Pre_init
971 | Post_shutdown
-> Post_shutdown
973 (************************************************************************)
974 (* Conversions - ad-hoc ones written as needed them, not systematic *)
975 (************************************************************************)
977 let lsp_uri_to_path = Lsp_helpers.lsp_uri_to_path
979 let path_to_lsp_uri = Lsp_helpers.path_to_lsp_uri
981 let lsp_position_to_ide (position
: Lsp.position
) : Ide_api_types.position
=
982 { Ide_api_types.line
= position
.line
+ 1; column
= position
.character
+ 1 }
984 let lsp_file_position_to_hack (params : Lsp.TextDocumentPositionParams.t
) :
986 let open Lsp.TextDocumentPositionParams
in
987 let { Ide_api_types.line
; column
} = lsp_position_to_ide params.position
in
989 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
params.textDocument
991 (filename, line
, column
)
993 let rename_params_to_document_position (params : Lsp.Rename.params) :
994 Lsp.TextDocumentPositionParams.t
=
997 TextDocumentPositionParams.textDocument
= params.textDocument
;
998 position
= params.position
;
1001 let hack_pos_to_lsp_range ~
(equal
: 'a
-> 'a
-> bool) (pos
: 'a
Pos.pos
) :
1003 (* .hhconfig errors are Positions with a filename, but dummy start/end
1004 * positions. Handle that case - and Pos.none - specially, as the LSP
1005 * specification requires line and character >= 0, and VSCode silently
1006 * drops diagnostics that violate the spec in this way *)
1007 if Pos.equal_pos equal pos
(Pos.make_from
(Pos.filename pos
)) then
1008 { start
= { line
= 0; character
= 0 }; end_
= { line
= 0; character
= 0 } }
1010 let (line1
, col1
, line2
, col2
) = Pos.destruct_range pos
in
1012 start
= { line
= line1
- 1; character
= col1
- 1 };
1013 end_
= { line
= line2
- 1; character
= col2
- 1 };
1016 let hack_pos_to_lsp_location (pos
: Pos.absolute
) ~
(default_path
: string) :
1020 uri
= path_to_lsp_uri (Pos.filename pos
) ~default_path
;
1021 range
= hack_pos_to_lsp_range ~equal
:String.equal pos
;
1024 let ide_range_to_lsp (range
: Ide_api_types.range
) : Lsp.range
=
1028 Lsp.line
= range
.Ide_api_types.st
.Ide_api_types.line
- 1;
1029 character
= range
.Ide_api_types.st
.Ide_api_types.column
- 1;
1033 Lsp.line
= range
.Ide_api_types.ed
.Ide_api_types.line
- 1;
1034 character
= range
.Ide_api_types.ed
.Ide_api_types.column
- 1;
1038 let lsp_range_to_ide (range
: Lsp.range
) : Ide_api_types.range
=
1041 st
= lsp_position_to_ide range
.start
;
1042 ed
= lsp_position_to_ide range
.end_
;
1045 let hack_symbol_definition_to_lsp_construct_location
1046 (symbol
: string SymbolDefinition.t
) ~
(default_path
: string) :
1048 let open SymbolDefinition
in
1049 hack_pos_to_lsp_location symbol
.span ~default_path
1051 let hack_pos_definition_to_lsp_identifier_location
1052 (sid
: Pos.absolute
* string) ~
(default_path
: string) :
1053 Lsp.DefinitionLocation.t
=
1054 let (pos
, title
) = sid
in
1055 let location = hack_pos_to_lsp_location pos ~default_path
in
1056 Lsp.DefinitionLocation.{ location; title
= Some title
}
1058 let hack_symbol_definition_to_lsp_identifier_location
1059 (symbol
: string SymbolDefinition.t
) ~
(default_path
: string) :
1060 Lsp.DefinitionLocation.t
=
1061 let open SymbolDefinition
in
1062 let location = hack_pos_to_lsp_location symbol
.pos ~default_path
in
1063 Lsp.DefinitionLocation.
1066 title
= Some
(Utils.strip_ns symbol
.SymbolDefinition.full_name
);
1069 let hack_errors_to_lsp_diagnostic
1070 (filename : string) (errors
: Errors.finalized_error list
) :
1071 PublishDiagnostics.params =
1072 let open Lsp.Location
in
1073 let location_message (message : Pos.absolute
* string) :
1074 Lsp.Location.t
* string =
1075 let (pos
, message) = message in
1076 let { uri
; range
} = hack_pos_to_lsp_location pos ~default_path
:filename in
1077 ({ Location.uri
; range
}, Markdown_lite.render
message)
1079 let hack_error_to_lsp_diagnostic (error : Errors.finalized_error
) =
1081 User_error.to_list
error |> List.map ~f
:location_message
1083 let (first_message
, additional_messages
) =
1084 match all_messages with
1085 | hd
:: tl
-> (hd
, tl
)
1086 | [] -> failwith
"Expected at least one error in the error list"
1091 (* This is the file of the first message of the error which is supposed to correspond to [filename] *)
1097 let relatedInformation =
1099 |> List.map ~f
:(fun (location, message) ->
1101 PublishDiagnostics.relatedLocation
= location;
1102 relatedMessage
= message;
1107 match get_severity
error with
1108 | Error
-> Some
PublishDiagnostics.Error
1109 | Warning
-> Some
PublishDiagnostics.Warning
)
1112 Lsp.PublishDiagnostics.range
;
1114 code
= PublishDiagnostics.IntCode
(User_error.get_code
error);
1115 source
= Some
"Hack";
1118 relatedLocations
= relatedInformation (* legacy FB extension *);
1121 (* The caller is required to give us a non-empty filename. If it is empty,
1122 the following path_to_lsp_uri will fall back to the default path - which
1123 is also empty - and throw, logging appropriate telemetry. *)
1125 Lsp.PublishDiagnostics.uri
= path_to_lsp_uri filename ~default_path
:"";
1127 diagnostics
= List.map errors ~f
:hack_error_to_lsp_diagnostic;
1130 let get_document_contents
1131 (editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
) (uri
: documentUri
) :
1133 match UriMap.find_opt uri editor_open_files
with
1134 | Some document
-> Some document
.TextDocumentItem.text
1137 let get_document_location
1138 (editor_open_files
: Lsp.TextDocumentItem.t
UriMap.t
)
1139 (params : Lsp.TextDocumentPositionParams.t
) :
1140 ClientIdeMessage.document_location
=
1141 let (file_path
, line
, column
) = lsp_file_position_to_hack params in
1143 params.TextDocumentPositionParams.textDocument
.TextDocumentIdentifier.uri
1145 let file_path = Path.make
file_path in
1146 let file_contents = get_document_contents editor_open_files
uri in
1147 { ClientIdeMessage.file_path; file_contents; line
; column
}
1149 (************************************************************************)
1150 (* Connection and rpc *)
1151 (************************************************************************)
1153 let start_server ~
(env
: env
) (root
: Path.t
) : unit =
1154 (* This basically does "hh_client start": a single attempt to open the *)
1155 (* socket, send+read version and compare for mismatch, send handoff and *)
1156 (* read response. It will print information to stderr. If the server is in *)
1157 (* an unresponsive or invalid state then it will kill the server. Next if *)
1158 (* necessary it tries to spawn the server and wait until the monitor is *)
1159 (* responsive enough to print "ready". It will do a hard program exit if *)
1160 (* there were spawn problems. *)
1166 watchman_debug_logging
= false;
1167 log_inference_constraints
= false;
1170 exit_on_failure
= false;
1171 ignore_hh_version
= false;
1172 saved_state_ignore_hhconfig
= false;
1175 save_human_readable_64bit_dep_map
= None
;
1177 config
= env
.args
.config
;
1178 custom_hhi_path
= None
;
1179 custom_telemetry_data
= [];
1180 allow_non_opt_build
= false;
1183 let _exit_status = ClientStart.main
env_start in
1186 let rec connect_client ~
(env
: env
) (root
: Path.t
) ~
(autostart
: bool) :
1188 log "connect_client";
1189 (* This basically does the same connection attempt as "hh_client check":
1190 * it makes repeated attempts to connect; it prints useful messages to
1191 * stderr; in case of failure it will raise an exception. Below we're
1192 * catching the main exceptions so we can give a good user-facing error
1193 * text. For other exceptions, they'll end up showing to the user just
1194 * "internal error" with the error code. *)
1200 local_config
= get_local_config_exn ();
1201 force_dormant_start
= false;
1202 watchman_debug_logging
= false;
1203 (* If you want this, start the server manually in terminal. *)
1204 deadline
= Some
(Unix.time
() +. 3.);
1205 (* limit to 3 seconds *)
1207 (* only relevant when autostart=true *)
1208 log_inference_constraints
= false;
1210 log_on_slow_monitor_connect
= false;
1211 (* Only used when running hh from terminal *)
1215 (* only relevant when autostart=true *)
1216 progress_callback
= None
;
1218 do_post_handoff_handshake
= false;
1219 ignore_hh_version
= false;
1220 saved_state_ignore_hhconfig
= false;
1223 save_human_readable_64bit_dep_map
= None
;
1224 (* priority_pipe delivers good experience for hh_server, but has a bug,
1225 and doesn't provide benefits in serverless-ide. *)
1226 use_priority_pipe
= not env
.use_serverless_ide
;
1228 config
= env
.args
.config
;
1229 custom_hhi_path
= None
;
1230 custom_telemetry_data
= [];
1231 allow_non_opt_build
= false;
1235 let%lwt
ClientConnect.{ channels
= (ic
, oc
); server_specific_files
; _
} =
1236 ClientConnect.connect
env_connect
1238 can_autostart_after_mismatch := false;
1239 let pending_messages = Queue.create
() in
1240 Lwt.return
{ ic
; oc
; pending_messages; server_specific_files
}
1242 | Exit_status.Exit_with
Exit_status.Build_id_mismatch
1243 when !can_autostart_after_mismatch ->
1244 (* Raised when the server was running an old version. We'll retry once. *)
1245 log "connect_client: build_id_mismatch";
1246 can_autostart_after_mismatch := false;
1247 connect_client ~env root ~autostart
:true
1249 (** Either connect to the monitor and leave in an
1250 In_init state waiting for the server hello, or fail to connect and
1251 leave in a Lost_server state. You might call this from Pre_init or
1252 Lost_server states, obviously. But you can also call it from In_init state
1253 if you want to give up on the prior attempt at connection and try again. *)
1254 let rec connect ~
(env
: env
) (state
: state
) : state
Lwt.t
=
1257 | In_init
{ In_init_env.conn
; _
} ->
1260 Timeout.shutdown_connection conn
.ic
;
1261 Timeout.close_in_noerr conn
.ic
1268 | _
-> failwith
"connect only in Pre_init, In_init or Lost_server state"
1271 let%lwt conn
= connect_client ~env
(get_root_exn ()) ~autostart
:false in
1272 set_hh_server_state Hh_server_initializing
;
1277 { ienv
with In_init_env.conn
; most_recent_start_time
= Unix.time
() })
1279 let state = dismiss_diagnostics state in
1284 first_start_time
= Unix.time
();
1285 most_recent_start_time
= Unix.time
();
1286 most_recent_file
= get_most_recent_file state;
1288 Option.value (get_editor_open_files state) ~default
:UriMap.empty
;
1289 (* uris_with_unsaved_changes should always be empty here: *)
1290 (* Pre_init will of course be empty; *)
1291 (* Lost_server will exit rather than reconnect with unsaved changes. *)
1292 uris_with_unsaved_changes
= get_uris_with_unsaved_changes state;
1293 hh_server_status_diagnostic
= None
;
1297 let exn = Exception.wrap
exn in
1298 (* Exit_with Out_of_retries, Exit_with Out_of_time: raised when we *)
1299 (* couldn't complete the handshake up to handoff within 3 attempts over *)
1300 (* 3 seconds. Maybe the informant is stopping anything from happening *)
1301 (* until a rebase has settled? *)
1302 (* Exit_with No_server_running: raised when (1) the server's simply not *)
1303 (* running, or there's some other reason why the connection was refused *)
1304 (* or timed-out and no lockfile is present; (2) the server was dormant *)
1305 (* and had already received too many pending connection requests; *)
1306 (* (3) server failed to load saved-state but was required to do so. *)
1307 (* Exit_with Monitor_connection_failure: raised when the lockfile is *)
1308 (* present but connection-attempt to the monitor times out - maybe it's *)
1309 (* under DDOS, or maybe it's declining to answer new connections. *)
1311 match Exception.unwrap
exn with
1312 | Exit_status.Exit_with code
-> Exit_status.show code
1313 | _
-> Exception.get_ctor_string
exn
1317 "connect failed: %s\n%s"
1319 (Exception.get_backtrace_string
exn |> Exception.clean_stack
)
1321 let () = Lsp_helpers.telemetry_error
to_stdout longMessage in
1322 let open Exit_status
in
1323 let new_hh_server_state =
1324 match Exception.unwrap
exn with
1325 | Exit_with Build_id_mismatch
1326 | Exit_with No_server_running_should_retry
1327 | Exit_with Server_hung_up_should_retry
1328 | Exit_with Server_hung_up_should_abort
->
1330 | Exit_with Out_of_retries
1331 | Exit_with Out_of_time
->
1332 Hh_server_denying_connection
1333 | _
-> Hh_server_unknown
1336 match Exception.unwrap
exn with
1337 | Exit_with Out_of_retries
1338 | Exit_with Out_of_time
->
1339 "hh_server is waiting for things to settle"
1340 | Exit_with No_server_running_should_retry
-> "hh_server: stopped."
1341 | _
-> "hh_server: " ^
message
1346 ~allow_immediate_reconnect
:false
1349 Lost_env.explanation;
1350 new_hh_server_state;
1351 start_on_click
= true;
1352 trigger_on_lock_file
= true;
1353 trigger_on_lsp
= false;
1358 and reconnect_from_lost_if_necessary
1359 ~
(env
: env
) (state : state) (reason
: [> `Event
of event
| `Force_regain
])
1362 let should_reconnect =
1363 match (state, reason
) with
1364 | (Lost_server _
, `Force_regain
) -> true
1365 | ( Lost_server
{ p
= { trigger_on_lsp
= true; _
}; _
},
1366 `Event
(Client_message
(_
, RequestMessage _
)) ) ->
1368 | ( Lost_server
{ p
= { trigger_on_lock_file
= true; _
}; lock_file
; _
},
1370 MonitorConnection.server_exists lock_file
1373 if should_reconnect then
1374 let%lwt current_version_and_switch
=
1375 read_hhconfig_version_and_switch ()
1377 let needs_to_terminate =
1379 (String.equal
!hhconfig_version_and_switch current_version_and_switch
)
1381 if needs_to_terminate then (
1382 (* In these cases we have to terminate our LSP server, and trust the *)
1383 (* client to restart us. Note that we can't do clientStart because that *)
1384 (* would start our (old) version of hh_server, not the new one! *)
1385 let unsaved = get_uris_with_unsaved_changes state |> UriSet.elements
in
1387 if List.is_empty
unsaved then
1390 unsaved |> List.map ~f
:string_of_uri
|> String.concat ~sep
:"\n"
1395 ^
"\nVersion in hhconfig and switch that spawned the current hh_client: "
1396 ^
!hhconfig_version_and_switch
1397 ^
"\nVersion in hhconfig and switch currently: "
1398 ^ current_version_and_switch
1401 Lsp_helpers.telemetry_log
to_stdout message;
1404 let%lwt
state = connect ~env
state in
1409 (* do_lost_server: handles the various ways we might lose hh_server. We keep *)
1410 (* the LSP server alive, and will (elsewhere) listen for the various triggers *)
1411 (* of getting the server back. *)
1415 ?
(allow_immediate_reconnect
= true)
1416 (p
: Lost_env.params) : state Lwt.t
=
1418 set_hh_server_state p
.new_hh_server_state;
1420 let state = dismiss_diagnostics state in
1421 let uris_with_unsaved_changes = get_uris_with_unsaved_changes state in
1422 let most_recent_file = get_most_recent_file state in
1423 let editor_open_files =
1424 Option.value (get_editor_open_files state) ~default
:UriMap.empty
1426 let lock_file = ServerFiles.lock_file (get_root_exn ()) in
1427 let reconnect_immediately =
1428 allow_immediate_reconnect
1429 && p
.trigger_on_lock_file
1430 && MonitorConnection.server_exists
lock_file
1432 if reconnect_immediately then (
1439 uris_with_unsaved_changes;
1441 hh_server_status_diagnostic
= None
;
1444 Lsp_helpers.telemetry_log
1446 "Reconnecting immediately to hh_server";
1448 reconnect_from_lost_if_necessary ~env
lost_state `Force_regain
1450 Lwt.return new_state
1458 uris_with_unsaved_changes;
1460 hh_server_status_diagnostic
= None
;
1463 let report_connect_end (ienv
: In_init_env.t
) : state =
1464 log "report_connect_end";
1466 let _state = dismiss_diagnostics (In_init ienv
) in
1469 Main_env.conn
= ienv
.In_init_env.conn
;
1471 most_recent_file = ienv
.most_recent_file;
1472 editor_open_files = ienv
.editor_open_files;
1473 uris_with_diagnostics
= UriSet.empty
;
1474 uris_with_unsaved_changes = ienv
.In_init_env.uris_with_unsaved_changes;
1477 ShowStatusFB.request =
1479 ShowMessageRequest.type_
= MessageType.InfoMessage
;
1480 message = "hh_server: ready.";
1485 shortMessage
= None
;
1492 let announce_ide_failure (error_data
: ClientIdeMessage.stopped_reason
) :
1494 let open ClientIdeMessage
in
1496 "IDE services could not be initialized.\n%s\n%s"
1497 error_data
.long_user_message
1498 error_data
.debug_details
;
1503 error_data
.long_user_message
1504 error_data
.debug_details
1506 let%lwt upload_result
=
1507 Clowder_paste.clowder_upload_and_get_url ~timeout
:10. input
1510 match upload_result
with
1511 | Ok url
-> Printf.sprintf
"\nMore details: %s" url
1514 "\n\nMore details:\n%s\n\nTried to upload those details but it didn't work...\n%s"
1515 error_data
.debug_details
1518 Lsp_helpers.log_error to_stdout (error_data
.long_user_message ^
append_to_log);
1519 if error_data
.is_actionable
then
1520 Lsp_helpers.showMessage_error
1522 (error_data
.medium_user_message ^
see_output_hack);
1525 (** Like all async methods, this method has a synchronous preamble up
1526 to its first await point, at which point it returns a promise to its
1527 caller; the rest of the method will be scheduled asynchronously.
1528 The synchronous preamble sends an "initialize" request to the ide_service.
1529 The asynchronous continuation is triggered when the response comes back;
1530 it then pumps messages to and from the ide service.
1531 Note: the fact that the request is sent in the synchronous preamble, is
1532 important for correctness - the rest of the codebase can send other requests
1533 to the ide_service at any time, safe in the knowledge that such requests will
1534 necessarily be delivered after the initialize request. *)
1537 (ide_service
: ClientIdeService.t
)
1538 (initialize_params : Lsp.Initialize.params)
1539 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
option) : unit Lwt.t
=
1540 let open Lsp.Initialize
in
1541 let root = Some
(Lsp_helpers.get_root
initialize_params) |> Wwwroot.get
in
1544 initialize_params.client_capabilities
.workspace
.didChangeWatchedFiles
1545 .dynamicRegistration
1547 log_error "client doesn't support file-watching";
1549 let naming_table_load_info =
1550 match initialize_params.initializationOptions
.namingTableSavedStatePath
with
1555 ClientIdeMessage.Initialize_from_saved_state.path = Path.make
path;
1557 initialize_params.initializationOptions
1558 .namingTableSavedStateTestDelay
;
1563 |> Option.value ~default
:UriMap.empty
1565 |> List.map ~f
:(fun uri -> uri |> lsp_uri_to_path |> Path.make
)
1567 log_debug "initialize_from_saved_state";
1569 ClientIdeService.initialize_from_saved_state
1572 ~
naming_table_load_info
1573 ~use_ranked_autocomplete
:env
.use_ranked_autocomplete
1574 ~config
:env
.args
.config
1577 log_debug "initialize_from_saved_state.done";
1580 let%lwt
() = ClientIdeService.serve ide_service
in
1582 | Error error_data
->
1583 let%lwt
() = announce_ide_failure error_data
in
1586 let stop_ide_service
1587 (ide_service
: ClientIdeService.t
)
1588 ~
(tracking_id : string)
1589 ~
(stop_reason
: ClientIdeService.Stop_reason.t
) : unit Lwt.t
=
1591 "Stopping IDE service process: %s"
1592 (ClientIdeService.Stop_reason.to_log_string stop_reason
);
1594 ClientIdeService.stop ide_service ~
tracking_id ~stop_reason ~
exn:None
1598 let on_status_restart_action
1600 ~
(ide_service
: ClientIdeService.t
ref option)
1601 (result : ShowStatusFB.result)
1602 (state : state) : state Lwt.t
=
1603 let open ShowMessageRequest
in
1604 match (result, state, ide_service
) with
1605 | (Some
{ title
}, Lost_server _
, _
)
1606 when String.equal title
hh_server_restart_button_text ->
1607 let root = get_root_exn () in
1608 (* Belt-and-braces kill the server. This is in case the server was *)
1609 (* stuck in some weird state. It's also what 'hh restart' does. *)
1610 if MonitorConnection.server_exists
(Path.to_string
root) then
1611 ClientStop.kill_server
root !from;
1613 (* After that it's safe to try to reconnect! *)
1614 start_server ~env
root;
1615 let%lwt
state = reconnect_from_lost_if_necessary ~env
state `Force_regain
in
1617 | (Some
{ title
}, _
, Some ide_service
)
1618 when String.equal title
client_ide_restart_button_text ->
1619 log "Restarting IDE service";
1621 (* It's possible that [destroy] takes a while to finish, so make
1622 sure to assign the new IDE service to the [ref] before attempting
1623 to do an asynchronous operation with the old one. *)
1626 ClientIdeMessage.init_id
= env
.init_id
;
1627 verbose_to_stderr
= env
.args
.verbose
;
1628 verbose_to_file = !verbose_to_file;
1631 let new_ide_service = ClientIdeService.make
ide_args in
1632 let old_ide_service = !ide_service
in
1633 ide_service
:= new_ide_service;
1634 (* Note: the env.verbose passed on init controls verbosity for stderr
1635 and is only ever controlled by --verbose command line, stored in env.
1636 But verbosity-to-file can be altered dynamically by the user. *)
1637 let (promise
: unit Lwt.t
) =
1641 (initialize_params_exc ())
1642 (get_editor_open_files state)
1644 ignore_promise_but_handle_failure
1646 ~desc
:"run-ide-after-restart"
1647 ~terminate_on_failure
:true;
1648 (* Invariant: at all times after InitializeRequest, ide_service has
1649 already been sent an "initialize" message. *)
1653 ~
tracking_id:"restart"
1654 ~stop_reason
:ClientIdeService.Stop_reason.Restarting
1657 | _
-> Lwt.return
state
1659 let get_client_ide_status (ide_service
: ClientIdeService.t
) :
1660 ShowStatusFB.params option =
1661 let (type_
, shortMessage
, message, actions, telemetry
) =
1662 match ClientIdeService.get_status ide_service
with
1663 | ClientIdeService.Status.Initializing
->
1664 ( MessageType.WarningMessage
,
1665 "Hack: initializing",
1666 "Hack IDE: initializing.",
1669 | ClientIdeService.Status.Processing_files p
->
1670 let open ClientIdeMessage.Processing_files
in
1671 ( MessageType.WarningMessage
,
1673 Printf.sprintf
"Hack IDE: processing %d files." p
.total
,
1676 | ClientIdeService.Status.Rpc requests
->
1678 Hh_json.JSON_Array
(List.map requests ~f
:Telemetry.to_json
)
1680 ( MessageType.WarningMessage
,
1682 "Hack IDE: working...",
1685 | ClientIdeService.Status.Ready
->
1686 (MessageType.InfoMessage
, "Hack: ready", "Hack IDE: ready.", [], None
)
1687 | ClientIdeService.Status.Stopped
s ->
1688 let open ClientIdeMessage
in
1689 ( MessageType.ErrorMessage
,
1690 "Hack: " ^
s.short_user_message
,
1691 s.medium_user_message ^
see_output_hack,
1692 [{ ShowMessageRequest.title
= client_ide_restart_button_text }],
1697 ShowStatusFB.shortMessage
= Some shortMessage
;
1698 request = { ShowMessageRequest.type_
; message; actions };
1704 (** This function blocks while it attempts to connect to the monitor to read status.
1705 It normally it gets status quickly, but has a 3s timeout just in case. *)
1706 let get_hh_server_status (state : state) : ShowStatusFB.params option =
1707 let open ShowStatusFB
in
1708 let open ShowMessageRequest
in
1714 let open In_init_env
in
1715 let time = Unix.time () in
1717 if Sys_utils.deterministic_behavior_for_tests
() then
1718 (* we avoid raciness in our tests by not showing a real time *)
1721 int_of_float
(time -. ienv
.first_start_time
) |> string_of_int
1723 (* TODO: better to report time that hh_server has spent initializing *)
1724 let (progress
, warning
) =
1725 let open ServerCommandTypes
in
1727 | In_init
{ In_init_env.conn
; _
}
1728 | Main_loop
{ Main_env.conn
; _
} ->
1729 let server_progress_file =
1730 conn
.server_specific_files
.ServerCommandTypes.server_progress_file
1732 let server_progress =
1733 ServerCommandTypesUtils.read_progress_file ~
server_progress_file
1735 (server_progress.server_progress, server_progress.server_warning
)
1736 | _
-> ("connecting", None
)
1738 (* [progress] comes from ServerProgress.ml, sent to the monitor, and now we've fetched
1739 it from the monitor. It's a string "op X/Y units (%)" e.g. "typechecking 5/16 files (78%)",
1740 or "connecting", if there is no relevant progress to show.
1741 [warning] comes from the same place, and if pressent is a human-readable string
1742 that warns about saved-state-init failure. *)
1744 if Option.is_some
warning then
1745 " (saved-state not found - will take a while)"
1751 "hh_server initializing%s: %s [%s seconds]"
1758 request = { type_
= MessageType.WarningMessage
; message; actions = [] };
1761 shortMessage
= Some
"Hack: initializing";
1764 | Main_loop
{ Main_env.hh_server_status
; _
} ->
1765 (* This shows whether the connected hh_server is busy or ready.
1766 It's produced in clientLsp.do_server_busy upon receipt of a status
1767 enum from the server. See comments on hh_server_status for invariants. *)
1768 Some hh_server_status
1769 | Lost_server
{ Lost_env.p
; _
} ->
1772 shortMessage
= Some
"Hack: stopped";
1775 type_
= MessageType.ErrorMessage
;
1776 message = p
.Lost_env.explanation;
1777 actions = [{ title
= hh_server_restart_button_text }];
1784 (** Makes a diagnostic messages for cases where the server status is not fully running. *)
1785 let hh_server_status_to_diagnostic
1786 (uri : documentUri
option) (hh_server_status
: ShowStatusFB.params) :
1787 PublishDiagnostics.params option =
1788 let open ShowStatusFB
in
1789 let open ShowMessageRequest
in
1790 let open PublishDiagnostics
in
1793 PublishDiagnostics.range
=
1795 start
= { line
= 0; character
= 0 };
1796 end_
= { line
= 0; character
= 1 };
1800 source
= Some
"hh_server";
1802 relatedInformation = [];
1803 relatedLocations
= [];
1806 match (uri, hh_server_status
.request.type_
) with
1808 | (_
, (MessageType.InfoMessage
| MessageType.LogMessage
)) ->
1810 | (Some
uri, MessageType.ErrorMessage
) ->
1820 "hh_server isn't running, so there may be undetected errors. Try `hh` at the command line... "
1821 ^ hh_server_status
.request.message;
1822 severity = Some Error
;
1826 | (Some
uri, MessageType.WarningMessage
) ->
1836 "hh_server isn't yet ready, so there may be undetected errors... "
1837 ^ hh_server_status
.request.message;
1838 severity = Some Warning
;
1843 (** Manage the state of which diagnostics have been shown to the user
1844 about hh_server status: removes the old one if necessary, and adds a new one
1845 if necessary. Note that we only display hh_server_status diagnostics
1846 during In_init and Lost_server states, neither of which have diagnostics
1848 let publish_hh_server_status_diagnostic
1849 (state : state) (hh_server_status
: ShowStatusFB.params option) : state =
1851 match (get_most_recent_file state, get_editor_open_files state) with
1852 | (Some
uri, Some
open_files) when UriMap.mem
uri open_files -> Some
uri
1853 | (_
, Some
open_files) when not
(UriMap.is_empty
open_files) ->
1854 Some
(UriMap.choose
open_files |> fst
)
1857 let desired_diagnostic =
1858 Option.bind hh_server_status ~f
:(hh_server_status_to_diagnostic uri)
1860 let get_existing_diagnostic state =
1862 | In_init ienv
-> ienv
.In_init_env.hh_server_status_diagnostic
1863 | Lost_server lenv
-> lenv
.Lost_env.hh_server_status_diagnostic
1866 let publish_and_update_diagnostic state diagnostic =
1867 let notification = PublishDiagnosticsNotification
diagnostic in
1868 notification |> print_lsp_notification
|> to_stdout;
1872 { ienv
with In_init_env.hh_server_status_diagnostic
= Some
diagnostic }
1873 | Lost_server lenv
->
1875 { lenv
with Lost_env.hh_server_status_diagnostic
= Some
diagnostic }
1878 let open PublishDiagnostics
in
1879 (* The following match emboodies these rules:
1880 (1) we only publish hh_server_status diagnostics in In_init and Lost_server states,
1881 (2) we'll remove the old PublishDiagnostic if necessary and add a new one if necessary
1882 (3) to avoid extra LSP messages, if the diagnostic hasn't changed then we won't send anything
1883 (4) to avoid flicker, if the diagnostic has changed but is still in the same file, then
1884 we refrain from sending an "erase old" message and it will be implied by sending "new". *)
1885 match (get_existing_diagnostic state, desired_diagnostic, state) with
1886 | (_
, _
, Main_loop _
)
1888 | (_
, _
, Post_shutdown
)
1889 | (None
, None
, _
) ->
1891 | (Some _
, None
, _
) -> dismiss_diagnostics state
1892 | (Some existing
, Some desired
, _
)
1893 when Lsp.equal_documentUri existing
.uri desired
.uri
1895 PublishDiagnostics.equal_diagnostic
1896 (List.hd existing
.diagnostics
)
1897 (List.hd desired
.diagnostics
) ->
1899 | (Some existing
, Some desired
, _
)
1900 when Lsp.equal_documentUri existing
.uri desired
.uri ->
1901 publish_and_update_diagnostic state desired
1902 | (Some _
, Some desired
, _
) ->
1903 let state = dismiss_diagnostics state in
1904 publish_and_update_diagnostic state desired
1905 | (None
, Some desired
, _
) -> publish_and_update_diagnostic state desired
1907 (** Here are the rules for merging status. They embody the principle that the spinner
1908 shows if initializing/typechecking is in progress, the error icon shows if error,
1909 and the status bar word is "Hack" if IDE services are available or "Hack: xyz" if not.
1910 Note that if Hack IDE is up but hh_server is down, then the hh_server failure message
1911 is conveyed via a publishDiagnostic; it's not conveyed via status.
1912 [ok] Hack -- if ide_service is up and hh_server is ready
1913 [spin] Hack -- if ide_service is processing-files or hh_server is initializing/typechecking
1914 [spin] Hack: initializing -- if ide_service is initializing
1915 [err] Hack: failure -- if ide_service is down
1916 If client_ide_service isn't enabled, then we show thing differently:
1917 [ok] Hack -- if hh_server is ready (Main_loop)
1918 [spin] Hack -- if hh_server is doing local or global typechecks (Main_loop)
1919 [spin] Hack: busy -- if hh_server is doing non-interruptible typechecks (Main_loop)
1920 [spin] Hack: initializing -- if hh_server is initializing (In_init)
1921 [err] hh_server: stopped -- hh_server is down (Lost_server)
1922 As for the tooltip and actions, they are combined from both ide_service and hh_server. *)
1924 ~
(client_ide_status
: ShowStatusFB.params option)
1925 ~
(hh_server_status
: ShowStatusFB.params option) :
1926 ShowStatusFB.params option =
1927 (* The correctness of the following match is a bit subtle. This is how to think of it.
1928 From the spec in the docblock, (1) if there's no client_ide_service, then the result
1929 of this function is simply the same as hh_server_status, since that's how it was constructed
1930 by get_hh_server_status (for In_init and Lost_server) and do_server_busy; (2) if there
1931 is a client_ide_service then the result is almost always simply the same as ide_service
1932 since that's how it was constructed by get_client_ide_status; (3) the only exception to
1933 rule 2 is that, if client_ide_status would have shown "[ok] Hack" and hh_server_status
1934 would have been a spinner, then we change to "[spin] Hack". *)
1935 match (client_ide_status
, hh_server_status
) with
1936 | (None
, None
) -> None
1937 | (None
, Some _
) -> hh_server_status
1938 | (Some _
, None
) -> client_ide_status
1939 | (Some client_ide_status
, Some hh_server_status
) ->
1940 let open Lsp.ShowStatusFB
in
1941 let open Lsp.ShowMessageRequest
in
1944 client_ide_status
.request with
1946 client_ide_status
.request.message
1948 ^ hh_server_status
.request.message;
1950 client_ide_status
.request.actions @ hh_server_status
.request.actions;
1954 MessageType.equal client_ide_status
.request.type_
MessageType.InfoMessage
1955 && MessageType.equal
1956 hh_server_status
.request.type_
1957 MessageType.WarningMessage
1959 let request = { request with type_
= MessageType.WarningMessage
} in
1960 Some
{ client_ide_status
with request; shortMessage
= Some
"Hack" }
1962 Some
{ client_ide_status
with request }
1964 let refresh_status ~
(env
: env
) ~
(ide_service
: ClientIdeService.t
ref option) :
1966 let client_ide_status =
1967 match ide_service
with
1969 | Some ide_service
-> get_client_ide_status !ide_service
1972 merge_statuses ~hh_server_status
:!latest_hh_server_status ~
client_ide_status
1977 (request_showStatusFB
1978 ~on_result
:(on_status_restart_action ~env ~ide_service
));
1981 let rpc_lock = Lwt_mutex.create
()
1984 (server_conn
: server_conn
)
1985 (ref_unblocked_time
: float ref)
1987 (command
: 'a
ServerCommandTypes.t
) : 'a
Lwt.t
=
1989 Lwt_mutex.with_lock
rpc_lock (fun () ->
1990 let callback () push
=
1991 update_hh_server_state_if_necessary
1992 (Server_message
{ push
; has_updated_server_state
= false });
1994 server_conn
.pending_messages
1995 { push
; has_updated_server_state
= true }
1997 let start_time = Unix.gettimeofday
() in
1999 ServerCommandLwt.rpc_persistent
2000 (server_conn
.ic
, server_conn
.oc
)
2006 let end_time = Unix.gettimeofday
() in
2007 let duration = end_time -. start_time in
2008 let msg = ServerCommandTypesUtils.debug_describe_t command
in
2009 log_debug "hh_server rpc: [%s] [%0.3f]" msg duration;
2011 | Ok
((), res
, tracker
) ->
2013 (Connection_tracker.get_server_unblocked_time tracker
)
2014 ~f
:(fun t
-> ref_unblocked_time
:= t
);
2019 ServerCommandLwt.Remote_fatal_exception remote_e_data
) ->
2020 raise
(Server_fatal_connection_exception remote_e_data
)
2024 ServerCommandLwt.Remote_nonfatal_exception
2025 { Marshal_tools.message; stack } ) ->
2026 raise
(Server_nonfatal_exception
(make_lsp_error message ~
stack))
2027 | Error
((), Utils.Callstack
stack, e) ->
2028 let message = Exn.to_string
e in
2030 (Server_fatal_connection_exception
{ Marshal_tools.message; stack }))
2034 let rpc_with_retry server_conn ref_unblocked_time ~desc command
=
2035 ServerCommandTypes.Done_or_retry.call ~f
:(fun () ->
2036 rpc server_conn ref_unblocked_time ~desc command
)
2038 (** A thin wrapper around ClientIdeMessage which turns errors into exceptions *)
2040 (ide_service
: ClientIdeService.t
ref)
2042 ~
(tracking_id : string)
2043 ~
(ref_unblocked_time
: float ref)
2044 (message : 'a
ClientIdeMessage.t
) : 'a
Lwt.t
=
2045 let progress () = refresh_status ~env ~ide_service
:(Some ide_service
) in
2047 ClientIdeService.rpc
2055 | Ok
result -> Lwt.return
result
2056 | Error error_data
-> raise
(Server_nonfatal_exception error_data
)
2058 (************************************************************************)
2060 (************************************************************************)
2064 (ide_service
: ClientIdeService.t
ref option)
2065 (tracking_id : string)
2066 (ref_unblocked_time
: float ref) : state Lwt.t
=
2067 log "Received shutdown request";
2068 let state = dismiss_diagnostics state in
2072 (* In Main_loop state, we're expected to unsubscribe diagnostics and tell *)
2073 (* server to disconnect so it can revert the state of its unsaved files. *)
2080 ServerCommandTypes.DISCONNECT
2084 (* In In_init state, even though we have a 'conn', it's still waiting for *)
2085 (* the server to become responsive, so there's no use sending any rpc *)
2086 (* messages to the server over it. *)
2089 (* No other states have a 'conn' to send any disconnect messages over. *)
2092 match ide_service
with
2093 | None
-> Lwt.return_unit
2094 | Some ide_service
->
2098 ~stop_reason
:ClientIdeService.Stop_reason.Editor_exited
2100 Lwt.return Post_shutdown
2102 let state_to_rage (state : state) : string =
2103 let uris_to_string uris
=
2104 List.map uris ~f
:(fun (DocumentUri
uri) -> uri) |> String.concat ~sep
:","
2109 | Post_shutdown
-> ""
2111 let open Main_env
in
2114 ^^
"editor_open_files: %s\n"
2115 ^^
"uris_with_diagnostics: %s\n"
2116 ^^
"uris_with_unsaved_changes: %s\n"
2117 ^^
"hh_server_status.message: %s\n"
2118 ^^
"hh_server_status.shortMessage: %s\n")
2120 (menv.editor_open_files |> UriMap.keys
|> uris_to_string)
2121 (menv.uris_with_diagnostics
|> UriSet.elements
|> uris_to_string)
2122 (menv.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2123 menv.hh_server_status
.ShowStatusFB.request.ShowMessageRequest.message
2125 menv.hh_server_status
.ShowStatusFB.shortMessage
2126 ~default
:"[absent]")
2128 let open In_init_env
in
2130 ("first_start_time: %f\n"
2131 ^^
"most_recent_sstart_time: %f\n"
2132 ^^
"editor_open_files: %s\n"
2133 ^^
"uris_with_unsaved_changes: %s\n")
2134 ienv
.first_start_time
2135 ienv
.most_recent_start_time
2136 (ienv
.editor_open_files |> UriMap.keys
|> uris_to_string)
2137 (ienv
.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2138 | Lost_server lenv
->
2139 let open Lost_env
in
2141 ("editor_open_files: %s\n"
2142 ^^
"uris_with_unsaved_changes: %s\n"
2143 ^^
"lock_file: %s\n"
2144 ^^
"explanation: %s\n"
2145 ^^
"new_hh_server_state: %s\n"
2146 ^^
"start_on_click: %b\n"
2147 ^^
"trigger_on_lsp: %b\n"
2148 ^^
"trigger_on_lock_file: %b\n")
2149 (lenv
.editor_open_files |> UriMap.keys
|> uris_to_string)
2150 (lenv
.uris_with_unsaved_changes |> UriSet.elements
|> uris_to_string)
2153 (lenv
.p
.new_hh_server_state |> hh_server_state_to_string)
2154 lenv
.p
.start_on_click
2155 lenv
.p
.trigger_on_lsp
2156 lenv
.p
.trigger_on_lock_file
2158 Printf.sprintf
"clientLsp state: %s\n%s\n" (state_to_string state) details
2160 let do_rageFB (state : state) : RageFB.result Lwt.t
=
2161 (* clientLsp status *)
2162 let tnow = Unix.gettimeofday
() in
2163 let server_state_to_string (tstate
, state) =
2164 let tdiff = tnow -. tstate
in
2165 let state = hh_server_state_to_string state in
2166 let tm = Unix.localtime tstate
in
2167 let ms = int_of_float
(tstate
*. 1000.) mod 1000 in
2169 "[%02d:%02d:%02d.%03d] [%03.3fs ago] %s"
2178 !hh_server_state_log
2179 |> List.sort ~compare
:(fun (t1
, _
) (t2
, _
) -> Float.compare t1 t2
)
2180 |> List.map ~f
:server_state_to_string
2181 |> String.concat ~sep
:"\n"
2183 let%lwt current_version_and_switch
= read_hhconfig_version_and_switch () in
2189 ^^
"version previously read from .hhconfig and switch: %s\n"
2190 ^^
"version in .hhconfig and switch: %s\n\n"
2191 ^^
"clientLsp belief of hh_server_state:\n%s\n")
2192 (state_to_rage state)
2193 !hhconfig_version_and_switch
2194 current_version_and_switch
2197 Lwt.return
[{ RageFB.title
= None
; data }]
2200 (conn
: server_conn
)
2201 (ref_unblocked_time
: float ref)
2202 (params : DidOpen.params) : unit Lwt.t
=
2204 let open TextDocumentItem
in
2205 let filename = lsp_uri_to_path params.textDocument
.uri in
2206 let text = params.textDocument
.text in
2207 let command = ServerCommandTypes.OPEN_FILE
(filename, text) in
2208 rpc conn ref_unblocked_time ~desc
:"open" command
2211 (conn
: server_conn
)
2212 (ref_unblocked_time
: float ref)
2213 (params : DidClose.params) : unit Lwt.t
=
2214 let open DidClose
in
2215 let open TextDocumentIdentifier
in
2216 let filename = lsp_uri_to_path params.textDocument
.uri in
2217 let command = ServerCommandTypes.CLOSE_FILE
filename in
2218 rpc conn ref_unblocked_time ~desc
:"close" command
2221 (conn
: server_conn
)
2222 (ref_unblocked_time
: float ref)
2223 (params : DidChange.params) : unit Lwt.t
=
2224 let open VersionedTextDocumentIdentifier
in
2225 let open Lsp.DidChange
in
2226 let lsp_change_to_ide (lsp
: DidChange.textDocumentContentChangeEvent
) :
2227 Ide_api_types.text_edit
=
2229 Ide_api_types.range
= Option.map lsp
.range ~f
:lsp_range_to_ide;
2233 let filename = lsp_uri_to_path params.textDocument
.uri in
2234 let changes = List.map
params.contentChanges ~f
:lsp_change_to_ide in
2235 let command = ServerCommandTypes.EDIT_FILE
(filename, changes) in
2236 rpc conn ref_unblocked_time ~desc
:"change" command
2238 let do_hover_common (infos
: HoverService.hover_info list
) : Hover.result =
2241 |> List.map ~f
:(fun hoverInfo
->
2242 (* Hack server uses None to indicate absence of a result. *)
2243 (* We're also catching the non-result "" just in case... *)
2244 match hoverInfo
with
2245 | { HoverService.snippet
= ""; _
} -> []
2246 | { HoverService.snippet
; addendum
; _
} ->
2247 MarkedCode
("hack", snippet
)
2248 :: List.map ~f
:(fun s -> MarkedString
s) addendum
)
2251 (* We pull the position from the SymbolOccurrence.t record, so I would be
2252 surprised if there were any different ones in here. Just take the first
2256 |> List.filter_map ~f
:(fun { HoverService.pos
; _
} -> pos
)
2258 |> Option.map ~f
:(hack_pos_to_lsp_range ~equal
:Relative_path.equal
)
2260 if List.is_empty
contents then
2263 Some
{ Hover.contents; range }
2266 (conn
: server_conn
)
2267 (ref_unblocked_time
: float ref)
2268 (params : Hover.params) : Hover.result Lwt.t
=
2269 let (file, line
, column
) = lsp_file_position_to_hack params in
2270 let command = ServerCommandTypes.IDE_HOVER
(file, line
, column
) in
2271 let%lwt infos
= rpc conn ref_unblocked_time ~desc
:"hover" command in
2272 Lwt.return
(do_hover_common infos
)
2275 (ide_service
: ClientIdeService.t
ref)
2277 (tracking_id : string)
2278 (ref_unblocked_time
: float ref)
2279 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2280 (params : Hover.params) : Hover.result Lwt.t
=
2281 let document_location = get_document_location editor_open_files params in
2288 (ClientIdeMessage.Hover
document_location)
2290 Lwt.return
(do_hover_common infos
)
2292 let do_typeDefinition
2293 (conn
: server_conn
)
2294 (ref_unblocked_time
: float ref)
2295 (params : Definition.params) : TypeDefinition.result Lwt.t
=
2296 let (file, line
, column
) = lsp_file_position_to_hack params in
2298 ServerCommandTypes.(IDENTIFY_TYPES
(LabelledFileName
file, line
, column
))
2300 let%lwt results
= rpc conn ref_unblocked_time ~desc
:"go-to-typedef" command in
2302 (List.map results ~f
:(fun nast_sid
->
2303 hack_pos_definition_to_lsp_identifier_location
2305 ~default_path
:file))
2307 let do_typeDefinition_local
2308 (ide_service
: ClientIdeService.t
ref)
2310 (tracking_id : string)
2311 (ref_unblocked_time
: float ref)
2312 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2313 (params : Definition.params) : TypeDefinition.result Lwt.t
=
2314 let document_location = get_document_location editor_open_files params in
2321 (ClientIdeMessage.Type_definition
document_location)
2323 let file = Path.to_string
document_location.ClientIdeMessage.file_path in
2325 List.map
results ~f
:(fun nast_sid
->
2326 hack_pos_definition_to_lsp_identifier_location
2333 (conn
: server_conn
)
2334 (ref_unblocked_time
: float ref)
2335 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2336 (params : Definition.params) : (Definition.result * bool) Lwt.t
=
2337 let (filename, line
, column
) = lsp_file_position_to_hack params in
2339 params.TextDocumentPositionParams.textDocument
.TextDocumentIdentifier.uri
2342 match UriMap.find_opt
uri editor_open_files with
2344 ServerCommandTypes.(
2346 { filename; content
= document
.TextDocumentItem.text })
2347 | None
-> ServerCommandTypes.(LabelledFileName
filename)
2350 ServerCommandTypes.GO_TO_DEFINITION
(labelled_file, line
, column
)
2352 let%lwt
results = rpc conn ref_unblocked_time ~desc
:"go-to-def" command in
2354 List.map
results ~f
:(fun (_
, definition
) ->
2355 hack_symbol_definition_to_lsp_identifier_location
2357 ~default_path
:filename)
2359 let has_xhp_attribute =
2360 List.exists
results ~f
:(fun (occurence
, _
) ->
2361 SymbolOccurrence.is_xhp_literal_attr occurence
)
2363 Lwt.return
(locations, has_xhp_attribute)
2365 let do_definition_local
2366 (ide_service
: ClientIdeService.t
ref)
2368 (tracking_id : string)
2369 (ref_unblocked_time
: float ref)
2370 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2371 (params : Definition.params) : (Definition.result * bool) Lwt.t
=
2372 let document_location = get_document_location editor_open_files params in
2379 (ClientIdeMessage.Definition
document_location)
2382 List.map
results ~f
:(fun (_
, definition
) ->
2383 hack_symbol_definition_to_lsp_identifier_location
2386 (document_location.ClientIdeMessage.file_path |> Path.to_string
))
2388 let has_xhp_attribute =
2389 List.exists
results ~f
:(fun (occurence
, _
) ->
2390 SymbolOccurrence.is_xhp_literal_attr occurence
)
2392 Lwt.return
(locations, has_xhp_attribute)
2394 let snippet_re = Str.regexp
{|[\$
}]|} (* snippets must backslash-escape "$\}" *)
2396 let make_ide_completion_response
2397 (result : AutocompleteTypes.ide_result
) (filename : string) :
2398 Completion.completionList
Lwt.t
=
2399 let open AutocompleteTypes
in
2400 let open Completion
in
2401 (* We use snippets to provide parentheses+arguments when autocompleting *)
2402 (* method calls e.g. "$c->|" ==> "$c->foo($arg1)". But we'll only do this *)
2403 (* there's nothing after the caret: no "$c->|(1)" -> "$c->foo($arg1)(1)" *)
2404 let is_caret_followed_by_lparen = Char.equal
result.char_at_pos '
('
in
2405 let p = initialize_params_exc () in
2406 let hack_to_itemType (completion
: complete_autocomplete_result
) :
2408 (* TODO: we're using itemType (left column) for function return types, and *)
2409 (* the inlineDetail (right column) for variable/field types. Is that good? *)
2410 Option.map completion
.func_details ~f
:(fun details -> details.return_ty
)
2412 let hack_to_detail (completion
: complete_autocomplete_result
) : string =
2413 (* TODO: retrieve the actual signature including name+modifiers *)
2414 (* For now we just return the type of the completion. In the case *)
2415 (* of functions, their function-types have parentheses around them *)
2416 (* which we want to strip. In other cases like tuples, no strip. *)
2417 match completion
.func_details
with
2418 | None
-> completion
.res_ty
2420 String_utils.rstrip
(String_utils.lstrip completion
.res_ty
"(") ")"
2422 let hack_to_inline_detail (completion
: complete_autocomplete_result
) : string
2424 match completion
.func_details
with
2425 | None
-> hack_to_detail completion
2427 (* "(type1 $param1, ...)" *)
2428 let f param
= Printf.sprintf
"%s %s" param
.param_ty param
.param_name
in
2429 let params = String.concat ~sep
:", " (List.map
details.params ~
f) in
2430 Printf.sprintf
"(%s)" params
2431 (* Returns a tuple of (insertText, insertTextFormat, textEdits). *)
2433 let hack_to_insert (completion
: complete_autocomplete_result
) :
2434 [ `InsertText
of string | `TextEdit
of TextEdit.t list
]
2435 * Completion.insertTextFormat
=
2437 Initialize.(p.initializationOptions
.useTextEditAutocomplete
)
2439 match (completion
.func_details
, use_textedits) with
2441 when Lsp_helpers.supports_snippets
p
2442 && (not
is_caret_followed_by_lparen)
2444 (SearchUtils.equal_si_kind
2446 SearchUtils.SI_LocalVariable
) ->
2447 (* "method(${1:arg1}, ...)" but for args we just use param names. *)
2449 let name = Str.global_replace
snippet_re "\\\\\\0" param
.param_name
in
2450 Printf.sprintf
"${%i:%s}" (i
+ 1) name
2452 let params = String.concat ~sep
:", " (List.mapi
details.params ~
f) in
2453 ( `InsertText
(Printf.sprintf
"%s(%s)" completion
.res_name
params),
2455 | (_
, false) -> (`InsertText completion
.res_name
, PlainText
)
2461 range = ide_range_to_lsp completion
.res_replace_pos
;
2462 newText
= completion
.res_name
;
2467 let hack_completion_to_lsp (completion
: complete_autocomplete_result
) :
2468 Completion.completionItem
=
2469 let (insertText
, insertTextFormat
, textEdits
) =
2470 match hack_to_insert completion
with
2471 | (`InsertText
text, format
) -> (Some
text, format
, [])
2472 | (`TextEdit edits
, format
) -> (None
, format
, edits
)
2475 if String.equal
(Pos.filename completion
.res_pos
) "" then
2476 Pos.set_file
filename completion
.res_pos
2481 let (line
, start
, _
) = Pos.info_pos
pos in
2482 let filename = Pos.filename pos in
2484 match completion
.res_base_class
with
2485 | Some
base_class -> [("base_class", Hh_json.JSON_String
base_class)]
2488 let ranking_detail =
2489 match completion
.ranking_details
with
2492 ("ranking_detail", Hh_json.JSON_String
details.detail
);
2493 ("ranking_source", Hh_json.JSON_Number
details.kind
);
2497 (* If we do not have a correct file position, skip sending that data *)
2498 if Int.equal line
0 && Int.equal start
0 then
2500 (Hh_json.JSON_Object
2501 ([("fullname", Hh_json.JSON_String completion
.res_fullname
)]
2506 (Hh_json.JSON_Object
2508 (* Fullname is needed for namespaces. We often trim namespaces to make
2509 * the results more readable, such as showing "ad__breaks" instead of
2510 * "Thrift\Packages\cf\ad__breaks".
2512 ("fullname", Hh_json.JSON_String completion
.res_fullname
);
2513 (* Filename/line/char/base_class are used to handle class methods.
2514 * We could unify this with fullname in the future.
2516 ("filename", Hh_json.JSON_String
filename);
2517 ("line", Hh_json.int_ line
);
2518 ("char", Hh_json.int_ start
);
2523 let hack_to_sort_text (completion
: complete_autocomplete_result
) :
2525 let label = completion
.res_name
in
2526 let should_downrank label =
2527 String.length
label > 2
2528 && String.equal
(Str.string_before
label 2) "__"
2529 || Str.string_match
(Str.regexp_case_fold
".*do_not_use.*") label 0
2531 let downranked_result_prefix_character = "~" in
2532 if should_downrank label then
2533 Some
(downranked_result_prefix_character ^
label)
2539 (completion
.res_name
2542 SearchUtils.equal_si_kind completion
.res_kind
SearchUtils.SI_Namespace
2548 (match completion
.ranking_details
with
2549 | Some _
-> Some
Completion.Event
2551 si_kind_to_completion_kind completion
.AutocompleteTypes.res_kind
);
2552 detail
= Some
(hack_to_detail completion
);
2553 inlineDetail
= Some
(hack_to_inline_detail completion
);
2554 itemType
= hack_to_itemType completion
;
2556 Option.map completion
.res_documentation ~
f:(fun s ->
2557 MarkedStringsDocumentation
[MarkedString
s]);
2558 (* This will be filled in by completionItem/resolve. *)
2560 (match completion
.ranking_details
with
2561 | Some detail
-> Some detail
.sort_text
2562 | None
-> hack_to_sort_text completion
);
2565 insertTextFormat
= Some insertTextFormat
;
2573 isIncomplete
= not
result.is_complete
;
2574 items
= List.map
result.completions ~
f:hack_completion_to_lsp;
2577 let do_completion_ffp
2578 (conn
: server_conn
)
2579 (ref_unblocked_time
: float ref)
2580 (params : Completion.params) : Completion.result Lwt.t
=
2581 let open Completion
in
2582 let open TextDocumentIdentifier
in
2584 lsp_position_to_ide params.loc
.TextDocumentPositionParams.position
2587 lsp_uri_to_path params.loc
.TextDocumentPositionParams.textDocument
.uri
2589 let command = ServerCommandTypes.IDE_FFP_AUTOCOMPLETE
(filename, pos) in
2590 let%lwt
result = rpc conn ref_unblocked_time ~desc
:"completion" command in
2591 make_ide_completion_response result filename
2593 let do_completion_legacy
2594 (conn
: server_conn
)
2595 (ref_unblocked_time
: float ref)
2596 (params : Completion.params) : Completion.result Lwt.t
=
2597 let open Completion
in
2598 let open TextDocumentIdentifier
in
2600 lsp_position_to_ide params.loc
.TextDocumentPositionParams.position
2603 lsp_uri_to_path params.loc
.TextDocumentPositionParams.textDocument
.uri
2605 let is_manually_invoked =
2606 match params.context
with
2608 | Some c
-> is_invoked c
.triggerKind
2611 ServerCommandTypes.IDE_AUTOCOMPLETE
(filename, pos, is_manually_invoked)
2613 let%lwt
result = rpc conn ref_unblocked_time ~desc
:"completion" command in
2614 make_ide_completion_response result filename
2616 let do_completion_local
2617 (ide_service
: ClientIdeService.t
ref)
2619 (tracking_id : string)
2620 (ref_unblocked_time
: float ref)
2621 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2622 (params : Completion.params) : Completion.result Lwt.t
=
2623 let open Completion
in
2624 let document_location = get_document_location editor_open_files params.loc
in
2625 (* Other parameters *)
2626 let is_manually_invoked =
2627 match params.context
with
2629 | Some c
-> is_invoked c
.triggerKind
2631 (* this is what I want to fix *)
2633 ClientIdeMessage.Completion
2634 { ClientIdeMessage.Completion.document_location; is_manually_invoked }
2637 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2640 document_location.ClientIdeMessage.file_path |> Path.to_string
2642 let%lwt response
= make_ide_completion_response infos
filename in
2645 exception NoLocationFound
2647 let docblock_to_markdown (raw_docblock
: DocblockService.result) :
2648 Completion.completionDocumentation
option =
2649 match raw_docblock
with
2653 (Completion.MarkedStringsDocumentation
2654 (Core_kernel.List.fold docblock ~init
:[] ~
f:(fun acc elt
->
2656 | DocblockService.Markdown txt
-> MarkedString txt
:: acc
2657 | DocblockService.HackSnippet txt
->
2658 MarkedCode
("hack", txt
) :: acc
2659 | DocblockService.XhpSnippet txt
->
2660 MarkedCode
("html", txt
) :: acc
)))
2662 let docblock_with_ranking_detail
2663 (raw_docblock
: DocblockService.result) (ranking_detail : string option) :
2664 DocblockService.result =
2665 match ranking_detail with
2666 | Some detail
-> raw_docblock
@ [DocblockService.Markdown detail
]
2667 | None
-> raw_docblock
2669 let resolve_ranking_source
2670 (kind
: SearchUtils.si_kind
) (ranking_source
: int option) :
2671 SearchUtils.si_kind
=
2672 match ranking_source
with
2673 | Some x
-> SearchUtils.int_to_kind x
2676 let do_completionItemResolve
2677 (conn
: server_conn
)
2678 (ref_unblocked_time
: float ref)
2679 (params : CompletionItemResolve.params) : CompletionItemResolve.result Lwt.t
2681 if Option.is_some
params.Completion.documentation
then
2684 (* No matter what, we need the kind *)
2685 let raw_kind = params.Completion.kind
in
2686 let kind = completion_kind_to_si_kind raw_kind in
2687 (* First try fetching position data from json *)
2688 let%lwt raw_docblock
=
2690 match params.Completion.data with
2691 | None
-> raise NoLocationFound
2693 (* Some docblocks are for class methods. Class methods need to know
2694 * file/line/column/base_class to find the docblock. *)
2695 let filename = Jget.string_exn
data "filename" in
2696 let line = Jget.int_exn
data "line" in
2697 let column = Jget.int_exn
data "char" in
2698 let base_class = Jget.string_opt
data "base_class" in
2699 let ranking_detail = Jget.string_opt
data "ranking_detail" in
2700 let ranking_source = Jget.int_opt
data "ranking_source" in
2701 (* If not found ... *)
2702 if line = 0 && column = 0 then (
2703 (* For global symbols such as functions, classes, enums, etc, we
2704 * need to know the full name INCLUDING all namespaces. Once
2705 * we know that, we can look up its file/line/column. *)
2706 let fullname = Jget.string_exn
data "fullname" in
2707 if String.equal
fullname "" then raise NoLocationFound
;
2708 let fullname = Utils.add_ns
fullname in
2710 ServerCommandTypes.DOCBLOCK_FOR_SYMBOL
2711 (fullname, resolve_ranking_source kind ranking_source)
2713 let%lwt raw_docblock
=
2714 rpc conn ref_unblocked_time ~desc
:"completion" command
2717 (docblock_with_ranking_detail raw_docblock
ranking_detail)
2719 (* Okay let's get a docblock for this specific location *)
2721 ServerCommandTypes.DOCBLOCK_AT
2726 resolve_ranking_source kind ranking_source )
2728 let%lwt raw_docblock
=
2729 rpc conn ref_unblocked_time ~desc
:"completion" command
2732 (docblock_with_ranking_detail raw_docblock
ranking_detail)
2733 (* If that failed, fetch docblock using just the symbol name *)
2736 let symbolname = params.Completion.label in
2737 let ranking_source =
2738 try Jget.int_opt
params.Completion.data "ranking_source" with
2742 ServerCommandTypes.DOCBLOCK_FOR_SYMBOL
2743 (symbolname, resolve_ranking_source kind ranking_source)
2745 let%lwt raw_docblock
=
2746 rpc conn ref_unblocked_time ~desc
:"completion" command
2748 Lwt.return raw_docblock
2750 (* Convert to markdown and return *)
2751 let documentation = docblock_to_markdown raw_docblock
in
2752 Lwt.return
{ params with Completion.documentation }
2755 * Note that resolve does not depend on having previously executed completion in
2756 * the same process. The LSP resolve request takes, as input, a single item
2757 * produced by any previously executed completion request. So it's okay for
2758 * one process to respond to another, because they'll both know the answers
2759 * to the same symbol requests.
2761 * And it's totally okay to mix and match requests to serverless IDE and
2764 let do_resolve_local
2765 (ide_service
: ClientIdeService.t
ref)
2767 (tracking_id : string)
2768 (ref_unblocked_time
: float ref)
2769 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2770 (params : CompletionItemResolve.params) : CompletionItemResolve.result Lwt.t
2772 if Option.is_some
params.Completion.documentation then
2775 let raw_kind = params.Completion.kind in
2776 let kind = completion_kind_to_si_kind raw_kind in
2777 (* Some docblocks are for class methods. Class methods need to know
2778 * file/line/column/base_class to find the docblock. *)
2781 match params.Completion.data with
2782 | None
-> raise NoLocationFound
2784 let filename = Jget.string_exn
data "filename" in
2785 let uri = File_url.create
filename |> Lsp.uri_of_string
in
2786 let file_path = Path.make
filename in
2787 let line = Jget.int_exn
data "line" in
2788 let column = Jget.int_exn
data "char" in
2789 let file_contents = get_document_contents editor_open_files uri in
2790 let ranking_detail = Jget.string_opt
data "ranking_detail" in
2791 let ranking_source = Jget.int_opt
data "ranking_source" in
2792 if line = 0 && column = 0 then failwith
"NoFileLineColumnData";
2794 ClientIdeMessage.Completion_resolve_location
2796 ClientIdeMessage.Completion_resolve_location.document_location =
2798 ClientIdeMessage.file_path;
2799 ClientIdeMessage.file_contents;
2800 ClientIdeMessage.line;
2801 ClientIdeMessage.column;
2803 kind = resolve_ranking_source kind ranking_source;
2806 let%lwt raw_docblock
=
2807 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2810 docblock_with_ranking_detail raw_docblock
ranking_detail
2811 |> docblock_to_markdown
2813 Lwt.return
{ params with Completion.documentation }
2814 (* If that fails, next try using symbol *)
2817 (* The "fullname" value includes the fully qualified namespace, so
2818 * we want to use that. However, if it's missing (it shouldn't be)
2819 * let's default to using the label which doesn't include the
2822 try Jget.string_exn
params.Completion.data "fullname" with
2823 | _
-> params.Completion.label
2825 let ranking_source =
2826 try Jget.int_opt
params.Completion.data "ranking_source" with
2830 ClientIdeMessage.Completion_resolve
2832 ClientIdeMessage.Completion_resolve.symbol
= symbolname;
2833 kind = resolve_ranking_source kind ranking_source;
2836 let%lwt raw_docblock
=
2837 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2839 let documentation = docblock_to_markdown raw_docblock
in
2840 Lwt.return
{ params with Completion.documentation }
2844 let hack_symbol_to_lsp (symbol
: SearchUtils.symbol
) =
2845 let open SearchUtils
in
2846 (* Hack sometimes gives us back items with an empty path, by which it
2847 intends "whichever path you asked me about". That would be meaningless
2848 here. If it does, then it'll pick up our default path (also empty),
2849 which will throw and go into our telemetry. That's the best we can do. *)
2850 let hack_to_lsp_kind = function
2851 | SearchUtils.SI_Class
-> SymbolInformation.Class
2852 | SearchUtils.SI_Interface
-> SymbolInformation.Interface
2853 | SearchUtils.SI_Trait
-> SymbolInformation.Interface
2854 (* LSP doesn't have traits, so we approximate with interface *)
2855 | SearchUtils.SI_Enum
-> SymbolInformation.Enum
2856 (* TODO(T36697624): Add SymbolInformation.Record *)
2857 | SearchUtils.SI_ClassMethod
-> SymbolInformation.Method
2858 | SearchUtils.SI_Function
-> SymbolInformation.Function
2859 | SearchUtils.SI_Typedef
-> SymbolInformation.Class
2860 (* LSP doesn't have typedef, so we approximate with class *)
2861 | SearchUtils.SI_GlobalConstant
-> SymbolInformation.Constant
2862 | SearchUtils.SI_Namespace
-> SymbolInformation.Namespace
2863 | SearchUtils.SI_Mixed
-> SymbolInformation.Variable
2864 | SearchUtils.SI_XHP
-> SymbolInformation.Class
2865 | SearchUtils.SI_Literal
-> SymbolInformation.Variable
2866 | SearchUtils.SI_ClassConstant
-> SymbolInformation.Constant
2867 | SearchUtils.SI_Property
-> SymbolInformation.Property
2868 | SearchUtils.SI_LocalVariable
-> SymbolInformation.Variable
2869 | SearchUtils.SI_Constructor
-> SymbolInformation.Constructor
2870 (* Do these happen in practice? *)
2871 | SearchUtils.SI_Keyword
2872 | SearchUtils.SI_Unknown
->
2873 failwith
"Unknown symbol kind"
2876 SymbolInformation.name = Utils.strip_ns symbol
.name;
2877 kind = hack_to_lsp_kind symbol
.result_type
;
2878 location = hack_pos_to_lsp_location symbol
.pos ~default_path
:"";
2879 containerName
= None
;
2882 let do_workspaceSymbol
2883 (conn
: server_conn
)
2884 (ref_unblocked_time
: float ref)
2885 (params : WorkspaceSymbol.params) : WorkspaceSymbol.result Lwt.t
=
2886 let query_type = "" in
2888 ServerCommandTypes.SEARCH
(params.WorkspaceSymbol.query
, query_type)
2890 let%lwt
results = rpc conn ref_unblocked_time ~desc
:"find-symbol" command in
2891 Lwt.return
(List.map
results ~
f:hack_symbol_to_lsp)
2893 let do_workspaceSymbol_local
2894 (ide_service
: ClientIdeService.t
ref)
2896 (tracking_id : string)
2897 (ref_unblocked_time
: float ref)
2898 (params : WorkspaceSymbol.params) : WorkspaceSymbol.result Lwt.t
=
2899 let query = params.WorkspaceSymbol.query in
2900 let request = ClientIdeMessage.Workspace_symbol
query in
2902 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2904 Lwt.return
(List.map
results ~
f:hack_symbol_to_lsp)
2906 let rec hack_symbol_tree_to_lsp
2907 ~
(filename : string)
2908 ~
(accu
: Lsp.SymbolInformation.t list
)
2909 ~
(container_name
: string option)
2910 (defs
: FileOutline.outline
) : Lsp.SymbolInformation.t list
=
2911 let open SymbolDefinition
in
2912 let hack_to_lsp_kind = function
2913 | SymbolDefinition.Function
-> SymbolInformation.Function
2914 | SymbolDefinition.Class
-> SymbolInformation.Class
2915 | SymbolDefinition.Method
-> SymbolInformation.Method
2916 | SymbolDefinition.Property
-> SymbolInformation.Property
2917 | SymbolDefinition.Const
-> SymbolInformation.Constant
2918 | SymbolDefinition.Enum
-> SymbolInformation.Enum
2919 | SymbolDefinition.Interface
-> SymbolInformation.Interface
2920 | SymbolDefinition.Trait
-> SymbolInformation.Interface
2921 (* LSP doesn't have traits, so we approximate with interface *)
2922 | SymbolDefinition.LocalVar
-> SymbolInformation.Variable
2923 | SymbolDefinition.TypeVar
-> SymbolInformation.TypeParameter
2924 | SymbolDefinition.Typeconst
-> SymbolInformation.Class
2925 (* e.g. "const type Ta = string;" -- absent from LSP *)
2926 | SymbolDefinition.Typedef
-> SymbolInformation.Class
2927 (* e.g. top level type alias -- absent from LSP *)
2928 | SymbolDefinition.Param
-> SymbolInformation.Variable
2929 (* We never return a param from a document-symbol-search *)
2931 let hack_symbol_to_lsp definition containerName
=
2933 SymbolInformation.name = definition
.name;
2934 kind = hack_to_lsp_kind definition
.kind;
2936 hack_symbol_definition_to_lsp_construct_location
2938 ~default_path
:filename;
2943 (* Flattens the recursive list of symbols *)
2944 | [] -> List.rev accu
2946 let children = Option.value def
.children ~default
:[] in
2947 let accu = hack_symbol_to_lsp def container_name
:: accu in
2949 hack_symbol_tree_to_lsp
2952 ~container_name
:(Some def
.name)
2955 hack_symbol_tree_to_lsp ~
filename ~
accu ~container_name defs
2957 let do_documentSymbol
2958 (conn
: server_conn
)
2959 (ref_unblocked_time
: float ref)
2960 (params : DocumentSymbol.params) : DocumentSymbol.result Lwt.t
=
2961 let open DocumentSymbol
in
2962 let open TextDocumentIdentifier
in
2963 let filename = lsp_uri_to_path params.textDocument
.uri in
2964 let command = ServerCommandTypes.OUTLINE
filename in
2965 let%lwt outline
= rpc conn ref_unblocked_time ~desc
:"outline" command in
2967 hack_symbol_tree_to_lsp ~
filename ~
accu:[] ~container_name
:None outline
2969 Lwt.return
converted
2971 (* for serverless ide *)
2972 let do_documentSymbol_local
2973 (ide_service
: ClientIdeService.t
ref)
2975 (tracking_id : string)
2976 (ref_unblocked_time
: float ref)
2977 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
2978 (params : DocumentSymbol.params) : DocumentSymbol.result Lwt.t
=
2979 let open DocumentSymbol
in
2980 let open TextDocumentIdentifier
in
2981 let filename = lsp_uri_to_path params.textDocument
.uri in
2982 let document_location =
2984 ClientIdeMessage.file_path = Path.make
filename;
2986 get_document_contents editor_open_files params.textDocument
.uri;
2991 let request = ClientIdeMessage.Document_symbol
document_location in
2993 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
2996 hack_symbol_tree_to_lsp ~
filename ~
accu:[] ~container_name
:None outline
2998 Lwt.return
converted
3000 let do_findReferences
3001 (conn
: server_conn
)
3002 (ref_unblocked_time
: float ref)
3003 (params : FindReferences.params) : FindReferences.result Lwt.t
=
3004 let { Ide_api_types.line; column } =
3006 params.FindReferences.loc
.TextDocumentPositionParams.position
3009 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
3010 params.FindReferences.loc
.TextDocumentPositionParams.textDocument
3013 params.FindReferences.context
.FindReferences.includeDeclaration
3015 let labelled_file = ServerCommandTypes.LabelledFileName
filename in
3017 ServerCommandTypes.IDE_FIND_REFS
(labelled_file, line, column, include_defs)
3020 rpc_with_retry conn ref_unblocked_time ~desc
:"find-refs" command
3022 (* TODO: respect params.context.include_declaration *)
3024 | None
-> Lwt.return
[]
3025 | Some
(_name
, positions
) ->
3027 (List.map positions ~
f:(hack_pos_to_lsp_location ~default_path
:filename))
3029 let do_goToImplementation
3030 (conn
: server_conn
)
3031 (ref_unblocked_time
: float ref)
3032 (params : Implementation.params) : Implementation.result Lwt.t
=
3033 let { Ide_api_types.line; column } =
3034 lsp_position_to_ide params.TextDocumentPositionParams.position
3037 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
3038 params.TextDocumentPositionParams.textDocument
3040 let labelled_file = ServerCommandTypes.LabelledFileName
filename in
3042 ServerCommandTypes.IDE_GO_TO_IMPL
(labelled_file, line, column)
3045 rpc_with_retry conn ref_unblocked_time ~desc
:"go-to-impl" command
3048 | None
-> Lwt.return
[]
3049 | Some
(_name
, positions
) ->
3051 (List.map positions ~
f:(hack_pos_to_lsp_location ~default_path
:filename))
3053 (* Shared function for hack range conversion *)
3054 let hack_range_to_lsp_highlight range =
3055 { DocumentHighlight.range = ide_range_to_lsp range; kind = None
}
3057 let do_documentHighlight
3058 (conn
: server_conn
)
3059 (ref_unblocked_time
: float ref)
3060 (params : DocumentHighlight.params) : DocumentHighlight.result Lwt.t
=
3061 let (file, line, column) = lsp_file_position_to_hack params in
3063 ServerCommandTypes.(IDE_HIGHLIGHT_REFS
(file, FileName
file, line, column))
3066 rpc conn ref_unblocked_time ~desc
:"highlight-references" command
3068 Lwt.return
(List.map
results ~
f:hack_range_to_lsp_highlight)
3070 (* Serverless IDE implementation of highlight *)
3071 let do_highlight_local
3072 (ide_service
: ClientIdeService.t
ref)
3074 (tracking_id : string)
3075 (ref_unblocked_time
: float ref)
3076 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3077 (params : DocumentHighlight.params) : DocumentHighlight.result Lwt.t
=
3078 let document_location = get_document_location editor_open_files params in
3085 (ClientIdeMessage.Document_highlight
document_location)
3087 Lwt.return
(List.map ranges ~
f:hack_range_to_lsp_highlight)
3089 let format_typeCoverage_result ~
(equal
: 'a
-> 'a
-> bool) results counts
=
3091 let coveredPercent = Coverage_level.get_percent counts
in
3092 let hack_coverage_to_lsp (pos, level
) =
3093 let range = hack_pos_to_lsp_range ~equal
pos in
3095 (* We only show diagnostics for completely untypechecked code. *)
3096 | Ide_api_types.Checked
3097 | Ide_api_types.Partial
->
3099 | Ide_api_types.Unchecked
-> Some
{ range; message = None
}
3103 uncoveredRanges
= List.filter_map
results ~
f:hack_coverage_to_lsp;
3104 defaultMessage
= "Un-type checked code. Consider adding type annotations.";
3107 let do_typeCoverageFB
3108 (conn
: server_conn
)
3109 (ref_unblocked_time
: float ref)
3110 (params : TypeCoverageFB.params) : TypeCoverageFB.result Lwt.t
=
3113 Lsp_helpers.lsp_textDocumentIdentifier_to_filename
params.textDocument
3116 ServerCommandTypes.COVERAGE_LEVELS
3117 (filename, ServerCommandTypes.FileName
filename)
3119 let%lwt
(results, counts
) : Coverage_level_defs.result =
3120 rpc conn ref_unblocked_time ~desc
:"coverage" command
3123 format_typeCoverage_result ~equal
:String.equal
results counts
3125 Lwt.return
formatted)
3127 let do_typeCoverage_localFB
3128 (ide_service
: ClientIdeService.t
ref)
3130 (tracking_id : string)
3131 (ref_unblocked_time
: float ref)
3132 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3133 (params : TypeCoverageFB.params) : TypeCoverageFB.result Lwt.t
=
3134 let open TypeCoverageFB
in
3135 let document_contents =
3136 get_document_contents
3138 params.textDocument
.TextDocumentIdentifier.uri
3140 match document_contents with
3141 | None
-> failwith
"Local type coverage failed, file could not be found."
3142 | Some
file_contents ->
3144 params.textDocument
.TextDocumentIdentifier.uri
3149 ClientIdeMessage.Type_coverage
3150 { ClientIdeMessage.file_path; ClientIdeMessage.file_contents }
3153 ide_rpc ide_service ~env ~
tracking_id ~ref_unblocked_time
request
3155 let (results, counts
) = result in
3157 format_typeCoverage_result ~equal
:String.equal
results counts
3159 Lwt.return
formatted
3161 let do_formatting_common
3162 (uri : Lsp.documentUri
)
3163 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3164 (action
: ServerFormatTypes.ide_action
)
3165 (options
: DocumentFormatting.formattingOptions
) : TextEdit.t list
=
3166 let open ServerFormatTypes
in
3167 let filename_for_logging = lsp_uri_to_path uri in
3168 (* Following line will throw if the document isn't already open, so we'll *)
3169 (* return an error code to the LSP client. The spec doesn't spell out if we *)
3170 (* should be expected to handle formatting requests on unopened files. *)
3171 let lsp_doc = UriMap.find
uri editor_open_files in
3172 let content = lsp_doc.Lsp.TextDocumentItem.text in
3174 ServerFormat.go_ide ~
filename_for_logging ~
content ~action ~options
3177 | Error
"File failed to parse without errors" ->
3178 (* If LSP issues a formatting request at a given line+char, but we can't *)
3179 (* calculate a better format for the file due to syntax errors in it, *)
3180 (* then we should return "success and there are no edits to apply" *)
3181 (* rather than "error". *)
3182 (* TODO: let's eliminate hh_format, and incorporate hackfmt into the *)
3183 (* hh_client binary itself, and make make "hackfmt" just a wrapper for *)
3184 (* "hh_client format", and then make it return proper error that we can *)
3185 (* pattern-match upon, rather than hard-coding the string... *)
3190 { Error.code
= Error.UnknownErrorCode
; message; data = None
})
3192 let range = ide_range_to_lsp r
.range in
3193 let newText = r
.new_text
in
3194 [{ TextEdit.range; newText }]
3196 let do_documentRangeFormatting
3197 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3198 (params : DocumentRangeFormatting.params) : DocumentRangeFormatting.result =
3199 let open DocumentRangeFormatting
in
3200 let open TextDocumentIdentifier
in
3201 let action = ServerFormatTypes.Range
(lsp_range_to_ide params.range) in
3202 do_formatting_common
3203 params.textDocument
.uri
3208 let do_documentOnTypeFormatting
3209 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3210 (params : DocumentOnTypeFormatting.params) : DocumentOnTypeFormatting.result
3212 let open DocumentOnTypeFormatting
in
3213 let open TextDocumentIdentifier
in
3215 In LSP, positions do not point directly to characters, but to spaces in between characters.
3216 Thus, the LSP position that the cursor points to after typing a character is the space
3217 immediately after the character.
3220 Character positions: 0 1 2 3 4 5 6
3222 LSP positions: 0 1 2 3 4 5 6 7
3224 The cursor is at LSP position 7 after typing the "}" of "foo(){}"
3225 But the character position of "}" is 6.
3227 Nuclide currently sends positions according to LSP, but everything else in the server
3228 and in hack formatting assumes that positions point directly to characters.
3230 Thus, to send the position of the character itself for formatting,
3231 we must subtract one.
3234 { params.position with character
= params.position.character
- 1 }
3236 let action = ServerFormatTypes.Position
(lsp_position_to_ide position) in
3237 do_formatting_common
3238 params.textDocument
.uri
3243 let do_documentFormatting
3244 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3245 (params : DocumentFormatting.params) : DocumentFormatting.result =
3246 let open DocumentFormatting
in
3247 let open TextDocumentIdentifier
in
3248 let action = ServerFormatTypes.Document
in
3249 do_formatting_common
3250 params.textDocument
.uri
3255 let do_willSaveWaitUntil
3256 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3257 (params : WillSaveWaitUntil.params) : WillSaveWaitUntil.result =
3258 let uri = params.WillSaveWaitUntil.textDocument
.TextDocumentIdentifier.uri in
3259 let lsp_doc = UriMap.find
uri editor_open_files in
3260 let content = lsp_doc.Lsp.TextDocumentItem.text in
3261 match Formatting.is_formattable
content with
3263 let open DocumentFormatting
in
3264 do_documentFormatting
3267 textDocument
= params.WillSaveWaitUntil.textDocument
;
3268 options
= { tabSize
= 2; insertSpaces
= true };
3272 let do_codeAction_local
3273 (ide_service
: ClientIdeService.t
ref)
3275 (tracking_id : string)
3276 (ref_unblocked_time
: float ref)
3277 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3278 (params : CodeActionRequest.params) :
3279 CodeAction.command_or_action list
Lwt.t
=
3283 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri)
3286 get_document_contents
3288 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri
3290 let range = lsp_range_to_ide params.CodeActionRequest.range in
3297 (ClientIdeMessage.Code_action
3298 { ClientIdeMessage.Code_action.file_path; file_contents; range })
3303 (conn
: server_conn
)
3304 (ref_unblocked_time
: float ref)
3305 (params : CodeActionRequest.params) :
3306 CodeAction.command_or_action list
Lwt.t
=
3309 params.CodeActionRequest.textDocument
.TextDocumentIdentifier.uri
3311 let range = lsp_range_to_ide params.CodeActionRequest.range in
3312 let command = ServerCommandTypes.CODE_ACTIONS
(filename, range) in
3313 rpc conn ref_unblocked_time ~desc
:"code_actions" command
3315 let do_signatureHelp
3316 (conn
: server_conn
)
3317 (ref_unblocked_time
: float ref)
3318 (params : SignatureHelp.params) : SignatureHelp.result Lwt.t
=
3319 let (file, line, column) = lsp_file_position_to_hack params in
3320 let command = ServerCommandTypes.IDE_SIGNATURE_HELP
(file, line, column) in
3321 rpc conn ref_unblocked_time ~desc
:"tooltip" command
3323 (* Serverless IDE version of signature help *)
3324 let do_signatureHelp_local
3325 (ide_service
: ClientIdeService.t
ref)
3327 (tracking_id : string)
3328 (ref_unblocked_time
: float ref)
3329 (editor_open_files : Lsp.TextDocumentItem.t
UriMap.t
)
3330 (params : SignatureHelp.params) : SignatureHelp.result Lwt.t
=
3331 let document_location = get_document_location editor_open_files params in
3332 let%lwt signatures
=
3338 (ClientIdeMessage.Signature_help
document_location)
3340 Lwt.return signatures
3342 let patch_to_workspace_edit_change (patch
: ServerRefactorTypes.patch
) :
3343 string * TextEdit.t
=
3344 let open ServerRefactorTypes
in
3348 | Insert insert_patch
3349 | Replace insert_patch
->
3352 hack_pos_to_lsp_range ~equal
:String.equal insert_patch
.pos;
3353 newText = insert_patch
.text;
3357 TextEdit.range = hack_pos_to_lsp_range ~equal
:String.equal
pos;
3363 | Insert insert_patch
3364 | Replace insert_patch
->
3365 File_url.create
(filename insert_patch
.pos)
3366 | Remove
pos -> File_url.create
(filename pos)
3370 let patches_to_workspace_edit (patches
: ServerRefactorTypes.patch list
) :
3372 let changes = List.map patches ~
f:patch_to_workspace_edit_change in
3374 List.fold
changes ~init
:SMap.empty ~
f:(fun acc
(uri, text_edit) ->
3375 let current_edits = Option.value ~default
:[] (SMap.find_opt
uri acc
) in
3376 let new_edits = text_edit :: current_edits in
3377 SMap.add
uri new_edits acc
)
3379 { WorkspaceEdit.changes }
3381 let do_documentRename
3382 (conn
: server_conn
)
3383 (ref_unblocked_time
: float ref)
3384 (params : Rename.params) : WorkspaceEdit.t
Lwt.t
=
3385 let (filename, line, char
) =
3386 lsp_file_position_to_hack (rename_params_to_document_position params)
3389 let new_name = params.newName
in
3391 ServerCommandTypes.IDE_REFACTOR
3392 { ServerCommandTypes.Ide_refactor_type.filename; line; char
; new_name }
3395 rpc_with_retry conn ref_unblocked_time ~desc
:"rename" command
3399 | Ok
patches -> patches
3403 { Error.code
= Error.InvalidRequest
; message; data = None
})
3405 Lwt.return
(patches_to_workspace_edit patches)
3407 (** This updates Main_env.hh_server_status according to the status message
3408 we just received from hh_server. See comments on hh_server_status for
3409 the invariants on its fields. *)
3410 let do_server_busy (state : state) (status : ServerCommandTypes.busy_status
) :
3412 let open Main_env
in
3413 let open ServerCommandTypes
in
3414 let (type_
, shortMessage
, message) =
3416 | Needs_local_typecheck
->
3417 ( MessageType.InfoMessage
,
3419 "hh_server is preparing to check edits" )
3420 | Doing_local_typecheck
->
3421 (MessageType.WarningMessage
, "Hack", "hh_server is checking edits")
3422 | Done_local_typecheck
->
3423 ( MessageType.InfoMessage
,
3425 "hh_server is initialized and running correctly." )
3426 | Doing_global_typecheck Blocking
->
3427 ( MessageType.WarningMessage
,
3429 "hh_server is typechecking the entire project (blocking)" )
3430 | Doing_global_typecheck Interruptible
->
3431 ( MessageType.WarningMessage
,
3433 "hh_server is typechecking entire project" )
3434 | Doing_global_typecheck
(Remote_blocking
message) ->
3435 ( MessageType.WarningMessage
,
3437 "hh_server is remote-typechecking the entire project - " ^
message )
3438 | Done_global_typecheck
->
3439 ( MessageType.InfoMessage
,
3441 "hh_server is initialized and running correctly." )
3445 let hh_server_status =
3447 ShowStatusFB.shortMessage
= Some shortMessage
;
3448 request = { ShowMessageRequest.type_
; message; actions = [] };
3454 Main_loop
{ menv with hh_server_status }
3457 let warn_truncated_diagnostic_list is_truncated
=
3458 Option.iter is_truncated ~
f:(fun total_error_count
->
3461 "Hack produced %d errors in total. Showing only a limited number to preserve performance."
3464 Lsp_helpers.showMessage_warning
to_stdout msg)
3466 (** Hack sometimes reports a diagnostic on an empty file path when it can't
3467 figure out which file to report. In this case we'll report on the root.
3468 Nuclide and VSCode both display this fine, though they obviously don't
3469 let you click-to-go-to-file on it. *)
3470 let fix_empty_paths_in_error_map errors_per_file
=
3471 let default_path = get_root_exn () |> Path.to_string
in
3472 match SMap.find_opt
"" errors_per_file
with
3473 | None
-> errors_per_file
3475 SMap.remove
"" errors_per_file
3476 |> SMap.add ~combine
:( @ ) default_path errors
3478 let update_uris_with_diagnostics uris_with_diagnostics errors_per_file
=
3479 let default_path = get_root_exn () |> Path.to_string
in
3480 let is_error_free _uri errors
= List.is_empty errors
in
3481 (* reports_without/reports_with are maps of filename->ErrorList. *)
3482 let (reports_without
, reports_with
) =
3483 SMap.partition
is_error_free errors_per_file
3485 (* files_without/files_with are sets of filenames *)
3486 let files_without = SMap.bindings reports_without
|> List.map ~
f:fst
in
3487 let files_with = SMap.bindings reports_with
|> List.map ~
f:fst
in
3488 (* uris_without/uris_with are sets of uris *)
3490 List.map
files_without ~
f:(path_to_lsp_uri ~
default_path) |> UriSet.of_list
3493 List.map
files_with ~
f:(path_to_lsp_uri ~
default_path) |> UriSet.of_list
3495 (* this is "(uris_with_diagnostics \ uris_without) U uris_with" *)
3496 UriSet.union
(UriSet.diff uris_with_diagnostics
uris_without) uris_with
3498 (** Send notifications for all reported diagnostics.
3499 Returns an updated "uris_with_diagnostics" set of all files for which
3500 our client currently has non-empty diagnostic reports. *)
3502 (uris_with_diagnostics
: UriSet.t
)
3503 (errors_per_file
: Errors.finalized_error list
SMap.t
)
3504 ~
(is_truncated
: int option) : UriSet.t
=
3505 let errors_per_file = fix_empty_paths_in_error_map errors_per_file in
3506 let send_diagnostic_notification file errors
=
3507 let params = hack_errors_to_lsp_diagnostic file errors
in
3508 let notification = PublishDiagnosticsNotification
params in
3509 notify_jsonrpc ~powered_by
:Hh_server
notification
3511 SMap.iter
send_diagnostic_notification errors_per_file;
3512 warn_truncated_diagnostic_list is_truncated
;
3513 update_uris_with_diagnostics uris_with_diagnostics
errors_per_file
3515 let do_initialize (local_config
: ServerLocalConfig.t
) : Initialize.result =
3518 server_capabilities
=
3522 want_openClose
= true;
3523 want_change
= IncrementalSync
;
3524 want_willSave
= false;
3525 want_willSaveWaitUntil
= true;
3526 want_didSave
= Some
{ includeText
= false };
3528 hoverProvider
= true;
3529 completionProvider
=
3532 resolveProvider
= true;
3533 completion_triggerCharacters
=
3534 ["$"; ">"; "\\"; ":"; "<"; "["; "'"; "\""; "{"; "#"];
3536 signatureHelpProvider
=
3537 Some
{ sighelp_triggerCharacters
= ["("; ","] };
3538 definitionProvider
= true;
3539 typeDefinitionProvider
= true;
3540 referencesProvider
= true;
3541 documentHighlightProvider
= true;
3542 documentSymbolProvider
= true;
3543 workspaceSymbolProvider
= true;
3544 codeActionProvider
= true;
3545 codeLensProvider
= None
;
3546 documentFormattingProvider
= true;
3547 documentRangeFormattingProvider
= true;
3548 documentOnTypeFormattingProvider
=
3549 Some
{ firstTriggerCharacter
= ";"; moreTriggerCharacter
= ["}"] };
3550 renameProvider
= true;
3551 documentLinkProvider
= None
;
3552 executeCommandProvider
= None
;
3553 implementationProvider
=
3554 local_config
.ServerLocalConfig.go_to_implementation
;
3555 typeCoverageProviderFB
= true;
3556 rageProviderFB
= true;
3560 let do_didChangeWatchedFiles_registerCapability () : Lsp.lsp_request
=
3561 (* We want a glob-pattern like "**/*.{php,phpt,hack,hackpartial,hck,hh,hhi,xhp}".
3562 I'm constructing it from FindUtils.extensions so our glob-pattern doesn't get out
3563 of sync with FindUtils.file_filter. *)
3565 List.map
FindUtils.extensions ~
f:(fun s -> String_utils.lstrip
s ".")
3568 Printf.sprintf
"**/*.{%s}" (extensions |> String.concat ~sep
:",")
3570 let registration_options =
3571 DidChangeWatchedFilesRegistrationOptions
3573 DidChangeWatchedFiles.watchers
= [{ DidChangeWatchedFiles.globPattern }];
3577 Lsp.RegisterCapability.make_registration
registration_options
3579 Lsp.RegisterCapabilityRequest
3580 { RegisterCapability.registrations
= [registration] }
3582 let handle_idle_if_necessary (state : state) (event
: event
) : state =
3584 | Main_loop
menv when not
(is_tick event
) ->
3585 Main_loop
{ menv with Main_env.needs_idle
= true }
3588 let track_open_and_recent_files (state : state) (event
: event
) : state =
3589 (* We'll keep track of which files are opened by the editor. *)
3590 let prev_opened_files =
3591 Option.value (get_editor_open_files state) ~default
:UriMap.empty
3593 let editor_open_files =
3595 | Client_message
(_
, NotificationMessage
(DidOpenNotification
params)) ->
3596 let doc = params.DidOpen.textDocument
in
3597 let uri = params.DidOpen.textDocument
.TextDocumentItem.uri in
3598 UriMap.add
uri doc prev_opened_files
3599 | Client_message
(_
, NotificationMessage
(DidChangeNotification
params)) ->
3601 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3603 let doc = UriMap.find_opt
uri prev_opened_files in
3604 let open Lsp.TextDocumentItem
in
3611 params.DidChange.textDocument
3612 .VersionedTextDocumentIdentifier.version;
3614 Lsp_helpers.apply_changes_unsafe
3616 params.DidChange.contentChanges
;
3619 UriMap.add
uri doc'
prev_opened_files
3620 | None
-> prev_opened_files)
3621 | Client_message
(_
, NotificationMessage
(DidCloseNotification
params)) ->
3622 let uri = params.DidClose.textDocument
.TextDocumentIdentifier.uri in
3623 UriMap.remove
uri prev_opened_files
3624 | _
-> prev_opened_files
3626 (* We'll track which was the most recent file to have an event *)
3627 let most_recent_file =
3629 | Client_message
(_metadata
, message) ->
3630 let uri = Lsp_fmt.get_uri_opt
message in
3631 if Option.is_some
uri then
3634 get_most_recent_file state
3635 | _
-> get_most_recent_file state
3639 Main_loop
{ menv with Main_env.editor_open_files; most_recent_file }
3641 In_init
{ ienv
with In_init_env.editor_open_files; most_recent_file }
3642 | Lost_server lenv
->
3643 Lost_server
{ lenv
with Lost_env.editor_open_files; most_recent_file }
3646 let track_edits_if_necessary (state : state) (event
: event
) : state =
3647 (* We'll keep track of which files have unsaved edits. Note that not all
3648 * clients send didSave messages; for those we only rely on didClose. *)
3649 let previous = get_uris_with_unsaved_changes state in
3650 let uris_with_unsaved_changes =
3652 | Client_message
(_
, NotificationMessage
(DidChangeNotification
params)) ->
3654 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3656 UriSet.add
uri previous
3657 | Client_message
(_
, NotificationMessage
(DidCloseNotification
params)) ->
3658 let uri = params.DidClose.textDocument
.TextDocumentIdentifier.uri in
3659 UriSet.remove
uri previous
3660 | Client_message
(_
, NotificationMessage
(DidSaveNotification
params)) ->
3661 let uri = params.DidSave.textDocument
.TextDocumentIdentifier.uri in
3662 UriSet.remove
uri previous
3666 | Main_loop
menv -> Main_loop
{ menv with Main_env.uris_with_unsaved_changes }
3667 | In_init ienv
-> In_init
{ ienv
with In_init_env.uris_with_unsaved_changes }
3668 | Lost_server lenv
->
3669 Lost_server
{ lenv
with Lost_env.uris_with_unsaved_changes }
3672 let get_filename_in_message_for_logging (message : lsp_message
) :
3673 Relative_path.t
option =
3674 let uri_opt = Lsp_fmt.get_uri_opt
message in
3679 let path = Lsp_helpers.lsp_uri_to_path uri in
3680 Some
(Relative_path.create_detect_prefix
path)
3683 Some
(Relative_path.create
Relative_path.Dummy
(Lsp.string_of_uri
uri)))
3685 (* Historical quirk: we log kind and method-name a bit idiosyncratically... *)
3686 let get_message_kind_and_method_for_logging (message : lsp_message
) :
3689 | ResponseMessage
(_
, _
) -> ("Response", "[response]")
3690 | RequestMessage
(_
, r
) -> ("Request", Lsp_fmt.request_name_to_string r
)
3691 | NotificationMessage n
->
3692 ("Notification", Lsp_fmt.notification_name_to_string n
)
3694 let log_response_if_necessary
3697 (result_telemetry_opt
: result_telemetry
option)
3698 (unblocked_time
: float) : unit =
3700 | Client_message
(metadata
, message) ->
3701 let (kind, method_
) = get_message_kind_and_method_for_logging message in
3702 let t = Unix.gettimeofday
() in
3704 "lsp-message [%s] queue time [%0.3f] execution time [%0.3f]"
3706 (unblocked_time
-. metadata
.timestamp
)
3707 (t -. unblocked_time
);
3708 let (result_count
, result_extra_telemetry
) =
3709 match result_telemetry_opt
with
3710 | None
-> (None
, None
)
3711 | Some
{ result_count
; result_extra_telemetry
} ->
3712 (Some result_count
, result_extra_telemetry
)
3714 HackEventLogger.client_lsp_method_handled
3715 ~
root:(get_root_opt ())
3718 ~path_opt
:(get_filename_in_message_for_logging message)
3720 ~result_extra_telemetry
3721 ~
tracking_id:metadata
.tracking_id
3722 ~start_queue_time
:metadata
.timestamp
3723 ~start_hh_server_state
:
3724 (get_older_hh_server_state metadata
.timestamp
3725 |> hh_server_state_to_string)
3726 ~start_handle_time
:unblocked_time
3727 ~serverless_ide_flag
:env
.use_serverless_ide
3731 | Error_from_server_fatal
3732 | Error_from_client_fatal
3733 | Error_from_client_recoverable
3734 | Error_from_server_recoverable
3735 | Error_from_lsp_cancelled
3736 | Error_from_lsp_misc
3739 (event
: event
option)
3741 (source
: error_source
)
3742 (unblocked_time
: float)
3743 (env
: env
) : unit =
3744 let root = get_root_opt () in
3747 | Error_from_lsp_cancelled
-> true
3748 | Error_from_server_fatal
3749 | Error_from_client_fatal
3750 | Error_from_client_recoverable
3751 | Error_from_server_recoverable
3752 | Error_from_lsp_misc
->
3757 | Error_from_server_fatal
-> "server_fatal"
3758 | Error_from_client_fatal
-> "client_fatal"
3759 | Error_from_client_recoverable
-> "client_recoverable"
3760 | Error_from_server_recoverable
-> "server_recoverable"
3761 | Error_from_lsp_cancelled
-> "lsp_cancelled"
3762 | Error_from_lsp_misc
-> "lsp_misc"
3764 if not
is_expected then log "%s" (Lsp_fmt.error_to_log_string
e);
3766 | Some
(Client_message
(metadata
, message)) ->
3767 let start_hh_server_state =
3768 get_older_hh_server_state metadata
.timestamp
|> hh_server_state_to_string
3770 let (kind, method_
) = get_message_kind_and_method_for_logging message in
3771 HackEventLogger.client_lsp_method_exception
3775 ~path_opt
:(get_filename_in_message_for_logging message)
3776 ~
tracking_id:metadata
.tracking_id
3777 ~start_queue_time
:metadata
.timestamp
3778 ~
start_hh_server_state
3779 ~start_handle_time
:unblocked_time
3780 ~serverless_ide_flag
:env
.use_serverless_ide
3781 ~
message:e.Error.message
3782 ~data_opt
:e.Error.data
3785 HackEventLogger.client_lsp_exception
3787 ~
message:e.Error.message
3788 ~data_opt
:e.Error.data
3791 (* cancel_if_stale: If a message is stale, throw the necessary exception to
3792 cancel it. A message is considered stale if it's sufficiently old and there
3793 are other messages in the queue that are newer than it. *)
3794 let short_timeout = 2.5
3796 let long_timeout = 15.0
3798 let cancel_if_stale (client
: Jsonrpc.t) (timestamp
: float) (timeout
: float) :
3800 let time_elapsed = Unix.gettimeofday
() -. timestamp
in
3801 if Float.(time_elapsed >= timeout
) && Jsonrpc.has_message client
then
3805 Error.code
= Error.RequestCancelled
;
3806 message = "request timed out";
3812 (** This is called before we even start processing a message. Its purpose:
3813 if the Jsonrpc queue has already previously read off stdin a cancellation
3814 request for the message we're about to handle, then throw an exception.
3815 There are races, e.g. we might start handling this request because we haven't
3816 yet gotten around to reading a cancellation message off stdin. But
3817 that's inevitable. Think of this only as best-effort. *)
3818 let cancel_if_has_pending_cancel_request
3819 (client
: Jsonrpc.t) (message : lsp_message
) : unit =
3821 | ResponseMessage _
-> ()
3822 | NotificationMessage _
-> ()
3823 | RequestMessage
(id, _request
) ->
3824 (* Scan the queue for any pending (future) cancellation messages that are requesting
3825 cancellation of the same id as our current request *)
3826 let pending_cancel_request_opt =
3827 Jsonrpc.find_already_queued_message client ~
f:(fun { Jsonrpc.json; _
} ->
3830 Lsp_fmt.parse_lsp
json (fun _
->
3831 failwith
"not resolving responses")
3834 | NotificationMessage
3835 (CancelRequestNotification
{ Lsp.CancelRequest.id = peek_id
})
3837 Lsp.IdKey.compare
id peek_id
= 0
3842 (* If there is a future cancellation request, we won't even embark upon this message *)
3843 if Option.is_some
pending_cancel_request_opt then
3847 Error.code
= Error.RequestCancelled
;
3848 message = "request cancelled";
3854 (************************************************************************)
3855 (* Message handling *)
3856 (************************************************************************)
3858 (** send DidOpen/Close/Change/Save to hh_server and ide_service as needed *)
3859 let handle_editor_buffer_message
3861 ~
(ide_service
: ClientIdeService.t ref option)
3863 ~
(metadata
: incoming_metadata
)
3864 ~
(ref_unblocked_time
: float ref)
3865 ~
(message : lsp_message
) : unit Lwt.t =
3866 let uri_to_path uri = uri |> lsp_uri_to_path |> Path.make
in
3867 let ref_hh_unblocked_time = ref 0. in
3868 let ref_ide_unblocked_time = ref 0. in
3870 (* send to hh_server as necessary *)
3871 let (hh_server_promise
: unit Lwt.t) =
3872 let open Main_env
in
3873 match (state, message) with
3874 (* textDocument/didOpen notification *)
3875 | (Main_loop
menv, NotificationMessage
(DidOpenNotification
params)) ->
3876 let%lwt
() = do_didOpen menv.conn
ref_hh_unblocked_time params in
3878 (* textDocument/didClose notification *)
3879 | (Main_loop
menv, NotificationMessage
(DidCloseNotification
params)) ->
3880 let%lwt
() = do_didClose menv.conn
ref_hh_unblocked_time params in
3882 (* textDocument/didChange notification *)
3883 | (Main_loop
menv, NotificationMessage
(DidChangeNotification
params)) ->
3884 let%lwt
() = do_didChange menv.conn
ref_hh_unblocked_time params in
3886 (* textDocument/didSave notification *)
3887 | (Main_loop _menv
, NotificationMessage
(DidSaveNotification _params
)) ->
3889 | (_
, _
) -> Lwt.return_unit
3892 (* send to ide_service as necessary *)
3893 (* For now 'ide_service_promise' is immediately fulfilled, but in future it will
3894 be fulfilled only when the ide_service has finished processing the message. *)
3895 let (ide_service_promise
: unit Lwt.t) =
3896 match (ide_service
, message) with
3897 | (Some ide_service
, NotificationMessage
(DidOpenNotification
params)) ->
3899 uri_to_path params.DidOpen.textDocument
.TextDocumentItem.uri
3901 let file_contents = params.DidOpen.textDocument
.TextDocumentItem.text in
3902 (* The ClientIdeDaemon only delivers answers for open files, which is why it's vital
3903 never to let is miss a DidOpen. *)
3908 ~
tracking_id:metadata
.tracking_id
3909 ~ref_unblocked_time
:ref_ide_unblocked_time
3910 ClientIdeMessage.(Ide_file_opened
{ file_path; file_contents })
3913 | (Some ide_service
, NotificationMessage
(DidChangeNotification
params)) ->
3916 params.DidChange.textDocument
.VersionedTextDocumentIdentifier.uri
3922 ~
tracking_id:metadata
.tracking_id
3923 ~ref_unblocked_time
:ref_ide_unblocked_time
3924 ClientIdeMessage.(Ide_file_changed
{ Ide_file_changed.file_path })
3927 | (Some ide_service
, NotificationMessage
(DidCloseNotification
params)) ->
3929 uri_to_path params.DidClose.textDocument
.TextDocumentIdentifier.uri
3935 ~
tracking_id:metadata
.tracking_id
3936 ~ref_unblocked_time
:ref_ide_unblocked_time
3937 ClientIdeMessage.(Ide_file_closed
file_path)
3941 (* Don't handle other events for now. When we show typechecking errors for
3942 the open file, we'll start handling them. *)
3946 (* Our asynchrony deal is (1) we want to kick off notifications to
3947 hh_server and ide_service at the same time, (2) we want to wait until
3948 both are done, (3) an exception in one shouldn't jeapordize the other,
3949 (4) our failure model only allows us to record at most one exception
3950 so we'll pick one arbitrarily. *)
3951 let%lwt
(hh_server_e
: Exception.t option) =
3953 let%lwt
() = hh_server_promise
in
3956 | e -> Lwt.return_some
(Exception.wrap
e)
3957 and (ide_service_e
: Exception.t option) =
3959 let%lwt
() = ide_service_promise
in
3962 | e -> Lwt.return_some
(Exception.wrap
e)
3964 ref_unblocked_time
:= Float.max
!ref_hh_unblocked_time !ref_ide_unblocked_time;
3965 match (hh_server_e
, ide_service_e
) with
3969 | _
-> Lwt.return_unit
3971 let set_verbose_to_file
3972 ~
(ide_service
: ClientIdeService.t ref option)
3974 ~
(tracking_id : string)
3975 (value : bool) : unit =
3976 verbose_to_file := value;
3977 if !verbose_to_file then
3978 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Debug
3980 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Info
;
3981 match ide_service
with
3982 | Some ide_service
->
3983 let ref_unblocked_time = ref 0. in
3984 let (promise
: unit Lwt.t) =
3990 (ClientIdeMessage.Verbose_to_file
!verbose_to_file)
3992 ignore_promise_but_handle_failure
3994 ~desc
:"verbose-ide-rpc"
3995 ~terminate_on_failure
:false
3998 (* handle_event: Process and respond to a message, and update the LSP state
3999 machine accordingly. In case the message was a request, it returns the
4000 json it responded with, so the caller can log it. *)
4001 let handle_client_message
4003 ~
(state : state ref)
4004 ~
(client
: Jsonrpc.t)
4005 ~
(ide_service
: ClientIdeService.t ref option)
4006 ~
(metadata
: incoming_metadata
)
4007 ~
(message : lsp_message
)
4008 ~
(ref_unblocked_time : float ref) : result_telemetry
option Lwt.t =
4009 let open Main_env
in
4010 cancel_if_has_pending_cancel_request client
message;
4011 let%lwt result_telemetry_opt
=
4012 (* make sure to wrap any exceptions below in the promise *)
4013 let tracking_id = metadata
.tracking_id in
4014 let timestamp = metadata
.timestamp in
4015 let editor_open_files =
4016 match get_editor_open_files !state with
4017 | Some files
-> files
4018 | None
-> UriMap.empty
4020 match (!state, ide_service
, message) with
4022 | (_
, _
, ResponseMessage
(id, response)) ->
4023 let (_
, handler) = IdMap.find
id !requests_outstanding in
4024 let%lwt new_state
= handler response !state in
4027 (* shutdown request *)
4028 | (_
, _
, RequestMessage
(id, ShutdownRequest
)) ->
4030 do_shutdown !state ide_service
tracking_id ref_unblocked_time
4033 respond_jsonrpc ~powered_by
:Language_server
id ShutdownResult
;
4035 (* cancel notification *)
4036 | (_
, _
, NotificationMessage
(CancelRequestNotification _
)) ->
4037 (* In [cancel_if_has_pending_cancel_request] above, when we received request ID "x",
4038 then at that time then we scanned through the queue for any CancelRequestNotification
4039 of the same ID. We didn't remove that CancelRequestNotification though.
4040 If we worked through the queue long enough to handle a CancelRequestNotification,
4041 it means that either we've earlier cancelled it, or that processing was done
4042 before the cancel request got into the queue. Either way, there's nothing to do now! *)
4044 (* exit notification *)
4045 | (_
, _
, NotificationMessage ExitNotification
) ->
4046 if is_post_shutdown !state then
4050 (* setTrace notification *)
4051 | (_
, _
, NotificationMessage
(SetTraceNotification
params)) ->
4054 | SetTraceNotification.Verbose
-> true
4055 | SetTraceNotification.Off
-> false
4057 set_verbose_to_file ~ide_service ~env ~
tracking_id value;
4059 (* test entrypoint: shutdown client_ide_service *)
4062 RequestMessage
(id, HackTestShutdownServerlessRequestFB
) ) ->
4067 ~stop_reason
:ClientIdeService.Stop_reason.Testing
4070 ~powered_by
:Serverless_ide
4072 HackTestShutdownServerlessResultFB
;
4074 (* test entrypoint: stop hh_server *)
4075 | (_
, _
, RequestMessage
(id, HackTestStopServerRequestFB
)) ->
4077 Path.make
(Relative_path.path_of_prefix
Relative_path.Root
)
4079 ClientStop.kill_server
root_folder !from;
4080 respond_jsonrpc ~powered_by
:Serverless_ide
id HackTestStopServerResultFB
;
4082 (* test entrypoint: start hh_server *)
4083 | (_
, _
, RequestMessage
(id, HackTestStartServerRequestFB
)) ->
4085 Path.make
(Relative_path.path_of_prefix
Relative_path.Root
)
4087 start_server ~env
root_folder;
4088 respond_jsonrpc ~powered_by
:Serverless_ide
id HackTestStartServerResultFB
;
4090 (* initialize request *)
4091 | (Pre_init
, _
, RequestMessage
(id, InitializeRequest
initialize_params)) ->
4092 let open Initialize
in
4093 initialize_params_ref := Some
initialize_params;
4095 (* There's a lot of global-mutable-variable initialization we can only do after
4096 we get root, here in the handler of the initialize request. The function
4097 [get_root_exn] becomes available after we've set up initialize_params_ref, above. *)
4098 let root = get_root_exn () in
4099 Relative_path.set_path_prefix
Relative_path.Root
root;
4100 set_up_hh_logger_for_client_lsp root;
4102 (* Following is a hack. Atom incorrectly passes '--from vscode', rendering us
4103 unable to distinguish Atom from VSCode. But Atom is now frozen at vscode client
4104 v3.14. So by looking at the version, we can at least distinguish that it's old. *)
4107 initialize_params.client_capabilities
.textDocument
.declaration
4108 .declarationLinkSupport
)
4109 && String.equal env
.args
.from "vscode"
4111 from := "vscode_pre314";
4112 HackEventLogger.set_from
!from
4115 (* The function [get_local_config_exn] becomes available after we've set ref_local_config. *)
4117 ServerArgs.default_options ~
root:(Path.to_string
root)
4119 let server_args = ServerArgs.set_config
server_args env
.args
.config
in
4121 snd
@@ ServerConfig.load ~silent
:true ServerConfig.filename server_args
4123 ref_local_config := Some
local_config;
4124 HackEventLogger.set_rollout_flags
4125 (ServerLocalConfig.to_rollout_flags
local_config);
4126 HackEventLogger.set_rollout_group
4127 local_config.ServerLocalConfig.rollout_group
;
4128 HackEventLogger.set_machine_class
4129 local_config.ServerLocalConfig.machine_class
;
4131 let%lwt
version = read_hhconfig_version () in
4132 HackEventLogger.set_hhconfig_version
4133 (Some
(String_utils.lstrip
version "^"));
4134 let%lwt version_and_switch
= read_hhconfig_version_and_switch () in
4135 hhconfig_version_and_switch := version_and_switch
;
4136 let%lwt new_state
= connect ~env
!state in
4138 (* If editor sent 'trace: on' then that will turn on verbose_to_file. But we won't turn off
4139 verbose here, since the command-line argument --verbose trumps initialization params. *)
4141 match initialize_params.Initialize.trace
with
4142 | Initialize.Off
-> ()
4143 | Initialize.Messages
4144 | Initialize.Verbose
->
4145 set_verbose_to_file ~ide_service ~env ~
tracking_id true
4147 let result = do_initialize local_config in
4148 respond_jsonrpc ~powered_by
:Language_server
id (InitializeResult
result);
4151 match ide_service
with
4153 | Some ide_service
->
4154 let (promise
: unit Lwt.t) =
4155 run_ide_service env
!ide_service
initialize_params None
4157 ignore_promise_but_handle_failure
4159 ~desc
:"run-ide-after-init"
4160 ~terminate_on_failure
:true;
4161 (* Invariant: at all times after InitializeRequest, ide_service has
4162 already been sent an "initialize" message. *)
4163 let id = NumberId
(Jsonrpc.get_next_request_id
()) in
4164 let request = do_didChangeWatchedFiles_registerCapability () in
4165 to_stdout (print_lsp_request
id request);
4166 (* TODO: our handler should really handle an error response properly *)
4167 let handler _response
state = Lwt.return
state in
4168 requests_outstanding :=
4169 IdMap.add
id (request, handler) !requests_outstanding
4172 if not
(Sys_utils.deterministic_behavior_for_tests
()) then
4173 Lsp_helpers.telemetry_log
4175 ("Version in hhconfig and switch=" ^
!hhconfig_version_and_switch);
4176 Lwt.return_some
{ result_count
= 0; result_extra_telemetry
= None
}
4177 (* any request/notification if we haven't yet initialized *)
4178 | (Pre_init
, _
, _
) ->
4182 Error.code
= Error.ServerNotInitialized
;
4183 message = "Server not yet initialized";
4186 | (Post_shutdown
, _
, _c
) ->
4190 Error.code
= Error.InvalidRequest
;
4191 message = "already received shutdown request";
4194 (* initialized notification *)
4195 | (_
, _
, NotificationMessage InitializedNotification
) -> Lwt.return_none
4197 | (_
, _
, RequestMessage
(id, RageRequestFB
)) ->
4198 let%lwt
result = do_rageFB !state in
4199 respond_jsonrpc ~powered_by
:Language_server
id (RageResultFB
result);
4201 { result_count
= List.length
result; result_extra_telemetry
= None
}
4204 NotificationMessage
(DidChangeWatchedFilesNotification
notification) )
4206 let open DidChangeWatchedFiles
in
4208 List.map
notification.changes ~
f:(fun change
->
4209 ClientIdeMessage.Changed_file
(lsp_uri_to_path change
.uri))
4217 ClientIdeMessage.(Disk_files_changed
changes)
4220 (* Text document completion: "AutoComplete!" *)
4221 | (_
, Some ide_service
, RequestMessage
(id, CompletionRequest
params)) ->
4222 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4232 respond_jsonrpc ~powered_by
:Serverless_ide
id (CompletionResult
result);
4235 result_count
= List.length
result.Completion.items
;
4236 result_extra_telemetry
= None
;
4238 (* Resolve documentation for a symbol: "Autocomplete Docblock!" *)
4241 RequestMessage
(id, CompletionItemResolveRequest
params) ) ->
4242 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4253 ~powered_by
:Serverless_ide
4255 (CompletionItemResolveResult
result);
4256 Lwt.return_some
{ result_count
= 1; result_extra_telemetry
= None
}
4257 (* Document highlighting in serverless IDE *)
4258 | (_
, Some ide_service
, RequestMessage
(id, DocumentHighlightRequest
params))
4260 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4271 ~powered_by
:Serverless_ide
4273 (DocumentHighlightResult
result);
4275 { result_count
= List.length
result; result_extra_telemetry
= None
}
4276 (* Type coverage in serverless IDE *)
4277 | (_
, Some ide_service
, RequestMessage
(id, TypeCoverageRequestFB
params))
4279 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4281 do_typeCoverage_localFB
4290 ~powered_by
:Serverless_ide
4292 (TypeCoverageResultFB
result);
4295 result_count
= List.length
result.TypeCoverageFB.uncoveredRanges
;
4296 result_extra_telemetry
= None
;
4298 (* Hover docblocks in serverless IDE *)
4299 | (_
, Some ide_service
, RequestMessage
(id, HoverRequest
params)) ->
4300 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4310 respond_jsonrpc ~powered_by
:Serverless_ide
id (HoverResult
result);
4314 | Some
{ Hover.contents; _
} -> List.length
contents
4316 Lwt.return_some
{ result_count; result_extra_telemetry
= None
}
4317 | (_
, Some ide_service
, RequestMessage
(id, DocumentSymbolRequest
params))
4319 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4321 do_documentSymbol_local
4330 ~powered_by
:Serverless_ide
4332 (DocumentSymbolResult
result);
4334 { result_count = List.length
result; result_extra_telemetry
= None
}
4335 | (_
, Some ide_service
, RequestMessage
(id, WorkspaceSymbolRequest
params))
4338 do_workspaceSymbol_local
4346 ~powered_by
:Serverless_ide
4348 (WorkspaceSymbolResult
result);
4350 { result_count = List.length
result; result_extra_telemetry
= None
}
4351 | (_
, Some ide_service
, RequestMessage
(id, DefinitionRequest
params)) ->
4352 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4353 let%lwt
(result, has_xhp_attribute) =
4362 let result_extra_telemetry =
4365 (Telemetry.create
()
4366 |> Telemetry.bool_ ~key
:"has_xhp_attribute" ~
value:true)
4368 respond_jsonrpc ~powered_by
:Serverless_ide
id (DefinitionResult
result);
4370 { result_count = List.length
result; result_extra_telemetry }
4371 | (_
, Some ide_service
, RequestMessage
(id, TypeDefinitionRequest
params))
4373 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4375 do_typeDefinition_local
4384 ~powered_by
:Serverless_ide
4386 (TypeDefinitionResult
result);
4388 { result_count = List.length
result; result_extra_telemetry = None
}
4389 (* Resolve documentation for a symbol: "Autocomplete Docblock!" *)
4390 | (_
, Some ide_service
, RequestMessage
(id, SignatureHelpRequest
params)) ->
4391 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4393 do_signatureHelp_local
4401 respond_jsonrpc ~powered_by
:Serverless_ide
id (SignatureHelpResult
result);
4405 | Some
{ SignatureHelp.signatures
; _
} -> List.length signatures
4407 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4408 (* textDocument/codeAction request *)
4409 | (_
, Some ide_service
, RequestMessage
(id, CodeActionRequest
params)) ->
4410 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4420 respond_jsonrpc ~powered_by
:Serverless_ide
id (CodeActionResult
result);
4422 { result_count = List.length
result; result_extra_telemetry = None
}
4423 (* textDocument/codeAction request, when not in serverless IDE mode *)
4424 | (Main_loop
menv, None
, RequestMessage
(id, CodeActionRequest
params)) ->
4425 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4426 let%lwt
result = do_codeAction menv.conn
ref_unblocked_time params in
4427 respond_jsonrpc ~powered_by
:Hh_server
id (CodeActionResult
result);
4429 { result_count = List.length
result; result_extra_telemetry = None
}
4430 (* textDocument/formatting *)
4431 | (_
, _
, RequestMessage
(id, DocumentFormattingRequest
params)) ->
4432 let result = do_documentFormatting editor_open_files params in
4434 ~powered_by
:Language_server
4436 (DocumentFormattingResult
result);
4438 { result_count = List.length
result; result_extra_telemetry = None
}
4439 (* textDocument/rangeFormatting *)
4440 | (_
, _
, RequestMessage
(id, DocumentRangeFormattingRequest
params)) ->
4441 let result = do_documentRangeFormatting editor_open_files params in
4443 ~powered_by
:Language_server
4445 (DocumentRangeFormattingResult
result);
4447 { result_count = List.length
result; result_extra_telemetry = None
}
4448 (* textDocument/onTypeFormatting *)
4449 | (_
, _
, RequestMessage
(id, DocumentOnTypeFormattingRequest
params)) ->
4450 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4451 let result = do_documentOnTypeFormatting editor_open_files params in
4453 ~powered_by
:Language_server
4455 (DocumentOnTypeFormattingResult
result);
4457 { result_count = List.length
result; result_extra_telemetry = None
}
4458 (* textDocument/willSaveWaitUntil request *)
4459 | (_
, _
, RequestMessage
(id, WillSaveWaitUntilRequest
params)) ->
4460 let result = do_willSaveWaitUntil editor_open_files params in
4462 ~powered_by
:Language_server
4464 (WillSaveWaitUntilResult
result);
4466 { result_count = List.length
result; result_extra_telemetry = None
}
4467 (* editor buffer events *)
4471 ( DidOpenNotification _
| DidChangeNotification _
4472 | DidCloseNotification _
| DidSaveNotification _
) ) ->
4474 handle_editor_buffer_message
4483 (* any request/notification that we can't handle yet *)
4484 | (In_init _
, _
, message) ->
4485 (* we respond with Operation_cancelled so that clients don't produce *)
4486 (* user-visible logs/warnings. *)
4490 Error.code
= Error.RequestCancelled
;
4491 message = Hh_server_initializing
|> hh_server_state_to_string;
4494 (Hh_json.JSON_Object
4496 ("state", !state |> state_to_string |> Hh_json.string_
);
4499 (Lsp_fmt.denorm_message_to_string
message) );
4502 (* textDocument/hover request *)
4503 | (Main_loop
menv, _
, RequestMessage
(id, HoverRequest
params)) ->
4504 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4505 let%lwt
result = do_hover menv.conn
ref_unblocked_time params in
4506 respond_jsonrpc ~powered_by
:Hh_server
id (HoverResult
result);
4510 | Some
{ Hover.contents; _
} -> List.length
contents
4512 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4513 (* textDocument/typeDefinition request *)
4514 | (Main_loop
menv, _
, RequestMessage
(id, TypeDefinitionRequest
params)) ->
4515 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4516 let%lwt
result = do_typeDefinition menv.conn
ref_unblocked_time params in
4517 respond_jsonrpc ~powered_by
:Hh_server
id (TypeDefinitionResult
result);
4519 { result_count = List.length
result; result_extra_telemetry = None
}
4520 (* textDocument/definition request *)
4521 | (Main_loop
menv, _
, RequestMessage
(id, DefinitionRequest
params)) ->
4522 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4523 let%lwt
(result, has_xhp_attribute) =
4524 do_definition menv.conn
ref_unblocked_time editor_open_files params
4526 let result_extra_telemetry =
4529 (Telemetry.create
()
4530 |> Telemetry.bool_ ~key
:"has_xhp_attribute" ~
value:true)
4532 respond_jsonrpc ~powered_by
:Hh_server
id (DefinitionResult
result);
4534 { result_count = List.length
result; result_extra_telemetry }
4535 (* textDocument/completion request *)
4536 | (Main_loop
menv, _
, RequestMessage
(id, CompletionRequest
params)) ->
4538 if env
.use_ffp_autocomplete
then
4541 do_completion_legacy
4543 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4544 let%lwt
result = do_completion menv.conn
ref_unblocked_time params in
4545 respond_jsonrpc ~powered_by
:Hh_server
id (CompletionResult
result);
4548 result_count = List.length
result.Completion.items
;
4549 result_extra_telemetry = None
;
4551 (* completionItem/resolve request *)
4554 RequestMessage
(id, CompletionItemResolveRequest
params) ) ->
4555 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4557 do_completionItemResolve menv.conn
ref_unblocked_time params
4560 ~powered_by
:Hh_server
4562 (CompletionItemResolveResult
result);
4563 Lwt.return_some
{ result_count = 1; result_extra_telemetry = None
}
4564 (* workspace/symbol request *)
4565 | (Main_loop
menv, _
, RequestMessage
(id, WorkspaceSymbolRequest
params)) ->
4566 let%lwt
result = do_workspaceSymbol menv.conn
ref_unblocked_time params in
4567 respond_jsonrpc ~powered_by
:Hh_server
id (WorkspaceSymbolResult
result);
4569 { result_count = List.length
result; result_extra_telemetry = None
}
4570 (* textDocument/documentSymbol request *)
4571 | (Main_loop
menv, _
, RequestMessage
(id, DocumentSymbolRequest
params)) ->
4572 let%lwt
result = do_documentSymbol menv.conn
ref_unblocked_time params in
4573 respond_jsonrpc ~powered_by
:Hh_server
id (DocumentSymbolResult
result);
4575 { result_count = List.length
result; result_extra_telemetry = None
}
4576 (* textDocument/references request *)
4577 | (Main_loop
menv, _
, RequestMessage
(id, FindReferencesRequest
params)) ->
4578 let%lwt
() = cancel_if_stale client
timestamp long_timeout in
4579 let%lwt
result = do_findReferences menv.conn
ref_unblocked_time params in
4580 respond_jsonrpc ~powered_by
:Hh_server
id (FindReferencesResult
result);
4582 { result_count = List.length
result; result_extra_telemetry = None
}
4583 (* textDocument/implementation request *)
4584 | (Main_loop
menv, _
, RequestMessage
(id, ImplementationRequest
params)) ->
4585 let%lwt
() = cancel_if_stale client
timestamp long_timeout in
4587 do_goToImplementation menv.conn
ref_unblocked_time params
4589 respond_jsonrpc ~powered_by
:Hh_server
id (ImplementationResult
result);
4591 { result_count = List.length
result; result_extra_telemetry = None
}
4592 (* textDocument/rename *)
4593 | (Main_loop
menv, _
, RequestMessage
(id, RenameRequest
params)) ->
4594 let%lwt
result = do_documentRename menv.conn
ref_unblocked_time params in
4595 respond_jsonrpc ~powered_by
:Hh_server
id (RenameResult
result);
4598 (fun _file
changes tot
-> tot
+ List.length
changes)
4599 result.WorkspaceEdit.changes
4602 let result_extra_telemetry =
4606 ~
value:(SMap.cardinal
result.WorkspaceEdit.changes)
4609 { result_count; result_extra_telemetry = Some
result_extra_telemetry }
4610 (* textDocument/documentHighlight *)
4611 | (Main_loop
menv, _
, RequestMessage
(id, DocumentHighlightRequest
params))
4613 let%lwt
() = cancel_if_stale client
timestamp short_timeout in
4615 do_documentHighlight menv.conn
ref_unblocked_time params
4617 respond_jsonrpc ~powered_by
:Hh_server
id (DocumentHighlightResult
result);
4619 { result_count = List.length
result; result_extra_telemetry = None
}
4620 (* textDocument/typeCoverage *)
4621 | (Main_loop
menv, _
, RequestMessage
(id, TypeCoverageRequestFB
params)) ->
4622 let%lwt
result = do_typeCoverageFB menv.conn
ref_unblocked_time params in
4623 respond_jsonrpc ~powered_by
:Hh_server
id (TypeCoverageResultFB
result);
4626 result_count = List.length
result.TypeCoverageFB.uncoveredRanges
;
4627 result_extra_telemetry = None
;
4629 (* textDocument/signatureHelp notification *)
4630 | (Main_loop
menv, _
, RequestMessage
(id, SignatureHelpRequest
params)) ->
4631 let%lwt
result = do_signatureHelp menv.conn
ref_unblocked_time params in
4632 respond_jsonrpc ~powered_by
:Hh_server
id (SignatureHelpResult
result);
4636 | Some
result -> List.length
result.SignatureHelp.signatures
4638 Lwt.return_some
{ result_count; result_extra_telemetry = None
}
4639 (* catch-all for client reqs/notifications we haven't yet implemented *)
4640 | (Main_loop _menv
, _
, message) ->
4641 let method_ = Lsp_fmt.message_name_to_string
message in
4645 Error.code
= Error.MethodNotFound
;
4646 message = Printf.sprintf
"not implemented: %s" method_;
4649 (* catch-all for requests/notifications after shutdown request *)
4650 (* client message when we've lost the server *)
4651 | (Lost_server lenv
, _
, _
) ->
4652 let open Lost_env
in
4653 (* if trigger_on_lsp_method is set, our caller should already have *)
4654 (* transitioned away from this state. *)
4655 assert (not lenv
.p.trigger_on_lsp
);
4657 (* We deny all other requests. This is the only response that won't *)
4658 (* produce logs/warnings on most clients... *)
4662 Error.code
= Error.RequestCancelled
;
4663 message = lenv
.p.new_hh_server_state |> hh_server_state_to_string;
4666 (Hh_json.JSON_Object
4668 ("state", !state |> state_to_string |> Hh_json.string_
);
4671 (Lsp_fmt.denorm_message_to_string
message) );
4675 Lwt.return result_telemetry_opt
4677 let handle_server_message
4678 ~
(env
: env
) ~
(state : state ref) ~
(message : server_message
) :
4679 result_telemetry
option Lwt.t =
4681 match (!state, message) with
4682 (* server busy status *)
4683 | (_
, { push
= ServerCommandTypes.BUSY_STATUS
status; _
}) ->
4684 state := do_server_busy !state status;
4686 (* textDocument/publishDiagnostics notification *)
4688 { push
= ServerCommandTypes.DIAGNOSTIC
{ errors
; is_truncated
}; _
} )
4690 let uris_with_diagnostics =
4691 do_diagnostics menv.Main_env.uris_with_diagnostics errors ~is_truncated
4693 state := Main_loop
{ menv with Main_env.uris_with_diagnostics };
4695 (* any server diagnostics that come after we've shut down *)
4696 | (_
, { push
= ServerCommandTypes.DIAGNOSTIC _
; _
}) -> Lwt.return_unit
4697 (* server shut-down request *)
4698 | (Main_loop _menv
, { push
= ServerCommandTypes.NEW_CLIENT_CONNECTED
; _
})
4705 Lost_env.explanation = "hh_server is active in another window.";
4706 new_hh_server_state = Hh_server_stolen
;
4707 start_on_click
= false;
4708 trigger_on_lock_file
= false;
4709 trigger_on_lsp
= true;
4714 (* server shut-down request, unexpected *)
4715 | (_
, { push
= ServerCommandTypes.NEW_CLIENT_CONNECTED
; _
}) ->
4716 let message = "unexpected close of absent server" in
4718 raise
(Server_fatal_connection_exception
{ Marshal_tools.message; stack })
4719 (* server fatal shutdown *)
4720 | (_
, { push
= ServerCommandTypes.FATAL_EXCEPTION
e; _
}) ->
4721 raise
(Server_fatal_connection_exception
e)
4722 (* server non-fatal exception *)
4726 ServerCommandTypes.NONFATAL_EXCEPTION
4727 { Marshal_tools.message; stack };
4730 raise
(Server_nonfatal_exception
(make_lsp_error message ~
stack))
4734 (** The server sending 'hello' means that it is ready to establish a persistent
4735 connection. Establish that connection and send our backlog of file-edits to the server. *)
4736 let connect_after_hello (server_conn
: server_conn
) (state : state) : unit Lwt.t
4738 log "connect_after_hello";
4741 (* tell server we want persistent connection *)
4742 let oc = server_conn
.oc in
4743 ServerCommandLwt.send_connection_type
oc ServerCommandTypes.Persistent
;
4744 let fd = oc |> Unix.descr_of_out_channel
|> Lwt_unix.of_unix_file_descr
in
4745 let%lwt
(response : 'a
ServerCommandTypes.message_type
) =
4746 Marshal_tools_lwt.from_fd_with_preamble
fd
4750 | ServerCommandTypes.Response
(ServerCommandTypes.Connected
, _
) ->
4751 set_hh_server_state Hh_server_handling_or_ready
4752 | _
-> failwith
"Didn't get server Connected response"
4755 (* Extract the list of file changes we're tracking *)
4756 let editor_open_files =
4759 | Main_loop
menv -> Main_env.(menv.editor_open_files)
4760 | In_init ienv
-> In_init_env.(ienv
.editor_open_files)
4761 | Lost_server lenv
-> Lost_env.(lenv
.editor_open_files)
4762 | _
-> UriMap.empty
)
4764 (* send open files and unsaved buffers to server *)
4765 let float_unblocked_time = ref 0.0 in
4766 (* Note: do serially since these involve RPC calls. *)
4769 (fun (uri, textDocument
) ->
4770 let filename = lsp_uri_to_path uri in
4772 ServerCommandTypes.OPEN_FILE
4773 (filename, textDocument
.TextDocumentItem.text)
4775 rpc server_conn
float_unblocked_time ~desc
:"open" command)
4781 let e = Exception.wrap
exn in
4782 log "connect_after_hello exception %s" (Exception.to_string
e);
4783 raise
(Server_fatal_connection_exception
(Marshal_tools.of_exception
e))
4787 let handle_server_hello ~
(state : state ref) : result_telemetry
option Lwt.t =
4790 (* server completes initialization *)
4792 let%lwt
() = connect_after_hello ienv
.In_init_env.conn
!state in
4793 state := report_connect_end ienv
;
4795 (* any "hello" from the server when we weren't expecting it. This is so *)
4796 (* egregious that we can't trust anything more from the server. *)
4798 let message = "Unexpected hello" in
4800 raise
(Server_fatal_connection_exception
{ Marshal_tools.message; stack })
4804 let handle_client_ide_notification
4805 ~
(notification : ClientIdeMessage.notification) :
4806 result_telemetry
option Lwt.t =
4807 (* In response to ide_service notifications we have three goals:
4808 (1) in case of Done_init, we might have to announce the failure to the user
4809 (2) in a few other cases, we send telemetry events so that test harnesses
4810 get insight into the internal state of the ide_service
4811 (3) after every single event, includinng client_ide_notification events,
4812 our caller queries the ide_service for what status it wants to display to
4813 the user, so these notifications have the goal of triggering that refresh. *)
4814 match notification with
4815 | ClientIdeMessage.Done_init
(Ok
p) ->
4816 Lsp_helpers.telemetry_log
to_stdout "[client-ide] Finished init: ok";
4817 Lsp_helpers.telemetry_log
4820 "[client-ide] Initialized; %d file changes to process"
4821 p.ClientIdeMessage.Processing_files.total
);
4823 | ClientIdeMessage.Done_init
(Error error_data
) ->
4824 log_debug "<-- done_init";
4825 Lsp_helpers.telemetry_log
to_stdout "[client-ide] Finished init: failure";
4826 let%lwt
() = announce_ide_failure error_data
in
4828 | ClientIdeMessage.Processing_files _
->
4829 (* used solely for triggering a refresh of status by our caller; nothing
4830 for us to do here. *)
4832 | ClientIdeMessage.Done_processing
->
4833 Lsp_helpers.telemetry_log
4835 "[client-ide] Done processing file changes";
4839 ~
(env
: env
) ~
(state : state ref) ~
(ref_unblocked_time : float ref) :
4840 result_telemetry
option Lwt.t =
4841 EventLogger.recheck_disk_files
();
4842 HackEventLogger.Memory.profile_if_needed
();
4843 (* Update the hh_server_status global variable, either by asking the monitor
4844 during In_init, or reading it from Main_env: *)
4845 latest_hh_server_status := get_hh_server_status !state;
4848 (* idle tick while waiting for server to complete initialization *)
4850 let open In_init_env
in
4851 let time = Unix.time () in
4852 let delay_in_secs = int_of_float
(time -. ienv
.most_recent_start_time
) in
4854 if delay_in_secs <= 10 then
4857 (* terminate + retry the connection *)
4858 let%lwt new_state
= connect ~env
!state in
4863 (* Tick when we're connected to the server *)
4865 let open Main_env
in
4867 if menv.needs_idle
then begin
4868 (* If we're connected to a server and have no more messages in the queue, *)
4869 (* then we must let the server know we're idle, so it will be free to *)
4870 (* handle command-line requests. *)
4871 state := Main_loop
{ menv with needs_idle
= false };
4877 ServerCommandTypes.IDE_IDLE
4884 (* idle tick. No-op. *)
4885 | _
-> Lwt.return_unit
4887 let (promise
: unit Lwt.t) = EventLoggerLwt.flush
() in
4888 ignore_promise_but_handle_failure
4890 ~desc
:"tick-event-flush"
4891 ~terminate_on_failure
:false;
4894 let main (args
: args
) ~
(init_id
: string) : Exit_status.t Lwt.t =
4895 Printexc.record_backtrace
true;
4897 HackEventLogger.set_from
!from;
4899 (* The hh.conf can't fully be loaded without root, since it has flags like "foo=^4.53" that
4900 depend on the version= line we read from root/.hhconfig. But nevertheless we need right now
4901 a few hh.conf flags that control clientLsp and which aren't done that way. So we'll read
4902 those flags right now. *)
4903 let versionless_local_config =
4904 ServerLocalConfig.load
4906 ~current_version
:(Config_file.parse_version None
)
4907 (Config_file.of_list args
.config
)
4913 use_ffp_autocomplete
=
4914 versionless_local_config.ServerLocalConfig.ide_ffp_autocomplete
;
4915 use_ranked_autocomplete
=
4916 versionless_local_config.ServerLocalConfig.ide_ranked_autocomplete
;
4917 use_serverless_ide
=
4918 versionless_local_config.ServerLocalConfig.ide_serverless
;
4922 if env.args
.verbose
then begin
4923 Hh_logger.Level.set_min_level_stderr
Hh_logger.Level.Debug
;
4924 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Debug
4926 Hh_logger.Level.set_min_level_stderr
Hh_logger.Level.Error
;
4927 Hh_logger.Level.set_min_level_file
Hh_logger.Level.Info
4929 (* The --verbose flag in env.verbose is the only thing that controls verbosity
4930 to stderr. Meanwhile, verbosity-to-file can be altered dynamically by the user.
4931 Why are they different? because we should write to stderr under a test harness,
4932 but we should never write to stderr when invoked by VSCode - it's not even guaranteed
4933 to drain the stderr pipe. *)
4935 if env.use_serverless_ide
then
4938 (ClientIdeService.make
4940 ClientIdeMessage.init_id
= env.init_id
;
4941 verbose_to_stderr
= env.args
.verbose
;
4942 verbose_to_file = env.args
.verbose
;
4948 let client = Jsonrpc.make_t
() in
4949 let deferred_action : (unit -> unit Lwt.t) option ref = ref None
in
4950 let state = ref Pre_init
in
4951 let ref_event = ref None
in
4952 let ref_unblocked_time = ref (Unix.gettimeofday
()) in
4953 (* ref_unblocked_time is the time at which we're no longer blocked on either
4954 * clientLsp message-loop or hh_server, and can start actually handling.
4955 * Everything that blocks will update this variable. *)
4956 let process_next_event () : unit Lwt.t =
4959 match !deferred_action with
4960 | Some
deferred_action ->
4961 let%lwt
() = deferred_action () in
4963 | None
-> Lwt.return_unit
4965 deferred_action := None
;
4966 let%lwt event
= get_next_event !state client ide_service in
4967 if not
(is_tick event
) then
4968 log_debug "next event: %s" (event_to_string event
);
4969 ref_event := Some event
;
4970 ref_unblocked_time := Unix.gettimeofday
();
4972 (* maybe set a flag to indicate that we'll need to send an idle message *)
4973 state := handle_idle_if_necessary !state event
;
4975 (* if we're in a lost-server state, some triggers cause us to reconnect *)
4977 reconnect_from_lost_if_necessary ~
env !state (`Event event
)
4981 (* we keep track of all open files and their contents *)
4982 state := track_open_and_recent_files !state event
;
4984 (* we keep track of all files that have unsaved changes in them *)
4985 state := track_edits_if_necessary !state event
;
4987 (* if a message comes from the server, maybe update our record of server state *)
4988 update_hh_server_state_if_necessary event
;
4990 (* update status immediately if warranted *)
4991 if not
(is_pre_init !state || is_post_shutdown !state) then begin
4993 publish_hh_server_status_diagnostic !state !latest_hh_server_status;
4994 refresh_status ~
env ~
ide_service
4997 (* this is the main handler for each message*)
4998 let%lwt result_telemetry_opt
=
5000 | Client_message
(metadata
, message) ->
5001 handle_client_message
5009 | Client_ide_notification
notification ->
5010 handle_client_ide_notification ~
notification
5011 | Server_message
message -> handle_server_message ~
env ~
state ~
message
5012 | Server_hello
-> handle_server_hello ~
state
5013 | Tick
-> handle_tick ~
env ~
state ~
ref_unblocked_time
5015 (* for LSP requests and notifications, we keep a log of what+when we responded.
5016 INVARIANT: every LSP request gets either a response logged here,
5017 or an error logged by one of the handlers below. *)
5018 log_response_if_necessary
5021 result_telemetry_opt
5022 !ref_unblocked_time;
5025 | Server_fatal_connection_exception
{ Marshal_tools.stack; message } ->
5026 if not
(is_post_shutdown !state) then (
5027 (* The server never tells us why it closed the connection - it simply *)
5028 (* closes. We don't have privilege to inspect its exit status. *)
5029 (* But in some cases of a controlled exit, the server does write to a *)
5030 (* "finale file" to explain its reason for exit... *)
5031 let server_finale_data =
5033 | Main_loop
{ Main_env.conn
; _
}
5034 | In_init
{ In_init_env.conn
; _
} ->
5035 Exit.get_finale_data
5036 conn
.server_specific_files
.ServerCommandTypes.server_finale_file
5039 let server_finale_stack =
5040 match server_finale_data with
5041 | Some
{ Exit.stack = Utils.Callstack
s; _
} ->
5042 s |> Exception.clean_stack
5047 (Hh_json.JSON_Object
5048 [("server_finale_stack", Hh_json.string_
server_finale_stack)])
5050 let e = make_lsp_error ~
stack ~
data message in
5051 (* Log all the things! *)
5055 Error_from_server_fatal
5058 Lsp_helpers.telemetry_error
5060 (message ^
", from_server\n" ^
stack);
5062 (* The monitor is responsible for detecting server closure and exit *)
5063 (* status, and restarting the server if necessary (that's not our job). *)
5064 (* All we'll do is put up a dialog telling the user that the server is *)
5065 (* down and giving them a button to restart. *)
5067 match server_finale_data with
5068 | Some
{ Exit.msg = Some
msg; _
} -> msg
5069 | Some
{ Exit.msg = None
; exit_status
; _
} ->
5071 "hh_server: stopped [%s]"
5072 (Exit_status.show exit_status
)
5073 | _
-> "hh_server: stopped."
5075 (* When would be a good time to auto-dismiss the dialog and attempt *)
5076 (* a proper re-connection? it's not our job to ascertain with certainty *)
5077 (* whether that re-connection will succeed - it's impossible to know, *)
5078 (* but also our re-connection attempt is pretty forceful. *)
5079 (* First: if the server determined in its finale that there shouldn't *)
5080 (* be automatic retry then we won't. Otherwise, we'll sleep for 1 sec *)
5081 (* and then look for the presence of the lock file. The sleep is *)
5082 (* because typically if you do "hh stop" then the persistent connection *)
5083 (* shuts down instantly but the monitor takes a short time to release *)
5085 let trigger_on_lock_file =
5086 match server_finale_data with
5088 { Exit.exit_status
= Exit_status.Failed_to_load_should_abort
; _
}
5095 (* We're right now inside an exception handler. We don't want to do *)
5096 (* work that might itself throw. So instead we'll leave that to the *)
5097 (* next time around the loop. *)
5106 Lost_env.explanation;
5107 new_hh_server_state = Hh_server_stopped
;
5108 start_on_click
= true;
5109 trigger_on_lock_file;
5110 trigger_on_lsp
= false;
5117 | Client_fatal_connection_exception
{ Marshal_tools.stack; message } ->
5118 let e = make_lsp_error ~
stack message in
5122 Error_from_client_fatal
5125 Lsp_helpers.telemetry_error
to_stdout (message ^
", from_client\n" ^
stack);
5126 let () = exit_fail () in
5128 | Client_recoverable_connection_exception
{ Marshal_tools.stack; message }
5130 let e = make_lsp_error ~
stack message in
5134 Error_from_client_recoverable
5137 Lsp_helpers.telemetry_error
to_stdout (message ^
", from_client\n" ^
stack);
5139 | (Server_nonfatal_exception
e | Error.LspException
e) as exn ->
5140 let exn = Exception.wrap
exn in
5142 match (e.Error.code
, Exception.unwrap
exn) with
5143 | (Error.RequestCancelled
, _
) -> Error_from_lsp_cancelled
5144 | (_
, Server_nonfatal_exception _
) -> Error_from_server_recoverable
5145 | (_
, _
) -> Error_from_lsp_misc
5148 make_lsp_error ~
data:e.Error.data ~code
:e.Error.code
e.Error.message
5150 respond_to_error !ref_event e;
5151 hack_log_error !ref_event e error_source !ref_unblocked_time env;
5154 let exn = Exception.wrap
exn in
5157 ~
stack:(Exception.get_backtrace_string
exn)
5158 ~current_stack
:false
5159 (Exception.get_ctor_string
exn)
5161 respond_to_error !ref_event e;
5162 hack_log_error !ref_event e Error_from_lsp_misc
!ref_unblocked_time env;
5165 let rec main_loop () : unit Lwt.t =
5166 let%lwt
() = process_next_event () in
5169 let%lwt
() = main_loop () in
5170 Lwt.return
Exit_status.No_error