Gentype: propagate more comments (#6334)

* propagate docstrings for types emitted

* emit comments in emitted module type definitions

* to inline records

* cleanup

* updated files

* simplify docstring abstraction

Author: zth

jscomp/gentype/Annotation.ml

@@ -149,15 +149,10 @@ let getAttributeImportRenaming attributes =
 let getDocPayload attributes =
   let docPayload = attributes |> getAttributePayload tagIsDoc in
   match docPayload with
-  | Some (_, StringPayload docString) -> Some docString
+  | Some (_, StringPayload docString) when docString <> "" -> Some docString
   | _ -> None
 
-let mkDocString maybeDoc =
-  match maybeDoc with
-  | Some docString -> "/** " ^ docString ^ " */\n"
-  | _ -> ""
-
-let getDocString attributes = getDocPayload attributes |> mkDocString
+let docStringFromAttrs attributes = attributes |> getDocPayload
 
 let hasAttribute checkText (attributes : Typedtree.attributes) =
   getAttributePayload checkText attributes <> None

jscomp/gentype/CodeItem.ml

@@ -7,6 +7,7 @@ type exportType = {
   type_: type_;
   typeVars: string list;
   resolvedTypeName: ResolvedName.t;
+  docString: DocString.t;
 }
 
 type importValue = {
@@ -17,7 +18,7 @@ type importValue = {
 }
 
 type exportValue = {
-  docString: string;
+  docString: DocString.t;
   moduleAccessPath: Runtime.moduleAccessPath;
   originalName: string;
   resolvedName: ResolvedName.t;

jscomp/gentype/EmitJs.ml

@@ -69,7 +69,8 @@ let codeItemToString ~config ~typeNameIsInterface (codeItem : CodeItem.t) =
     "ImportValue " ^ (importAnnotation.importPath |> ImportPath.dump)
 
 let emitExportType ~emitters ~config ~typeNameIsInterface
-    {CodeItem.loc; nameAs; opaque; type_; typeVars; resolvedTypeName} =
+    {CodeItem.loc; nameAs; opaque; type_; typeVars; resolvedTypeName; docString}
+    =
   let freeTypeVars = TypeVars.free type_ in
   let isGADT =
     freeTypeVars |> List.exists (fun s -> not (List.mem s typeVars))
@@ -93,7 +94,7 @@ let emitExportType ~emitters ~config ~typeNameIsInterface
   in
   resolvedTypeName |> ResolvedName.toString
   |> EmitType.emitExportType ~config ~emitters ~nameAs ~opaque ~type_
-       ~typeNameIsInterface ~typeVars
+       ~typeNameIsInterface ~typeVars ~docString
 
 let typeNameIsInterface ~(exportTypeMap : CodeItem.exportTypeMap)
     ~(exportTypeMapFromOtherFiles : CodeItem.exportTypeMap) typeName =
@@ -335,7 +336,8 @@ let emitCodeItem ~config ~emitters ~moduleItemsEmitter ~env ~fileName
       | _ -> (type_, None)
     in
 
-    resolvedName |> ExportModule.extendExportModules ~moduleItemsEmitter ~type_;
+    resolvedName
+    |> ExportModule.extendExportModules ~docString ~moduleItemsEmitter ~type_;
     let emitters =
       match hookType with
       | Some {propsType; resolvedTypeName; typeVars} ->
@@ -347,6 +349,7 @@ let emitCodeItem ~config ~emitters ~moduleItemsEmitter ~env ~fileName
              type_ = propsType;
              typeVars;
              resolvedTypeName;
+             docString;
            }
             : CodeItem.exportType)
         in

jscomp/gentype/EmitType.ml

@@ -47,7 +47,7 @@ let typeReactRef ~type_ =
           nameJS = reactRefCurrent;
           optional = Mandatory;
           type_ = Null type_;
-          docString = None;
+          docString = DocString.empty;
         };
       ] )
 
@@ -163,7 +163,7 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface
              type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType)
     in
     let noPayloadsRendered = noPayloads |> List.map labelJSToString in
-    let field ~name ?docString value =
+    let field ~name ?(docString = DocString.empty) value =
       {
         mutable_ = Mutable;
         nameJS = name;
@@ -255,12 +255,11 @@ and renderField ~config ~indent ~typeNameIsInterface ~inFunType
     mutMarker ^ lbl ^ optMarker ^ ": "
     ^ (type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType)
   in
-  match docString with
-  | None -> Indent.break ~indent ^ defStr
-  | Some docString ->
+  if DocString.hasContent docString then
     (* Always print comments on newline before definition. *)
     let indentStr = indent |> Option.value ~default:"" in
-    "\n" ^ indentStr ^ "/**" ^ docString ^ "*/\n" ^ indentStr ^ defStr
+    "\n" ^ indentStr ^ DocString.render docString ^ indentStr ^ defStr
+  else Indent.break ~indent ^ defStr
 
 and renderFields ~config ~indent ~inFunType ~typeNameIsInterface fields =
   let indent1 = indent |> Indent.more in
@@ -312,12 +311,13 @@ let typeToString ~config ~typeNameIsInterface type_ =
 let ofType ~config ~typeNameIsInterface ~type_ s =
   s ^ ": " ^ (type_ |> typeToString ~config ~typeNameIsInterface)
 
-let emitExportConst ~early ?(comment = "") ~config ?(docString = "") ~emitters
-    ~name ~type_ ~typeNameIsInterface line =
+let emitExportConst ~early ?(comment = "") ~config
+    ?(docString = DocString.empty) ~emitters ~name ~type_ ~typeNameIsInterface
+    line =
   (match comment = "" with
   | true -> comment
   | false -> "// " ^ comment ^ "\n")
-  ^ docString ^ "export const "
+  ^ DocString.render docString ^ "export const "
   ^ (name |> ofType ~config ~typeNameIsInterface ~type_)
   ^ " = " ^ line
   |> (match early with
@@ -329,7 +329,8 @@ let emitExportDefault ~emitters name =
   "export default " ^ name ^ ";" |> Emitters.export ~emitters
 
 let emitExportType ~(config : Config.t) ~emitters ~nameAs ~opaque ~type_
-    ~typeNameIsInterface ~typeVars resolvedTypeName =
+    ~typeNameIsInterface ~typeVars ~docString resolvedTypeName =
+  let docString = DocString.render docString in
   let typeParamsString = EmitText.genericsString ~typeVars in
   let isInterface = resolvedTypeName |> typeNameIsInterface in
   let resolvedTypeName =
@@ -357,15 +358,15 @@ let emitExportType ~(config : Config.t) ~emitters ~nameAs ~opaque ~type_
     ^ (match String.capitalize_ascii resolvedTypeName <> resolvedTypeName with
       | true -> "// tslint:disable-next-line:class-name\n"
       | false -> "")
-    ^ "export abstract class " ^ resolvedTypeName ^ typeParamsString
+    ^ docString ^ "export abstract class " ^ resolvedTypeName ^ typeParamsString
     ^ " { protected opaque!: " ^ typeOfOpaqueField
     ^ " }; /* simulate opaque types */" ^ exportNameAs
     |> Emitters.export ~emitters
   else
     (if isInterface && config.exportInterfaces then
-     "export interface " ^ resolvedTypeName ^ typeParamsString ^ " "
+     docString ^ "export interface " ^ resolvedTypeName ^ typeParamsString ^ " "
     else
-      "// tslint:disable-next-line:interface-over-type-literal\n"
+      "// tslint:disable-next-line:interface-over-type-literal\n" ^ docString
       ^ "export type " ^ resolvedTypeName ^ typeParamsString ^ " = ")
     ^ (match type_ with
       | _ -> type_ |> typeToString ~config ~typeNameIsInterface)

jscomp/gentype/ExportModule.ml

@@ -2,18 +2,21 @@ open GenTypeCommon
 
 type exportModuleItem = (string, exportModuleValue) Hashtbl.t
 
-and exportModuleValue = S of string * type_ | M of exportModuleItem
+and exportModuleValue =
+  | S of {name: string; type_: type_; docString: DocString.t}
+  | M of {exportModuleItem: exportModuleItem}
 
 type exportModuleItems = (string, exportModuleItem) Hashtbl.t
 
-type types = {typeForValue: type_; typeForType: type_}
+type types = {typeForValue: type_; typeForType: type_; docString: DocString.t}
 
 type fieldInfo = {fieldForValue: field; fieldForType: field}
 
 let rec exportModuleValueToType ~config exportModuleValue =
   match exportModuleValue with
-  | S (s, type_) -> {typeForValue = ident s; typeForType = type_}
-  | M exportModuleItem ->
+  | S {name; type_; docString} ->
+    {typeForValue = ident name; typeForType = type_; docString}
+  | M {exportModuleItem} ->
     let fieldsInfo = exportModuleItem |> exportModuleItemToFields ~config in
     let fieldsForValue =
       fieldsInfo |> List.map (fun {fieldForValue} -> fieldForValue)
@@ -24,13 +27,14 @@ let rec exportModuleValueToType ~config exportModuleValue =
     {
       typeForValue = Object (Open, fieldsForValue);
       typeForType = Object (Open, fieldsForType);
+      docString = DocString.empty;
     }
 
 and exportModuleItemToFields =
   (fun ~config exportModuleItem ->
      Hashtbl.fold
        (fun fieldName exportModuleValue fields ->
-         let {typeForValue; typeForType} =
+         let {typeForValue; typeForType; docString} =
            exportModuleValue |> exportModuleValueToType ~config
          in
          let fieldForType =
@@ -39,36 +43,38 @@ and exportModuleItemToFields =
              nameJS = fieldName;
              optional = Mandatory;
              type_ = typeForType;
-             docString = None;
+             docString;
            }
          in
          let fieldForValue = {fieldForType with type_ = typeForValue} in
          {fieldForValue; fieldForType} :: fields)
        exportModuleItem []
     : config:Config.t -> exportModuleItem -> fieldInfo list)
 
-let rec extendExportModuleItem x ~(exportModuleItem : exportModuleItem) ~type_
-    ~valueName =
+let rec extendExportModuleItem ~docString x
+    ~(exportModuleItem : exportModuleItem) ~type_ ~valueName =
   match x with
   | [] -> ()
   | [fieldName] ->
-    Hashtbl.replace exportModuleItem fieldName (S (valueName, type_))
+    Hashtbl.replace exportModuleItem fieldName
+      (S {name = valueName; type_; docString})
   | fieldName :: rest ->
     let innerExportModuleItem =
       match Hashtbl.find exportModuleItem fieldName with
-      | M innerExportModuleItem -> innerExportModuleItem
+      | M {exportModuleItem = innerExportModuleItem} -> innerExportModuleItem
       | S _ -> assert false
       | exception Not_found ->
         let innerExportModuleItem = Hashtbl.create 1 in
-        Hashtbl.replace exportModuleItem fieldName (M innerExportModuleItem);
+        Hashtbl.replace exportModuleItem fieldName
+          (M {exportModuleItem = innerExportModuleItem});
         innerExportModuleItem
     in
     rest
-    |> extendExportModuleItem ~exportModuleItem:innerExportModuleItem ~valueName
-         ~type_
+    |> extendExportModuleItem ~docString ~exportModuleItem:innerExportModuleItem
+         ~valueName ~type_
 
-let extendExportModuleItems x ~(exportModuleItems : exportModuleItems) ~type_
-    ~valueName =
+let extendExportModuleItems x ~docString
+    ~(exportModuleItems : exportModuleItems) ~type_ ~valueName =
   match x with
   | [] -> assert false
   | [_valueName] -> ()
@@ -81,7 +87,8 @@ let extendExportModuleItems x ~(exportModuleItems : exportModuleItems) ~type_
         Hashtbl.replace exportModuleItems moduleName exportModuleItem;
         exportModuleItem
     in
-    rest |> extendExportModuleItem ~exportModuleItem ~type_ ~valueName
+    rest
+    |> extendExportModuleItem ~docString ~exportModuleItem ~type_ ~valueName
 
 let createModuleItemsEmitter =
   (fun () -> Hashtbl.create 1 : unit -> exportModuleItems)
@@ -95,22 +102,23 @@ let emitAllModuleItems ~config ~emitters ~fileName
   emitters
   |> rev_fold
        (fun moduleName exportModuleItem emitters ->
-         let {typeForType} =
-           M exportModuleItem |> exportModuleValueToType ~config
+         let {typeForType; docString} =
+           M {exportModuleItem} |> exportModuleValueToType ~config
          in
          if !Debug.codeItems then Log_.item "EmitModule %s @." moduleName;
          let emittedModuleItem =
            ModuleName.forInnerModule ~fileName ~innerModuleName:moduleName
            |> ModuleName.toString
          in
          emittedModuleItem
-         |> EmitType.emitExportConst ~early:false ~config ~emitters
+         |> EmitType.emitExportConst ~docString ~early:false ~config ~emitters
               ~name:moduleName ~type_:typeForType ~typeNameIsInterface:(fun _ ->
                 false))
        exportModuleItems
 
-let extendExportModules ~(moduleItemsEmitter : exportModuleItems) ~type_
-    resolvedName =
+let extendExportModules ~(moduleItemsEmitter : exportModuleItems) ~docString
+    ~type_ resolvedName =
   resolvedName |> ResolvedName.toList
   |> extendExportModuleItems ~exportModuleItems:moduleItemsEmitter ~type_
+       ~docString
        ~valueName:(resolvedName |> ResolvedName.toString)

jscomp/gentype/GenTypeCommon.ml

@@ -2,6 +2,16 @@ module StringMap = Map.Make (String)
 module StringSet = Set.Make (String)
 module Config = GenTypeConfig
 
+module DocString = struct
+  type t = string option
+  let render t =
+    match t with
+    | None | Some "" -> ""
+    | Some docString -> "/** " ^ String.trim docString ^ " */\n"
+  let empty = None
+  let hasContent docString = Option.is_some docString
+end
+
 let logNotImplemented x =
   if !Debug.notImplemented then Log_.item "Not Implemented: %s\n" x
 
@@ -78,7 +88,7 @@ and field = {
   nameJS: string;
   optional: optional;
   type_: type_;
-  docString: string option;
+  docString: DocString.t;
 }
 
 and function_ = {argTypes: argType list; retType: type_; typeVars: string list}

jscomp/gentype/NamedArgs.ml

@@ -19,7 +19,7 @@ let rec groupReversed ~revCurGroup ~revResult labeledTypes =
            nameJS = name;
            optional = Optional;
            type_;
-           docString = None;
+           docString = DocString.empty;
          }
         :: revCurGroup)
       ~revResult tl
@@ -31,7 +31,7 @@ let rec groupReversed ~revCurGroup ~revResult labeledTypes =
            nameJS = name;
            optional = Mandatory;
            type_;
-           docString = None;
+           docString = DocString.empty;
          }
         :: revCurGroup)
       ~revResult tl

jscomp/gentype/TranslateSignature.ml

@@ -15,7 +15,7 @@ let translateSignatureValue ~config ~outputFileRelative ~resolver ~typeEnv
   | id, GenType ->
     id |> Ident.name
     |> Translation.translateValue ~attributes:val_attributes ~config
-         ~docString:(Annotation.getDocString val_attributes)
+         ~docString:(Annotation.docStringFromAttrs val_attributes)
          ~outputFileRelative ~resolver ~typeEnv ~typeExpr
          ~addAnnotationsToFunction
   | _ -> Translation.empty

jscomp/gentype/TranslateSignatureFromTypes.ml

@@ -82,7 +82,7 @@ and translateSignatureItemFromTypes ~config ~outputFileRelative ~resolver
     then
       name
       |> Translation.translateValue ~attributes:val_attributes ~config
-           ~docString:(Annotation.getDocString val_attributes)
+           ~docString:(Annotation.docStringFromAttrs val_attributes)
            ~outputFileRelative ~resolver ~typeEnv ~typeExpr:val_type
            ~addAnnotationsToFunction:(fun t -> t)
     else Translation.empty

jscomp/gentype/TranslateStructure.ml

@@ -101,7 +101,7 @@ let translateValueBinding ~config ~outputFileRelative ~resolver ~typeEnv
     then
       id |> Ident.name
       |> Translation.translateValue ~attributes:vb_attributes ~config
-           ~docString:(Annotation.getDocString vb_attributes)
+           ~docString:(Annotation.docStringFromAttrs vb_attributes)
            ~outputFileRelative ~resolver ~typeEnv ~typeExpr:vb_pat.pat_type
            ~addAnnotationsToFunction:
              (addAnnotationsToFunctionType ~config vb_expr)