Use Yojson and lsp types for analysis JSON output

CHANGELOG.md

@@ -41,6 +41,7 @@
 - Use a single vendored @rescript/react package across the repo. https://github.com/rescript-lang/rescript/pull/7525
 - Improve deprecated attribute extraction and support record form. https://github.com/rescript-lang/rescript/pull/8396
 - Refactor analysis to decouple I/O from core logic. https://github.com/rescript-lang/rescript/pull/8426
+- Remove vendored `Json` library and use `yojson` and `lsp` library for analysis. https://github.com/rescript-lang/rescript/pull/8436
 
 #### :house: Internal
 

analysis.opam

@@ -11,6 +11,8 @@ depends: [
   "ocaml" {>= "5.0.0"}
   "cppo" {= "1.8.0"}
   "odoc" {with-doc}
+  "lsp" {= "1.22.0"}
+  "yojson" {= "2.2.2"}
 ]
 build: [
   ["dune" "subst"] {dev}

analysis/bin/main.ml

@@ -180,13 +180,12 @@ let main () =
       | _ -> raise (Failure "unsupported type")
     in
     let source = Files.readFile path |> Option.value ~default:"" in
-    let res =
-      Codemod.transform ~source
-        ~pos:(int_of_string line, int_of_string col)
-        ~debug ~typ ~hint
-      |> Json.escape
-    in
-    Printf.printf "\"%s\"" res
+    `String
+      (Codemod.transform ~source
+         ~pos:(int_of_string line, int_of_string col)
+         ~debug ~typ ~hint)
+    |> Yojson.Safe.pretty_to_string ~std:true
+    |> print_endline
   | [_; "diagnosticSyntax"; path] -> Cli.diagnosticSyntax ~path
   | [_; "references"; path; line; col] ->
     Cli.references ~path ~pos:(int_of_string line, int_of_string col) ~debug
@@ -198,8 +197,9 @@ let main () =
       ~newName ~debug
   | [_; "semanticTokens"; currentFile] -> Cli.semanticTokens ~path:currentFile
   | [_; "createInterface"; path; cmiFile] ->
-    Printf.printf "\"%s\""
-      (Json.escape (CreateInterface.command ~path ~cmiFile))
+    `String (CreateInterface.command ~path ~cmiFile)
+    |> Yojson.Safe.pretty_to_string ~std:true
+    |> print_endline
   | [_; "format"; path] -> Cli.format ~path
   | [_; "test"; path] -> Cli.test ~path
   | [_; "cmt"; rescript_json; cmt_path] -> CmtViewer.dump rescript_json cmt_path

analysis/reanalyze/src/EmitJson.ml

@@ -4,18 +4,19 @@ let start () =
   Printf.printf "["
 let finish () = Printf.printf "\n]\n"
 let emitClose () = "\n}"
+let jsonString text = Yojson.Safe.to_string (`String text)
 
 let emitItem ~ppf ~name ~kind ~file ~range ~message =
   let open Format in
   items := !items + 1;
   let startLine, startCharacter, endLine, endCharacter = range in
   fprintf ppf "%s{\n" (if !items = 1 then "\n" else ",\n");
-  fprintf ppf "  \"name\": \"%s\",\n" name;
-  fprintf ppf "  \"kind\": \"%s\",\n" kind;
-  fprintf ppf "  \"file\": \"%s\",\n" file;
+  fprintf ppf "  \"name\": %s,\n" (jsonString name);
+  fprintf ppf "  \"kind\": %s,\n" (jsonString kind);
+  fprintf ppf "  \"file\": %s,\n" (jsonString file);
   fprintf ppf "  \"range\": [%d,%d,%d,%d],\n" startLine startCharacter endLine
     endCharacter;
-  fprintf ppf "  \"message\": \"%s\"" message
+  fprintf ppf "  \"message\": %s" (jsonString message)
 
 let locToPos (loc : Location.t) =
   (loc.loc_start.pos_lnum - 1, loc.loc_start.pos_cnum - loc.loc_start.pos_bol)
@@ -24,6 +25,6 @@ let emitAnnotate ~pos ~text ~action =
   let line, character = pos in
   Format.asprintf
     ",\n\
-    \  \"annotate\": { \"line\": %d, \"character\": %d, \"text\": \"%s\", \
-     \"action\": \"%s\"}"
-    line character text action
+    \  \"annotate\": { \"line\": %d, \"character\": %d, \"text\": %s, \
+     \"action\": %s}"
+    line character (jsonString text) (jsonString action)

analysis/reanalyze/src/Log_.ml

@@ -164,12 +164,12 @@ let logIssue ~config ~(issue : Issue.t) =
   let open Format in
   let loc = issue.loc in
   if config.DceConfig.cli.json then
-    let file = Json.escape loc.loc_start.pos_fname in
+    let file = loc.loc_start.pos_fname in
     let startLine = loc.loc_start.pos_lnum - 1 in
     let startCharacter = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in
     let endLine = loc.loc_end.pos_lnum - 1 in
     let endCharacter = loc.loc_end.pos_cnum - loc.loc_start.pos_bol in
-    let message = Json.escape (descriptionToMessage issue.description) in
+    let message = descriptionToMessage issue.description in
     Format.asprintf "%a%s%s"
       (fun ppf () ->
         EmitJson.emitItem ~ppf ~name:issue.name

analysis/reanalyze/src/Paths.ml

@@ -1,5 +1,11 @@
 let rescriptJson = "rescript.json"
 
+(** If `t` is an object (`Assoc), get the value associated with the given string key *)
+let get key t =
+  match t with
+  | `Assoc items -> List.assoc_opt key items
+  | _ -> None
+
 let readFile filename =
   try
     (* windows can't use open_in *)
@@ -33,50 +39,49 @@ let setReScriptProjectRoot = lazy (setProjectRootFromCwd ())
 
 module Config = struct
   let readSuppress conf =
-    match Json.get "suppress" conf with
-    | Some (Array elements) ->
+    match conf |> get "suppress" with
+    | Some (`List elements) ->
       let names =
         elements
-        |> List.filter_map (fun (x : Json.t) ->
+        |> List.filter_map (fun (x : Yojson.Safe.t) ->
                match x with
-               | String s -> Some s
+               | `String s -> Some s
                | _ -> None)
       in
       runConfig.suppress <- names @ runConfig.suppress
     | _ -> ()
 
   let readUnsuppress conf =
-    match Json.get "unsuppress" conf with
-    | Some (Array elements) ->
+    match conf |> get "unsuppress" with
+    | Some (`List elements) ->
       let names =
         elements
-        |> List.filter_map (fun (x : Json.t) ->
+        |> List.filter_map (fun (x : Yojson.Safe.t) ->
                match x with
-               | String s -> Some s
+               | `String s -> Some s
                | _ -> None)
       in
       runConfig.unsuppress <- names @ runConfig.unsuppress
     | _ -> ()
 
   let readAnalysis conf =
-    match Json.get "analysis" conf with
-    | Some (Array elements) ->
+    match conf |> get "analysis" with
+    | Some (`List elements) ->
       elements
-      |> List.iter (fun (x : Json.t) ->
+      |> List.iter (fun (x : Yojson.Safe.t) ->
              match x with
-             | String "all" -> RunConfig.all ()
-             | String "dce" -> RunConfig.dce ()
-             | String "exception" -> RunConfig.exception_ ()
-             | String "termination" -> RunConfig.termination ()
+             | `String "all" -> RunConfig.all ()
+             | `String "dce" -> RunConfig.dce ()
+             | `String "exception" -> RunConfig.exception_ ()
+             | `String "termination" -> RunConfig.termination ()
              | _ -> ())
     | _ ->
       (* if no "analysis" specified, default to dce *)
       RunConfig.dce ()
 
   let readTransitive conf =
-    match Json.get "transitive" conf with
-    | Some True -> RunConfig.transitive true
-    | Some False -> RunConfig.transitive false
+    match conf |> get "transitive" with
+    | Some (`Bool bool) -> RunConfig.transitive bool
     | _ -> ()
 
   (* Read the config from rescript.json and apply it to runConfig and suppress and unsuppress *)
@@ -85,10 +90,9 @@ module Config = struct
     let rescriptFile = Filename.concat runConfig.projectRoot rescriptJson in
 
     let processText text =
-      match Json.parse text with
-      | None -> ()
+      match try Some (Yojson.Safe.from_string text) with _ -> None with
       | Some json -> (
-        match Json.get "reanalyze" json with
+        match get "reanalyze" json with
         | Some conf ->
           readSuppress conf;
           readUnsuppress conf;
@@ -97,6 +101,7 @@ module Config = struct
         | None ->
           (* if no "analysis" specified, default to dce *)
           RunConfig.dce ())
+      | _ -> ()
     in
 
     match readFile rescriptFile with
@@ -145,18 +150,23 @@ let readCmtScan () =
     ["lib"; "bs"; ".sourcedirs.json"]
     |> List.fold_left Filename.concat runConfig.bsbProjectRoot
   in
-  let get key fn json =
-    Json.get key json |> Option.to_list |> List.filter_map fn
+  let get_fn key fn json =
+    get key json |> Option.to_list |> List.filter_map fn
   in
-  let read_entry (json : Json.t) =
-    let build_root = json |> get "build_root" Json.string in
+  let read_entry (json : Yojson.Safe.t) =
+    let build_root =
+      json |> get_fn "build_root" Yojson.Safe.Util.to_string_option
+    in
     let scan_dirs =
-      match json |> get "scan_dirs" Json.array with
-      | [arr] -> arr |> List.filter_map Json.string
+      match json |> get "scan_dirs" with
+      | Some (`List arr) ->
+        arr |> List.filter_map Yojson.Safe.Util.to_string_option
       | _ -> []
     in
     let also_scan_build_root =
-      match json |> get "also_scan_build_root" Json.bool with
+      match
+        json |> get_fn "also_scan_build_root" Yojson.Safe.Util.to_bool_option
+      with
       | [b] -> b
       | _ -> false
     in
@@ -167,9 +177,9 @@ let readCmtScan () =
   match readFile sourceDirsFile with
   | None -> []
   | Some text -> (
-    match Json.parse text with
+    match try Some (Yojson.Safe.from_string text) with _ -> None with
     | None -> []
     | Some json -> (
-      match json |> get "cmt_scan" Json.array with
-      | [arr] -> arr |> List.filter_map read_entry
+      match get "cmt_scan" json with
+      | Some (`List 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 ml str unix))
+ (libraries reactive yojson ml str unix))