complete payload of @module attribute (#879)

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -1516,6 +1516,8 @@ let rec completeTypedValue ~full ~prefix ~completionContext ~mode
     ]
   | Tpromise _ -> []
 
+module StringSet = Set.Make (String)
+
 let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
   if debug then
     Printf.printf "Completable: %s\n" (Completable.toString completable);
@@ -1571,6 +1573,83 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
              && (forHover || not (List.mem name identsSeen)))
       |> List.map mkLabel)
       @ keyLabels
+  | CdecoratorPayload (Module prefix) ->
+    let packageJsonPath =
+      Utils.findPackageJson (full.package.rootPath |> Uri.fromPath)
+    in
+    let itemsFromPackageJson =
+      match packageJsonPath with
+      | None ->
+        if debug then
+          Printf.printf
+            "Did not find package.json, started looking (going upwards) from: %s\n"
+            full.package.rootPath;
+        []
+      | Some path -> (
+        match Files.readFile path with
+        | None ->
+          if debug then print_endline "Could not read package.json";
+          []
+        | Some s -> (
+          match Json.parse s with
+          | Some (Object items) ->
+            items
+            |> List.filter_map (fun (key, t) ->
+                   match (key, t) with
+                   | ("dependencies" | "devDependencies"), Json.Object o ->
+                     Some
+                       (o
+                       |> List.filter_map (fun (pkgName, _) ->
+                              match pkgName with
+                              | "rescript" -> None
+                              | pkgName -> Some pkgName))
+                   | _ -> None)
+            |> List.flatten
+          | _ ->
+            if debug then print_endline "Could not parse package.json";
+            []))
+    in
+    (* TODO: Resolve relatives? *)
+    let localItems =
+      try
+        let files =
+          Sys.readdir (Filename.dirname (env.file.uri |> Uri.toPath))
+          |> Array.to_list
+        in
+        (* Try to filter out compiled in source files *)
+        let resFiles =
+          StringSet.of_list
+            (files
+            |> List.filter_map (fun f ->
+                   if Filename.extension f = ".res" then
+                     Some (try Filename.chop_extension f with _ -> f)
+                   else None))
+        in
+        files
+        |> List.filter_map (fun fileName ->
+               let withoutExtension =
+                 try Filename.chop_extension fileName with _ -> fileName
+               in
+               if
+                 String.ends_with fileName ~suffix:package.suffix
+                 && resFiles |> StringSet.mem withoutExtension
+               then None
+               else
+                 match Filename.extension fileName with
+                 | ".js" | ".mjs" -> Some ("./" ^ fileName)
+                 | _ -> None)
+      with _ ->
+        if debug then print_endline "Could not read relative directory";
+        []
+    in
+    let items = itemsFromPackageJson @ localItems in
+    items
+    |> List.filter (fun name -> Utils.startsWith name prefix)
+    |> List.map (fun name ->
+           let isLocal = Utils.startsWith name "./" in
+           Completion.create name
+             ~kind:(Label (if isLocal then "Local file" else "Package"))
+             ~env)
   | Cdecorator prefix ->
     let mkDecorator (name, docstring) =
       {(Completion.create name ~kind:(Label "") ~env) with docstring}

analysis/src/CompletionFrontEnd.ml

@@ -736,7 +736,21 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
           Printf.printf "Attribute id:%s:%s label:%s\n" id.txt
             (Loc.toString id.loc) label;
         setResult (Completable.Cdecorator label)
-      | _ -> ());
+      | _ -> ()
+    else if id.txt = "module" then
+      (match payload with
+      | PStr
+          [
+            {
+              pstr_desc =
+                Pstr_eval
+                  ( {pexp_loc; pexp_desc = Pexp_constant (Pconst_string (s, _))},
+                    _ );
+            };
+          ]
+        when locHasCursor pexp_loc ->
+        setResult (Completable.CdecoratorPayload (Module s))
+      | _ -> ()));
     Ast_iterator.default_iterator.attribute iterator (id, payload)
   in
   let rec iterateFnArguments ~args ~iterator ~isPipe

analysis/src/Packages.ml

@@ -47,6 +47,11 @@ let newBsPackage ~rootPath =
           Some
             (let namespace = FindFiles.getNamespace config in
              let rescriptVersion = getReScriptVersion () in
+             let suffix =
+              match config |> Json.get "suffix" with
+              | Some (String suffix) -> suffix
+              | _ -> ".js"
+            in
              let uncurried =
                let ns = config |> Json.get "uncurried" in
                match (rescriptVersion, ns) with
@@ -115,6 +120,7 @@ let newBsPackage ~rootPath =
                ("Opens from ReScript config file: "
                ^ (opens |> List.map pathToString |> String.concat " "));
              {
+               suffix;
                rescriptVersion;
                rootPath;
                projectFiles =

analysis/src/SharedTypes.ml

@@ -489,6 +489,7 @@ type builtInCompletionModules = {
 }
 
 type package = {
+  suffix: string;
   rootPath: filePath;
   projectFiles: FileSet.t;
   dependenciesFiles: FileSet.t;
@@ -619,8 +620,11 @@ module Completable = struct
 
   type patternMode = Default | Destructuring
 
+  type decoratorPayload = Module of string
+
   type t =
     | Cdecorator of string  (** e.g. @module *)
+    | CdecoratorPayload of decoratorPayload
     | CnamedArg of contextPath * string * string list
         (** e.g. (..., "label", ["l1", "l2"]) for ...(...~l1...~l2...~label...) *)
     | Cnone  (** e.g. don't complete inside strings *)
@@ -701,6 +705,7 @@ module Completable = struct
   let toString = function
     | Cpath cp -> "Cpath " ^ contextPathToString cp
     | Cdecorator s -> "Cdecorator(" ^ str s ^ ")"
+    | CdecoratorPayload (Module s) -> "CdecoratorPayload(module=" ^ s ^ ")"
     | CnamedArg (cp, s, sl2) ->
       "CnamedArg("
       ^ (cp |> contextPathToString)

analysis/src/Utils.ml

@@ -260,3 +260,16 @@ let printMaybeExoticIdent ?(allowUident = false) txt =
       | _ -> "\"" ^ txt ^ "\""
   in
   if Res_token.isKeywordTxt txt then "\"" ^ txt ^ "\"" else loop 0
+
+let findPackageJson root =
+  let path = Uri.toPath root in
+
+  let rec loop path =
+    if path = "/" then None
+    else if Files.exists (Filename.concat path "package.json") then
+      Some (Filename.concat path "package.json")
+    else
+      let parent = Filename.dirname path in
+      if parent = path then (* reached root *) None else loop parent
+  in
+  loop path

analysis/tests/src/CompletionAttributes.res

@@ -0,0 +1,3 @@
+// @module("") external doStuff: t = "test"
+//          ^com
+

analysis/tests/src/expected/CompletionAttributes.res.txt

@@ -0,0 +1,19 @@
+Complete src/CompletionAttributes.res 0:12
+XXX Not found!
+Completable: CdecoratorPayload(module=)
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+[{
+    "label": "@rescript/react",
+    "kind": 4,
+    "tags": [],
+    "detail": "Package",
+    "documentation": null
+  }, {
+    "label": "./tst.js",
+    "kind": 4,
+    "tags": [],
+    "detail": "Local file",
+    "documentation": null
+  }]
+