hphp/hack/src/server/serverHotClasses.ml

   1 (**
   2  * Copyright (c) 2018, Facebook, Inc.
   3  * All rights reserved.
   4  *
   5  * This source code is licensed under the MIT license found in the
   6  * LICENSE fn in the "hack" directory of this source tree.
   7  *
   8  *)
   9
  10 open Core_kernel
  11
  12 module DepSet = Typing_deps.DepSet
  13 module Dep = Typing_deps.Dep
  14
  15 let go
  16     (workers : MultiWorker.worker list option)
  17     (env : ServerEnv.env)
  18     (threshold : int)
  19   : string =
  20   let naming_table = env.ServerEnv.naming_table in
  21   let start_t = Unix.gettimeofday () in
  22   Hh_logger.log "Generating hot classes file...";
  23   let classes_in_repo =
  24     Naming_table.fold naming_table ~init:[] ~f:begin fun path info acc ->
  25       match Relative_path.prefix path with
  26       | Relative_path.Root ->
  27         List.fold info.FileInfo.classes ~init:acc ~f:(fun acc (_,x) -> x::acc)
  28       | _ -> acc
  29     end
  30   in
  31   let add_hot_classes acc cids =
  32     List.fold cids ~init:acc ~f:begin fun acc cid ->
  33       let deps = DepSet.singleton @@ Dep.make (Dep.Class cid) in
  34       let deps = Typing_deps.add_all_deps deps in
  35       if DepSet.cardinal deps > threshold then cid::acc else acc
  36     end
  37   in
  38   let classes_to_save =
  39     MultiWorker.call
  40       workers
  41       ~job:add_hot_classes
  42       ~neutral:[]
  43       ~merge:List.rev_append
  44       ~next:(MultiWorker.next workers classes_in_repo)
  45   in
  46   let classes_to_save =
  47     classes_to_save
  48     |> List.sort ~compare:String.compare
  49     |> List.remove_consecutive_duplicates ~equal:String.equal
  50   in
  51   let result =
  52     let open Hh_json in
  53     let comment = List.map ServerHotClassesDescription.comment string_ in
  54     let classes = List.map classes_to_save string_ in
  55     json_to_string ~pretty:true @@ JSON_Object [
  56       "comment", JSON_Array comment;
  57       "threshold", int_ threshold;
  58       "classes", JSON_Array classes;
  59     ]
  60   in
  61   let result = ServerHotClassesDescription.postprocess (result ^ "\n") in
  62   let _ : float =
  63     Hh_logger.log_duration "Done generating hot classes file" start_t in
  64   result