[PR] Implements custom resolvers

Summary:
This diff adds a new configuration option to Flow: `module_resolver`. It points to an executable that consumes a stream of JSON objects under the form `[request, issuer]`, and outputs a stream of paths in response.

Since it's been my first work with OCaml since quite a long time there's probably errors and odity in my code, feel free to point them 🙂 Some of them I have in mind (maybe they can be fixed in a followup pass, you tell me):

- The JSON payload is crafted with sprintf, I wasn't sure how to properly generate a JSON string
- For the same reason, the resolver returns a stream of paths instead of an actual JSON object because I wasn't sure how to parse them in Flow
- Related to the previous point, the resolver doesn't have a way to notify Flow that a request cannot be satisfied (it would be solved if the return object was a `[err, result]` entity).
- If the `module_resolver` is invalid, Flow will currently hang (I thought `create_process` would "throw", but maybe it doesn't make sense in OCaml?)
Closes #6132

Reviewed By: gabelevi

Differential Revision: D7619501

Pulled By: arcanis

fbshipit-source-id: a4bf8b89a6f94a8f1e8dac92ae1789a3c7be77f2

src/commands/commandUtils.ml

@@ -795,6 +795,15 @@ let make_options ~flowconfig ~lazy_mode ~root (options_flags: Options_flags.t) =
     | timeout -> timeout) |> Option.map ~f:float_of_int
   in
 
+  let expand_project_root_token path root =
+    let str_root = Path.to_string root
+      |> Sys_utils.normalize_filename_dir_sep in
+    Path.to_string path
+      |> Str.split_delim Files.project_root_token
+      |> String.concat str_root
+      |> Path.make
+  in
+
   let strict_mode = FlowConfig.strict_mode flowconfig in
   { Options.
     opt_lazy_mode = lazy_mode;
@@ -810,6 +819,8 @@ let make_options ~flowconfig ~lazy_mode ~root (options_flags: Options_flags.t) =
     opt_profile = options_flags.profile;
     opt_strip_root = options_flags.strip_root;
     opt_module = FlowConfig.module_system flowconfig;
+    opt_module_resolver = Option.value_map (FlowConfig.module_resolver flowconfig) ~default:None ~f:(fun module_resolver ->
+      Some (expand_project_root_token module_resolver root));
     opt_munge_underscores =
       options_flags.munge_underscore_members || FlowConfig.munge_underscores flowconfig;
     opt_temp_dir = temp_dir;

src/commands/config/flowConfig.ml

@@ -51,6 +51,7 @@ module Opts = struct
     haste_use_name_reducers: bool;
     ignore_non_literal_requires: bool;
     include_warnings: bool;
+    module_resolver: Path.t option;
     module_system: Options.module_system;
     module_name_mappers: (Str.regexp * string) list;
     node_resolver_dirnames: string list;
@@ -159,6 +160,7 @@ module Opts = struct
     ignore_non_literal_requires = false;
     include_warnings = false;
     merge_timeout = Some 100;
+    module_resolver = None;
     module_system = Options.Node;
     module_name_mappers = [];
     node_resolver_dirnames = ["node_modules"];
@@ -691,6 +693,15 @@ let parse_options config lines =
       );
     }
 
+    |> define_opt "module.resolver" {
+      initializer_ = USE_DEFAULT;
+      flags = [];
+      optparser = optparse_filepath;
+      setter = (fun opts v -> Ok {
+        opts with module_resolver = Some v;
+      });
+    }
+
     |> define_opt "module.system" {
       initializer_ = USE_DEFAULT;
       flags = [];
@@ -1044,6 +1055,7 @@ let max_workers c = c.options.Opts.max_workers
 let merge_timeout c = c.options.Opts.merge_timeout
 let module_file_exts c = c.options.Opts.module_file_exts
 let module_name_mappers c = c.options.Opts.module_name_mappers
+let module_resolver c = c.options.Opts.module_resolver
 let module_resource_exts c = c.options.Opts.module_resource_exts
 let module_system c = c.options.Opts.module_system
 let modules_are_use_strict c = c.options.Opts.modules_are_use_strict

src/commands/config/flowConfig.mli

@@ -59,6 +59,7 @@ val max_workers: config -> int
 val merge_timeout: config -> int option
 val module_file_exts: config -> SSet.t
 val module_name_mappers: config -> (Str.regexp * string) list
+val module_resolver: config -> Path.t option
 val module_resource_exts: config -> SSet.t
 val module_system: config -> Options.module_system
 val modules_are_use_strict: config -> bool

src/common/options.ml

@@ -61,6 +61,7 @@ type t = {
   opt_merge_timeout: float option;
   opt_module: module_system;
   opt_module_name_mappers: (Str.regexp * string) list;
+  opt_module_resolver: Path.t option;
   opt_modules_are_use_strict: bool;
   opt_munge_underscores: bool;
   opt_profile : bool;
@@ -106,6 +107,7 @@ let max_trace_depth opts = opts.opt_traces
 let max_workers opts = opts.opt_max_workers
 let merge_timeout opts = opts.opt_merge_timeout
 let module_name_mappers opts = opts.opt_module_name_mappers
+let module_resolver opts = opts.opt_module_resolver
 let module_system opts = opts.opt_module
 let modules_are_use_strict opts = opts.opt_modules_are_use_strict
 let root opts = opts.opt_root

src/server/rechecker/rechecker.ml

@@ -62,14 +62,20 @@ let process_updates genv env updates =
       | Some ast -> Module_js.package_incompatible filename_str ast
   in
 
-  (* Die if a package.json changed in an incompatible way *)
-  let incompatible_packages = SSet.filter (fun f ->
-    (String_utils.string_starts_with f sroot ||
-      Files.is_included file_options f)
+  let is_incompatible_package_json f = (
+      String_utils.string_starts_with f sroot ||
+      Files.is_included file_options f
+    )
     && (Filename.basename f) = "package.json"
     && want f
     && is_incompatible f
+  in
+
+  (* Die if a package.json changed in an incompatible way *)
+  let incompatible_packages = SSet.filter (fun f ->
+    is_incompatible_package_json f
   ) updates in
+
   if not (SSet.is_empty incompatible_packages)
   then begin
     Hh_logger.fatal "Status: Error";
@@ -79,6 +85,16 @@ let process_updates genv env updates =
     FlowExitStatus.(exit Server_out_of_date)
   end;
 
+  Option.iter (Options.module_resolver options) ~f:(fun module_resolver ->
+    let str_module_resolver = Path.to_string module_resolver in
+    if SSet.mem str_module_resolver updates then begin
+      let msg = Printf.sprintf "Module resolver %s changed in an incompatible way. Exiting.\n%!"
+        str_module_resolver in
+      Hh_logger.fatal "%s" msg;
+      FlowExitStatus.(exit ~msg Server_out_of_date)
+    end;
+  );
+
   let flow_typed_path = Path.to_string (Files.get_flowtyped_path root) in
   let is_changed_lib filename =
     let is_lib = SSet.mem filename all_libs || filename = flow_typed_path in

src/services/inference/module_js.ml

@@ -13,6 +13,7 @@
    variables) but also flow-sensitive information about local variables at every
    point inside a function (and when to narrow or widen their types). *)
 
+open Hh_json
 open Utils_js
 
 (* Subset of a file's context, with the important distinction that module
@@ -304,6 +305,101 @@ let eponymous_module file =
 
 (*******************************)
 
+exception Module_resolver_fatal of string
+exception Invalid_resolution
+
+module External = struct
+  let external_status = ref true
+
+  let external_channels = ref None
+
+  let get_external_channels resolver =
+    (* Create the channels if they don't exists *)
+    if !external_status && !external_channels = None
+    then begin
+      let program = Path.to_string resolver in
+
+      if not (Sys.file_exists program) then
+        external_status := false
+      else begin
+        let (child_r, parent_w) = Unix.pipe () in
+        let (parent_r, child_w) = Unix.pipe () in
+
+        (* Don't leak these fds *)
+        List.iter (Unix.set_close_on_exec) [parent_w; parent_r];
+
+        let channels = (
+          (Unix.out_channel_of_descr parent_w),
+          (Unix.in_channel_of_descr parent_r)
+        ) in
+
+        try
+          ignore (Unix.create_process program [| program |] child_r child_w Unix.stderr);
+          List.iter Unix.close [child_r; child_w];
+          external_channels := Some channels
+        with
+        | Unix.Unix_error (_, _, _) ->
+          Hh_logger.info "Failed to create module resolver";
+          List.iter Unix.close [child_r; child_w; parent_r; parent_w]
+      end
+    end;
+
+    !external_channels
+
+  let resolve_import opts f r =
+    match Options.module_resolver opts with
+      | None -> None
+      | Some resolver ->
+        let issuer = File_key.to_string f in
+        let payload = json_to_string (JSON_Array [ JSON_String r; JSON_String issuer; ]) in
+
+        match get_external_channels resolver with
+          | None -> None
+          | Some (out_channel, in_channel) ->
+            let response_data =
+              try
+                output_string out_channel (payload ^ "\n");
+                Pervasives.flush out_channel;
+
+                let response_text = input_line in_channel in
+                json_of_string response_text
+              with exn ->
+                let () = Hh_logger.fatal ~exn "Failed to talk to the module resolver" in
+                let exn_str = Printf.sprintf "Exception %s" (Printexc.to_string exn) in
+                raise (Module_resolver_fatal exn_str)
+            in
+
+            let resolution = match response_data with
+              | JSON_Null -> None
+              | JSON_Array items ->
+                begin
+                  match items with
+                    | [ error; resolution ] ->
+                      begin
+                        match error with
+                          | JSON_Null ->
+                            begin
+                              match resolution with
+                                | JSON_Null -> None
+                                | JSON_String r -> Some (resolve_symlinks r)
+                                | _ -> raise (Invalid_resolution)
+                            end
+                          | _ -> None
+                      end
+                    | _ -> raise (Invalid_resolution)
+                end
+              | _ -> raise (Invalid_resolution) in
+
+            match resolution with
+              | None -> None
+              | Some r ->
+                let file_options = Options.file_options opts in
+                if not (Files.is_ignored file_options r) then Some r else None
+
+end
+
+(*******************************)
+
 module Node = struct
   let exported_module _ file _ =
     eponymous_module file
@@ -542,6 +638,7 @@ module Haste: MODULE_SYSTEM = struct
   let resolve_import ~options node_modules_containers f loc ?resolution_acc r =
     let file = File_key.to_string f in
     lazy_seq [
+      lazy (External.resolve_import options f r);
       lazy (Node.resolve_import ~options node_modules_containers f loc ?resolution_acc r);
       lazy (match expanded_name r with
         | Some r ->

tests/custom-resolver-haste/.flowconfig

@@ -0,0 +1,3 @@
+[options]
+module.system=haste
+module.resolver=./resolver.js

tests/custom-resolver-haste/.testconfig

@@ -0,0 +1,2 @@
+all: false
+shell: test.sh

tests/custom-resolver-haste/custom-resolver-haste.exp

@@ -0,0 +1 @@
+No errors!

tests/custom-resolver-haste/hello.js

@@ -0,0 +1,4 @@
+// @providesModule hello
+// @flow
+
+require('world');

tests/custom-resolver-haste/resolver.js

@@ -0,0 +1,38 @@
+#!/usr/bin/env node
+
+var fs = require('fs');
+var StringDecoder = require('string_decoder');
+
+var buffer = '';
+var decoder = new StringDecoder.StringDecoder();
+
+var ext = 'foo';
+
+process.stdin.on('data', function (chunk) {
+  buffer += decoder.write(chunk);
+
+  do {
+    var index = buffer.indexOf('\n');
+    if (index === -1) {
+      break;
+    }
+
+    var line = buffer.slice(0, index);
+    buffer = buffer.slice(index + 1);
+
+    try {
+      var path = __dirname + '/' + JSON.parse(line)[0] + '.' + ext + '.js';
+      if (fs.existsSync(path)) {
+        process.stdout.write(JSON.stringify([null, path]) + '\n');
+      } else {
+        process.stdout.write(JSON.stringify([{
+          message: `File not found`,
+        }, null]) + '\n');
+      }
+    } catch (error) {
+      process.stdout.write(JSON.stringify([{
+        message: error.message,
+      }, null]) + '\n');
+    }
+  } while (true);
+});

tests/custom-resolver-haste/test.sh

@@ -0,0 +1,5 @@
+#!/bin/bash
+. ../assert.sh
+FLOW=$1
+
+assert_ok "$FLOW" status .

tests/custom-resolver-haste/world.js

@@ -0,0 +1,4 @@
+// @providesModule world
+// @flow
+
+require('hello');

tests/custom-resolver-projectroot/.flowconfig

@@ -0,0 +1,3 @@
+[options]
+module.system=haste
+module.resolver=<PROJECT_ROOT>/resolver.js

tests/custom-resolver-projectroot/.testconfig

@@ -0,0 +1,2 @@
+all: false
+shell: test.sh

tests/custom-resolver-projectroot/custom-resolver-projectroot.exp

@@ -0,0 +1 @@
+No errors!

tests/custom-resolver-projectroot/hello.js

@@ -0,0 +1,4 @@
+// @providesModule hello
+// @flow
+
+require('./world');

tests/custom-resolver-projectroot/resolver.js

@@ -0,0 +1,38 @@
+#!/usr/bin/env node
+
+var fs = require('fs');
+var StringDecoder = require('string_decoder');
+
+var buffer = '';
+var decoder = new StringDecoder.StringDecoder();
+
+var ext = 'foo';
+
+process.stdin.on('data', function (chunk) {
+  buffer += decoder.write(chunk);
+
+  do {
+    var index = buffer.indexOf('\n');
+    if (index === -1) {
+      break;
+    }
+
+    var line = buffer.slice(0, index);
+    buffer = buffer.slice(index + 1);
+
+    try {
+      var path = __dirname + '/' + JSON.parse(line)[0] + '.' + ext + '.js';
+      if (fs.existsSync(path)) {
+        process.stdout.write(JSON.stringify([null, path]) + '\n');
+      } else {
+        process.stdout.write(JSON.stringify([{
+          message: `File not found`,
+        }, null]) + '\n');
+      }
+    } catch (error) {
+      process.stdout.write(JSON.stringify([{
+        message: error.message,
+      }, null]) + '\n');
+    }
+  } while (true);
+});

tests/custom-resolver-projectroot/test.sh

@@ -0,0 +1,5 @@
+#!/bin/bash
+. ../assert.sh
+FLOW=$1
+
+assert_ok "$FLOW" status .

tests/custom-resolver-projectroot/world.js

@@ -0,0 +1,4 @@
+// @providesModule world
+// @flow
+
+require('hello');

tests/custom-resolver-restart/.flowconfig

@@ -0,0 +1,3 @@
+[options]
+module.resolver=./resolver.js
+module.system=haste

tests/custom-resolver-restart/.testconfig

@@ -0,0 +1,2 @@
+all: false
+shell: test.sh