add experimental mainTypeForModule annotation

Author: zth

analysis/src/CompletionBackEnd.ml

@@ -990,35 +990,44 @@ 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, path) ->
+        | Some (env, fields, typDecl, path, attributes) ->
           Some
             ( env,
               fields,
               typDecl.item.decl |> Shared.declToString typDecl.name.txt,
-              Some path )
+              Some path,
+              attributes )
         | None -> None)
       | Some (ExtractedType typ, env) -> (
         match typ with
-        | Trecord {fields; path} ->
-          Some (env, fields, typ |> TypeUtils.extractedTypeToString, path)
+        | Trecord {fields; path; attributes} ->
+          Some
+            ( env,
+              fields,
+              typ |> TypeUtils.extractedTypeToString,
+              path,
+              attributes )
         | _ -> None)
       | None -> None
     in
     match extracted with
     | 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
+    | Some (env, fields, recordAsString, path, attributes) ->
+      let pipeCompletion =
+        match
+          (path, ProcessAttributes.findMainTypeForModuleAttribute attributes)
+        with
+        | Some path, _ when Path.last path = "t" ->
+          Some
+            ( path,
               path |> SharedTypes.pathIdentToString |> String.split_on_char '.'
-              |> List.rev
-            with
-            | _ :: rest -> rest
-            | [] -> []
-          in
+              |> List.rev |> List.tl )
+        | Some path, Some modulePath -> Some (path, modulePath)
+        | _ -> None
+      in
+      let pipeCompletionsForModule =
+        match pipeCompletion with
+        | Some (path, completionPath) ->
           (* Most of this is copied from the pipe completion code. Should probably be unified. *)
           let completions =
             completionPath @ [fieldName]
@@ -1046,10 +1055,8 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact
               match
                 TypeUtils.extractFunctionType ~env ~package:full.package t
               with
-              | ( (Nolabel, {desc = Tconstr (Path.Pident {name = "t"}, _, _)})
-                  :: _,
-                  _ ) ->
-                true
+              | (Nolabel, {desc = Tconstr (p, _, _)}) :: _, _ ->
+                Path.same p path || Path.name p = "t"
               | _ -> false)
             | _ -> false
           in
@@ -2031,6 +2038,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
           env;
           definition = `NameOnly "jsxConfig";
           path = None;
+          attributes = [];
           fields =
             [
               mkField ~name:"version" ~primitive:"int";
@@ -2061,6 +2069,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
         {
           env;
           path = None;
+          attributes = [];
           definition = `NameOnly "importAttributesConfig";
           fields = [mkField ~name:"type_" ~primitive:"string"];
         }
@@ -2070,6 +2079,7 @@ let rec processCompletable ~debug ~full ~scope ~env ~pos ~forHover completable =
         {
           env;
           path = None;
+          attributes = [];
           definition = `NameOnly "moduleConfig";
           fields =
             [

analysis/src/ProcessAttributes.ml

@@ -48,3 +48,19 @@ let newDeclared ~item ~extent ~name ~stamp ~modulePath isExported attributes =
       | Some d -> [d]);
     item;
   }
+
+let rec findMainTypeForModuleAttribute attributes =
+  let open Parsetree in
+  match attributes with
+  | [] -> None
+  | ( {Asttypes.txt = "mainTypeForModule"},
+      PStr
+        [
+          {
+            pstr_desc =
+              Pstr_eval ({pexp_desc = Pexp_construct ({txt = path}, None)}, _);
+          };
+        ] )
+    :: _ ->
+    Some (Utils.flattenLongIdent path)
+  | _ :: rest -> findMainTypeForModuleAttribute rest

analysis/src/SharedTypes.ml

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

analysis/src/TypeUtils.ml

@@ -203,7 +203,7 @@ let rec extractRecordType ~env ~package (t : Types.type_expr) =
   | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> extractRecordType ~env ~package t1
   | Tconstr (path, typeArgs, _) -> (
     match References.digConstructor ~env ~package path with
-    | Some (env, ({item = {kind = Record fields}} as typ)) ->
+    | Some (env, ({item = {kind = Record fields; attributes}} as typ)) ->
       let typeParams = typ.item.decl.type_params in
       let fields =
         fields
@@ -213,7 +213,7 @@ let rec extractRecordType ~env ~package (t : Types.type_expr) =
                in
                {field with typ = fieldTyp})
       in
-      Some (env, fields, typ, path)
+      Some (env, fields, typ, path, attributes)
     | Some
         ( env,
           {item = {decl = {type_manifest = Some t1; type_params = typeParams}}}
@@ -383,7 +383,9 @@ let rec extractType ?(printOpeningDebug = true)
               variantDecl = decl;
             },
           typeArgContext )
-    | Some (envFromDeclaration, {item = {kind = Record fields; decl}}) ->
+    | Some
+        (envFromDeclaration, {item = {kind = Record fields; decl; attributes}})
+      ->
       if Debug.verbose () then print_endline "[extract_type]--> found record";
       (* Need to create a new type arg context here because we're sending along a type expr that might have type vars. *)
       let typeArgContext =
@@ -396,6 +398,7 @@ let rec extractType ?(printOpeningDebug = true)
               path = Some path;
               fields;
               definition = `TypeExpr t;
+              attributes;
             },
           typeArgContext )
     | Some (envFromDeclaration, {item = {name = "t"; decl = {type_params}}}) ->
@@ -577,7 +580,15 @@ 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; path = None; definition = `NameOnly typ.name})
+    Some
+      (Trecord
+         {
+           env;
+           fields;
+           path = None;
+           definition = `NameOnly typ.name;
+           attributes = typ.attributes;
+         })
   | Variant constructors ->
     Some
       (Tvariant

analysis/tests/src/CompletionFromModule.res

@@ -12,3 +12,25 @@ let n = {SomeModule.name: "hello"}
 // n.
 //   ^com
 // ^dv-
+
+@mainTypeForModule(SomeOtherModule)
+type typeOutsideModule = {nname: string}
+
+module SomeOtherModule = {
+  type t = typeOutsideModule
+
+  type irrelevantType = string
+
+  @get external getNName: t => string = "nname"
+  @get external getNName2: typeOutsideModule => string = "nname"
+  @get external getNName3: irrelevantType => string = "nname"
+
+  let thisShouldNotBeCompletedFor = () => "hi"
+}
+
+let nn: SomeOtherModule.t = {nname: "hello"}
+
+// ^dv+
+// nn.
+//    ^com
+// ^dv-

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

@@ -728,7 +728,6 @@ Resolved opens 1 pervasives
 ContextPath Value[r].""
 ContextPath Value[r]
 Path r
-Path 
 [{
     "label": "x",
     "kind": 5,
@@ -752,7 +751,6 @@ Resolved opens 1 pervasives
 ContextPath Value[Objects, Rec, recordVal].""
 ContextPath Value[Objects, Rec, recordVal]
 Path Objects.Rec.recordVal
-Path 
 [{
     "label": "xx",
     "kind": 5,
@@ -835,8 +833,6 @@ ContextPath Value[q].aa.""
 ContextPath Value[q].aa
 ContextPath Value[q]
 Path q
-Path aa
-Path 
 [{
     "label": "x",
     "kind": 5,
@@ -861,8 +857,6 @@ ContextPath Value[q].aa.n
 ContextPath Value[q].aa
 ContextPath Value[q]
 Path q
-Path aa
-Path n
 [{
     "label": "name",
     "kind": 5,
@@ -1087,7 +1081,6 @@ ContextPath Value[FAO, forAutoObject]["forAutoLabel"].""
 ContextPath Value[FAO, forAutoObject]["forAutoLabel"]
 ContextPath Value[FAO, forAutoObject]
 Path FAO.forAutoObject
-Path FAR.
 [{
     "label": "forAuto",
     "kind": 5,
@@ -1113,7 +1106,6 @@ 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
@@ -1197,7 +1189,6 @@ Resolved opens 3 pervasives Completion.res Completion.res
 ContextPath Value[_z].""
 ContextPath Value[_z]
 Path _z
-Path 
 [{
     "label": "x",
     "kind": 5,
@@ -1356,7 +1347,6 @@ 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",
@@ -1377,7 +1367,6 @@ ContextPath Value[retAA](Nolabel).""
 ContextPath Value[retAA](Nolabel)
 ContextPath Value[retAA]
 Path retAA
-Path 
 [{
     "label": "x",
     "kind": 5,
@@ -1908,7 +1897,6 @@ Resolved opens 3 pervasives Completion.res Completion.res
 ContextPath Value[funRecord].""
 ContextPath Value[funRecord]
 Path funRecord
-Path 
 [{
     "label": "someFun",
     "kind": 5,
@@ -2165,7 +2153,6 @@ 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,7 +946,6 @@ Resolved opens 1 pervasives
 ContextPath Value[fff].someOpt
 ContextPath Value[fff]
 Path fff
-Path someOpt
 [{
     "label": "someOptField",
     "kind": 5,
@@ -1416,7 +1415,6 @@ Resolved opens 2 pervasives CompletionSupport.res
 ContextPath Value[someTyp].""
 ContextPath Value[someTyp]
 Path someTyp
-Path 
 [{
     "label": "test",
     "kind": 5,
@@ -1472,7 +1470,6 @@ 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

@@ -32,3 +32,48 @@ Path SomeModule.
   }]
 
 
+
+Complete src/CompletionFromModule.res 33:6
+posCursor:[33:6] posNoWhite:[33:5] Found expr:[33:3->33:6]
+Pexp_field [33:3->33:5] _:[37:0->33:6]
+[set_result] set new result to Cpath Value[nn].""
+Completable: Cpath Value[nn].""
+Package opens Pervasives.JsxModules.place holder
+Resolved opens 1 pervasives
+ContextPath Value[nn].""
+[ctx_path]--> CPField
+ContextPath Value[nn]
+[ctx_path]--> CPId
+Path nn
+Path SomeOtherModule.
+[{
+    "label": "->SomeOtherModule.getNName",
+    "kind": 12,
+    "tags": [],
+    "detail": "t => string",
+    "documentation": null,
+    "sortText": "getNName",
+    "textEdit": {
+    "range": {"start": {"line": 33, "character": 5}, "end": {"line": 33, "character": 5}},
+    "newText": "->SomeOtherModule.getNName"
+  }
+  }, {
+    "label": "->SomeOtherModule.getNName2",
+    "kind": 12,
+    "tags": [],
+    "detail": "typeOutsideModule => string",
+    "documentation": null,
+    "sortText": "getNName2",
+    "textEdit": {
+    "range": {"start": {"line": 33, "character": 5}, "end": {"line": 33, "character": 5}},
+    "newText": "->SomeOtherModule.getNName2"
+  }
+  }, {
+    "label": "nname",
+    "kind": 5,
+    "tags": [],
+    "detail": "string",
+    "documentation": {"kind": "markdown", "value": "```rescript\nnname: string\n```\n\n```rescript\ntype typeOutsideModule = {nname: string}\n```"}
+  }]
+
+