wip complete pipeable functions from dot completion on record when record is type t of module

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -970,30 +970,103 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
       with
       | Some (TypeExpr typ, env) -> (
         match typ |> TypeUtils.extractRecordType ~env ~package with
-        | Some (env, fields, typDecl) ->
+        | Some (env, fields, typDecl, path) ->
           Some
             ( env,
               fields,
-              typDecl.item.decl |> Shared.declToString typDecl.name.txt )
+              typDecl.item.decl |> Shared.declToString typDecl.name.txt,
+              Some path )
         | None -> None)
       | Some (ExtractedType typ, env) -> (
         match typ with
-        | Trecord {fields} ->
-          Some (env, fields, typ |> TypeUtils.extractedTypeToString)
+        | Trecord {fields; path} ->
+          Some (env, fields, typ |> TypeUtils.extractedTypeToString, path)
         | _ -> None)
       | None -> None
     in
     match extracted with
     | None -> []
-    | Some (env, fields, recordAsString) ->
-      fields
-      |> Utils.filterMap (fun field ->
-             if Utils.checkName field.fname.txt ~prefix:fieldName ~exact then
-               Some
-                 (Completion.create field.fname.txt ~env
-                    ?deprecated:field.deprecated ~docstring:field.docstring
-                    ~kind:(Completion.Field (field, recordAsString)))
-             else None))
+    | Some (env, fields, recordAsString, path) ->
+      let pipeCompletionsForModule =
+        match path with
+        | Some path ->
+          let completionPath =
+            (* Remove the last part of the path since we're only after the parent module *)
+            match
+              path |> SharedTypes.pathIdentToString |> String.split_on_char '.'
+              |> List.rev
+            with
+            | _ :: rest -> rest
+            | [] -> []
+          in
+          (* Most of this is copied from the pipe completion code. Should probably be unified. *)
+          let completions =
+            completionPath @ [fieldName]
+            |> getCompletionsForPath ~debug ~completionContext:Value
+                 ~exact:false ~opens ~full ~pos ~env ~scope
+          in
+          let completionPathMinusOpens =
+            TypeUtils.removeOpensFromCompletionPath ~rawOpens ~package
+              completionPath
+            |> String.concat "."
+          in
+          let completionName name =
+            if completionPathMinusOpens = "" then name
+            else completionPathMinusOpens ^ "." ^ name
+          in
+          (* Find all functions in the module that takes type t *)
+          let rec fnTakesTypeT t =
+            match t.Types.desc with
+            | Tlink t1
+            | Tsubst t1
+            | Tpoly (t1, [])
+            | Tconstr (Pident {name = "function$"}, [t1; _], _) ->
+              fnTakesTypeT t1
+            | Tarrow _ -> (
+              match
+                TypeUtils.extractFunctionType ~env ~package:full.package t
+              with
+              | ( (Nolabel, {desc = Tconstr (Path.Pident {name = "t"}, _, _)})
+                  :: _,
+                  _ ) ->
+                true
+              | _ -> false)
+            | _ -> false
+          in
+          completions
+          |> List.filter_map (fun (completion : Completion.t) ->
+                 match completion.kind with
+                 | Value t when fnTakesTypeT t ->
+                   let name = completionName completion.name in
+                   let nameWithPipe = "->" ^ name in
+                   (* TODO: We need to add support for setting the text insertion location explicitly,
+                      so we can account for the dot that triggered the completion, but that we want
+                      removed when inserting the pipe. This means we also need to track the loc of
+                      the dot + the identifier that we're filtering with (fieldName here).
+                      That should be easy to do by extending CPField. *)
+                   Some
+                     {
+                       completion with
+                       name = nameWithPipe;
+                       sortText =
+                         Some
+                           (name |> String.split_on_char '.' |> List.rev
+                          |> List.hd);
+                       insertText = Some nameWithPipe;
+                       env;
+                     }
+                 | _ -> None)
+        | None -> []
+      in
+      pipeCompletionsForModule
+      @ (fields
+        |> Utils.filterMap (fun field ->
+               if Utils.checkName field.fname.txt ~prefix:fieldName ~exact then
+                 Some
+                   (Completion.create field.fname.txt ~env
+                      ?deprecated:field.deprecated ~docstring:field.docstring
+                      ~kind:(Completion.Field (field, recordAsString)))
+               else None)))
   | CPObj (cp, label) -> (
     (* TODO: Also needs to support ExtractedType *)
     if Debug.verbose () then print_endline "[ctx_path]--> CPObj";
@@ -1936,6 +2009,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
         {
           env;
           definition = `NameOnly "jsxConfig";
+          path = None;
           fields =
             [
               mkField ~name:"version" ~primitive:"int";
@@ -1965,6 +2039,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
       Trecord
         {
           env;
+          path = None;
           definition = `NameOnly "importAttributesConfig";
           fields = [mkField ~name:"type_" ~primitive:"string"];
         }
@@ -1973,6 +2048,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
       Trecord
         {
           env;
+          path = None;
           definition = `NameOnly "moduleConfig";
           fields =
             [

analysis/src/SharedTypes.ml

@@ -354,6 +354,7 @@ and completionType =
   | Trecord of {
       env: QueryEnv.t;
       fields: field list;
+      path: Path.t option;
       definition:
         [ `NameOnly of string
           (** When we only have the name, like when pulling the record from a declared type. *)

analysis/src/TypeUtils.ml

@@ -213,7 +213,7 @@ let rec extractRecordType ~env ~package (t : Types.type_expr) =
                in
                {field with typ = fieldTyp})
       in
-      Some (env, fields, typ)
+      Some (env, fields, typ, path)
     | Some
         ( env,
           {item = {decl = {type_manifest = Some t1; type_params = typeParams}}}
@@ -390,7 +390,13 @@ let rec extractType ?(printOpeningDebug = true)
         maybeSetTypeArgCtx ~typeParams:decl.type_params ~typeArgs env
       in
       Some
-        ( Trecord {env = envFromDeclaration; fields; definition = `TypeExpr t},
+        ( Trecord
+            {
+              env = envFromDeclaration;
+              path = Some path;
+              fields;
+              definition = `TypeExpr t;
+            },
           typeArgContext )
     | Some (envFromDeclaration, {item = {name = "t"; decl = {type_params}}}) ->
       let typeArgContext =
@@ -571,7 +577,7 @@ let extractTypeFromResolvedType (typ : Type.t) ~env ~full =
   match typ.kind with
   | Tuple items -> Some (Tuple (env, items, Ctype.newty (Ttuple items)))
   | Record fields ->
-    Some (Trecord {env; fields; definition = `NameOnly typ.name})
+    Some (Trecord {env; fields; path = None; definition = `NameOnly typ.name})
   | Variant constructors ->
     Some
       (Tvariant

analysis/tests/src/CompletionFromModule.res

@@ -0,0 +1,14 @@
+module SomeModule = {
+  type t = {name: string}
+
+  @get external getName: t => string = "name"
+
+  let thisShouldNotBeCompletedFor = () => "hi"
+}
+
+let n = {SomeModule.name: "hello"}
+
+// ^dv+
+// n.
+//   ^com
+// ^dv-

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

@@ -728,6 +728,7 @@ Resolved opens 1 pervasives
 ContextPath Value[r].""
 ContextPath Value[r]
 Path r
+Path 
 [{
     "label": "x",
     "kind": 5,
@@ -751,6 +752,7 @@ Resolved opens 1 pervasives
 ContextPath Value[Objects, Rec, recordVal].""
 ContextPath Value[Objects, Rec, recordVal]
 Path Objects.Rec.recordVal
+Path 
 [{
     "label": "xx",
     "kind": 5,
@@ -833,6 +835,8 @@ ContextPath Value[q].aa.""
 ContextPath Value[q].aa
 ContextPath Value[q]
 Path q
+Path aa
+Path 
 [{
     "label": "x",
     "kind": 5,
@@ -857,6 +861,8 @@ ContextPath Value[q].aa.n
 ContextPath Value[q].aa
 ContextPath Value[q]
 Path q
+Path aa
+Path n
 [{
     "label": "name",
     "kind": 5,
@@ -1081,6 +1087,7 @@ ContextPath Value[FAO, forAutoObject]["forAutoLabel"].""
 ContextPath Value[FAO, forAutoObject]["forAutoLabel"]
 ContextPath Value[FAO, forAutoObject]
 Path FAO.forAutoObject
+Path FAR.
 [{
     "label": "forAuto",
     "kind": 5,
@@ -1106,6 +1113,7 @@ ContextPath Value[FAO, forAutoObject]["forAutoLabel"].forAuto
 ContextPath Value[FAO, forAutoObject]["forAutoLabel"]
 ContextPath Value[FAO, forAutoObject]
 Path FAO.forAutoObject
+Path FAR.forAuto
 CPPipe env:Completion envFromCompletionItem:Completion.FAR
 CPPipe type path:ForAuto.t
 CPPipe pathFromEnv:ForAuto found:false
@@ -1189,6 +1197,7 @@ Resolved opens 3 pervasives Completion.res Completion.res
 ContextPath Value[_z].""
 ContextPath Value[_z]
 Path _z
+Path 
 [{
     "label": "x",
     "kind": 5,
@@ -1347,6 +1356,7 @@ Resolved opens 3 pervasives Completion.res Completion.res
 ContextPath Value[funRecord].someFun
 ContextPath Value[funRecord]
 Path funRecord
+Path someFun
 Found type for function (~name: string) => unit
 [{
     "label": "name",
@@ -1367,6 +1377,7 @@ ContextPath Value[retAA](Nolabel).""
 ContextPath Value[retAA](Nolabel)
 ContextPath Value[retAA]
 Path retAA
+Path 
 [{
     "label": "x",
     "kind": 5,
@@ -1897,6 +1908,7 @@ Resolved opens 3 pervasives Completion.res Completion.res
 ContextPath Value[funRecord].""
 ContextPath Value[funRecord]
 Path funRecord
+Path 
 [{
     "label": "someFun",
     "kind": 5,
@@ -2153,6 +2165,7 @@ Resolved opens 3 pervasives Completion.res Completion.res
 ContextPath Value[rWithDepr].so
 ContextPath Value[rWithDepr]
 Path rWithDepr
+Path so
 [{
     "label": "someInt",
     "kind": 5,

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

@@ -946,6 +946,7 @@ Resolved opens 1 pervasives
 ContextPath Value[fff].someOpt
 ContextPath Value[fff]
 Path fff
+Path someOpt
 [{
     "label": "someOptField",
     "kind": 5,
@@ -1415,6 +1416,7 @@ Resolved opens 2 pervasives CompletionSupport.res
 ContextPath Value[someTyp].""
 ContextPath Value[someTyp]
 Path someTyp
+Path 
 [{
     "label": "test",
     "kind": 5,
@@ -1470,6 +1472,7 @@ Resolved opens 2 pervasives CompletionSupport.res
 ContextPath Value[someTyp].""
 ContextPath Value[someTyp]
 Path someTyp
+Path 
 [{
     "label": "test",
     "kind": 5,

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

@@ -0,0 +1,31 @@
+
+Complete src/CompletionFromModule.res 11:5
+posCursor:[11:5] posNoWhite:[11:4] Found expr:[11:3->11:5]
+Pexp_field [11:3->11:4] _:[15:0->11:5]
+[set_result] set new result to Cpath Value[n].""
+Completable: Cpath Value[n].""
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[n].""
+[ctx_path]--> CPField
+ContextPath Value[n]
+[ctx_path]--> CPId
+Path n
+Path SomeModule.
+[{
+    "label": "->SomeModule.getName",
+    "kind": 12,
+    "tags": [],
+    "detail": "t => string",
+    "documentation": null,
+    "sortText": "getName",
+    "insertText": "->SomeModule.getName"
+  }, {
+    "label": "name",
+    "kind": 5,
+    "tags": [],
+    "detail": "string",
+    "documentation": {"kind": "markdown", "value": "```rescript\nname: string\n```\n\n```rescript\ntype t = {name: string}\n```"}
+  }]
+
+