Skip to content
This repository was archived by the owner on Apr 24, 2021. It is now read-only.

Clean up dumpLocations a bit #115

Merged
merged 1 commit into from
Apr 13, 2021
Merged

Clean up dumpLocations a bit #115

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
119 changes: 30 additions & 89 deletions src/EditorSupportCommands.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,108 +1,49 @@
let posOfLexing {Lexing.pos_lnum; pos_cnum; pos_bol} =
Json.Object
[
("line", Json.Number (float_of_int (pos_lnum - 1)));
("character", Json.Number (float_of_int (pos_cnum - pos_bol)));
]

let rangeOfLoc {Location.loc_start; loc_end} =
Json.Object [("start", posOfLexing loc_start); ("end", posOfLexing loc_end)]

let dumpLocations state ~package ~file ~extra ~selectPos uri =
let dumpLocations state ~package ~file ~extra =
let locations =
extra.SharedTypes.locations
|> List.filter (fun (l, _) -> not l.Location.loc_ghost)
in
let locations =
match selectPos with
| Some (line, col) -> (
let pos = Utils.protocolLineColToCmtLoc ~line ~col in
match References.locForPos ~extra:{extra with locations} pos with
| None -> []
| Some l -> [l])
| None -> locations
in
let locationsInfo =
locations
|> Utils.filterMap (fun ((location : Location.t), loc) ->
let locIsModule =
match loc with
| SharedTypes.LModule _ | TopLevelModule _ -> true
| TypeDefinition _ | Typed _ | Constant _ | Explanation _ -> false
in
let hoverText =
Hover.newHover ~file
~getModule:(State.fileForModule state ~package)
loc
in
let hover =
match hoverText with
| None -> []
| Some s -> [("hover", Json.String s)]
in
let uriLocOpt =
References.definitionForLoc ~pathsForModule:package.pathsForModule
~file ~getUri:(State.fileForUri state)
~getModule:(State.fileForModule state ~package)
loc
in
let def, skipZero =
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Removed skipZero. Didn't make a different on my test file and not sure if important enough

Copy link
Contributor

@cristianoc cristianoc Apr 13, 2021 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's needed for correctness, with PPXs etc.
But, for debugging it might even be better to remove skipZero so you see the raw stuff not the curated one.

match uriLocOpt with
| None -> ([], false)
| Some (uri2, loc) ->
let uriIsCurrentFile = uri = uri2 in
let posIsZero {Lexing.pos_lnum; pos_bol; pos_cnum} =
pos_lnum = 1 && pos_cnum - pos_bol = 0
in
(* Skip if range is all zero, unless it's a module *)
let skipZero =
(not locIsModule) && posIsZero loc.loc_start
&& posIsZero loc.loc_end
in
let range = ("range", rangeOfLoc loc) in
( [
( "definition",
Json.Object
(match uriIsCurrentFile with
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Removed this check too

| true -> [range]
| false ->
[("uri", Json.String (Uri2.toString uri2)); range]) );
],
skipZero )
in
let skip = skipZero || (hover = [] && def = []) in
match skip with
| true -> None
| false ->
Some (Json.Object ([("range", rangeOfLoc location)] @ hover @ def)))
in
Json.stringify (Json.Array locationsInfo)

(* Split (line,char) from filepath:line:char *)
let splitLineChar pathWithPos =
let mkPos line char = Some (line |> int_of_string, char |> int_of_string) in
match pathWithPos |> String.split_on_char ':' with
| [filePath; line; char] -> (filePath, mkPos line char)
| [drive; rest; line; char] ->
(* c:\... on Windows *)
(drive ^ ":" ^ rest, mkPos line char)
| _ -> (pathWithPos, None)
locations
|> List.map (fun ((location : Location.t), loc) ->
let hoverText =
Hover.newHover ~file
~getModule:(State.fileForModule state ~package)
loc
in
let hover =
match hoverText with None -> "" | Some s -> String.escaped s
in
let uriLocOpt =
References.definitionForLoc ~pathsForModule:package.pathsForModule
~file ~getUri:(State.fileForUri state)
~getModule:(State.fileForModule state ~package)
loc
in
let def =
match uriLocOpt with
| None -> Protocol.null
| Some (uri2, loc) ->
Protocol.stringifyLocation
{uri = Uri2.toString uri2; range = Utils.cmtLocToRange loc}
in
Protocol.stringifyRange (Utils.cmtLocToRange location)
^ "\n Hover: " ^ hover ^ "\n Definition: " ^ def)
|> String.concat "\n\n"

let dump files =
Shared.cacheTypeToString := true;
let state = TopTypes.empty () in
files
|> List.iter (fun pathWithPos ->
let filePath, selectPos = pathWithPos |> splitLineChar in
let filePath = Files.maybeConcat (Unix.getcwd ()) filePath in
|> List.iter (fun path ->
let filePath = Files.maybeConcat (Unix.getcwd ()) path in
let uri = Uri2.fromPath filePath in
let result =
match State.getFullFromCmt ~state ~uri with
| Error message ->
prerr_endline message;
"[]"
| Ok (package, {file; extra}) ->
dumpLocations state ~package ~file ~extra ~selectPos uri
dumpLocations state ~package ~file ~extra
in
print_endline result)

Expand Down