analysis: fix namespace parsing after Yojson migration

CHANGELOG.md

@@ -31,6 +31,7 @@
 - Rewatch: use a single timestamp per compile pass. https://github.com/rescript-lang/rescript/pull/8428
 - Fix rewatch warning replay after early compile errors. https://github.com/rescript-lang/rescript/pull/8408
 - Fix formatting of trailing comments before `=` in let bindings. https://github.com/rescript-lang/rescript/pull/8444
+- Fix analysis namespace parsing after the Yojson migration. https://github.com/rescript-lang/rescript/pull/8454
 
 #### :memo: Documentation
 

analysis/reanalyze/src/Paths.ml

@@ -154,19 +154,14 @@ let readCmtScan () =
     get key json |> Option.to_list |> List.filter_map fn
   in
   let read_entry (json : Yojson.Safe.t) =
-    let build_root =
-      json |> get_fn "build_root" Yojson.Safe.Util.to_string_option
-    in
+    let build_root = json |> get_fn "build_root" YojsonHelpers.string_opt in
     let scan_dirs =
       match json |> get "scan_dirs" with
-      | Some (`List arr) ->
-        arr |> List.filter_map Yojson.Safe.Util.to_string_option
+      | Some (`List arr) -> arr |> List.filter_map YojsonHelpers.string_opt
       | _ -> []
     in
     let also_scan_build_root =
-      match
-        json |> get_fn "also_scan_build_root" Yojson.Safe.Util.to_bool_option
-      with
+      match json |> get_fn "also_scan_build_root" YojsonHelpers.bool_opt with
       | [b] -> b
       | _ -> false
     in

analysis/reanalyze/src/Reanalyze.ml

@@ -776,3 +776,4 @@ module ReanalyzeServer = ReanalyzeServer
 module RunConfig = RunConfig
 module DceConfig = DceConfig
 module Log_ = Log_
+module YojsonHelpers = YojsonHelpers

analysis/reanalyze/src/YojsonHelpers.ml

@@ -0,0 +1,19 @@
+let get key (t : Yojson.Safe.t) : Yojson.Safe.t option =
+  match t with
+  | `Assoc items -> List.assoc_opt key items
+  | _ -> None
+
+let bool_opt = function
+  | `Bool value -> Some value
+  | _ -> None
+
+let string_opt = function
+  | `String value -> Some value
+  | _ -> None
+
+let to_list_opt = function
+  | `List items -> Some items
+  | _ -> None
+
+let from_string_opt text =
+  try Some (Yojson.Safe.from_string text) with _ -> None

analysis/src/FindFiles.ml

@@ -11,14 +11,14 @@ let getSourceDirectories ~includeDev ~baseDir config =
     | `Assoc _ -> (
       let dir =
         item |> YojsonHelpers.get "dir"
-        |> bind Yojson.Safe.Util.to_string_option
+        |> bind YojsonHelpers.string_opt
         |> Option.value ~default:"Must specify directory"
       in
       let typ =
         if includeDev then "lib"
         else
           item |> YojsonHelpers.get "type"
-          |> bind Yojson.Safe.Util.to_string_option
+          |> bind YojsonHelpers.string_opt
           |> Option.value ~default:"lib"
       in
 
@@ -94,22 +94,27 @@ let nameSpaceToName n =
   |> List.map String.capitalize_ascii
   |> String.concat ""
 
+type namespace_config =
+  | NamespaceDisabled
+  | NamespaceFromPackageName
+  | NamespaceExplicit of string
+
+let getNamespaceConfig config =
+  match config |> YojsonHelpers.get "namespace" with
+  | None | Some (`Bool false) -> NamespaceDisabled
+  | Some (`Bool true) -> NamespaceFromPackageName
+  | Some (`String namespace) -> NamespaceExplicit namespace
+  | Some _ -> NamespaceDisabled
+
 let getNamespace config =
-  let ns = config |> YojsonHelpers.get "namespace" in
-  let fromString = ns |> bind Yojson.Safe.Util.to_string_option in
-  let isNamespaced =
-    ns
-    |> bind Yojson.Safe.Util.to_bool_option
-    |> Option.value ~default:(fromString |> Option.is_some)
-  in
-  let either x y = if x = None then y else x in
-  if isNamespaced then
+  match getNamespaceConfig config with
+  | NamespaceDisabled -> None
+  | NamespaceExplicit namespace -> Some (nameSpaceToName namespace)
+  | NamespaceFromPackageName ->
     let fromName =
-      config |> YojsonHelpers.get "name"
-      |> bind Yojson.Safe.Util.to_string_option
+      config |> YojsonHelpers.get "name" |> bind YojsonHelpers.string_opt
     in
-    either fromString fromName |> Option.map nameSpaceToName
-  else None
+    fromName |> Option.map nameSpaceToName
 
 module StringSet = Set.Make (String)
 
@@ -122,9 +127,8 @@ let getPublic config =
     | None -> None
     | Some public ->
       Some
-        (public
-        |> List.filter_map Yojson.Safe.Util.to_string_option
-        |> StringSet.of_list))
+        (public |> List.filter_map YojsonHelpers.string_opt |> StringSet.of_list)
+    )
 
 let collectFiles directory =
   let allFiles = Files.readDirectory directory in
@@ -262,7 +266,7 @@ let findDependencyFiles base config =
     with
     | None, None -> []
     | Some deps, None | _, Some deps ->
-      deps |> List.filter_map Yojson.Safe.Util.to_string_option
+      deps |> List.filter_map YojsonHelpers.string_opt
   in
   let devDeps =
     match
@@ -275,7 +279,7 @@ let findDependencyFiles base config =
     with
     | None, None -> []
     | Some devDeps, None | _, Some devDeps ->
-      devDeps |> List.filter_map (fun x -> Some (Yojson.Safe.Util.to_string x))
+      devDeps |> List.filter_map YojsonHelpers.string_opt
   in
   let deps = deps @ devDeps in
   Log.log ("Dependencies: " ^ String.concat " " deps);

analysis/src/Packages.ml

@@ -151,7 +151,7 @@ let newBsPackage ~rootPath =
            let opens_from_compiler_flags =
              List.fold_left
                (fun opens item ->
-                 match item |> Yojson.Safe.Util.to_string_option with
+                 match item |> YojsonHelpers.string_opt with
                  | None -> opens
                  | Some s -> (
                    let parts = String.split_on_char ' ' s in

analysis/src/YojsonHelpers.ml

@@ -1,9 +1 @@
-let get key (t : Yojson.Safe.t) : Yojson.Safe.t option =
-  match t with
-  | `Assoc items -> List.assoc_opt key items
-  | _ -> None
-
-let to_list_opt json = try Some (Yojson.Safe.Util.to_list json) with _ -> None
-
-let from_string_opt text =
-  try Some (Yojson.Safe.from_string text) with _ -> None
+include Reanalyze.YojsonHelpers

tests/ounit_tests/ounit_analysis_config_tests.ml

@@ -0,0 +1,67 @@
+let ( >:: ), ( >::: ) = OUnit.(( >:: ), ( >::: ))
+
+let json raw =
+  match Yojson.Safe.from_string raw with
+  | json -> json
+  | exception Yojson.Json_error message -> failwith message
+
+let assert_namespace ~expected raw =
+  OUnit.assert_equal
+    ~printer:(function
+      | Some s -> "Some " ^ s
+      | None -> "None")
+    expected
+    (Analysis.FindFiles.getNamespace (json raw))
+
+let assert_string_opt ~expected actual =
+  OUnit.assert_equal
+    ~printer:(function
+      | Some s -> "Some " ^ s
+      | None -> "None")
+    expected actual
+
+let assert_bool_opt ~expected actual =
+  OUnit.assert_equal
+    ~printer:(function
+      | Some b -> "Some " ^ string_of_bool b
+      | None -> "None")
+    expected actual
+
+let suites =
+  __FILE__
+  >::: [
+         ( "yojson helpers do not raise on type mismatch" >:: fun _ ->
+           assert_string_opt ~expected:(Some "value")
+             (Analysis.YojsonHelpers.string_opt (`String "value"));
+           assert_string_opt ~expected:None
+             (Analysis.YojsonHelpers.string_opt (`Bool true));
+           assert_bool_opt ~expected:(Some true)
+             (Analysis.YojsonHelpers.bool_opt (`Bool true));
+           assert_bool_opt ~expected:None
+             (Analysis.YojsonHelpers.bool_opt (`String "true"));
+           OUnit.assert_equal ~printer:string_of_int 1
+             (Analysis.YojsonHelpers.to_list_opt (`List [`Null])
+             |> Option.fold ~none:0 ~some:List.length);
+           OUnit.assert_equal ~printer:string_of_int 0
+             (Analysis.YojsonHelpers.to_list_opt (`String "not a list")
+             |> Option.fold ~none:0 ~some:List.length);
+           OUnit.assert_bool "valid JSON parses"
+             (Analysis.YojsonHelpers.from_string_opt {|{"ok": true}|}
+             |> Option.is_some);
+           OUnit.assert_bool "invalid JSON is ignored"
+             (Analysis.YojsonHelpers.from_string_opt {|{|} |> Option.is_none) );
+         ( "absent namespace is disabled" >:: fun _ ->
+           assert_namespace ~expected:None {|{"name": "@tests/pkg"}|} );
+         ( "false namespace is disabled" >:: fun _ ->
+           assert_namespace ~expected:None
+             {|{"name": "@tests/pkg", "namespace": false}|} );
+         ( "non-string non-bool namespace is disabled" >:: fun _ ->
+           assert_namespace ~expected:None
+             {|{"name": "@tests/pkg", "namespace": 1}|} );
+         ( "true namespace uses package name" >:: fun _ ->
+           assert_namespace ~expected:(Some "TestsNamespacedReferences")
+             {|{"name": "@tests/namespaced-references", "namespace": true}|} );
+         ( "string namespace uses explicit value" >:: fun _ ->
+           assert_namespace ~expected:(Some "MyNamespace")
+             {|{"name": "@tests/pkg", "namespace": "my-namespace"}|} );
+       ]

tests/ounit_tests/ounit_tests_main.ml

@@ -19,6 +19,7 @@ let suites =
       Ounit_util_tests.suites;
       Ounit_js_analyzer_tests.suites;
       Ounit_jsx_loc_tests.suites;
+      Ounit_analysis_config_tests.suites;
     ]
 
 let _ = OUnit.run_test_tt_main suites