fix ppx file resolution, ppx does not need to come from packages of bucklescript

Author: bobzhang

jscomp/all.depend

@@ -651,9 +651,10 @@ bsb/bsb_build_util.cmx : ext/ext_sys.cmx ext/ext_string.cmx ext/ext_list.cmx \
     bsb/bsb_config.cmx bsb/bsb_build_util.cmi
 bsb/bsb_config.cmx : common/js_config.cmx ext/ext_filename.cmx \
     bsb/bsb_config.cmi
-bsb/bsb_default.cmx : ext/string_set.cmx ext/literals.cmx ext/ext_string.cmx \
-    ext/ext_json.cmx ext/ext_filename.cmx bsb/bsb_build_util.cmx \
-    bsb/bsb_build_schemas.cmx common/bs_pkg.cmx bsb/bsb_default.cmi
+bsb/bsb_default.cmx : ext/string_set.cmx ext/literals.cmx ext/ext_sys.cmx \
+    ext/ext_string.cmx ext/ext_json.cmx ext/ext_filename.cmx \
+    bsb/bsb_build_util.cmx bsb/bsb_build_schemas.cmx common/bs_pkg.cmx \
+    bsb/bsb_default.cmi
 bsb/bsb_dep_infos.cmx : bsb/bsb_dep_infos.cmi
 bsb/bsb_dir.cmx : bsb/bsb_dir.cmi
 bsb/bsb_file.cmx : bsb/bsb_file.cmi

jscomp/bin/bsb.ml

@@ -6677,6 +6677,9 @@ module Bs_pkg : sig
 val resolve_bs_package : 
     cwd:string ->  string -> string option
 
+
+val resolve_npm_package_file :
+    cwd:string -> string -> string option
 end = struct
 #1 "bs_pkg.ml"
 
@@ -6691,13 +6694,13 @@ let  resolve_bs_package
     name = 
   let marker = Literals.bsconfig_json in 
   let sub_path = name // marker  in
-  let rec aux origin cwd name = 
+  let rec aux  cwd  = 
     let abs_marker =  cwd // Literals.node_modules // sub_path in 
     if Sys.file_exists abs_marker then Some (Filename.dirname abs_marker)
     else 
-      let cwd' = Filename.dirname cwd in 
+      let cwd' = Filename.dirname cwd in (* TODO: may non-terminating when see symlinks *)
       if String.length cwd' < String.length cwd then  
-        aux origin   cwd' name
+        aux    cwd' 
       else 
         try 
           let abs_marker = 
@@ -6711,8 +6714,38 @@ let  resolve_bs_package
           Not_found -> None
           (* Bs_exception.error (Bs_package_not_found name)           *)
   in
-  aux cwd cwd name
+  aux cwd 
+
 
+(** The package does not need to be a bspackage 
+  example:
+  {[
+    resolve_npm_package_file ~cwd "reason/refmt"
+  ]}
+  It also returns the path name
+*)
+let resolve_npm_package_file ~cwd sub_path =
+  let rec aux  cwd  = 
+    let abs_marker =  cwd // Literals.node_modules // sub_path in 
+    if Sys.file_exists abs_marker then Some abs_marker
+    else 
+      let cwd' = Filename.dirname cwd in 
+      if String.length cwd' < String.length cwd then  
+        aux cwd' 
+      else 
+        try 
+          let abs_marker = 
+            Sys.getenv "npm_config_prefix" 
+            // "lib" // Literals.node_modules // sub_path in
+          if Sys.file_exists abs_marker
+          then Some  abs_marker
+          else None
+            (* Bs_exception.error (Bs_package_not_found name) *)
+        with 
+          Not_found -> None
+          (* Bs_exception.error (Bs_package_not_found name)           *)
+  in
+  aux cwd 
 end
 module Bsb_default : sig 
 #1 "bsb_default.mli"
@@ -6832,11 +6865,10 @@ let resolve_bsb_magic_file ~cwd ~desc p =
   else if Filename.is_relative p &&
      p_len > 0 &&
      String.unsafe_get p 0 <> '.' then
-    let name = String.sub p 0 (String.index p '/') in
-    let package = (Bs_pkg.resolve_bs_package ~cwd name) in
-    match package with
-    | None -> failwith (name ^ " not found when resolving " ^ desc)
-    | Some package -> Bsb_build_util.convert_and_resolve_path (Filename.dirname package // p)
+    let p = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_slash_backward p else p in  
+    match Bs_pkg.resolve_npm_package_file ~cwd p with
+    | None -> failwith (p ^ " not found when resolving " ^ desc)
+    | Some v -> v 
   else
     Bsb_build_util.convert_and_resolve_path p
 

jscomp/bin/whole_compiler.ml

@@ -20205,6 +20205,9 @@ module Bs_pkg : sig
 val resolve_bs_package : 
     cwd:string ->  string -> string option
 
+
+val resolve_npm_package_file :
+    cwd:string -> string -> string option
 end = struct
 #1 "bs_pkg.ml"
 
@@ -20219,13 +20222,13 @@ let  resolve_bs_package
     name = 
   let marker = Literals.bsconfig_json in 
   let sub_path = name // marker  in
-  let rec aux origin cwd name = 
+  let rec aux  cwd  = 
     let abs_marker =  cwd // Literals.node_modules // sub_path in 
     if Sys.file_exists abs_marker then Some (Filename.dirname abs_marker)
     else 
-      let cwd' = Filename.dirname cwd in 
+      let cwd' = Filename.dirname cwd in (* TODO: may non-terminating when see symlinks *)
       if String.length cwd' < String.length cwd then  
-        aux origin   cwd' name
+        aux    cwd' 
       else 
         try 
           let abs_marker = 
@@ -20239,8 +20242,38 @@ let  resolve_bs_package
           Not_found -> None
           (* Bs_exception.error (Bs_package_not_found name)           *)
   in
-  aux cwd cwd name
+  aux cwd 
+
 
+(** The package does not need to be a bspackage 
+  example:
+  {[
+    resolve_npm_package_file ~cwd "reason/refmt"
+  ]}
+  It also returns the path name
+*)
+let resolve_npm_package_file ~cwd sub_path =
+  let rec aux  cwd  = 
+    let abs_marker =  cwd // Literals.node_modules // sub_path in 
+    if Sys.file_exists abs_marker then Some abs_marker
+    else 
+      let cwd' = Filename.dirname cwd in 
+      if String.length cwd' < String.length cwd then  
+        aux cwd' 
+      else 
+        try 
+          let abs_marker = 
+            Sys.getenv "npm_config_prefix" 
+            // "lib" // Literals.node_modules // sub_path in
+          if Sys.file_exists abs_marker
+          then Some  abs_marker
+          else None
+            (* Bs_exception.error (Bs_package_not_found name) *)
+        with 
+          Not_found -> None
+          (* Bs_exception.error (Bs_package_not_found name)           *)
+  in
+  aux cwd 
 end
 module Compenv : sig 
 #1 "compenv.mli"

jscomp/bsb/bsb_default.ml

@@ -42,11 +42,10 @@ let resolve_bsb_magic_file ~cwd ~desc p =
   else if Filename.is_relative p &&
      p_len > 0 &&
      String.unsafe_get p 0 <> '.' then
-    let name = String.sub p 0 (String.index p '/') in
-    let package = (Bs_pkg.resolve_bs_package ~cwd name) in
-    match package with
-    | None -> failwith (name ^ " not found when resolving " ^ desc)
-    | Some package -> Bsb_build_util.convert_and_resolve_path (Filename.dirname package // p)
+    let p = if Ext_sys.is_windows_or_cygwin then Ext_string.replace_slash_backward p else p in  
+    match Bs_pkg.resolve_npm_package_file ~cwd p with
+    | None -> failwith (p ^ " not found when resolving " ^ desc)
+    | Some v -> v 
   else
     Bsb_build_util.convert_and_resolve_path p
 

jscomp/common/bs_pkg.ml

@@ -10,13 +10,13 @@ let  resolve_bs_package
     name = 
   let marker = Literals.bsconfig_json in 
   let sub_path = name // marker  in
-  let rec aux origin cwd name = 
+  let rec aux  cwd  = 
     let abs_marker =  cwd // Literals.node_modules // sub_path in 
     if Sys.file_exists abs_marker then Some (Filename.dirname abs_marker)
     else 
-      let cwd' = Filename.dirname cwd in 
+      let cwd' = Filename.dirname cwd in (* TODO: may non-terminating when see symlinks *)
       if String.length cwd' < String.length cwd then  
-        aux origin   cwd' name
+        aux    cwd' 
       else 
         try 
           let abs_marker = 
@@ -30,4 +30,35 @@ let  resolve_bs_package
           Not_found -> None
           (* Bs_exception.error (Bs_package_not_found name)           *)
   in
-  aux cwd cwd name
+  aux cwd 
+
+
+(** The package does not need to be a bspackage 
+  example:
+  {[
+    resolve_npm_package_file ~cwd "reason/refmt"
+  ]}
+  It also returns the path name
+*)
+let resolve_npm_package_file ~cwd sub_path =
+  let rec aux  cwd  = 
+    let abs_marker =  cwd // Literals.node_modules // sub_path in 
+    if Sys.file_exists abs_marker then Some abs_marker
+    else 
+      let cwd' = Filename.dirname cwd in 
+      if String.length cwd' < String.length cwd then  
+        aux cwd' 
+      else 
+        try 
+          let abs_marker = 
+            Sys.getenv "npm_config_prefix" 
+            // "lib" // Literals.node_modules // sub_path in
+          if Sys.file_exists abs_marker
+          then Some  abs_marker
+          else None
+            (* Bs_exception.error (Bs_package_not_found name) *)
+        with 
+          Not_found -> None
+          (* Bs_exception.error (Bs_package_not_found name)           *)
+  in
+  aux cwd 

jscomp/common/bs_pkg.mli

@@ -35,3 +35,7 @@
 
 val resolve_bs_package : 
     cwd:string ->  string -> string option
+
+
+val resolve_npm_package_file :
+    cwd:string -> string -> string option