Add a command to find all the references to an item.

analysis/src/Cli.ml

@@ -22,9 +22,13 @@ Options:
 
     ./run.exe hover src/Foo.res 10 2
 
-  definition: get inferred type for Foo.res at line 10 column 2:
+  definition: get definition for item in Foo.res at line 10 column 2:
 
-    ./run.exe definition src/Foo.res 10 2|}
+    ./run.exe definition src/Foo.res 10 2
+
+  references: get references to item in Foo.res at line 10 column 2:
+
+  ./run.exe references src/Foo.res 10 2|}
 
 let main () =
   match Array.to_list Sys.argv with
@@ -36,6 +40,9 @@ let main () =
   | [_; "definition"; path; line; col] ->
     Commands.definition ~path ~line:(int_of_string line)
       ~col:(int_of_string col)
+  | [_; "references"; path; line; col] ->
+    Commands.references ~path ~line:(int_of_string line)
+      ~col:(int_of_string col)
   | _ :: "dump" :: files -> Commands.dump files
   | [_; "test"; path] -> Commands.test ~path
   | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help

analysis/src/Commands.ml

@@ -103,7 +103,7 @@ let hover state ~file ~line ~col ~extra ~package =
       in
       match hoverText with
       | None -> Protocol.null
-      | Some s -> Protocol.stringifyHover {contents = s} )
+      | Some s -> Protocol.stringifyHover {contents = s})
 
 let hover ~path ~line ~col =
   let state = TopTypes.empty () in
@@ -124,6 +124,7 @@ let definition state ~file ~line ~col ~extra ~package =
     |> List.filter (fun (l, _) -> not l.Location.loc_ghost)
   in
   let pos = Utils.protocolLineColToCmtLoc ~line ~col in
+
   match References.locForPos ~extra:{extra with locations} pos with
   | None -> Protocol.null
   | Some (_, loc) -> (
@@ -151,7 +152,7 @@ let definition state ~file ~line ~col ~extra ~package =
       if skipZero then Protocol.null
       else
         Protocol.stringifyLocation
-          {uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc} )
+          {uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc})
 
 let definition ~path ~line ~col =
   let state = TopTypes.empty () in
@@ -165,6 +166,53 @@ let definition ~path ~line ~col =
   in
   print_endline result
 
+let references state ~file ~line ~col ~extra ~package =
+  let open TopTypes in
+  let locations =
+    extra.SharedTypes.locations
+    |> List.filter (fun (l, _) -> not l.Location.loc_ghost)
+  in
+  let pos = Utils.protocolLineColToCmtLoc ~line ~col in
+
+  match References.locForPos ~extra:{extra with locations} pos with
+  | None -> Protocol.null
+  | Some (_, loc) ->
+    let allReferences =
+      References.allReferencesForLoc ~pathsForModule:package.pathsForModule
+        ~file ~extra ~allModules:package.localModules
+        ~getUri:(State.fileForUri state)
+        ~getModule:(State.fileForModule state ~package)
+        ~getExtra:(State.extraForModule state ~package)
+        loc
+    in
+    let allLocs =
+      allReferences
+      |> List.fold_left
+           (fun acc (uri2, references) ->
+             (references
+             |> List.map (fun loc ->
+                    Protocol.stringifyLocation
+                      {
+                        uri = Uri2.toString uri2;
+                        range = Utils.cmtLocToRange loc;
+                      }))
+             @ acc)
+           []
+    in
+    "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]"
+
+let references ~path ~line ~col =
+  let state = TopTypes.empty () in
+  let filePath = Files.maybeConcat (Unix.getcwd ()) path in
+  let uri = Uri2.fromPath filePath in
+  let result =
+    match State.getFullFromCmt ~state ~uri with
+    | Error _message -> Protocol.null
+    | Ok (package, {file; extra}) ->
+      references state ~file ~line ~col ~extra ~package
+  in
+  print_endline result
+
 let test ~path =
   Uri2.stripPath := true;
   match Files.readFile path with
@@ -180,22 +228,27 @@ let test ~path =
         let line = i - 1 in
         let col = mlen - 1 in
         if mlen >= 3 then (
-          ( match String.sub rest 0 3 with
+          (match String.sub rest 0 3 with
           | "def" ->
             print_endline
-              ( "Definition " ^ path ^ " " ^ string_of_int line ^ ":"
-              ^ string_of_int col );
+              ("Definition " ^ path ^ " " ^ string_of_int line ^ ":"
+             ^ string_of_int col);
             definition ~path ~line ~col
           | "hov" ->
             print_endline
-              ( "Hover " ^ path ^ " " ^ string_of_int line ^ ":"
-              ^ string_of_int col );
+              ("Hover " ^ path ^ " " ^ string_of_int line ^ ":"
+             ^ string_of_int col);
 
             hover ~path ~line ~col
+          | "ref" ->
+            print_endline
+              ("References " ^ path ^ " " ^ string_of_int line ^ ":"
+             ^ string_of_int col);
+            references ~path ~line ~col
           | "com" ->
             print_endline
-              ( "Complete " ^ path ^ " " ^ string_of_int line ^ ":"
-              ^ string_of_int col );
+              ("Complete " ^ path ^ " " ^ string_of_int line ^ ":"
+             ^ string_of_int col);
             let currentFile, cout = Filename.open_temp_file "def" "txt" in
             lines
             |> List.iteri (fun j l ->
@@ -208,7 +261,7 @@ let test ~path =
             close_out cout;
             complete ~path ~line ~col ~currentFile;
             Sys.remove currentFile
-          | _ -> () );
-          print_newline () )
+          | _ -> ());
+          print_newline ())
     in
     lines |> List.iteri processLine

analysis/src/References.ml

@@ -46,8 +46,8 @@ let locForPos ~extra pos =
        arg has the location range of arg
        heuristic for: [Props, arg], give loc of `arg` *)
     (* Printf.eprintf "l1 %s\nl2 %s\n"
-      (SharedTypes.locationToString _l1)
-      (SharedTypes.locationToString l2); *)
+       (SharedTypes.locationToString _l1)
+       (SharedTypes.locationToString l2); *)
     Some l2
   | [(loc1, _); ((loc2, _) as l); (loc3, _)] when loc1 = loc2 && loc2 = loc3 ->
     (* JSX with at most one child
@@ -301,3 +301,149 @@ let definitionForLoc ~pathsForModule ~file ~getUri ~getModule loc =
           (* oooh wht do I do if the stamp is inside a pseudo-file? *)
           maybeLog ("Got stamp " ^ string_of_int stamp);
           definition ~file:env.file ~getModule stamp tip)))
+
+let isVisible (declared : _ SharedTypes.declared) =
+  declared.exported
+  &&
+  let rec loop v =
+    match v with
+    | File _ -> true
+    | NotVisible -> false
+    | IncludedModule (_, inner) -> loop inner
+    | ExportedModule (_, inner) -> loop inner
+  in
+  loop declared.modulePath
+
+let rec pathFromVisibility visibilityPath current =
+  match visibilityPath with
+  | File _ -> Some current
+  | IncludedModule (_, inner) -> pathFromVisibility inner current
+  | ExportedModule (name, inner) ->
+    pathFromVisibility inner (Nested (name, current))
+  | NotVisible -> None
+
+let pathFromVisibility visibilityPath tipName =
+  pathFromVisibility visibilityPath (Tip tipName)
+
+let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri
+    ~getExtra stamp tip =
+  let env = Query.fileEnv file in
+  let open Infix in
+  match
+    match tip with
+    | Constructor name ->
+      Query.getConstructor file stamp name |?>> fun x -> x.stamp
+    | Field name -> Query.getField file stamp name |?>> fun x -> x.stamp
+    | _ -> Some stamp
+  with
+  | None -> []
+  | Some localStamp -> (
+    match Hashtbl.find_opt extra.internalReferences localStamp with
+    | None -> []
+    | Some local ->
+      maybeLog ("Checking externals: " ^ string_of_int stamp);
+      let externals =
+        match Query.declaredForTip ~stamps:env.file.stamps stamp tip with
+        | None -> []
+        | Some declared ->
+          if isVisible declared then (
+            let alternativeReferences =
+              match
+                alternateDeclared ~pathsForModule ~file ~getUri declared tip
+              with
+              | None -> []
+              | Some (file, extra, {stamp}) -> (
+                match
+                  match tip with
+                  | Constructor name ->
+                    Query.getConstructor file stamp name |?>> fun x -> x.stamp
+                  | Field name ->
+                    Query.getField file stamp name |?>> fun x -> x.stamp
+                  | _ -> Some stamp
+                with
+                | None -> []
+                | Some localStamp -> (
+                  match
+                    Hashtbl.find_opt extra.internalReferences localStamp
+                  with
+                  | None -> []
+                  | Some local -> [(file.uri, local)]))
+              (* if this file has a corresponding interface or implementation file
+                 also find the references in that file *)
+            in
+            match pathFromVisibility declared.modulePath declared.name.txt with
+            | None -> []
+            | Some path ->
+              maybeLog ("Now checking path " ^ pathToString path);
+              let thisModuleName = file.moduleName in
+              let externals =
+                allModules
+                |> List.filter (fun name -> name <> file.moduleName)
+                |> Utils.filterMap (fun name ->
+                       match getModule name with
+                       | None -> None
+                       | Some file -> (
+                         match getExtra name with
+                         | None -> None
+                         | Some extra -> (
+                           match
+                             Hashtbl.find_opt extra.externalReferences
+                               thisModuleName
+                           with
+                           | None -> None
+                           | Some refs ->
+                             let refs =
+                               refs
+                               |> Utils.filterMap (fun (p, t, l) ->
+                                      match p = path && t = tip with
+                                      | true -> Some l
+                                      | false -> None)
+                             in
+                             Some (file.uri, refs))))
+              in
+              alternativeReferences @ externals)
+          else (
+            maybeLog "Not visible";
+            [])
+      in
+      (file.uri, local) :: externals)
+
+let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules
+    ~getModule ~getExtra loc =
+  match loc with
+  | Explanation _
+  | Typed (_, NotFound)
+  | LModule NotFound
+  | TopLevelModule _ | Constant _ ->
+    []
+  | TypeDefinition (_, _, stamp) ->
+    forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules ~getModule
+      ~getExtra stamp Type
+  | Typed (_, (LocalReference (stamp, tip) | Definition (stamp, tip)))
+  | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) ->
+    maybeLog
+      ("Finding references for " ^ Uri2.toString file.uri ^ " and stamp "
+     ^ string_of_int stamp ^ " and tip " ^ tipToString tip);
+    forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules ~getModule
+      ~getExtra stamp tip
+  | LModule (GlobalReference (moduleName, path, tip))
+  | Typed (_, GlobalReference (moduleName, path, tip)) -> (
+    match getModule moduleName with
+    | None -> []
+    | Some file -> (
+      let env = Query.fileEnv file in
+      match Query.resolvePath ~env ~path ~getModule with
+      | None -> []
+      | Some (env, name) -> (
+        match Query.exportedForTip ~env name tip with
+        | None -> []
+        | Some stamp -> (
+          match getUri env.file.uri with
+          | Error _ -> []
+          | Ok (file, extra) ->
+            maybeLog
+              ("Finding references for (global) " ^ Uri2.toString env.file.uri
+             ^ " and stamp " ^ string_of_int stamp ^ " and tip "
+             ^ tipToString tip);
+            forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules
+              ~getModule ~getExtra stamp tip))))

analysis/src/State.ml

@@ -75,3 +75,14 @@ let fileForModule state ~package modname =
   match docsForModule modname state ~package with
   | None -> None
   | Some (file, _) -> Some file
+
+let extraForModule state ~package modname =
+  if Hashtbl.mem package.TopTypes.pathsForModule modname then
+    let paths = Hashtbl.find package.pathsForModule modname in
+    match SharedTypes.getSrc paths with
+    | None -> None
+    | Some src -> (
+      match getFullFromCmt ~state ~uri:(Uri2.fromPath src) with
+      | Ok (_package, {extra}) -> Some extra
+      | Error _ -> None)
+  else None

analysis/tests/src/References.res

@@ -0,0 +1,8 @@
+let x = 12
+//  ^ref
+
+let a = x
+
+let b = a
+
+let c = x

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

@@ -0,0 +1,7 @@
+References tests/src/References.res 0:4
+[
+{"uri": "References.res", "range": {"start": {"line": 7, "character": 8}, "end": {"line": 7, "character": 9}}},
+{"uri": "References.res", "range": {"start": {"line": 3, "character": 8}, "end": {"line": 3, "character": 9}}},
+{"uri": "References.res", "range": {"start": {"line": 0, "character": 4}, "end": {"line": 0, "character": 5}}}
+]
+