Move rescript.json reading out of bsc into rewatch

CHANGELOG.md

@@ -36,6 +36,8 @@
 
 #### :house: Internal
 
+- Move `rescript.json` reading out of `bsc` into rewatch; remove the custom OCaml JSON parser. https://github.com/rescript-lang/rescript/pull/8365
+
 # 13.0.0-alpha.3
 
 #### :boom: Breaking Change

analysis/reanalyze/src/Paths.ml

@@ -1,5 +1,3 @@
-module StringMap = Map_string
-
 let rescriptJson = "rescript.json"
 
 let readFile filename =
@@ -127,79 +125,6 @@ let handleNamespace cmt =
 
 let getModuleName cmt = cmt |> handleNamespace |> Filename.basename
 
-let readDirsFromConfig ~configSources =
-  let dirs = ref [] in
-  let root = runConfig.projectRoot in
-  let rec processDir ~subdirs dir =
-    let absDir =
-      match dir = "" with
-      | true -> root
-      | false -> Filename.concat root dir
-    in
-    if Sys.file_exists absDir && Sys.is_directory absDir then (
-      dirs := dir :: !dirs;
-      if subdirs then
-        absDir |> Sys.readdir
-        |> Array.iter (fun d -> processDir ~subdirs (Filename.concat dir d)))
-  in
-  let rec processSourceItem (sourceItem : Ext_json_types.t) =
-    match sourceItem with
-    | Str {str} -> str |> processDir ~subdirs:false
-    | Obj {map} -> (
-      match StringMap.find_opt map "dir" with
-      | Some (Str {str}) ->
-        let subdirs =
-          match StringMap.find_opt map "subdirs" with
-          | Some (True _) -> true
-          | Some (False _) -> false
-          | _ -> false
-        in
-        str |> processDir ~subdirs
-      | _ -> ())
-    | Arr {content = arr} -> arr |> Array.iter processSourceItem
-    | _ -> ()
-  in
-  (match configSources with
-  | Some sourceItem -> processSourceItem sourceItem
-  | None -> ());
-  !dirs
-
-let readSourceDirs ~configSources =
-  let sourceDirs =
-    ["lib"; "bs"; ".sourcedirs.json"]
-    |> List.fold_left Filename.concat runConfig.bsbProjectRoot
-  in
-  let dirs = ref [] in
-  let readDirs json =
-    match json with
-    | Ext_json_types.Obj {map} -> (
-      match StringMap.find_opt map "dirs" with
-      | Some (Arr {content = arr}) ->
-        arr
-        |> Array.iter (fun x ->
-               match x with
-               | Ext_json_types.Str {str} -> dirs := str :: !dirs
-               | _ -> ());
-        ()
-      | _ -> ())
-    | _ -> ()
-  in
-  if sourceDirs |> Sys.file_exists then
-    let jsonOpt = sourceDirs |> Ext_json_parse.parse_json_from_file in
-    match jsonOpt with
-    | exception _ -> ()
-    | json ->
-      if runConfig.bsbProjectRoot <> runConfig.projectRoot then (
-        readDirs json;
-        dirs := readDirsFromConfig ~configSources)
-      else readDirs json
-  else (
-    if !Cli.debug then (
-      Log_.item "Warning: can't find source dirs: %s\n" sourceDirs;
-      Log_.item "Types for cross-references will not be found.\n");
-    dirs := readDirsFromConfig ~configSources);
-  !dirs
-
 type cmt_scan_entry = {
   build_root: string;
   scan_dirs: string list;
@@ -220,51 +145,31 @@ let readCmtScan () =
     ["lib"; "bs"; ".sourcedirs.json"]
     |> List.fold_left Filename.concat runConfig.bsbProjectRoot
   in
-  let entries = ref [] in
-  let read_entry (json : Ext_json_types.t) =
-    match json with
-    | Ext_json_types.Obj {map} -> (
-      let build_root =
-        match StringMap.find_opt map "build_root" with
-        | Some (Ext_json_types.Str {str}) -> Some str
-        | _ -> None
-      in
-      let scan_dirs =
-        match StringMap.find_opt map "scan_dirs" with
-        | Some (Ext_json_types.Arr {content = arr}) ->
-          arr |> Array.to_list
-          |> List.filter_map (fun x ->
-                 match x with
-                 | Ext_json_types.Str {str} -> Some str
-                 | _ -> None)
-        | _ -> []
-      in
-      let also_scan_build_root =
-        match StringMap.find_opt map "also_scan_build_root" with
-        | Some (Ext_json_types.True _) -> true
-        | Some (Ext_json_types.False _) -> false
-        | _ -> false
-      in
-      match build_root with
-      | Some build_root ->
-        entries := {build_root; scan_dirs; also_scan_build_root} :: !entries
-      | None -> ())
-    | _ -> ()
+  let get key fn json =
+    Json.get key json |> Option.to_list |> List.filter_map fn
   in
-  let read_cmt_scan (json : Ext_json_types.t) =
-    match json with
-    | Ext_json_types.Obj {map} -> (
-      match StringMap.find_opt map "cmt_scan" with
-      | Some (Ext_json_types.Arr {content = arr}) ->
-        arr |> Array.iter read_entry
-      | _ -> ())
-    | _ -> ()
+  let read_entry (json : Json.t) =
+    let build_root = json |> get "build_root" Json.string in
+    let scan_dirs =
+      match json |> get "scan_dirs" Json.array with
+      | [arr] -> arr |> List.filter_map Json.string
+      | _ -> []
+    in
+    let also_scan_build_root =
+      match json |> get "also_scan_build_root" Json.bool with
+      | [b] -> b
+      | _ -> false
+    in
+    match build_root with
+    | [build_root] -> Some {build_root; scan_dirs; also_scan_build_root}
+    | _ -> None
   in
-  if sourceDirsFile |> Sys.file_exists then (
-    let jsonOpt = sourceDirsFile |> Ext_json_parse.parse_json_from_file in
-    match jsonOpt with
-    | exception _ -> []
-    | json ->
-      read_cmt_scan json;
-      !entries |> List.rev)
-  else []
+  match readFile sourceDirsFile with
+  | None -> []
+  | Some text -> (
+    match Json.parse text with
+    | None -> []
+    | Some json -> (
+      match json |> get "cmt_scan" Json.array with
+      | [arr] -> arr |> List.filter_map read_entry
+      | _ -> []))

analysis/reanalyze/src/dune

@@ -2,4 +2,4 @@
  (name reanalyze)
  (flags
   (-w "+6+26+27+32+33+39"))
- (libraries reactive jsonlib ext ml str unix))
+ (libraries reactive jsonlib ml str unix))

cli/bsc.js

@@ -3,14 +3,40 @@
 // @ts-check
 
 import { execFileSync } from "node:child_process";
+import { existsSync } from "node:fs";
+import { dirname, join } from "node:path";
 
 import { bsc_exe } from "./common/bins.js";
 import { runtimePath } from "./common/runtime.js";
 
+/**
+ * Walk up from `startDir` until a directory containing `rescript.json`
+ * is found. Returns null if none is found.
+ * @param {string} startDir
+ * @returns {string | null}
+ */
+function findProjectRoot(startDir) {
+  let dir = startDir;
+  while (true) {
+    if (existsSync(join(dir, "rescript.json"))) {
+      return dir;
+    }
+    const parent = dirname(dir);
+    if (parent === dir) return null;
+    dir = parent;
+  }
+}
+
 const delegate_args = process.argv.slice(2);
 if (!delegate_args.includes("-runtime-path")) {
   delegate_args.push("-runtime-path", runtimePath);
 }
+if (!delegate_args.includes("-bs-project-root")) {
+  const projectRoot = findProjectRoot(process.cwd());
+  if (projectRoot !== null) {
+    delegate_args.push("-bs-project-root", projectRoot);
+  }
+}
 
 try {
   execFileSync(bsc_exe, delegate_args, { stdio: "inherit" });

compiler/bsc/rescript_compiler_main.ml

@@ -263,6 +263,11 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
       string_call Js_packages_state.update_npm_package_path,
       "*internal* Set npm-output-path: [opt_module]:path, for example: \
        'lib/cjs', 'amdjs:lib/amdjs', 'es6:lib/es6' " );
+    ( "-bs-project-root",
+      string_call (fun s ->
+          Ext_path.project_root := Some s;
+          GenTypeConfig.project_root := s),
+      "*internal* Set the project root directory" );
     ( "-bs-ast",
       unit_call (fun _ ->
           Js_config.binary_ast := true;
@@ -293,6 +298,49 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
       set Clflags.transparent_modules,
       "*internal*Do not record dependencies for module aliases" );
     ("-bs-gentype", set Clflags.bs_gentype, "*internal* Pass gentype command");
+    ( "-bs-gentype-module",
+      string_call (fun s ->
+          GenTypeConfig.module_flag := GenTypeConfig.module_of_string s),
+      "*internal* Set gentype module system: commonjs|esmodule" );
+    ( "-bs-gentype-module-resolution",
+      string_call (fun s ->
+          GenTypeConfig.module_resolution_flag :=
+            GenTypeConfig.module_resolution_of_string s),
+      "*internal* Set gentype module resolution strategy: node|node16|bundler"
+    );
+    ( "-bs-gentype-export-interfaces",
+      set GenTypeConfig.export_interfaces_flag,
+      "*internal* Emit gentype interface files" );
+    ( "-bs-gentype-generated-extension",
+      string_call (fun s ->
+          GenTypeConfig.generated_file_extension_flag := Some s),
+      "*internal* Set gentype generated-file extension (e.g. .gen.tsx)" );
+    ( "-bs-gentype-suffix",
+      string_call (fun s -> GenTypeConfig.suffix_flag := Some s),
+      "*internal* Set gentype import-path suffix (e.g. .bs.js, .mjs)" );
+    ( "-bs-gentype-shim",
+      string_call GenTypeConfig.add_shim,
+      "*internal* Register a gentype shim mapping: From=To (repeatable)" );
+    ( "-bs-gentype-debug",
+      string_call Debug.set_item,
+      "*internal* Enable a gentype debug category (repeatable): \
+       all|basic|codeItems|config|converter|dependencies|moduleResolution|notImplemented|translation|typeEnv|typeResolution"
+    );
+    ( "-bs-gentype-dep",
+      string_call GenTypeConfig.add_bs_dependency,
+      "*internal* Register a gentype bsb dependency (repeatable)" );
+    ( "-bs-gentype-source-dir",
+      string_call GenTypeConfig.add_source_dir,
+      "*internal* Register a gentype source directory relative to the project \
+       root (repeatable)" );
+    ( "-bs-gentype-dep-path",
+      string_call GenTypeConfig.add_dep_path,
+      "*internal* Register a gentype dependency install path: \
+       <name>=<absolute-path> (repeatable)" );
+    ( "-bs-gentype-bsb-project-root",
+      string_call (fun s -> GenTypeConfig.bsb_project_root := s),
+      "*internal* Set gentype bsb project root (workspace root containing \
+       .sourcedirs.json)" );
     (******************************************************************************)
     ( "-unboxed-types",
       set Clflags.unboxed_types,

compiler/core/lam_compile_main.ml

@@ -314,12 +314,12 @@ let lambda_as_module
         let basename =  
           Ext_namespace.change_ext_ns_suffix (Filename.basename output_prefix) suffix
         in
-        let target_file = 
-          (Lazy.force Ext_path.package_dir //
+        let target_file =
+          (Ext_path.package_dir () //
            path //
            basename
            (* #913 only generate little-case js file *)
-          ) in     
+          ) in
         (if not !Clflags.dont_write_files then 
            Ext_pervasives.with_file_as_chan
              target_file output_chan );

compiler/ext/dune

@@ -15,8 +15,6 @@
   (language c)
   (names ext_basic_hash_stubs)))
 
-(ocamllex ext_json_parse)
-
 (rule
  (targets hash_set_string.ml)
  (deps hash_set.cppo.ml)