Add references command.

Author: cristianoc

analysis/src/Cli.ml

@@ -22,9 +22,13 @@ Options:
 
     current-platform.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:
 
-    current-platform.exe definition src/Foo.res 10 2|}
+    current-platform.exe definition src/Foo.res 10 2
+
+  references: get references to item in Foo.res at line 10 column 2:
+
+  current-platform.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

@@ -128,15 +128,6 @@ let definition state ~file ~line ~col ~extra ~package =
   match References.locForPos ~extra:{extra with locations} pos with
   | None -> Protocol.null
   | Some (_, loc) -> (
-    let zzzTODO =
-      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 locIsModule =
       match loc with
       | SharedTypes.LModule _ | TopLevelModule _ -> true
@@ -175,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") ^ "]"
+
+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
@@ -202,6 +240,11 @@ let test ~path =
              ^ 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 ^ ":"

analysis/src/References.ml

@@ -336,10 +336,10 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri
     | Field name -> Query.getField file stamp name |?>> fun x -> x.stamp
     | _ -> Some stamp
   with
-  | None -> None
+  | None -> []
   | Some localStamp -> (
     match Hashtbl.find_opt extra.internalReferences localStamp with
-    | None -> None
+    | None -> []
     | Some local ->
       maybeLog ("Checking externals: " ^ string_of_int stamp);
       let externals =
@@ -406,7 +406,7 @@ let forLocalStamp ~pathsForModule ~file ~extra ~allModules ~getModule ~getUri
             maybeLog "Not visible";
             [])
       in
-      Some ((file.uri, local) :: externals))
+      (file.uri, local) :: externals)
 
 let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules
     ~getModule ~getExtra loc =
@@ -415,7 +415,7 @@ let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules
   | Typed (_, NotFound)
   | LModule NotFound
   | TopLevelModule _ | Constant _ ->
-    None
+    []
   | TypeDefinition (_, _, stamp) ->
     forLocalStamp ~pathsForModule ~getUri ~file ~extra ~allModules ~getModule
       ~getExtra stamp Type
@@ -429,17 +429,17 @@ let allReferencesForLoc ~pathsForModule ~getUri ~file ~extra ~allModules
   | LModule (GlobalReference (moduleName, path, tip))
   | Typed (_, GlobalReference (moduleName, path, tip)) -> (
     match getModule moduleName with
-    | None -> None
+    | None -> []
     | Some file -> (
       let env = Query.fileEnv file in
       match Query.resolvePath ~env ~path ~getModule with
-      | None -> None
+      | None -> []
       | Some (env, name) -> (
         match Query.exportedForTip ~env name tip with
-        | None -> None
+        | None -> []
         | Some stamp -> (
           match getUri env.file.uri with
-          | Error _ -> None
+          | Error _ -> []
           | Ok (file, extra) ->
             maybeLog
               ("Finding references for (global) " ^ Uri2.toString env.file.uri

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,6 @@
+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}}}]
+