outline: keep the selection range inside the item range

CHANGES.md

@@ -9,6 +9,11 @@ unreleased
       submodule no longer hides the opened module (fixes #1748)
     - Fix occurrences staleness detection when the server is not running at the
       project's source root. (#2097)
+    - outline: hide bindings that carry no source location, such as the
+      compiler-generated eta-expansion of a function with an optional
+      argument, keeping their descendants; also fall back to the item
+      location for the `selection` range when a name's location lies
+      outside of it (#2111, fixes #2106)
   + ocaml index
     - Fix staleness detection in the presence of ppxes. (#2110)
 

src/analysis/outline.ml

@@ -41,10 +41,19 @@ let name_of_patt = function
 
 let mk ?(children = []) ~location ~deprecated outline_kind outline_type
     (name : string Location.loc) =
+  (* The LSP protocol requires the selection range to be included in the
+     item range. Bindings carrying no location at all are elided from
+     the outline (see [get_val_elements]); the fallback below remains as
+     a safety net for any other out-of-range provenance, such as a dummy
+     name location on a node whose own location is real (#2106). *)
+  let selection =
+    if Location_aux.included ~into:location name.loc then name.loc
+    else location
+  in
   { Query_protocol.outline_kind;
     outline_type;
     location;
-    selection = name.loc;
+    selection;
     children;
     outline_name = name.txt;
     deprecated
@@ -156,6 +165,14 @@ and get_val_elements node =
   match node.t_node with
   | Expression _ ->
     List.concat_map (Lazy.force node.t_children) ~f:get_val_elements
+  (* The typechecker synthesizes bindings with no counterpart in the
+     source, such as the eta-expansion of a function with an optional
+     argument; they carry [Location.none]. Elide them but keep their
+     descendants, which belong to the user's expression (#2106).
+     Bindings with a ghost but real location, as ppxes usually produce,
+     are unaffected. *)
+  | Value_binding { vb_loc; _ } when Location.is_none vb_loc ->
+    List.concat_map (Lazy.force node.t_children) ~f:get_val_elements
   | Class_expr _ | Class_structure _ -> get_class_elements node
   | _ -> Option.to_list (summarize node)
 

tests/test-dirs/issue2106.t

@@ -0,0 +1,90 @@
+When `f` takes an optional argument and is passed to `List.map`, the
+compiler eta-expands it; the generated binding carries no source
+location and must not appear in the outline. Descendants coming from
+the user's expression must survive the elision. See issue #2106.
+
+  $ cat >test.ml <<EOF
+  > let f ?x _ = x
+  > let g childs = List.map f childs
+  > EOF
+
+  $ $MERLIN single outline -filename test.ml <test.ml
+  {
+    "class": "return",
+    "value": [
+      {
+        "start": {
+          "line": 2,
+          "col": 0
+        },
+        "end": {
+          "line": 2,
+          "col": 32
+        },
+        "name": "g",
+        "kind": "Value",
+        "type": "'a list -> 'b option list",
+        "children": [],
+        "deprecated": false,
+        "selection": {
+          "start": {
+            "line": 2,
+            "col": 4
+          },
+          "end": {
+            "line": 2,
+            "col": 5
+          }
+        }
+      },
+      {
+        "start": {
+          "line": 1,
+          "col": 0
+        },
+        "end": {
+          "line": 1,
+          "col": 14
+        },
+        "name": "f",
+        "kind": "Value",
+        "type": "?x:'a -> 'b -> 'a option",
+        "children": [],
+        "deprecated": false,
+        "selection": {
+          "start": {
+            "line": 1,
+            "col": 4
+          },
+          "end": {
+            "line": 1,
+            "col": 5
+          }
+        }
+      }
+    ],
+    "notifications": []
+  }
+
+The elided binding's children belong to the user's expression and
+must be hoisted, not dropped: `seed` below stays visible under `g`.
+
+  $ cat >test2.ml <<EOF
+  > let f ?x y = (x, y)
+  > let g l = List.map (ignore (let seed = 1 in seed); f) l
+  > EOF
+
+  $ $MERLIN single outline -filename test2.ml <test2.ml |
+  > jq '[.value[] | {name, children: [.children[].name]}]'
+  [
+    {
+      "name": "g",
+      "children": [
+        "seed"
+      ]
+    },
+    {
+      "name": "f",
+      "children": []
+    }
+  ]