Fix @genType issue with module aliases (rescript-lang#6113)

* WIP: Demonstrate @genType issue with module aliasesgi

See rescript-lang#6112

* add the option to use the `@genType` annotation at the module level

* Don't need wrapper to be a separate file.

* Resolve module aliases in local modules.

* Back to having the alias in an separate file.

* Expand module aliases.

when a module alias is created

```res
module A = B
```

expand the definition of B (as in an include) for genType's purposes

* Update CHANGELOG.md

Fixes rescript-lang#6112

Author: cristianoc

CHANGELOG.md

@@ -32,6 +32,8 @@ Use best effort to determine the config when formatting a file.
 https://github.com/rescript-lang/rescript-compiler/pull/5968 https://github.com/rescript-lang/rescript-compiler/pull/6080 https://github.com/rescript-lang/rescript-compiler/pull/6086 https://github.com/rescript-lang/rescript-compiler/pull/6087
 - Customization of runtime representation of variants. This is work in progress. E.g. some restrictions on the input. See comments of the form "TODO: put restriction on the variant definitions allowed, to make sure this never happens". https://github.com/rescript-lang/rescript-compiler/pull/6095
 - Introduce untagged variants https://github.com/rescript-lang/rescript-compiler/pull/6103
+- GenType: add the option to use the `@genType` annotation at the module level, meaning that all the items in the module should be exported. https://github.com/rescript-lang/rescript-compiler/pull/6113
+- GenType: add support for `@genType` annotations on module definitions. https://github.com/rescript-lang/rescript-compiler/pull/6113
 
 #### :boom: Breaking Change
 
@@ -69,6 +71,7 @@ These are only breaking changes for unformatted code.
 - Fix parsing uncurried type starting with path https://github.com/rescript-lang/rescript-compiler/pull/6089
 - Fix bigInt comparison https://github.com/rescript-lang/rescript-compiler/pull/6097
 - Fixed a bug where the async attribute was not preserved when using the `@this` decorator in ReScript functions. This fix allows proper handling of async functions with the `@this` decorator. Issue: https://github.com/rescript-lang/rescript-compiler/issues/6100
+- Fix issue with GenType and module aliases https://github.com/rescript-lang/rescript-compiler/issues/6112
 
 #### :nail_care: Polish
 

jscomp/gentype/Annotation.ml

@@ -154,7 +154,9 @@ let getDocString attributes =
 let hasAttribute checkText (attributes : Typedtree.attributes) =
   getAttributePayload checkText attributes <> None
 
-let fromAttributes ~loc (attributes : Typedtree.attributes) =
+let fromAttributes ~(config : GenTypeConfig.t) ~loc
+    (attributes : Typedtree.attributes) =
+  let default = if config.everything then GenType else NoGenType in
   if hasAttribute tagIsGenTypeOpaque attributes then GenTypeOpaque
   else if hasAttribute (fun s -> tagIsGenType s || tagIsGenTypeAs s) attributes
   then (
@@ -166,7 +168,7 @@ let fromAttributes ~loc (attributes : Typedtree.attributes) =
           Format.fprintf ppf "Annotation payload is ignored")
     | _ -> ());
     GenType)
-  else NoGenType
+  else default
 
 let rec moduleTypeCheckAnnotation ~checkAnnotation
     ({mty_desc} : Typedtree.module_type) =
@@ -289,3 +291,8 @@ let importFromString importString : import =
   in
   let importPath = ImportPath.fromStringUnsafe importString in
   {name; importPath}
+
+let updateConfigForModule ~(config : GenTypeConfig.t) attributes =
+  if attributes |> hasAttribute tagIsGenType then
+    {config with everything = true}
+  else config

jscomp/gentype/Dependencies.ml

@@ -11,19 +11,30 @@ let rec fromPath1 ~config ~typeEnv (path : Path.t) =
   | Pident id -> (
     let name = id |> Ident.name in
     match typeEnv |> TypeEnv.lookup ~name with
-    | None -> External name
+    | None -> (typeEnv, External name)
     | Some typeEnv1 -> (
+      let typeEnv2 =
+        match typeEnv |> TypeEnv.getModule ~name with
+        | Some typeEnv2 -> typeEnv2
+        | None -> typeEnv1
+      in
       match typeEnv1 |> TypeEnv.expandAliasToExternalModule ~name with
-      | Some dep -> dep
+      | Some dep -> (typeEnv2, dep)
       | None ->
         let resolvedName = name |> TypeEnv.addModulePath ~typeEnv:typeEnv1 in
-        Internal resolvedName))
+        (typeEnv2, Internal resolvedName)))
   | Pdot (Pident id, s, _pos) when id |> ScopedPackage.isGeneratedModule ~config
     ->
-    External (s |> ScopedPackage.addGeneratedModule ~generatedModule:id)
-  | Pdot (p, s, _pos) -> Dot (p |> fromPath1 ~config ~typeEnv, s)
+    ( typeEnv,
+      External (s |> ScopedPackage.addGeneratedModule ~generatedModule:id) )
+  | Pdot (p, s, _pos) -> (
+    let typeEnvFromP, dep = p |> fromPath1 ~config ~typeEnv in
+    match typeEnvFromP |> TypeEnv.expandAliasToExternalModule ~name:s with
+    | Some dep -> (typeEnvFromP, dep)
+    | None -> (typeEnvFromP, Dot (dep, s)))
   | Papply _ ->
-    Internal ("__Papply_unsupported_genType__" |> ResolvedName.fromString)
+    ( typeEnv,
+      Internal ("__Papply_unsupported_genType__" |> ResolvedName.fromString) )
 
 let rec isInternal dep =
   match dep with
@@ -32,7 +43,7 @@ let rec isInternal dep =
   | Dot (d, _) -> d |> isInternal
 
 let fromPath ~config ~typeEnv path =
-  let dep = path |> fromPath1 ~config ~typeEnv in
+  let _, dep = path |> fromPath1 ~config ~typeEnv in
   if !Debug.typeResolution then
     Log_.item "fromPath path:%s typeEnv:%s %s resolved:%s\n" (path |> Path.name)
       (typeEnv |> TypeEnv.toString)

jscomp/gentype/GenTypeConfig.ml

@@ -9,6 +9,7 @@ type t = {
   mutable emitImportCurry: bool;
   mutable emitImportReact: bool;
   mutable emitTypePropDone: bool;
+  mutable everything: bool;
   exportInterfaces: bool;
   generatedFileExtension: string option;
   module_: module_;
@@ -27,6 +28,7 @@ let default =
     emitImportCurry = false;
     emitImportReact = false;
     emitTypePropDone = false;
+    everything = false;
     exportInterfaces = false;
     generatedFileExtension = None;
     module_ = ES6;
@@ -190,13 +192,15 @@ let readConfig ~getBsConfigFile ~namespace =
       | Some sourceItem -> Some sourceItem
       | _ -> default.sources
     in
+    let everything = false in
     {
       bsbProjectRoot;
       bsDependencies;
       suffix;
       emitImportCurry = false;
       emitImportReact = false;
       emitTypePropDone = false;
+      everything;
       exportInterfaces;
       generatedFileExtension;
       module_;

jscomp/gentype/TranslateCoreType.ml

@@ -178,8 +178,7 @@ and translateCoreType_ ~config ~typeVarsGen
         |> Annotation.hasAttribute Annotation.tagIsString
       in
       let asInt =
-        coreType.ctyp_attributes
-        |> Annotation.hasAttribute Annotation.tagIsInt
+        coreType.ctyp_attributes |> Annotation.hasAttribute Annotation.tagIsInt
       in
       let lastBsInt = ref (-1) in
       let noPayloads =

jscomp/gentype/TranslateSignature.ml

@@ -9,7 +9,9 @@ let translateSignatureValue ~config ~outputFileRelative ~resolver ~typeEnv
     Log_.item "Translate Signature Value %s\n" (val_id |> Ident.name);
   let typeExpr = val_desc.ctyp_type in
   let addAnnotationsToFunction type_ = type_ in
-  match (val_id, val_attributes |> Annotation.fromAttributes ~loc:val_loc) with
+  match
+    (val_id, val_attributes |> Annotation.fromAttributes ~config ~loc:val_loc)
+  with
   | id, GenType ->
     id |> Ident.name
     |> Translation.translateValue ~attributes:val_attributes ~config
@@ -118,6 +120,10 @@ and translateSignatureItem ~config ~outputFileRelative ~resolver ~typeEnv
     let moduleItem =
       Runtime.newModuleItem ~name:(moduleTypeDeclaration.mtd_id |> Ident.name)
     in
+    let config =
+      moduleTypeDeclaration.mtd_attributes
+      |> Annotation.updateConfigForModule ~config
+    in
     typeEnv |> TypeEnv.updateModuleItem ~moduleItem;
     moduleTypeDeclaration
     |> translateModuleTypeDeclaration ~config ~outputFileRelative ~resolver

jscomp/gentype/TranslateSignatureFromTypes.ml

@@ -64,6 +64,10 @@ and translateSignatureItemFromTypes ~config ~outputFileRelative ~resolver
     }
   | Types.Sig_module (id, moduleDeclaration, _) ->
     let moduleItem = Runtime.newModuleItem ~name:(id |> Ident.name) in
+    let config =
+      moduleDeclaration.md_attributes
+      |> Annotation.updateConfigForModule ~config
+    in
     typeEnv |> TypeEnv.updateModuleItem ~moduleItem;
     moduleDeclaration
     |> translateModuleDeclarationFromTypes ~config ~outputFileRelative ~resolver
@@ -73,7 +77,9 @@ and translateSignatureItemFromTypes ~config ~outputFileRelative ~resolver
     if !Debug.translation then Log_.item "Translate Sig Value %s\n" name;
     let moduleItem = Runtime.newModuleItem ~name in
     typeEnv |> TypeEnv.updateModuleItem ~moduleItem;
-    if val_attributes |> Annotation.fromAttributes ~loc:val_loc = GenType then
+    if
+      val_attributes |> Annotation.fromAttributes ~config ~loc:val_loc = GenType
+    then
       name
       |> Translation.translateValue ~attributes:val_attributes ~config
            ~docString:(Annotation.getDocString val_attributes)

jscomp/gentype/TranslateStructure.ml

@@ -94,7 +94,10 @@ let translateValueBinding ~config ~outputFileRelative ~resolver ~typeEnv
     if !Debug.translation then Log_.item "Translate Value Binding %s\n" name;
     let moduleItem = Runtime.newModuleItem ~name in
     typeEnv |> TypeEnv.updateModuleItem ~moduleItem;
-    if vb_attributes |> Annotation.fromAttributes ~loc:vb_pat.pat_loc = GenType
+    if
+      vb_attributes
+      |> Annotation.fromAttributes ~config ~loc:vb_pat.pat_loc
+      = GenType
     then
       id |> Ident.name
       |> Translation.translateValue ~attributes:vb_attributes ~config
@@ -137,15 +140,29 @@ let rec removeDuplicateValueBindings
     (boundInRest, structureItem :: filteredRest)
   | [] -> (StringSet.empty, [])
 
-let rec translateModuleBinding ~config ~outputFileRelative ~resolver ~typeEnv
+let rec translateModuleBinding ~(config : GenTypeConfig.t) ~outputFileRelative
+    ~resolver ~typeEnv
     ({mb_id; mb_expr; mb_attributes} : Typedtree.module_binding) : Translation.t
     =
   let name = mb_id |> Ident.name in
   if !Debug.translation then Log_.item "Translate Module Binding %s\n" name;
   let moduleItem = Runtime.newModuleItem ~name in
+  let config = mb_attributes |> Annotation.updateConfigForModule ~config in
   typeEnv |> TypeEnv.updateModuleItem ~moduleItem;
   let typeEnv = typeEnv |> TypeEnv.newModule ~name in
   match mb_expr.mod_desc with
+  | Tmod_ident (path, _) -> (
+    let dep = path |> Dependencies.fromPath ~config ~typeEnv in
+    let internal = dep |> Dependencies.isInternal in
+    typeEnv |> TypeEnv.addModuleEquation ~dep ~internal;
+    match Env.scrape_alias mb_expr.mod_env mb_expr.mod_type with
+    | Mty_signature signature ->
+      (* Treat module M = N as include N *)
+      signature
+      |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config
+           ~outputFileRelative ~resolver ~typeEnv
+      |> Translation.combine
+    | Mty_alias _ | Mty_ident _ | Mty_functor _ -> Translation.empty)
   | Tmod_structure structure ->
     let isLetPrivate =
       mb_attributes |> Annotation.hasAttribute Annotation.tagIsInternLocal
@@ -193,11 +210,6 @@ let rec translateModuleBinding ~config ~outputFileRelative ~resolver ~typeEnv
     | Mty_alias _ ->
       logNotImplemented ("Mty_alias " ^ __LOC__);
       Translation.empty)
-  | Tmod_ident (path, _) ->
-    let dep = path |> Dependencies.fromPath ~config ~typeEnv in
-    let internal = dep |> Dependencies.isInternal in
-    typeEnv |> TypeEnv.addModuleEquation ~dep ~internal;
-    Translation.empty
   | Tmod_functor _ ->
     logNotImplemented ("Tmod_functor " ^ __LOC__);
     Translation.empty
@@ -240,9 +252,9 @@ let rec translateModuleBinding ~config ~outputFileRelative ~resolver ~typeEnv
     Translation.empty
 
 and translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv
-    structItem : Translation.t =
+    (structItem : Typedtree.structure_item) : Translation.t =
   match structItem with
-  | {Typedtree.str_desc = Typedtree.Tstr_type (recFlag, typeDeclarations)} ->
+  | {str_desc = Tstr_type (recFlag, typeDeclarations)} ->
     {
       importTypes = [];
       codeItems = [];
@@ -252,30 +264,30 @@ and translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv
              ~outputFileRelative ~recursive:(recFlag = Recursive) ~resolver
              ~typeEnv;
     }
-  | {Typedtree.str_desc = Tstr_value (_loc, valueBindings)} ->
+  | {str_desc = Tstr_value (_loc, valueBindings)} ->
     valueBindings
     |> List.map
          (translateValueBinding ~config ~outputFileRelative ~resolver ~typeEnv)
     |> Translation.combine
-  | {Typedtree.str_desc = Tstr_primitive valueDescription} ->
+  | {str_desc = Tstr_primitive valueDescription} ->
     (* external declaration *)
     valueDescription
     |> Translation.translatePrimitive ~config ~outputFileRelative ~resolver
          ~typeEnv
-  | {Typedtree.str_desc = Tstr_module moduleBinding} ->
+  | {str_desc = Tstr_module moduleBinding} ->
     moduleBinding
     |> translateModuleBinding ~config ~outputFileRelative ~resolver ~typeEnv
-  | {Typedtree.str_desc = Tstr_modtype moduleTypeDeclaration} ->
+  | {str_desc = Tstr_modtype moduleTypeDeclaration} ->
     moduleTypeDeclaration
     |> TranslateSignature.translateModuleTypeDeclaration ~config
          ~outputFileRelative ~resolver ~typeEnv
-  | {Typedtree.str_desc = Tstr_recmodule moduleBindings} ->
+  | {str_desc = Tstr_recmodule moduleBindings} ->
     moduleBindings
     |> List.map
          (translateModuleBinding ~config ~outputFileRelative ~resolver ~typeEnv)
     |> Translation.combine
   | {
-   Typedtree.str_desc =
+   str_desc =
      (* Bucklescript's encoding of bs.module: include with constraint. *)
      Tstr_include
        {
@@ -301,30 +313,30 @@ and translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv
   } ->
     structItem1
     |> translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv
-  | {Typedtree.str_desc = Tstr_include {incl_type = signature}} ->
+  | {str_desc = Tstr_include {incl_type = signature}} ->
     signature
     |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config
          ~outputFileRelative ~resolver ~typeEnv
     |> Translation.combine
-  | {Typedtree.str_desc = Tstr_eval _} ->
+  | {str_desc = Tstr_eval _} ->
     logNotImplemented ("Tstr_eval " ^ __LOC__);
     Translation.empty
-  | {Typedtree.str_desc = Tstr_typext _} ->
+  | {str_desc = Tstr_typext _} ->
     logNotImplemented ("Tstr_typext " ^ __LOC__);
     Translation.empty
-  | {Typedtree.str_desc = Tstr_exception _} ->
+  | {str_desc = Tstr_exception _} ->
     logNotImplemented ("Tstr_exception " ^ __LOC__);
     Translation.empty
-  | {Typedtree.str_desc = Tstr_open _} ->
+  | {str_desc = Tstr_open _} ->
     logNotImplemented ("Tstr_open " ^ __LOC__);
     Translation.empty
-  | {Typedtree.str_desc = Tstr_class _} ->
+  | {str_desc = Tstr_class _} ->
     logNotImplemented ("Tstr_class " ^ __LOC__);
     Translation.empty
-  | {Typedtree.str_desc = Tstr_class_type _} ->
+  | {str_desc = Tstr_class_type _} ->
     logNotImplemented ("Tstr_class_type " ^ __LOC__);
     Translation.empty
-  | {Typedtree.str_desc = Tstr_attribute _} ->
+  | {str_desc = Tstr_attribute _} ->
     logNotImplemented ("Tstr_attribute " ^ __LOC__);
     Translation.empty
 

jscomp/gentype/TranslateTypeDeclarations.ml

@@ -50,7 +50,7 @@ let renameRecordField ~attributes ~name =
 let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver
     ~typeAttributes ~typeEnv ~typeName ~typeVars declarationKind :
     CodeItem.typeDeclaration list =
-  let annotation = typeAttributes |> Annotation.fromAttributes ~loc in
+  let annotation = typeAttributes |> Annotation.fromAttributes ~config ~loc in
   let opaque =
     match annotation = Annotation.GenTypeOpaque with
     | true -> Some true

jscomp/gentype_tests/typescript-react-example/src/FirstClassModulesInterface.gen.tsx

@@ -2,8 +2,16 @@
 /* eslint-disable import/first */
 
 
+// @ts-ignore: Implicit any on import
+import * as FirstClassModulesInterfaceBS__Es6Import from './FirstClassModulesInterface.bs';
+const FirstClassModulesInterfaceBS: any = FirstClassModulesInterfaceBS__Es6Import;
+
 // tslint:disable-next-line:interface-over-type-literal
 export type record = { readonly x: number; readonly y: string };
 
 // tslint:disable-next-line:interface-over-type-literal
 export type firstClassModule = { readonly x: number };
+
+export const MT_x: number = FirstClassModulesInterfaceBS.MT.x;
+
+export const MT: { x: number } = FirstClassModulesInterfaceBS.MT

jscomp/gentype_tests/typescript-react-example/src/Hooks.res

@@ -25,7 +25,8 @@ let make = (~vehicle) => {
   </div>
 }
 
-@genType let default = make
+@genType
+let default = make
 
 module Another = {
   @genType @react.component

jscomp/gentype_tests/typescript-react-example/src/JSXV4.res

@@ -1,14 +1,16 @@
 @@jsxConfig({version: 4})
 
+@genType
 module CompV4 = {
-  @genType @react.component
+  @react.component
   let make = (~x, ~y) => React.string(x ++ y)
 }
 
 @@jsxConfig({version: 3})
 
+@genType
 module CompV3 = {
-  @genType @react.component
+  @react.component
   let make = (~x, ~y) => React.string(x ++ y)
 }