Generalize labelled argument completion, and remove dead code.

Author: cristianoc

analysis/src/Commands.ml

@@ -20,8 +20,9 @@ let completion ~debug ~path ~pos ~currentFile =
           | Some full ->
             let env = SharedTypes.QueryEnv.fromFile full.file in
             let package = full.package in
-            NewCompletions.computeCompletions ~completable ~package ~pos ~scope
-              ~env)
+            completable
+            |> NewCompletions.processCompletable ~debug ~package ~pos ~scope
+                 ~env)
       in
       completionItems
   in

analysis/src/Completion.ml

@@ -75,28 +75,6 @@ let findJsxPropsCompletable ~jsxProps ~endPos ~posBeforeCursor ~posAfterCompName
   in
   loop jsxProps.props
 
-let rec skipLineComment ~pos ~i str =
-  if i < String.length str then
-    match str.[i] with
-    | '\n' -> Some ((fst pos + 1, 0), i + 1)
-    | _ -> skipLineComment ~pos:(fst pos, snd pos + 1) ~i:(i + 1) str
-  else None
-
-let rec skipComment ~pos ~i ~depth str =
-  if i < String.length str then
-    match str.[i] with
-    | '\n' -> skipComment ~depth ~pos:(fst pos + 1, 0) ~i:(i + 1) str
-    | '/' when i + 1 < String.length str && str.[i + 1] = '*' ->
-      skipComment ~depth:(depth + 1) ~pos:(fst pos, snd pos + 2) ~i:(i + 2) str
-    | '*' when i + 1 < String.length str && str.[i + 1] = '/' ->
-      if depth > 1 then
-        skipComment ~depth:(depth - 1)
-          ~pos:(fst pos, snd pos + 2)
-          ~i:(i + 2) str
-      else Some ((fst pos, snd pos + 2), i + 2)
-    | _ -> skipComment ~depth ~pos:(fst pos, snd pos + 1) ~i:(i + 1) str
-  else None
-
 let extractJsxProps ~(compName : Longident.t Location.loc) ~args =
   let thisCaseShouldNotHappen =
     {
@@ -147,9 +125,7 @@ type label = labelled option
 type arg = {label : label; exp : Parsetree.expression}
 
 let findExpApplyCompletable ~(args : arg list) ~endPos ~posBeforeCursor
-    ~(funName : Longident.t Location.loc) =
-  let funPath = Utils.flattenLongIdent funName.txt in
-  let posAfterFunName = Loc.end_ funName.loc in
+    ~(contextPath : Completable.contextPath) ~posAfterFunExpr =
   let allNames =
     List.fold_right
       (fun arg allLabels ->
@@ -164,18 +140,15 @@ let findExpApplyCompletable ~(args : arg list) ~endPos ~posBeforeCursor
       if
         labelled.posStart <= posBeforeCursor
         && posBeforeCursor < labelled.posEnd
-      then
-        Some
-          (Completable.CnamedArg
-             (Completable.CPId (funPath, Value), labelled.name, allNames))
+      then Some (Completable.CnamedArg (contextPath, labelled.name, allNames))
       else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then None
       else loop rest
     | {label = None; exp} :: rest ->
       if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then None
       else loop rest
     | [] ->
-      if posAfterFunName <= posBeforeCursor && posBeforeCursor < endPos then
-        Some (CnamedArg (Completable.CPId (funPath, Value), "", allNames))
+      if posAfterFunExpr <= posBeforeCursor && posBeforeCursor < endPos then
+        Some (CnamedArg (contextPath, "", allNames))
       else None
   in
   loop args
@@ -574,10 +547,11 @@ let completionWithParser ~debug ~path ~posCursor ~currentFile ~text =
           setPipeResult ~lhs ~id:"" |> ignore
         | Pexp_apply ({pexp_desc = Pexp_ident {txt = Lident "|."}}, [_; _]) ->
           ()
-        | Pexp_apply ({pexp_desc = Pexp_ident funName}, args) ->
+        | Pexp_apply (funExpr, args) ->
           let args = extractExpApplyArgs ~args in
           if debug then
-            Printf.printf "Pexp_apply ...%s (%s)\n" (Loc.toString funName.loc)
+            Printf.printf "Pexp_apply ...%s (%s)\n"
+              (Loc.toString funExpr.pexp_loc)
               (args
               |> List.map (fun {label; exp} ->
                      Printf.sprintf "%s...%s"
@@ -590,9 +564,14 @@ let completionWithParser ~debug ~path ~posCursor ~currentFile ~text =
                        (Loc.toString exp.pexp_loc))
               |> String.concat ", ");
           let expApplyCompletable =
-            findExpApplyCompletable ~funName ~args
-              ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor
+            match exprToContextPath funExpr with
+            | Some contextPath ->
+              findExpApplyCompletable ~contextPath ~args
+                ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor
+                ~posAfterFunExpr:(Loc.end_ funExpr.pexp_loc)
+            | None -> None
           in
+
           setResultOpt expApplyCompletable
         | Pexp_send (lhs, {txt; loc}) -> (
           (* e["txt"]

analysis/src/NewCompletions.ml

@@ -1076,7 +1076,7 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
           | Tfield (name, _, t1, t2) ->
             let fields = t2 |> getFields in
             (name, t1) :: fields
-          | Tlink te -> te |> getFields
+          | Tlink te | Tsubst te | Tpoly (te, []) -> te |> getFields
           | Tvar None -> []
           | _ -> []
         in
@@ -1119,6 +1119,7 @@ let rec getCompletionsForContextPath ~package ~opens ~rawOpens ~allFiles ~pos
         match typ.Types.desc with
         | Tconstr (path, _, _)
         | Tlink {desc = Tconstr (path, _, _)}
+        | Tsubst {desc = Tconstr (path, _, _)}
         | Tpoly ({desc = Tconstr (path, _, _)}, []) ->
           Some path
         | _ -> None
@@ -1204,7 +1205,8 @@ let getOpens ~rawOpens ~package ~env =
   (* Last open takes priority *)
   List.rev resolvedOpens
 
-let processCompletable ~package ~scope ~env ~pos (completable : Completable.t) =
+let processCompletable ~debug ~package ~scope ~env ~pos
+    (completable : Completable.t) =
   let rawOpens = Scope.getRawOpens scope in
   let opens = getOpens ~rawOpens ~package ~env in
   let allFiles = FileSet.union package.projectFiles package.dependenciesFiles in
@@ -1245,13 +1247,13 @@ let processCompletable ~package ~scope ~env ~pos (completable : Completable.t) =
           | Tfield (name, _, t1, t2) ->
             let fields = t2 |> getFields in
             if name = "children" then fields else (name, t1) :: fields
-          | Tlink te -> te |> getFields
+          | Tlink te | Tsubst te | Tpoly (te, []) -> te |> getFields
           | Tvar None -> []
           | _ -> []
         in
         let rec getLabels (t : Types.type_expr) =
           match t.desc with
-          | Tlink t1 | Tsubst t1 -> getLabels t1
+          | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1
           | Tarrow
               ( Nolabel,
                 {
@@ -1347,9 +1349,12 @@ let processCompletable ~package ~scope ~env ~pos (completable : Completable.t) =
         |> completionsGetTypeEnv
       with
       | Some (typ, _env) ->
+        if debug then
+          Printf.printf "Found type for function %s\n"
+            (typ |> Shared.typeToString);
         let rec getLabels (t : Types.type_expr) =
           match t.desc with
-          | Tlink t1 | Tsubst t1 -> getLabels t1
+          | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> getLabels t1
           | Tarrow ((Labelled l | Optional l), tArg, tRet, _) ->
             (l, tArg) :: getLabels tRet
           | Tarrow (Nolabel, _, tRet, _) -> getLabels tRet
@@ -1367,7 +1372,3 @@ let processCompletable ~package ~scope ~env ~pos (completable : Completable.t) =
     |> List.filter (fun (name, _t) ->
            Utils.startsWith name prefix && not (List.mem name identsSeen))
     |> List.map mkLabel
-
-let computeCompletions ~(completable : Completable.t) ~package ~pos ~scope ~env
-    =
-  completable |> processCompletable ~package ~scope ~env ~pos

analysis/tests/src/Completion.res

@@ -281,3 +281,13 @@ let _foo = _world => {
 type someType = {hello: string}
 // type t = SomeType(s)
 //                    ^com
+
+type funRecord = {
+  someFun: (~name: string) => unit,
+  stuff: string,
+}
+
+let funRecord: funRecord = assert false
+
+// let _ = funRecord.someFun(~ )
+//                            ^com

analysis/tests/src/expected/Completion.res.txt

@@ -362,6 +362,7 @@ Complete tests/src/Completion.res 23:20
 posCursor:[23:20] posNoWhite:[23:19] Found expr:[23:11->23:20]
 Pexp_apply ...[23:11->23:18] ()
 Completable: CnamedArg(Value[Lib, foo], "", [])
+Found type for function (~age: int, ~name: string) => string
 [{
     "label": "age",
     "kind": 4,
@@ -513,6 +514,7 @@ Complete tests/src/Completion.res 71:27
 posCursor:[71:27] posNoWhite:[71:26] Found expr:[71:11->71:27]
 Pexp_apply ...[71:11->71:18] (~name71:20->71:24=...[71:20->71:24])
 Completable: CnamedArg(Value[Lib, foo], "", [name])
+Found type for function (~age: int, ~name: string) => string
 [{
     "label": "age",
     "kind": 4,
@@ -525,6 +527,7 @@ Complete tests/src/Completion.res 74:26
 posCursor:[74:26] posNoWhite:[74:25] Found expr:[74:11->74:26]
 Pexp_apply ...[74:11->74:18] (~age74:20->74:23=...[74:20->74:23])
 Completable: CnamedArg(Value[Lib, foo], "", [age])
+Found type for function (~age: int, ~name: string) => string
 [{
     "label": "name",
     "kind": 4,
@@ -537,6 +540,7 @@ Complete tests/src/Completion.res 77:32
 posCursor:[77:32] posNoWhite:[77:31] Found expr:[77:11->77:32]
 Pexp_apply ...[77:11->77:18] (~age77:20->77:23=...[77:25->77:28])
 Completable: CnamedArg(Value[Lib, foo], "", [age])
+Found type for function (~age: int, ~name: string) => string
 [{
     "label": "name",
     "kind": 4,
@@ -549,6 +553,7 @@ Complete tests/src/Completion.res 82:5
 posCursor:[82:5] posNoWhite:[82:4] Found expr:[80:8->86:1]
 Pexp_apply ...[80:8->80:15] (~age84:3->84:6=...[84:7->84:8], ~name85:3->85:7=...[85:8->85:10])
 Completable: CnamedArg(Value[Lib, foo], "", [age, name])
+Found type for function (~age: int, ~name: string) => string
 []
 
 Complete tests/src/Completion.res 90:13
@@ -1068,3 +1073,16 @@ Completable: Cpath Type[s]
     "documentation": null
   }]
 
+Complete tests/src/Completion.res 291:30
+posCursor:[291:30] posNoWhite:[291:29] Found expr:[291:11->291:32]
+Pexp_apply ...[291:11->291:28] ()
+Completable: CnamedArg(Value[funRecord].someFun, "", [])
+Found type for function (~name: string) => unit
+[{
+    "label": "name",
+    "kind": 4,
+    "tags": [],
+    "detail": "string",
+    "documentation": null
+  }]
+