hphp/hack/src/server/serverCommandTypesUtils.ml

   1 open Hh_prelude
   2 open ServerCommandTypes
   3
   4 let debug_describe_t : type a. a t -> string = function
   5   | STATUS _ -> "STATUS"
   6   | STATUS_SINGLE _ -> "STATUS_SINGLE"
   7   | STATUS_SINGLE_REMOTE_EXECUTION _ -> "STATUS_SINGLE_REMOTE_EXECUTION"
   8   | STATUS_REMOTE_EXECUTION _ -> "STATUS_REMOTE_EXECUTION"
   9   | STATUS_MULTI_REMOTE_EXECUTION _ -> "STATUS_MULTI_REMOTE_EXECUTION"
  10   | INFER_TYPE _ -> "INFER_TYPE"
  11   | INFER_TYPE_BATCH _ -> "INFER_TYPE_BATCH"
  12   | INFER_TYPE_ERROR _ -> "INFER_TYPE_ERROR"
  13   | TAST_HOLES _ -> "TAST_HOLES"
  14   | IDE_HOVER _ -> "IDE_HOVER"
  15   | DOCBLOCK_AT _ -> "DOCBLOCK_AT"
  16   | DOCBLOCK_FOR_SYMBOL _ -> "DOCBLOCK_FOR_SYMBOL"
  17   | IDE_SIGNATURE_HELP _ -> "SIGNATURE_HELP"
  18   | COVERAGE_LEVELS _ -> "COVERAGE_LEVELS"
  19   | COMMANDLINE_AUTOCOMPLETE _ -> "AUTOCOMPLETE"
  20   | IDENTIFY_FUNCTION _ -> "IDENTIFY_FUNCTION"
  21   | IDENTIFY_SYMBOL _ -> "IDENTIFY_SYMBOL"
  22   | METHOD_JUMP _ -> "METHOD_JUMP"
  23   | METHOD_JUMP_BATCH _ -> "METHOD_JUMP_BATCH"
  24   | FIND_REFS _ -> "FIND_REFS"
  25   | GO_TO_IMPL _ -> "GO_TO_IMPL"
  26   | IDE_FIND_REFS _ -> "IDE_FIND_REFS"
  27   | IDE_GO_TO_IMPL _ -> "IDE_GO_TO_IMPL"
  28   | IDE_HIGHLIGHT_REFS _ -> "IDE_HIGHLIGHT_REFS"
  29   | REFACTOR _ -> "REFACTOR"
  30   | IDE_REFACTOR _ -> "IDE_REFACTOR"
  31   | DUMP_SYMBOL_INFO _ -> "DUMP_SYMBOL_INFO"
  32   | REMOVE_DEAD_FIXMES _ -> "REMOVE_DEAD_FIXMES"
  33   | REWRITE_LAMBDA_PARAMETERS _ -> "REWRITE_LAMBDA_PARAMETERS"
  34   | REWRITE_TYPE_PARAMS_TYPE _ -> "REWRITE_TYPE_PARAMS_TYPE"
  35   | SEARCH _ -> "SEARCH"
  36   | COVERAGE_COUNTS _ -> "COVERAGE_COUNTS"
  37   | LINT _ -> "LINT"
  38   | LINT_STDIN _ -> "LINT_STDIN"
  39   | LINT_ALL _ -> "LINT_ALL"
  40   | CREATE_CHECKPOINT _ -> "CREATE_CHECKPOINT"
  41   | RETRIEVE_CHECKPOINT _ -> "RETRIEVE_CHECKPOINT"
  42   | DELETE_CHECKPOINT _ -> "DELETE_CHECKPOINT"
  43   | IN_MEMORY_DEP_TABLE_SIZE -> "IN_MEMORY_DEP_TABLE_SIZE"
  44   | SAVE_NAMING _ -> "SAVE_NAMING"
  45   | SAVE_STATE _ -> "SAVE_STATE"
  46   | STATS -> "STATS"
  47   | FORMAT _ -> "FORMAT"
  48   | AI_QUERY _ -> "AI_QUERY"
  49   | DUMP_FULL_FIDELITY_PARSE _ -> "DUMP_FULL_FIDELITY_PARSE"
  50   | OPEN_FILE _ -> "OPEN_FILE"
  51   | CLOSE_FILE _ -> "CLOSE_FILE"
  52   | EDIT_FILE _ -> "EDIT_FILE"
  53   | IDE_AUTOCOMPLETE _ -> "IDE_AUTOCOMPLETE"
  54   | IDE_FFP_AUTOCOMPLETE _ -> "IDE_FFP_AUTOCOMPLETE"
  55   | CODE_ACTIONS _ -> "CODE_ACTIONS"
  56   | DISCONNECT -> "DISCONNECT"
  57   | OUTLINE _ -> "OUTLINE"
  58   | IDE_IDLE -> "IDE_IDLE"
  59   | RAGE -> "RAGE"
  60   | CST_SEARCH _ -> "CST_SEARCH"
  61   | NO_PRECHECKED_FILES -> "NO_PRECHECKED_FILES"
  62   | GEN_HOT_CLASSES _ -> "GEN_HOT_CLASSES"
  63   | GEN_PREFETCH_DIR _ -> "GEN_PREFETCH_DIR"
  64   | FUN_DEPS_BATCH _ -> "FUN_DEPS_BATCH"
  65   | LIST_FILES_WITH_ERRORS -> "LIST_FILES_WITH_ERRORS"
  66   | FILE_DEPENDENTS _ -> "FILE_DEPENDENTS"
  67   | IDENTIFY_TYPES _ -> "IDENTIFY_TYPES"
  68   | EXTRACT_STANDALONE _ -> "EXTRACT_STANDALONE"
  69   | CONCATENATE_ALL _ -> "CONCATENATE_ALL"
  70   | GO_TO_DEFINITION _ -> "GO_TO_DEFINITION"
  71   | BIGCODE _ -> "BIGCODE"
  72   | PAUSE _ -> "PAUSE"
  73   | GLOBAL_INFERENCE _ -> "GLOBAL_INFERENCE"
  74   | VERBOSE _ -> "VERBOSE"
  75
  76 let debug_describe_cmd : type a. a command -> string = function
  77   | Rpc ({ ServerCommandTypes.from; _ }, rpc) ->
  78     debug_describe_t rpc
  79     ^
  80     if String.equal from "" then
  81       ""
  82     else
  83       " --from " ^ from
  84   | Debug_DO_NOT_USE -> failwith "Debug_DO_NOT_USE"
  85
  86 (** This returns a string that's shown "hh_server is busy [STATUS]".
  87 The intent is that users understand what command hh_server is currently busy with.
  88 For command-line commands, we show the "--" option that the user used, e.g. --type-at-pos.
  89 For IDE commands like hover, we show a description like "hover". *)
  90 let status_describe_cmd : type a. a command -> string =
  91  fun cmd ->
  92   match cmd with
  93   | Rpc ({ ServerCommandTypes.from; desc }, _rpc) ->
  94     (if String.equal from "" then
  95       ""
  96     else
  97       from ^ ":")
  98     ^ desc
  99   | Debug_DO_NOT_USE -> failwith "Debug_DO_NOT_USE"
 100
 101 let debug_describe_message_type : type a. a message_type -> string = function
 102   | Hello -> "Hello"
 103   | Monitor_failed_to_handoff -> "Monitor_failed_to_handoff"
 104   | Ping -> "Ping"
 105   | Response _ -> "Response"
 106   | Push _ -> "Push"
 107
 108 let extract_labelled_file (labelled_file : ServerCommandTypes.labelled_file) :
 109     Relative_path.t * ServerCommandTypes.file_input =
 110   match labelled_file with
 111   | ServerCommandTypes.LabelledFileName filename ->
 112     let path = Relative_path.create_detect_prefix filename in
 113     (path, ServerCommandTypes.FileName filename)
 114   | ServerCommandTypes.LabelledFileContent { filename; content } ->
 115     let path = Relative_path.create_detect_prefix filename in
 116     (path, ServerCommandTypes.FileContent content)
 117
 118 (** This writes to the specified progress file. It first acquires
 119 an exclusive (writer) lock. (Locks on unix are advisory; we trust
 120 read_progress_file below to also acquire a lock). It overwrites
 121 whatever was there before. In case of failure, it logs but is
 122 silent. That's on the principle that defects in
 123 progress-reporting should never break hh_server. *)
 124 let write_progress_file
 125     ~(server_progress_file : string)
 126     ~(server_progress : ServerCommandTypes.server_progress) : unit =
 127   let open Hh_json in
 128   let content =
 129     JSON_Object
 130       [
 131         ( "warning",
 132           Option.value_map
 133             server_progress.ServerCommandTypes.server_warning
 134             ~default:JSON_Null
 135             ~f:string_ );
 136         ("progress", string_ server_progress.ServerCommandTypes.server_progress);
 137         ("timestamp", float_ server_progress.ServerCommandTypes.server_timestamp);
 138       ]
 139     |> json_to_multiline
 140   in
 141   try Sys_utils.protected_write_exn server_progress_file content with
 142   | exn ->
 143     let e = Exception.wrap exn in
 144     Hh_logger.log
 145       "SERVER_PROGRESS_EXCEPTION(write) %s\n%s"
 146       (Exception.get_ctor_string e)
 147       (Exception.get_backtrace_string e |> Exception.clean_stack);
 148     HackEventLogger.server_progress_write_exn ~server_progress_file e;
 149     ()
 150
 151 (** This reads the specified progress file, which is assumed to exist.
 152 It first acquires a non-exclusive (reader) lock. (Locks on unix are
 153 advisory; we trust write_progress_file above to also acquire a writer
 154 lock).  If there are failures, we log, and return a human-readable
 155 string that indicates why. *)
 156 let read_progress_file ~(server_progress_file : string) :
 157     ServerCommandTypes.server_progress =
 158   let content = ref "[not yet read content]" in
 159   try
 160     content := Sys_utils.protected_read_exn server_progress_file;
 161     let json = Some (Hh_json.json_of_string !content) in
 162     let server_progress = Hh_json_helpers.Jget.string_exn json "progress" in
 163     let server_warning = Hh_json_helpers.Jget.string_opt json "warning" in
 164     let server_timestamp = Hh_json_helpers.Jget.float_exn json "timestamp" in
 165     ServerCommandTypes.{ server_progress; server_warning; server_timestamp }
 166   with
 167   | exn ->
 168     let e = Exception.wrap exn in
 169     Hh_logger.log
 170       "SERVER_PROGRESS_EXCEPTION(read) %s\n%s\n%s"
 171       (Exception.get_ctor_string e)
 172       (Exception.get_backtrace_string e |> Exception.clean_stack)
 173       !content;
 174     HackEventLogger.server_progress_read_exn ~server_progress_file e;
 175     ServerCommandTypes.
 176       {
 177         server_progress = "unknown hh_server state";
 178         server_warning = None;
 179         server_timestamp = Unix.gettimeofday ();
 180       }