Skip to content

Commit 527e4f2

Browse files
authored
feat(ocamllsp): Code action "Remove type annotation" (#1039)
1 parent d2b6fe9 commit 527e4f2

File tree

7 files changed

+242
-1
lines changed

7 files changed

+242
-1
lines changed

CHANGES.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,9 @@
77
([#1037](https://github.com/ocaml/ocaml-lsp/pull/1037)), fixes
88
[#1036](https://github.com/ocaml/ocaml-lsp/issues/1036)
99

10+
## Features
11+
- Add "Remove type annotation" code action. (#1039)
12+
1013
# 1.15.1
1114

1215
## Fixes

ocaml-lsp-server/src/code_actions.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,7 @@ let compute server (params : CodeActionParams.t) =
8484
[ Action_destruct.t state
8585
; Action_inferred_intf.t state
8686
; Action_type_annotate.t
87+
; Action_remove_type_annotation.t
8788
; Action_construct.t
8889
; Action_refactor_open.unqualify
8990
; Action_refactor_open.qualify
Lines changed: 79 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,79 @@
1+
open Import
2+
3+
let action_kind = "remove type annotation"
4+
5+
let check_typeable_context pipeline pos_start =
6+
let pos_start = Mpipeline.get_lexing_pos pipeline pos_start in
7+
let typer = Mpipeline.typer_result pipeline in
8+
let browse = Mbrowse.of_typedtree (Mtyper.get_typedtree typer) in
9+
let is_exp_constrained = function
10+
| Typedtree.Texp_constraint _, loc, _ -> Some loc
11+
| Typedtree.Texp_coerce (Some { ctyp_loc; _ }, _), _, _ -> Some ctyp_loc
12+
| _ -> None
13+
in
14+
let is_pat_constrained = function
15+
| Typedtree.Tpat_constraint _, loc, _ -> Some loc
16+
| _ -> None
17+
in
18+
let is_valid loc p extras =
19+
(* Constrains are listed from the farthest to the closest. We search
20+
reversed list to find the closest type annotation to remove. *)
21+
match extras |> List.rev |> List.find_map ~f:p with
22+
| Some x -> `Valid (loc, x)
23+
| None -> `Invalid
24+
in
25+
match Mbrowse.enclosing pos_start [ browse ] with
26+
| (_, Expression e) :: _ -> is_valid e.exp_loc is_exp_constrained e.exp_extra
27+
| (_, Pattern { pat_desc = Typedtree.Tpat_any; pat_loc; _ })
28+
:: (_, Pattern { pat_desc = Typedtree.Tpat_alias _; pat_extra; _ })
29+
:: _ -> is_valid pat_loc is_pat_constrained pat_extra
30+
| (_, Pattern p) :: _ -> is_valid p.pat_loc is_pat_constrained p.pat_extra
31+
| _ :: _ | [] -> `Invalid
32+
33+
let get_source_text doc (loc : Loc.t) =
34+
let open Option.O in
35+
let source = Document.source doc in
36+
let* start = Position.of_lexical_position loc.loc_start in
37+
let+ end_ = Position.of_lexical_position loc.loc_end in
38+
let (`Offset start) = Msource.get_offset source (Position.logical start) in
39+
let (`Offset end_) = Msource.get_offset source (Position.logical end_) in
40+
String.sub (Msource.text source) ~pos:start ~len:(end_ - start)
41+
42+
let code_action_of_type_enclosing uri doc (loc, constr_loc) =
43+
let open Option.O in
44+
let+ src_text = get_source_text doc loc in
45+
let edit : WorkspaceEdit.t =
46+
let textedit : TextEdit.t =
47+
{ range = Range.of_loc (Loc.union loc constr_loc); newText = src_text }
48+
in
49+
let version = Document.version doc in
50+
let textDocument =
51+
OptionalVersionedTextDocumentIdentifier.create ~uri ~version ()
52+
in
53+
let edit =
54+
TextDocumentEdit.create ~textDocument ~edits:[ `TextEdit textedit ]
55+
in
56+
WorkspaceEdit.create ~documentChanges:[ `TextDocumentEdit edit ] ()
57+
in
58+
let title = String.capitalize_ascii action_kind in
59+
CodeAction.create
60+
~title
61+
~kind:(CodeActionKind.Other action_kind)
62+
~edit
63+
~isPreferred:false
64+
()
65+
66+
let code_action doc (params : CodeActionParams.t) =
67+
match Document.kind doc with
68+
| `Other -> Fiber.return None
69+
| `Merlin merlin ->
70+
let pos_start = Position.logical params.range.start in
71+
Document.Merlin.with_pipeline_exn merlin (fun pipeline ->
72+
let context = check_typeable_context pipeline pos_start in
73+
match context with
74+
| `Invalid -> None
75+
| `Valid (loc1, loc2) ->
76+
code_action_of_type_enclosing params.textDocument.uri doc (loc1, loc2))
77+
78+
let t =
79+
{ Code_action.kind = CodeActionKind.Other action_kind; run = code_action }
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
val t : Code_action.t

ocaml-lsp-server/src/ocaml_lsp_server.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ let initialize_info (client_capabilities : ClientCapabilities.t) :
3535
:: List.map
3636
~f:(fun (c : Code_action.t) -> c.kind)
3737
[ Action_type_annotate.t
38+
; Action_remove_type_annotation.t
3839
; Action_construct.t
3940
; Action_refactor_open.unqualify
4041
; Action_refactor_open.qualify

ocaml-lsp-server/test/e2e-new/code_actions.ml

Lines changed: 155 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -70,6 +70,12 @@ let find_annotate_action =
7070
| `CodeAction { kind = Some (Other "type-annotate"); _ } -> true
7171
| _ -> false
7272
73+
let find_remove_annotation_action =
74+
let open CodeAction in
75+
function
76+
| `CodeAction { kind = Some (Other "remove type annotation"); _ } -> true
77+
| _ -> false
78+
7379
let%expect_test "code actions" =
7480
let source = {ocaml|
7581
let foo = 123
@@ -332,3 +338,152 @@ let f x = (1 : int :> int)
332338
in
333339
print_code_actions source range ~filter:find_annotate_action;
334340
[%expect {| No code actions |}]
341+
342+
let%expect_test "can remove type annotation from a function argument" =
343+
let source =
344+
{ocaml|
345+
type t = Foo of int | Bar of bool
346+
let f (x : t) = Foo x
347+
|ocaml}
348+
in
349+
let range =
350+
let start = Position.create ~line:2 ~character:7 in
351+
let end_ = Position.create ~line:2 ~character:8 in
352+
Range.create ~start ~end_
353+
in
354+
print_code_actions source range ~filter:find_remove_annotation_action;
355+
[%expect
356+
{|
357+
Code actions:
358+
{
359+
"edit": {
360+
"documentChanges": [
361+
{
362+
"edits": [
363+
{
364+
"newText": "x",
365+
"range": {
366+
"end": { "character": 13, "line": 2 },
367+
"start": { "character": 6, "line": 2 }
368+
}
369+
}
370+
],
371+
"textDocument": { "uri": "file:///foo.ml", "version": 0 }
372+
}
373+
]
374+
},
375+
"isPreferred": false,
376+
"kind": "remove type annotation",
377+
"title": "Remove type annotation"
378+
} |}]
379+
380+
let%expect_test "can remove type annotation from a toplevel value" =
381+
let source = {ocaml|
382+
let (iiii : int) = 3 + 4
383+
|ocaml} in
384+
let range =
385+
let start = Position.create ~line:1 ~character:5 in
386+
let end_ = Position.create ~line:1 ~character:6 in
387+
Range.create ~start ~end_
388+
in
389+
print_code_actions source range ~filter:find_remove_annotation_action;
390+
[%expect
391+
{|
392+
Code actions:
393+
{
394+
"edit": {
395+
"documentChanges": [
396+
{
397+
"edits": [
398+
{
399+
"newText": "iiii",
400+
"range": {
401+
"end": { "character": 16, "line": 1 },
402+
"start": { "character": 4, "line": 1 }
403+
}
404+
}
405+
],
406+
"textDocument": { "uri": "file:///foo.ml", "version": 0 }
407+
}
408+
]
409+
},
410+
"isPreferred": false,
411+
"kind": "remove type annotation",
412+
"title": "Remove type annotation"
413+
} |}]
414+
415+
let%expect_test "can remove type annotation from an argument in a function call"
416+
=
417+
let source =
418+
{ocaml|
419+
let f (x : int) = x + 1
420+
let () =
421+
let i = 8 in
422+
print_int (f i)
423+
|ocaml}
424+
in
425+
let range =
426+
let start = Position.create ~line:1 ~character:7 in
427+
let end_ = Position.create ~line:1 ~character:8 in
428+
Range.create ~start ~end_
429+
in
430+
print_code_actions source range ~filter:find_remove_annotation_action;
431+
[%expect
432+
{|
433+
Code actions:
434+
{
435+
"edit": {
436+
"documentChanges": [
437+
{
438+
"edits": [
439+
{
440+
"newText": "x",
441+
"range": {
442+
"end": { "character": 15, "line": 1 },
443+
"start": { "character": 6, "line": 1 }
444+
}
445+
}
446+
],
447+
"textDocument": { "uri": "file:///foo.ml", "version": 0 }
448+
}
449+
]
450+
},
451+
"isPreferred": false,
452+
"kind": "remove type annotation",
453+
"title": "Remove type annotation"
454+
} |}]
455+
456+
let%expect_test "can remove type annotation from a coerced expression" =
457+
let source = {ocaml|
458+
let x = (7 : int :> int)
459+
|ocaml} in
460+
let range =
461+
let start = Position.create ~line:1 ~character:9 in
462+
let end_ = Position.create ~line:1 ~character:10 in
463+
Range.create ~start ~end_
464+
in
465+
print_code_actions source range ~filter:find_remove_annotation_action;
466+
[%expect
467+
{|
468+
Code actions:
469+
{
470+
"edit": {
471+
"documentChanges": [
472+
{
473+
"edits": [
474+
{
475+
"newText": "7",
476+
"range": {
477+
"end": { "character": 16, "line": 1 },
478+
"start": { "character": 9, "line": 1 }
479+
}
480+
}
481+
],
482+
"textDocument": { "uri": "file:///foo.ml", "version": 0 }
483+
}
484+
]
485+
},
486+
"isPreferred": false,
487+
"kind": "remove type annotation",
488+
"title": "Remove type annotation"
489+
} |}]

ocaml-lsp-server/test/e2e-new/start_stop.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,8 @@ let%expect_test "start/stop" =
4848
"codeActionKinds": [
4949
"quickfix", "refactor.inline", "construct", "destruct",
5050
"inferred_intf", "put module name in identifiers",
51-
"remove module name from identifiers", "type-annotate"
51+
"remove module name from identifiers", "remove type annotation",
52+
"type-annotate"
5253
]
5354
},
5455
"codeLensProvider": { "resolveProvider": false },

0 commit comments

Comments
 (0)