Skip to content

Expand types on autocomplete hover #589

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Sep 22, 2022
Merged

Expand types on autocomplete hover #589

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7d617e6
refactor expanding types in hover so it can more easily be shared
zth Sep 21, 2022
2f3a5fd
add test where hover is not expanded as contents has not been saved
zth Sep 21, 2022
825afc2
refactor hover via completions to also expand types like the hover vi…
zth Sep 21, 2022
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
21 changes: 6 additions & 15 deletions analysis/src/Commands.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -46,21 +46,12 @@ let hover ~path ~pos ~currentFile ~debug ~supportsMarkdownLinks =
if debug then
Printf.printf
"Nothing at that position. Now trying to use completion.\n";
let completions =
getCompletions ~debug ~path ~pos ~currentFile ~forHover:true
in
match completions with
| {kind = Label typString; docstring} :: _ ->
let parts =
(if typString = "" then [] else [Hover.codeBlock typString])
@ docstring
in
Protocol.stringifyHover (String.concat "\n\n" parts)
| _ -> (
match CompletionBackEnd.completionsGetTypeEnv completions with
| Some (typ, _env) ->
Protocol.stringifyHover (Hover.codeBlock (Shared.typeToString typ))
| None -> Protocol.null))
match
Hover.getHoverViaCompletions ~debug ~path ~pos ~currentFile
~forHover:true ~supportsMarkdownLinks
with
| None -> Protocol.null
| Some hover -> hover)
| Some locItem -> (
let isModule =
match locItem.locType with
Expand Down
251 changes: 126 additions & 125 deletions analysis/src/Hover.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,51 +1,5 @@
open SharedTypes

let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code

(* Light weight, hopefully-enough-for-the-purpose fn to encode URI components.
Built to handle the reserved characters listed in
https://en.wikipedia.org/wiki/Percent-encoding. Note that this function is not
general purpose, rather it's currently only for URL encoding the argument list
passed to command links in markdown. *)
let encodeURIComponent text =
let ln = String.length text in
let buf = Buffer.create ln in
let rec loop i =
if i < ln then (
(match text.[i] with
| '"' -> Buffer.add_string buf "%22"
| '\'' -> Buffer.add_string buf "%22"
| ':' -> Buffer.add_string buf "%3A"
| ';' -> Buffer.add_string buf "%3B"
| '/' -> Buffer.add_string buf "%2F"
| '\\' -> Buffer.add_string buf "%5C"
| ',' -> Buffer.add_string buf "%2C"
| '&' -> Buffer.add_string buf "%26"
| '[' -> Buffer.add_string buf "%5B"
| ']' -> Buffer.add_string buf "%5D"
| '#' -> Buffer.add_string buf "%23"
| '$' -> Buffer.add_string buf "%24"
| '+' -> Buffer.add_string buf "%2B"
| '=' -> Buffer.add_string buf "%3D"
| '?' -> Buffer.add_string buf "%3F"
| '@' -> Buffer.add_string buf "%40"
| '%' -> Buffer.add_string buf "%25"
| c -> Buffer.add_char buf c);
loop (i + 1))
in
loop 0;
Buffer.contents buf

type link = {startPos: Protocol.position; file: string; label: string}

let linkToCommandArgs link =
Printf.sprintf "[\"%s\",%i,%i]" link.file link.startPos.line
link.startPos.character

let makeGotoCommand link =
Printf.sprintf "[%s](command:rescript-vscode.go_to_location?%s)" link.label
(encodeURIComponent (linkToCommandArgs link))

let showModuleTopLevel ~docstring ~name (topLevel : Module.item list) =
let contents =
topLevel
Expand All @@ -60,7 +14,9 @@ let showModuleTopLevel ~docstring ~name (topLevel : Module.item list) =
(* TODO indent *)
|> String.concat "\n"
in
let full = codeBlock ("module " ^ name ^ " = {" ^ "\n" ^ contents ^ "\n}") in
let full =
Markdown.codeBlock ("module " ^ name ^ " = {" ^ "\n" ^ contents ^ "\n}")
in
let doc =
match docstring with
| [] -> ""
Expand All @@ -80,11 +36,128 @@ let rec showModule ~docstring ~(file : File.t) ~name
| Some {item = Ident path} ->
Some ("Unable to resolve module reference " ^ Path.name path)

type extractedType = {
name: string;
path: Path.t;
decl: Types.type_declaration;
env: SharedTypes.QueryEnv.t;
loc: Warnings.loc;
}

let findRelevantTypesFromType ~file ~package typ =
(* Expand definitions of types mentioned in typ.
If typ itself is a record or variant, search its body *)
let env = QueryEnv.fromFile file in
let envToSearch, typesToSearch =
match typ |> Shared.digConstructor with
| Some path -> (
let labelDeclarationsTypes lds =
lds |> List.map (fun (ld : Types.label_declaration) -> ld.ld_type)
in
match References.digConstructor ~env ~package path with
| None -> (env, [typ])
| Some (env1, {item = {decl}}) -> (
match decl.type_kind with
| Type_record (lds, _) -> (env1, typ :: (lds |> labelDeclarationsTypes))
| Type_variant cds ->
( env1,
cds
|> List.map (fun (cd : Types.constructor_declaration) ->
let fromArgs =
match cd.cd_args with
| Cstr_tuple ts -> ts
| Cstr_record lds -> lds |> labelDeclarationsTypes
in
typ
::
(match cd.cd_res with
| None -> fromArgs
| Some t -> t :: fromArgs))
|> List.flatten )
| _ -> (env, [typ])))
| None -> (env, [typ])
in
let fromConstructorPath ~env path =
match References.digConstructor ~env ~package path with
| None -> None
| Some (env, {name = {txt}; extentLoc; item = {decl}}) ->
if Utils.isUncurriedInternal path then None
else Some {name = txt; env; loc = extentLoc; decl; path}
in
let constructors = Shared.findTypeConstructors typesToSearch in
constructors |> List.filter_map (fromConstructorPath ~env:envToSearch)

(* Produces a hover with relevant types expanded in the main type being hovered. *)
let hoverWithExpandedTypes ~docstring ~file ~package ~supportsMarkdownLinks typ
=
let typeString = Markdown.codeBlock (typ |> Shared.typeToString) in
let types = findRelevantTypesFromType typ ~file ~package in
let typeDefinitions =
types
|> List.map (fun {decl; env; loc; path} ->
let linkToTypeDefinitionStr =
if supportsMarkdownLinks then
Markdown.goToDefinitionText ~env ~pos:loc.Warnings.loc_start
else ""
in
"\n" ^ Markdown.spacing
^ Markdown.codeBlock
(decl
|> Shared.declToString ~printNameAsIs:true
(SharedTypes.pathIdentToString path))
^ linkToTypeDefinitionStr ^ "\n" ^ Markdown.divider)
in
(typeString :: typeDefinitions |> String.concat "\n", docstring)

(* Leverages autocomplete functionality to produce a hover for a position. This
makes it (most often) work with unsaved content. *)
let getHoverViaCompletions ~debug ~path ~pos ~currentFile ~forHover
~supportsMarkdownLinks =
let textOpt = Files.readFile currentFile in
match textOpt with
| None | Some "" -> None
| Some text -> (
match
CompletionFrontEnd.completionWithParser ~debug ~path ~posCursor:pos
~currentFile ~text
with
| None -> None
| Some (completable, scope) -> (
if debug then
Printf.printf "Completable: %s\n"
(SharedTypes.Completable.toString completable);
(* Only perform expensive ast operations if there are completables *)
match Cmt.fullFromPath ~path with
| None -> None
| Some {file; package} -> (
let env = SharedTypes.QueryEnv.fromFile file in
let completions =
completable
|> CompletionBackEnd.processCompletable ~debug ~package ~pos ~scope
~env ~forHover
in
match completions with
| {kind = Label typString; docstring} :: _ ->
let parts =
(if typString = "" then [] else [Markdown.codeBlock typString])
@ docstring
in
Some (Protocol.stringifyHover (String.concat "\n\n" parts))
| _ -> (
match CompletionBackEnd.completionsGetTypeEnv completions with
| Some (typ, _env) ->
let typeString, _docstring =
hoverWithExpandedTypes ~docstring:"" ~file ~package
~supportsMarkdownLinks typ
in
Some (Protocol.stringifyHover typeString)
| None -> None))))

let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
match locItem.locType with
| TypeDefinition (name, decl, _stamp) ->
let typeDef = Shared.declToString name decl in
Some (codeBlock typeDef)
Some (Markdown.codeBlock typeDef)
| LModule (Definition (stamp, _tip)) | LModule (LocalReference (stamp, _tip))
-> (
match Stamps.findModule file.stamps stamp with
Expand Down Expand Up @@ -132,7 +205,7 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
| Typed (_, _, Definition (_, (Field _ | Constructor _))) -> None
| Constant t ->
Some
(codeBlock
(Markdown.codeBlock
(match t with
| Const_int _ -> "int"
| Const_char _ -> "char"
Expand All @@ -142,81 +215,9 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
| Const_int64 _ -> "int64"
| Const_nativeint _ -> "int"))
| Typed (_, t, locKind) ->
let fromConstructorPath ~env path =
match References.digConstructor ~env ~package path with
| None -> None
| Some (env, {extentLoc; item = {decl}}) ->
if Utils.isUncurriedInternal path then None
else
Some
( decl
|> Shared.declToString ~printNameAsIs:true
(SharedTypes.pathIdentToString path),
extentLoc,
env )
in
let fromType ~docstring typ =
let typeString = codeBlock (typ |> Shared.typeToString) in
let typeDefinitions =
(* Expand definitions of types mentioned in typ.
If typ itself is a record or variant, search its body *)
let env = QueryEnv.fromFile file in
let envToSearch, typesToSearch =
match typ |> Shared.digConstructor with
| Some path -> (
let labelDeclarationsTypes lds =
lds |> List.map (fun (ld : Types.label_declaration) -> ld.ld_type)
in
match References.digConstructor ~env ~package path with
| None -> (env, [typ])
| Some (env1, {item = {decl}}) -> (
match decl.type_kind with
| Type_record (lds, _) ->
(env1, typ :: (lds |> labelDeclarationsTypes))
| Type_variant cds ->
( env1,
cds
|> List.map (fun (cd : Types.constructor_declaration) ->
let fromArgs =
match cd.cd_args with
| Cstr_tuple ts -> ts
| Cstr_record lds -> lds |> labelDeclarationsTypes
in
typ
::
(match cd.cd_res with
| None -> fromArgs
| Some t -> t :: fromArgs))
|> List.flatten )
| _ -> (env, [typ])))
| None -> (env, [typ])
in
let constructors = Shared.findTypeConstructors typesToSearch in
constructors
|> List.filter_map (fun constructorPath ->
match
constructorPath |> fromConstructorPath ~env:envToSearch
with
| None -> None
| Some (typString, extentLoc, env) ->
let startLine, startCol = Pos.ofLexing extentLoc.loc_start in
let linkToTypeDefinitionStr =
if supportsMarkdownLinks then
"\nGo to: "
^ makeGotoCommand
{
label = "Type definition";
file = Uri.toString env.file.uri;
startPos = {line = startLine; character = startCol};
}
else ""
in
Some
(Shared.markdownSpacing ^ codeBlock typString
^ linkToTypeDefinitionStr ^ "\n\n---\n"))
in
let typeString = typeString :: typeDefinitions |> String.concat "\n\n" in
(typeString, docstring)
hoverWithExpandedTypes ~docstring ~file ~package ~supportsMarkdownLinks
typ
in
let parts =
match References.definedForLoc ~file ~package locKind with
Expand All @@ -238,9 +239,9 @@ let newHover ~full:{file; package} ~supportsMarkdownLinks locItem =
|> List.map (fun (t, _) -> Shared.typeToString t)
|> String.concat ", " |> Printf.sprintf "(%s)"
in
typeString :: codeBlock (txt ^ argsString) :: docstring
typeString :: Markdown.codeBlock (txt ^ argsString) :: docstring
| `Field ->
let typeString, docstring = t |> fromType ~docstring in
typeString :: docstring)
in
Some (String.concat "\n\n" parts)
Some (String.concat "\n\n" parts)
23 changes: 23 additions & 0 deletions analysis/src/Markdown.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,23 @@
let spacing = "\n```\n \n```\n"
let codeBlock code = Printf.sprintf "```rescript\n%s\n```" code
let divider = "\n---\n"

type link = {startPos: Protocol.position; file: string; label: string}

let linkToCommandArgs link =
Printf.sprintf "[\"%s\",%i,%i]" link.file link.startPos.line
link.startPos.character

let makeGotoCommand link =
Printf.sprintf "[%s](command:rescript-vscode.go_to_location?%s)" link.label
(Uri.encodeURIComponent (linkToCommandArgs link))

let goToDefinitionText ~env ~pos =
let startLine, startCol = Pos.ofLexing pos in
"\nGo to: "
^ makeGotoCommand
{
label = "Type definition";
file = Uri.toString env.SharedTypes.QueryEnv.file.uri;
startPos = {line = startLine; character = startCol};
}
2 changes: 0 additions & 2 deletions analysis/src/Shared.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,5 +78,3 @@ let typeToString ?lineWidth (t : Types.type_expr) =
Hashtbl.replace typeTbl (t.id, t) s;
s
| Some s -> s

let markdownSpacing = "\n```\n \n```\n"
35 changes: 35 additions & 0 deletions analysis/src/Uri.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,3 +22,38 @@ let toTopLevelLoc {path} =
{Location.loc_start = topPos; Location.loc_end = topPos; loc_ghost = false}

let toString {uri} = if !stripPath then Filename.basename uri else uri


(* Light weight, hopefully-enough-for-the-purpose fn to encode URI components.
Built to handle the reserved characters listed in
https://en.wikipedia.org/wiki/Percent-encoding. Note that this function is not
general purpose, rather it's currently only for URL encoding the argument list
passed to command links in markdown. *)
let encodeURIComponent text =
let ln = String.length text in
let buf = Buffer.create ln in
let rec loop i =
if i < ln then (
(match text.[i] with
| '"' -> Buffer.add_string buf "%22"
| '\'' -> Buffer.add_string buf "%22"
| ':' -> Buffer.add_string buf "%3A"
| ';' -> Buffer.add_string buf "%3B"
| '/' -> Buffer.add_string buf "%2F"
| '\\' -> Buffer.add_string buf "%5C"
| ',' -> Buffer.add_string buf "%2C"
| '&' -> Buffer.add_string buf "%26"
| '[' -> Buffer.add_string buf "%5B"
| ']' -> Buffer.add_string buf "%5D"
| '#' -> Buffer.add_string buf "%23"
| '$' -> Buffer.add_string buf "%24"
| '+' -> Buffer.add_string buf "%2B"
| '=' -> Buffer.add_string buf "%3D"
| '?' -> Buffer.add_string buf "%3F"
| '@' -> Buffer.add_string buf "%40"
| '%' -> Buffer.add_string buf "%25"
| c -> Buffer.add_char buf c);
loop (i + 1))
in
loop 0;
Buffer.contents buf
Loading