Signature help should not appear on the function name

CHANGES.md

@@ -2,6 +2,7 @@ unreleased
 ==========
 
   + merlin library
+    - Signature help should not appear on the function name (#1997)
     - Fix completion not working for inlined records labels (#1978, fixes #1977)
     - Perform buffer indexing only if the query requires it (#1990 and #1991)
     - Stop unnecessarily forcing substitutions when initializing short-paths graph (#1988)

src/frontend/query_commands.ml

@@ -898,16 +898,19 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
     in
     match application_signature with
     | Some s ->
-      let prefix =
-        let fun_name = Option.value ~default:"_" s.function_name in
-        sprintf "%s : " fun_name
-      in
-      Some
-        { label = prefix ^ s.signature;
-          parameters = List.map ~f:(param (String.length prefix)) s.parameters;
-          active_param = Option.value ~default:0 s.active_param;
-          active_signature = 0
-        }
+      if (Msource.compare_logical (Msource.get_logical source position) (Msource.get_logical source s.function_position)) < 0 then None
+      else (
+        let prefix =
+          let fun_name = Option.value ~default:"_" s.function_name in
+          sprintf "%s : " fun_name
+        in
+        Some
+          { label = prefix ^ s.signature;
+            parameters = List.map ~f:(param (String.length prefix)) s.parameters;
+            active_param = Option.value ~default:0 s.active_param;
+            active_signature = 0
+          }
+      )
     | None -> None)
   | Version ->
     Printf.sprintf "The Merlin toolkit version %s, for Ocaml %s\n"

src/kernel/msource.ml

@@ -105,6 +105,17 @@ let get_logical { text } = function
     done;
     `Logical (!line, offset - !cnum)
 
+let compare_logical x y : int =
+  match x, y with
+  | `Logical (row_x, col_x),
+    `Logical (row_y, col_y) ->
+      let delta_row = row_x - row_y in
+      if delta_row = 0 then col_x - col_y else delta_row
+  | _ -> failwith "Only `Logical expected."
+
+let compare_logical (`Logical ((row_x: int), (col_x : int))) (`Logical ((row_y:int), (col_y: int))) =
+  compare (row_x, col_x) (row_y, col_y)
+
 let get_lexing_pos t ~filename pos =
   let (`Offset o) = get_offset t pos in
   let (`Logical (line, col)) = get_logical t pos in

src/kernel/msource.mli

@@ -27,6 +27,8 @@ val get_offset : t -> [< position ] -> [> `Offset of int ]
 
 val get_logical : t -> [< position ] -> [> `Logical of int * int ]
 
+val compare_logical : [< `Logical of int * int ] -> [< `Logical of int * int ] -> int
+
 val get_lexing_pos : t -> filename:string -> [< position ] -> Lexing.position
 
 (** {1 Managing content} *)

tests/test-dirs/signature-help/issue_fun_name.t

@@ -0,0 +1,147 @@
+  $ cat > test.ml <<'EOF'
+  > let v = List.map Fun.id []
+  > EOF
+
+Valid
+  $ $MERLIN single signature-help -position 1:4 -filename test < test.ml
+  {
+    "class": "return",
+    "value": {},
+    "notifications": []
+  }
+
+  $ $MERLIN single signature-help -position 1:18 -filename test < test.ml
+  {
+    "class": "return",
+    "value": {
+      "signatures": [
+        {
+          "label": "List.map : ('a -> 'a) -> 'a list -> 'a list",
+          "parameters": [
+            {
+              "label": [
+                11,
+                21
+              ]
+            },
+            {
+              "label": [
+                25,
+                32
+              ]
+            }
+          ]
+        }
+      ],
+      "activeParameter": 0,
+      "activeSignature": 0
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single signature-help -position 1:21 -filename test < test.ml
+  {
+    "class": "return",
+    "value": {
+      "signatures": [
+        {
+          "label": "List.map : ('a -> 'a) -> 'a list -> 'a list",
+          "parameters": [
+            {
+              "label": [
+                11,
+                21
+              ]
+            },
+            {
+              "label": [
+                25,
+                32
+              ]
+            }
+          ]
+        }
+      ],
+      "activeParameter": 0,
+      "activeSignature": 0
+    },
+    "notifications": []
+  }
+
+  $ $MERLIN single signature-help -position 1:24 -filename test < test.ml
+  {
+    "class": "return",
+    "value": {
+      "signatures": [
+        {
+          "label": "List.map : ('a -> 'a) -> 'a list -> 'a list",
+          "parameters": [
+            {
+              "label": [
+                11,
+                21
+              ]
+            },
+            {
+              "label": [
+                25,
+                32
+              ]
+            }
+          ]
+        }
+      ],
+      "activeParameter": 1,
+      "activeSignature": 0
+    },
+    "notifications": []
+  }
+
+  $ cat > t.ml <<'EOF'
+  > module M : sig
+  >   val f : int -> unit
+  > end = struct
+  >   let f (_ : int) = ()
+  > end
+  > 
+  > let () = M.f (* keep whitespace *)
+  > EOF
+
+  $ $MERLIN single signature-help -position 7:13 -filename test < t.ml
+  {
+    "class": "return",
+    "value": {
+      "signatures": [
+        {
+          "label": "M.f : int -> unit",
+          "parameters": [
+            {
+              "label": [
+                6,
+                9
+              ]
+            }
+          ]
+        }
+      ],
+      "activeParameter": 0,
+      "activeSignature": 0
+    },
+    "notifications": []
+  }
+
+
+FIXME: Signature help should not appear on the name of the function:
+  $ $MERLIN single signature-help -position 1:9 -filename test < test.ml
+  {
+    "class": "return",
+    "value": {},
+    "notifications": []
+  }
+
+  $ $MERLIN single signature-help -position 1:14 -filename test < test.ml
+  {
+    "class": "return",
+    "value": {},
+    "notifications": []
+  }