From a2fe6ffa00c422610d693ef761d92c769a139b27 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Rafa=C5=82=20Gwo=C5=BAdzi=C5=84ski?=
 <rafal.gwozdzinski@gmail.com>
Date: Mon, 6 Mar 2023 20:33:16 +0100
Subject: [PATCH] Disable redundant type annotation (#1037)

* Disable redundant type annotation
* Make it work for coercions too
---
 CHANGES.md                                    |  3 +
 .../src/code_actions/action_type_annotate.ml  | 18 ++++-
 ocaml-lsp-server/test/e2e-new/code_actions.ml | 69 ++++++++++++++++---
 3 files changed, 78 insertions(+), 12 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 15fab8fcb..22bf5dc18 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -3,6 +3,9 @@
 ## Fixes
 
 - Fix a document syncing issue when utf-16 is the position encoding (#1004)
+- Disable "Type-annotate" action for code that is already annotated.
+  ([#1037](https://github.com/ocaml/ocaml-lsp/pull/1037)), fixes
+  [#1036](https://github.com/ocaml/ocaml-lsp/issues/1036)
 
 # 1.15.1
 
diff --git a/ocaml-lsp-server/src/code_actions/action_type_annotate.ml b/ocaml-lsp-server/src/code_actions/action_type_annotate.ml
index 85cf7ff26..62cb57e6f 100644
--- a/ocaml-lsp-server/src/code_actions/action_type_annotate.ml
+++ b/ocaml-lsp-server/src/code_actions/action_type_annotate.ml
@@ -7,8 +7,24 @@ let check_typeable_context pipeline pos_start =
   let pos_start = Mpipeline.get_lexing_pos pipeline pos_start in
   let typer = Mpipeline.typer_result pipeline in
   let browse = Mbrowse.of_typedtree (Mtyper.get_typedtree typer) in
+  let is_exp_constrained = function
+    | Typedtree.Texp_constraint _, _, _ -> true
+    | Typedtree.Texp_coerce (Some _, _), _, _ -> true
+    | _ -> false
+  in
+  let is_pat_constrained = function
+    | Typedtree.Tpat_constraint _, _, _ -> true
+    | _ -> false
+  in
+  let is_valid p extras =
+    if List.exists ~f:p extras then `Invalid else `Valid
+  in
   match Mbrowse.enclosing pos_start [ browse ] with
-  | (_, (Expression _ | Pattern _)) :: _ -> `Valid
+  | (_, Expression e) :: _ -> is_valid is_exp_constrained e.exp_extra
+  | (_, Pattern { pat_desc = Typedtree.Tpat_any; _ })
+    :: (_, Pattern { pat_desc = Typedtree.Tpat_alias _; pat_extra; _ })
+    :: _ -> is_valid is_pat_constrained pat_extra
+  | (_, Pattern p) :: _ -> is_valid is_pat_constrained p.pat_extra
   | _ :: _ | [] -> `Invalid
 
 let get_source_text doc (loc : Loc.t) =
diff --git a/ocaml-lsp-server/test/e2e-new/code_actions.ml b/ocaml-lsp-server/test/e2e-new/code_actions.ml
index c69138cca..4ba0238c6 100644
--- a/ocaml-lsp-server/test/e2e-new/code_actions.ml
+++ b/ocaml-lsp-server/test/e2e-new/code_actions.ml
@@ -47,18 +47,28 @@ let iter_code_actions ?(path = "foo.ml") ~source range k =
   Fiber.fork_and_join_unit run_client (fun () ->
       run >>> Fiber.Ivar.read diagnostics >>> Client.stop client)
 
-let print_code_actions ?(path = "foo.ml") source range =
+let print_code_actions ?(path = "foo.ml") ?(filter = fun _ -> true) source range
+    =
   iter_code_actions ~path ~source range (function
-      | None -> print_endline "no code actions"
-      | Some code_actions ->
-        print_endline "Code actions:";
-        List.iter code_actions ~f:(fun ca ->
-            let json =
-              match ca with
-              | `Command command -> Command.yojson_of_t command
-              | `CodeAction ca -> CodeAction.yojson_of_t ca
-            in
-            Yojson.Safe.pretty_to_string ~std:false json |> print_endline))
+      | None -> print_endline "No code actions"
+      | Some code_actions -> (
+        code_actions |> List.filter ~f:filter |> function
+        | [] -> print_endline "No code actions"
+        | actions ->
+          print_endline "Code actions:";
+          List.iter actions ~f:(fun ca ->
+              let json =
+                match ca with
+                | `Command command -> Command.yojson_of_t command
+                | `CodeAction ca -> CodeAction.yojson_of_t ca
+              in
+              Yojson.Safe.pretty_to_string ~std:false json |> print_endline)))
+
+let find_annotate_action =
+  let open CodeAction in
+  function
+  | `CodeAction { kind = Some (Other "type-annotate"); _ } -> true
+  | _ -> false
 
 let%expect_test "code actions" =
   let source = {ocaml|
@@ -106,3 +116,40 @@ let foo = 123
       "kind": "switch",
       "title": "Create foo.mli"
     } |}]
+
+let%expect_test "does not type-annotate already annotated argument" =
+  let source = {ocaml|
+let f (x : int) = 1
+|ocaml} in
+  let range =
+    let start = Position.create ~line:1 ~character:7 in
+    let end_ = Position.create ~line:1 ~character:8 in
+    Range.create ~start ~end_
+  in
+  print_code_actions source range ~filter:find_annotate_action;
+  [%expect {| No code actions |}]
+
+let%expect_test "does not type-annotate already annotated expression" =
+  let source = {ocaml|
+let f x = (1 : int)
+|ocaml} in
+  let range =
+    let start = Position.create ~line:1 ~character:11 in
+    let end_ = Position.create ~line:1 ~character:12 in
+    Range.create ~start ~end_
+  in
+  print_code_actions source range ~filter:find_annotate_action;
+  [%expect {| No code actions |}]
+
+let%expect_test "does not type-annotate already annotated and coerced \
+                 expression" =
+  let source = {ocaml|
+let f x = (1 : int :> int)
+|ocaml} in
+  let range =
+    let start = Position.create ~line:1 ~character:11 in
+    let end_ = Position.create ~line:1 ~character:12 in
+    Range.create ~start ~end_
+  in
+  print_code_actions source range ~filter:find_annotate_action;
+  [%expect {| No code actions |}]