hphp/hack/src/server/serverFileSync.ml

   1 (**
   2  * Copyright (c) 2016, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE file in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11 open File_content
  12 open Option.Monad_infix
  13 open ServerEnv
  14
  15 let try_relativize_path x =
  16   Option.try_with (fun () -> Relative_path.(create Root x))
  17
  18 let get_file_content_from_disk path =
  19   let f () = Sys_utils.cat (Relative_path.to_absolute path) in
  20   Option.try_with f
  21
  22 let get_file_content = function
  23   | ServerCommandTypes.FileContent s -> s
  24   | ServerCommandTypes.FileName path ->
  25     begin try_relativize_path path >>= fun path ->
  26       match File_provider.get path with
  27         | Some (File_provider.Ide f) -> Some f
  28         | Some (File_provider.Disk c) -> Some c
  29         | None -> get_file_content_from_disk path
  30     end
  31       (* In case of errors, proceed with empty file contents *)
  32       |> Option.value ~default:""
  33
  34 (* Warning: this takes O(global error list) time. Should be OK while
  35  * it's only used in editor, where opening a file is a rare (compared to other
  36  * kind of queries) operation, but if this ever ends up being called by
  37  * other automation there is room for improvement (i.e finally changing global
  38  * error list to be a error map)
  39  *)
  40 let update_diagnostics diag_subscribe editor_open_files errorl  =
  41   Option.map diag_subscribe ~f:begin fun diag_subscribe ->
  42     Diagnostic_subscription.update diag_subscribe
  43       ~priority_files:editor_open_files
  44       ~reparsed:Relative_path.Set.empty
  45       ~rechecked:Relative_path.Map.empty
  46       ~global_errors:errorl
  47       ~full_check_done:true
  48   end
  49
  50 let open_file ~predeclare env path content =
  51   let prev_content = get_file_content (ServerCommandTypes.FileName path) in
  52   let new_env = try_relativize_path path >>= fun path ->
  53     (* Before making any changes, pre-load (into Decl_heap) currently existing
  54      * declarations so there is always a previous version to compare against,
  55      * which makes incremental mode perform better. *)
  56     if predeclare && (not (Relative_path.Set.mem env.editor_open_files path)) then
  57       Decl.make_env path;
  58     let editor_open_files = Relative_path.Set.add env.editor_open_files path in
  59     File_provider.remove_batch (Relative_path.Set.singleton path);
  60     File_provider.provide_file path (File_provider.Ide content);
  61     let ide_needs_parsing, diag_subscribe =
  62       if content = prev_content && (env.full_check = Full_check_done) then begin
  63         (* Try to avoid telling the user that a check is needed when the file
  64          * was unchanged. But even in this case, we might need to push
  65          * errors that were previously throttled. They are available only
  66          * when full recheck was completed and there were no further changes. In
  67          * all other cases, we will need to (lazily) recheck the file. *)
  68         env.ide_needs_parsing,
  69         update_diagnostics env.diag_subscribe editor_open_files env.errorl
  70       end else
  71         Relative_path.Set.add env.ide_needs_parsing path, env.diag_subscribe
  72       in
  73     (* Need to re-parse this file during next full check to update
  74      * global error list positions that refer to it *)
  75     let disk_needs_parsing =
  76       Relative_path.Set.add env.disk_needs_parsing path in
  77     let last_command_time = Unix.gettimeofday () in
  78     Some { env with
  79       editor_open_files; ide_needs_parsing; last_command_time; diag_subscribe;
  80       disk_needs_parsing;
  81     } in
  82   Option.value new_env ~default:env
  83
  84 let close_relative_path env path =
  85   let editor_open_files = Relative_path.Set.remove env.editor_open_files path in
  86   let contents = (match File_provider.get_unsafe path with
  87   | File_provider.Ide f -> f
  88   | _ -> assert false) in
  89   File_provider.remove_batch (Relative_path.Set.singleton path);
  90   let new_contents = File_provider.get_contents path in
  91   let ide_needs_parsing =
  92     if new_contents = Some contents then env.ide_needs_parsing
  93     else Relative_path.Set.add env.ide_needs_parsing path in
  94   let disk_needs_parsing =
  95     Relative_path.Set.add env.disk_needs_parsing path in
  96   let last_command_time = Unix.gettimeofday () in
  97   { env with
  98     editor_open_files; ide_needs_parsing; last_command_time; disk_needs_parsing
  99   }
 100
 101 let close_file env path =
 102   let new_env = try_relativize_path path >>| close_relative_path env in
 103   Option.value new_env ~default:env
 104
 105 let edit_file ~predeclare env path (edits: File_content.text_edit list) =
 106   let new_env = try_relativize_path path >>= fun path ->
 107     (* See similar predeclare in open_file function *)
 108     if predeclare && (not (Relative_path.Set.mem env.editor_open_files path)) then
 109       Decl.make_env path;
 110     ServerBusyStatus.send env ServerCommandTypes.Needs_local_typecheck;
 111     let fc = match File_provider.get path with
 112     | Some File_provider.Ide f -> f
 113     | Some File_provider.Disk content -> content
 114     | None ->
 115         try Sys_utils.cat (Relative_path.to_absolute path) with _ -> "" in
 116     let edited_fc = match edit_file fc edits with
 117       | Ok r -> r
 118       | Error (reason, _stack) ->
 119         Hh_logger.log "%s" reason;
 120         (* TODO: do not crash, but surface this to the client somehow *)
 121         assert false
 122     in
 123     let editor_open_files =
 124       Relative_path.Set.add env.editor_open_files path in
 125     File_provider.remove_batch (Relative_path.Set.singleton path);
 126     File_provider.provide_file path (File_provider.Ide edited_fc);
 127     let ide_needs_parsing =
 128       Relative_path.Set.add env.ide_needs_parsing path in
 129     let disk_needs_parsing =
 130       Relative_path.Set.add env.disk_needs_parsing path in
 131     let last_command_time = Unix.gettimeofday () in
 132     Some { env with
 133       editor_open_files; ide_needs_parsing; last_command_time;
 134       disk_needs_parsing
 135     } in
 136   Option.value new_env ~default:env
 137
 138 let clear_sync_data env =
 139   let env = Relative_path.Set.fold env.editor_open_files
 140     ~init:env
 141     ~f:(fun x env -> close_relative_path env x)
 142   in
 143 { env with
 144   persistent_client = None;
 145   diag_subscribe = None;
 146 }
 147
 148 let get_unsaved_changes env =
 149   Relative_path.Set.fold env.editor_open_files
 150     ~init:Relative_path.Map.empty
 151     ~f:begin fun path acc ->
 152       match File_provider.get path with
 153       | Some File_provider.Ide ide_contents ->
 154         begin match get_file_content_from_disk path with
 155         | Some disk_contents when ide_contents <> disk_contents ->
 156           Relative_path.Map.add acc path (ide_contents, disk_contents)
 157         | Some _ -> acc
 158         | None ->
 159           (* If one creates a new file, then there will not be corresponding
 160           * disk contents, and we should consider there to be unsaved changes in
 161           * the editor. *)
 162           Relative_path.Map.add acc path (ide_contents, "")
 163         end
 164       | _ -> acc
 165     end
 166
 167 let has_unsaved_changes env =
 168   not @@ Relative_path.Map.is_empty (get_unsaved_changes env)
 169
 170 let toggle_dynamic_view (env : env) (t : bool) : env =
 171  ServerDynamicView.toggle := t;
 172  {
 173    env with
 174    ide_needs_parsing = env.editor_open_files
 175  }