[B] Merge pull request ocaml#1756 from voodoos/improve-context-detection

Improve context detection for infix operators

CHANGES.md

@@ -7,6 +7,7 @@ merlin NEXT_VERSION
       fixes #1661)
     - Ignore SIGPIPE in the Merlin server process (#1746)
     - Fix lexing of quoted strings in comments (#1754, fixes #1753)
+    - Improve cursor position detection in longidents (#1756)
 
 merlin 4.14
 ===========

src/analysis/context.ml

@@ -64,8 +64,17 @@ let cursor_on_longident_end
   match lid with
   | Longident.Lident _ -> true
   | _ ->
-    let end_offset = loc.loc_end.pos_cnum in
-    let cstr_name_size = String.length name in
+    let end_offset =
+      loc.loc_end.pos_cnum in
+    let cstr_name_size =
+      (* FIXME: this is britle, but lids don't have precise enough location
+         information to handle these cases correctly. *)
+      let name_lenght = String.length name in
+      if Pprintast.needs_parens name then
+        name_lenght + 2
+      else
+        name_lenght
+    in
     let constr_pos =
       { loc.loc_end
         with pos_cnum = end_offset - cstr_name_size }
@@ -107,6 +116,7 @@ let inspect_expression ~cursor ~lid e : t =
     else Module_path
   | Texp_ident (p, lid_loc, _) ->
     let name = Path.last p in
+    log ~title:"inspect_context" "name is: [%s]" name;
     if name = "*type-error*" then
       (* For type_enclosing: it is enough to return Module_path here.
          - If the cursor was on the end of the lid typing should fail anyway

src/frontend/query_commands.ml

@@ -221,7 +221,7 @@ let reconstruct_identifier pipeline pos = function
          (dot.[0] >= 'a' && dot.[0] <= 'z') ||
          (dot.[0] >= 'A' && dot.[0] <= 'Z')
       then dot
-      else "(" ^ dot ^ ")"
+      else "( " ^ dot ^ ")"
     in
     begin match path with
       | [] -> []
@@ -507,9 +507,9 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
     let typer = Mpipeline.typer_result pipeline in
     let pos = Mpipeline.get_lexing_pos pipeline pos in
     let node = Mtyper.node_at typer pos in
-    let res = Syntax_doc.get_syntax_doc pos node in 
+    let res = Syntax_doc.get_syntax_doc pos node in
     (match res with
-    | Some res -> `Found res 
+    | Some res -> `Found res
     | None -> `No_documentation)
 
   | Locate (patho, ml_or_mli, pos) ->

src/ocaml/parsing/pprintast.mli

@@ -57,3 +57,4 @@ val tyvar: Format.formatter -> string -> unit
 (* merlin *)
 val case_list : Format.formatter -> Parsetree.case list -> unit
 val protect_ident : Format.formatter -> string -> unit
+val needs_parens : string -> bool

tests/test-dirs/type-enclosing/need-parens.t

@@ -0,0 +1,72 @@
+Locate on `M.(|+)` should work:
+  $ $MERLIN single locate -position 2:11 -filename test.ml <<'EOF' | \
+  > jq '.value'
+  > module M = struct let (+) a b = a + b end
+  > let _ = M.(+)
+  > EOF
+  {
+    "file": "test.ml",
+    "pos": {
+      "line": 1,
+      "col": 22
+    }
+  }
+
+Locate on `M.(+|)` should work:
+  $ $MERLIN single locate -position 2:12 -filename test.ml <<'EOF' | \
+  > jq '.value'
+  > module M = struct let (+) a b = a + b end
+  > let _ = M.(+)
+  > EOF
+  {
+    "file": "test.ml",
+    "pos": {
+      "line": 1,
+      "col": 22
+    }
+  }
+
+And need spaces:
+Locate on `M.(| * )` should work:
+  $ $MERLIN single locate -position 2:11 -filename test.ml <<'EOF' | \
+  > jq '.value'
+  > module M = struct let ( * ) a b = a + b end
+  > let _ = M.( * )
+  > EOF
+  {
+    "file": "test.ml",
+    "pos": {
+      "line": 1,
+      "col": 0
+    }
+  }
+
+And need spaces:
+Locate on `M.( |* )` should work:
+  $ $MERLIN single locate -position 2:12 -filename test.ml <<'EOF' | \
+  > jq '.value'
+  > module M = struct let ( * ) a b = a + b end
+  > let _ = M.( * )
+  > EOF
+  {
+    "file": "test.ml",
+    "pos": {
+      "line": 1,
+      "col": 22
+    }
+  }
+
+And need spaces:
+Locate on `M.( *| )` should work:
+  $ $MERLIN single locate -position 2:13 -filename test.ml <<'EOF' | \
+  > jq '.value'
+  > module M = struct let ( * ) a b = a + b end
+  > let _ = M.( * )
+  > EOF
+  {
+    "file": "test.ml",
+    "pos": {
+      "line": 1,
+      "col": 22
+    }
+  }