fuse bsconfig into package.json

aspeddro · aspeddro · commit d7fd9d81af67 · 2022-06-28T19:26:56.000-03:00
diff --git a/jscomp/bsb/bsb_build_schemas.ml b/jscomp/bsb/bsb_build_schemas.ml
@@ -123,3 +123,8 @@ let language = "language"
 let path = "path"
 
 let ignored_dirs = "ignored-dirs"
+
+module PackageJson = struct
+  let dependencies = "dependencies"
+  let devDependencies = "devDependencies"
+end
diff --git a/jscomp/bsb/bsb_build_util.ml b/jscomp/bsb/bsb_build_util.ml
@@ -125,11 +125,7 @@ let get_list_string_acc (s : Ext_json_types.t array) acc =
 
 let get_list_string s = get_list_string_acc s []
 
-(* Key is the path *)
-let ( |? ) m (key, cb) = m |> Ext_json.test key cb
-
 type top = Expect_none | Expect_name of string
-
 type package_context = { proj_dir : string; top : top }
 
 (**
@@ -148,8 +144,8 @@ let pp_packages_rev ppf lst =
 
 let rec walk_all_deps_aux (visited : string Hash_string.t) (paths : string list)
     ~(top : top) (dir : string) (queue : _ Queue.t) ~pinned_dependencies =
-  let bsconfig_json = dir // Literals.bsconfig_json in
-  match Ext_json_parse.parse_json_from_file bsconfig_json with
+  let package_json = dir // Literals.package_json in
+  match Ext_json_parse.parse_json_from_file package_json with
   | Obj { map; loc } ->
       let cur_package_name =
         match Map_string.find_opt map Bsb_build_schemas.name with
@@ -162,7 +158,7 @@ let rec walk_all_deps_aux (visited : string Hash_string.t) (paths : string list)
                     "package name is expected to be %s but got %s" s str);
             str
         | Some _ | None ->
-            Bsb_exception.errorf ~loc "package name missing in %s/bsconfig.json"
+            Bsb_exception.errorf ~loc "package name missing in %s/package.json"
               dir
       in
       if Ext_list.mem_string paths cur_package_name then (
@@ -174,31 +170,40 @@ let rec walk_all_deps_aux (visited : string Hash_string.t) (paths : string list)
       if Hash_string.mem visited cur_package_name then
         Bsb_log.info "@{<info>Visited before@} %s@." cur_package_name
       else
-        let explore_deps (deps : string) =
-          map
-          |? ( deps,
-               `Arr
-                 (fun (new_packages : Ext_json_types.t array) ->
-                   Ext_array.iter new_packages (fun js ->
-                       match js with
-                       | Str { str = new_package } ->
-                           let package_dir =
-                             Bsb_pkg.resolve_bs_package ~cwd:dir
-                               (Bsb_pkg_types.string_as_package new_package)
-                           in
-                           walk_all_deps_aux visited package_stacks
-                             ~top:(Expect_name new_package) package_dir queue
-                             ~pinned_dependencies
-                       | _ ->
-                           Bsb_exception.errorf ~loc "%s expect an array" deps))
-             )
-          |> ignore
+        let explore_deps_in_package_json (field : string) =
+          match Map_string.find_opt map field with
+          | Some (Obj { map = dependencies }) ->
+              let bsb_deps =
+                Map_string.keys dependencies
+                |> List.filter (fun dep ->
+                       let dep_dir =
+                         Bsb_pkg.resolve_bs_package ~cwd:dir
+                           (Bsb_pkg_types.string_as_package dep)
+                       in
+                       let bsconfig = dep_dir // Literals.bsconfig_json in
+                       (* NOTE: "rescript" package should be ignore *)
+                       dep <> Literals.rescript && Sys.file_exists bsconfig)
+              in
+              List.iter
+                (fun dep ->
+                  let package_dir =
+                    Bsb_pkg.resolve_bs_package ~cwd:dir
+                      (Bsb_pkg_types.string_as_package dep)
+                  in
+                  walk_all_deps_aux visited package_stacks
+                    ~top:(Expect_name dep) package_dir queue
+                    ~pinned_dependencies)
+                bsb_deps
+          | _ -> ()
         in
-        explore_deps Bsb_build_schemas.bs_dependencies;
+        explore_deps_in_package_json Bsb_build_schemas.PackageJson.dependencies;
         (match top with
-        | Expect_none -> explore_deps Bsb_build_schemas.bs_dev_dependencies
+        | Expect_none ->
+            explore_deps_in_package_json
+              Bsb_build_schemas.PackageJson.devDependencies
         | Expect_name n when Set_string.mem pinned_dependencies n ->
-            explore_deps Bsb_build_schemas.bs_dev_dependencies
+            explore_deps_in_package_json
+              Bsb_build_schemas.PackageJson.devDependencies
         | Expect_name _ -> ());
         Queue.add { top; proj_dir = dir } queue;
         Hash_string.add visited cur_package_name dir
diff --git a/jscomp/bsb/bsb_config_parse.ml b/jscomp/bsb/bsb_config_parse.ml
@@ -36,34 +36,30 @@ type json_map = Ext_json_types.t Map_string.t
 
 (* Key is the path *)
 let ( |? ) m (key, cb) = m |> Ext_json.test key cb
-
 let ( .?() ) = Map_string.find_opt
 
 (*TODO: it is a little mess that [cwd] and [project dir] are shared*)
 
-let extract_package_name_and_namespace (map : json_map) : string * string option
-    =
-  let package_name =
-    match map.?(Bsb_build_schemas.name) with
-    | Some (Str { str = "_" } as config) ->
-        Bsb_exception.config_error config "_ is a reserved package name"
-    | Some (Str { str = name }) -> name
-    | Some config ->
-        Bsb_exception.config_error config "name expect a string field"
-    | None -> Bsb_exception.invalid_spec "field name is required"
-  in
-  let namespace =
-    match map.?(Bsb_build_schemas.namespace) with
-    | None | Some (False _) -> None
-    | Some (True _) ->
-        Some (Ext_namespace.namespace_of_package_name package_name)
-    | Some (Str { str }) ->
-        (*TODO : check the validity of namespace *)
-        Some (Ext_namespace.namespace_of_package_name str)
-    | Some x ->
-        Bsb_exception.config_error x "namespace field expects string or boolean"
-  in
-  (package_name, namespace)
+let extract_package_name (map : json_map) =
+  match map.?(Bsb_build_schemas.name) with
+  | Some (Str { str = "_" } as config) ->
+      Bsb_exception.package_json_config_error config
+        "_ is a reserved package name"
+  | Some (Str { str = name }) -> name
+  | Some config ->
+      Bsb_exception.package_json_config_error config
+        "name expect a string field"
+  | None -> Bsb_exception.invalid_package_json_spec "field name is required"
+
+let extract_namespace (map : json_map) package_name =
+  match map.?(Bsb_build_schemas.namespace) with
+  | None | Some (False _) -> None
+  | Some (True _) -> Some (Ext_namespace.namespace_of_package_name package_name)
+  | Some (Str { str }) ->
+      (*TODO : check the validity of namespace *)
+      Some (Ext_namespace.namespace_of_package_name str)
+  | Some x ->
+      Bsb_exception.config_error x "namespace field expects string or boolean"
 
 (**
     There are two things to check:
@@ -190,14 +186,24 @@ let extract_generators (map : json_map) =
         (Bsb_build_schemas.generators ^ " expect an array field"));
   !generators
 
-let extract_dependencies (map : json_map) cwd (field : string) :
-    Bsb_config_types.dependencies =
+let extract_dependencies_from_package_json (map : json_map) cwd (field : string)
+    : Bsb_config_types.dependencies =
   match map.?(field) with
   | None -> []
-  | Some (Arr { content = s }) ->
-      Ext_list.map (Bsb_build_util.get_list_string s) (fun s ->
-          resolve_package cwd (Bsb_pkg_types.string_as_package s))
-  | Some config -> Bsb_exception.config_error config (field ^ " expect an array")
+  | Some (Obj { map = dependencies }) ->
+      let bsb_deps =
+        Map_string.keys dependencies
+        |> List.filter (fun dep ->
+               let bsconfig =
+                 Bsb_pkg.resolve_bs_package ~cwd
+                   (Bsb_pkg_types.string_as_package dep)
+               in
+               Sys.file_exists bsconfig)
+      in
+      Ext_list.map bsb_deps (fun dep ->
+          resolve_package cwd (Bsb_pkg_types.string_as_package dep))
+  | Some config ->
+      Bsb_exception.package_json_config_error config (field ^ " expect a object")
 
 (* return an empty array if not found *)
 let extract_string_list (map : json_map) (field : string) : string list =
@@ -251,6 +257,11 @@ let extract_js_post_build (map : json_map) cwd : string option =
   |> ignore;
   !js_post_build_cmd
 
+let read_packge_json cwd =
+  match Ext_json_parse.parse_json_from_file (cwd // Literals.package_json) with
+  | Obj { map } -> map
+  | _ -> Bsb_exception.invalid_package_json_spec "expect a json object {}"
+
 (** ATT: make sure such function is re-entrant. 
     With a given [cwd] it works anywhere*)
 let interpret_json ~(package_kind : Bsb_package_kind.t) ~(per_proj_dir : string)
@@ -273,7 +284,11 @@ let interpret_json ~(package_kind : Bsb_package_kind.t) ~(per_proj_dir : string)
     Ext_json_parse.parse_json_from_file (per_proj_dir // Literals.bsconfig_json)
   with
   | Obj { map } -> (
-      let package_name, namespace = extract_package_name_and_namespace map in
+      let map_json = read_packge_json per_proj_dir in
+
+      let package_name = extract_package_name map_json in
+      let namespace = extract_namespace map package_name in
+
       let gentype_config = extract_gentype_config map per_proj_dir in
 
       (* This line has to be before any calls to Bsb_global_backend.backend, because it'll read the entries
@@ -294,13 +309,14 @@ let interpret_json ~(package_kind : Bsb_package_kind.t) ~(per_proj_dir : string)
       in
       let reason_react_jsx = extract_reason_react_jsx map in
       let bs_dependencies =
-        extract_dependencies map per_proj_dir Bsb_build_schemas.bs_dependencies
+        extract_dependencies_from_package_json map_json per_proj_dir
+          Bsb_build_schemas.PackageJson.dependencies
       in
       let bs_dev_dependencies =
         match package_kind with
         | Toplevel | Pinned_dependency _ ->
-            extract_dependencies map per_proj_dir
-              Bsb_build_schemas.bs_dev_dependencies
+            extract_dependencies_from_package_json map_json per_proj_dir
+              Bsb_build_schemas.PackageJson.devDependencies
         | Dependency _ -> []
       in
       let pinned_dependencies = extract_pinned_dependencies map in
diff --git a/jscomp/bsb/bsb_exception.ml b/jscomp/bsb/bsb_exception.ml
@@ -25,16 +25,17 @@
 type error =
   | Package_not_found of Bsb_pkg_types.t * string option (* json file *)
   | Json_config of Ext_position.t * string
+  | PackageJson_config of Ext_position.t * string
   | Invalid_json of string
   | Invalid_spec of string
+  | Invalid_package_json_spec of string
   | Conflict_module of string * string * string
   | No_implementation of string
   | Not_consistent of string
 
 exception Error of error
 
 let error err = raise (Error err)
-
 let package_not_found ~pkg ~json = error (Package_not_found (pkg, json))
 
 let print (fmt : Format.formatter) (x : error) =
@@ -58,13 +59,13 @@ let print (fmt : Format.formatter) (x : error) =
       let name = Bsb_pkg_types.to_string name in
       if Ext_string.equal name !Bs_version.package_name then
         Format.fprintf fmt
-          "File \"bsconfig.json\", line 1\n\
+          "File \"package.json\", line 1\n\
            @{<error>Error:@} package @{<error>%s@} is not found %s\n\
            It's the basic, required package. If you have it installed globally,\n\
            Please run `npm link rescript` to make it available" name in_json
       else
         Format.fprintf fmt
-          "File \"bsconfig.json\", line 1\n\
+          "File \"package.json\", line 1\n\
            @{<error>Error:@} package @{<error>%s@} not found or built %s\n\
            - Did you install it?\n\
            - If you did, did you run `rescript build -with-deps`?" name in_json
@@ -75,8 +76,13 @@ let print (fmt : Format.formatter) (x : error) =
          For more details, please checkout the schema \
          https://rescript-lang.org/docs/manual/latest/build-configuration-schema"
         pos.pos_fname pos.pos_lnum s
+  | PackageJson_config (pos, s) ->
+      Format.fprintf fmt "File %S, line %d:\n@{<error>Error:@} %s" pos.pos_fname
+        pos.pos_lnum s
   | Invalid_spec s ->
       Format.fprintf fmt "@{<error>Error: Invalid bsconfig.json %s@}" s
+  | Invalid_package_json_spec s ->
+      Format.fprintf fmt "@{<error>Error: Invalid package.json %s@}" s
   | Invalid_json s ->
       Format.fprintf fmt
         "File %S, line 1\n@{<error>Error: Invalid json format@}" s
@@ -85,7 +91,6 @@ let conflict_module modname dir1 dir2 =
   Error (Conflict_module (modname, dir1, dir2))
 
 let no_implementation modname = error (No_implementation modname)
-
 let not_consistent modname = error (Not_consistent modname)
 
 let errorf ~loc fmt =
@@ -96,8 +101,13 @@ let config_error config fmt =
 
   error (Json_config (loc, fmt))
 
-let invalid_spec s = error (Invalid_spec s)
+let package_json_config_error config fmt =
+  let loc = Ext_json.loc_of config in
+
+  error (PackageJson_config (loc, fmt))
 
+let invalid_spec s = error (Invalid_spec s)
+let invalid_package_json_spec s = error (Invalid_package_json_spec s)
 let invalid_json s = error (Invalid_json s)
 
 let () =
diff --git a/jscomp/bsb/bsb_exception.mli b/jscomp/bsb/bsb_exception.mli
@@ -39,10 +39,14 @@ val errorf : loc:Ext_position.t -> ('a, unit, string, 'b) format4 -> 'a
 
 val config_error : Ext_json_types.t -> string -> 'a
 
+val package_json_config_error : Ext_json_types.t -> string -> 'a
+
 val invalid_spec : string -> 'a
 
 val invalid_json : string -> 'a
 
+val invalid_package_json_spec: string -> 'a
+
 val no_implementation : string -> 'a
 
 val not_consistent : string -> 'a
diff --git a/jscomp/ext/literals.ml b/jscomp/ext/literals.ml
@@ -178,3 +178,5 @@ let lazy_done = "LAZY_DONE"
 let lazy_val = "VAL"
 
 let pure = "@__PURE__"
+
+let rescript = "rescript"
diff --git a/jscomp/super_errors/super_typetexp.ml b/jscomp/super_errors/super_typetexp.ml
@@ -71,7 +71,7 @@ let report_error env ppf = function
                               - Did you list it in bsconfig.json?@,\
                               - @[Did you run `rescript build` instead of `rescript build -with-deps`@ (latter builds third-parties)@]?\
                               @]@,\
-                              - Did you include the file's directory in bsconfig.json?@]\
+                              - Did you include the file's directory in package.json?@]\
                               @]"
             Printtyp.longident lid
         end
