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