feat(graindoc): Allow doc comments on variants and record fields (#1852)

compiler/graindoc/docblock.re

@@ -30,6 +30,23 @@ type throw = {
 
 type example = {example_txt: string};
 
+type record_field_info = {
+  field_name: string,
+  field_description: option(string),
+  field_type: Types.type_expr,
+};
+
+type variant_info = {
+  variant_str: string,
+  variant_description: option(string),
+  variant_record_fields: option(list(record_field_info)),
+};
+
+type compound_type_descrs =
+  | RecordFields(list(record_field_info))
+  | Variants(list(variant_info))
+  | NonCompound;
+
 type t =
   | Type({
       module_namespace: option(string),
@@ -40,6 +57,7 @@ type t =
       since: option(since),
       history: list(history),
       examples: list(example),
+      compound_type_descrs,
     })
   | Value({
       module_namespace: option(string),
@@ -219,6 +237,63 @@ let output_for_throws = throws => {
   |> String.concat("");
 };
 
+let has_any_record_field_descrs = fields =>
+  List.exists(f => Option.is_some(f.field_description), fields);
+
+let output_for_record_fields = (buf, fields) =>
+  if (has_any_record_field_descrs(fields)) {
+    Buffer.add_string(buf, Markdown.paragraph("Fields:"));
+    Buffer.add_string(
+      buf,
+      Markdown.table(
+        ~headers=["name", "type", "description"],
+        List.map(
+          rf => {
+            [
+              Markdown.code(rf.field_name),
+              Markdown.code(Printtyp.string_of_type_sch(rf.field_type)),
+              Option.value(rf.field_description, ~default=""),
+            ]
+          },
+          fields,
+        ),
+      ),
+    );
+  };
+
+let variant_has_desc = variant =>
+  Option.is_some(variant.variant_description)
+  // Should also pass through inline record variants that do not have
+  // descriptions themselves but have descriptions for some of their fields
+  || Option.map(has_any_record_field_descrs, variant.variant_record_fields)
+  == Some(true);
+
+let has_any_variant_descrs = variants =>
+  List.exists(variant_has_desc, variants);
+
+let output_for_variants = (buf, variants) =>
+  if (has_any_variant_descrs(variants)) {
+    Buffer.add_string(buf, Markdown.paragraph("Variants:"));
+    List.iter(
+      variant => {
+        if (variant_has_desc(variant)) {
+          Buffer.add_string(buf, Markdown.code_block(variant.variant_str));
+        };
+
+        Option.iter(
+          desc => Buffer.add_string(buf, Markdown.paragraph(desc)),
+          variant.variant_description,
+        );
+
+        Option.iter(
+          rfs => output_for_record_fields(buf, rfs),
+          variant.variant_record_fields,
+        );
+      },
+      variants,
+    );
+  };
+
 let types_for_function = (~ident, vd: Types.value_description) => {
   switch (Ctype.repr(vd.val_type).desc) {
   | TTyArrow(args, returns, _) => (Some(args), Some(returns))
@@ -263,14 +338,31 @@ let get_comments_from_loc = (loc: Grain_parsing.Location.t) => {
   Comments.to_ordered(comments);
 };
 
+let attr_name = attr => {
+  Comment_attributes.(
+    switch (attr) {
+    | Deprecated(_) => "deprecated"
+    | Since(_) => "since"
+    | History(_) => "history"
+    | Param(_) => "param"
+    | Returns(_) => "returns"
+    | Throws(_) => "throws"
+    | Example(_) => "example"
+    }
+  );
+};
+
 let for_value_description =
     (~module_namespace, ~ident: Ident.t, vd: Types.value_description) => {
   let loc = vd.val_loc;
   let comments = get_comments_from_loc(loc);
   let name = Format.asprintf("%a", Printtyp.ident, ident);
   let type_sig = Printtyp.string_of_value_description(~ident, vd);
   let comment =
-    Comments.Doc.ending_on(~lnum=loc.loc_start.pos_lnum - 1, comments);
+    Comments.Doc.ending_on_including_attribute(
+      ~lnum=loc.loc_start.pos_lnum - 1,
+      comments,
+    );
 
   let (description, attributes) =
     switch (comment) {
@@ -420,7 +512,62 @@ let for_type_declaration =
   let name = Format.asprintf("%a", Printtyp.ident, ident);
   let type_sig = Printtyp.string_of_type_declaration(~ident, td);
   let comment =
-    Comments.Doc.ending_on(~lnum=loc.loc_start.pos_lnum - 1, comments);
+    Comments.Doc.ending_on_including_attribute(
+      ~lnum=loc.loc_start.pos_lnum - 1,
+      comments,
+    );
+
+  let extract_compound_type_descrs = (datas, mk_type_descr) => {
+    List.map(
+      ((data, loc: Warnings.loc, id)) => {
+        let comment =
+          Comments.Doc.ending_on(~lnum=loc.loc_start.pos_lnum - 1, comments);
+        switch (comment) {
+        | Some((_, _, [attr, ..._])) =>
+          raise(
+            InvalidAttribute({
+              name: Format.asprintf("%a", Printtyp.ident, id),
+              attr: attr_name(attr),
+            }),
+          )
+        | Some((_, description, [])) => mk_type_descr(data, description)
+        | _ => mk_type_descr(data, None)
+        };
+      },
+      datas,
+    );
+  };
+
+  let extract_record_descrs = rfs =>
+    extract_compound_type_descrs(
+      List.map(rf => (rf, rf.Types.rf_loc, rf.rf_name), rfs), (rf, desc) =>
+      {
+        field_name: rf.rf_name.name,
+        field_description: desc,
+        field_type: rf.rf_type,
+      }
+    );
+
+  let extract_variant_descrs = cds =>
+    extract_compound_type_descrs(
+      List.map(cd => (cd, cd.Types.cd_loc, cd.cd_id), cds), (cd, desc) =>
+      {
+        variant_str: Printtyp.string_of_constructor(cd),
+        variant_description: desc,
+        variant_record_fields:
+          switch (cd.cd_args) {
+          | TConstrRecord(rfs) => Some(extract_record_descrs(rfs))
+          | _ => None
+          },
+      }
+    );
+
+  let compound_type_descrs =
+    switch (td.type_kind) {
+    | TDataVariant(cds) => Variants(extract_variant_descrs(cds))
+    | TDataRecord(rfs) => RecordFields(extract_record_descrs(rfs))
+    | _ => NonCompound
+    };
 
   let (description, attributes) =
     switch (comment) {
@@ -454,12 +601,10 @@ let for_type_declaration =
             [{history_version, history_msg}, ...history],
             examples,
           )
-        | Param({attr_id: param_id, attr_desc: param_msg}) =>
-          raise(InvalidAttribute({name, attr: "param"}))
-        | Returns({attr_desc: returns_msg}) =>
-          raise(InvalidAttribute({name, attr: "returns"}))
-        | Throws({attr_type: throw_type, attr_desc: throw_msg}) =>
-          raise(InvalidAttribute({name, attr: "throws"}))
+        | Param(_)
+        | Returns(_)
+        | Throws(_) =>
+          raise(InvalidAttribute({name, attr: attr_name(attr)}))
         | Example({attr_desc}) => (
             deprecations,
             since,
@@ -482,6 +627,7 @@ let for_type_declaration =
     since,
     history: List.rev(history),
     examples: List.rev(examples),
+    compound_type_descrs,
   });
 };
 
@@ -549,7 +695,10 @@ and for_signature_items =
     ) => {
   let comments = get_comments_from_loc(loc);
   let comment =
-    Comments.Doc.ending_on(~lnum=loc.loc_start.pos_lnum - 1, comments);
+    Comments.Doc.ending_on_including_attribute(
+      ~lnum=loc.loc_start.pos_lnum - 1,
+      comments,
+    );
 
   let (description, attributes) =
     switch (comment) {
@@ -583,12 +732,10 @@ and for_signature_items =
             [{history_version, history_msg}, ...history],
             examples,
           )
-        | Param({attr_id: param_id, attr_desc: param_msg}) =>
-          raise(InvalidAttribute({name, attr: "param"}))
-        | Returns({attr_desc: returns_msg}) =>
-          raise(InvalidAttribute({name, attr: "returns"}))
-        | Throws({attr_type: throw_type, attr_desc: throw_msg}) =>
-          raise(InvalidAttribute({name, attr: "throws"}))
+        | Param(_)
+        | Returns(_)
+        | Throws(_) =>
+          raise(InvalidAttribute({name, attr: attr_name(attr)}))
         | Example({attr_desc}) => (
             deprecations,
             since,
@@ -728,6 +875,19 @@ let rec to_markdown = (~current_version, ~heading_level, docblock) => {
     Buffer.add_string(buf, Markdown.paragraph(desc))
   };
 
+  switch (docblock) {
+  | Value(_)
+  | Module(_)
+  | Type({
+      compound_type_descrs: Variants([]) | RecordFields([]) | NonCompound,
+    }) =>
+    ()
+  | Type({compound_type_descrs: Variants(variants)}) =>
+    output_for_variants(buf, variants)
+  | Type({compound_type_descrs: RecordFields(fields)}) =>
+    output_for_record_fields(buf, fields)
+  };
+
   switch (docblock) {
   | Type(_)
   | Value({params: []})

compiler/src/diagnostics/comments.re

@@ -239,6 +239,14 @@ module Doc = {
   };
 
   let ending_on = (~lnum, module C: OrderedComments) => {
+    let data = C.find_ending_on_lnum(lnum);
+    switch (data) {
+    | Some((Doc({cmt_content}), _, _)) => data
+    | _ => None
+    };
+  };
+
+  let ending_on_including_attribute = (~lnum, module C: OrderedComments) => {
     let rec ending_on_lnum_help = (lnum, check_prev) => {
       let data = C.find_ending_on_lnum(lnum);
       switch (data) {

compiler/src/typed/oprint.re

@@ -846,6 +846,7 @@ and print_out_extension_constructor = (ppf, ext) => {
 let _ = out_module_type := print_out_module_type;
 let _ = out_signature := print_out_signature;
 let _ = out_sig_item := print_out_sig_item;
+let _ = out_constr := print_out_constr;
 
 /* Phrases */
 

compiler/src/typed/printtyp.re

@@ -986,6 +986,15 @@ let constructor_arguments = (ppf, a) => {
   Oprint.out_type^(ppf, Otyp_tuple(tys));
 };
 
+let constructor = (ppf, cstr) =>
+  Oprint.out_constr^(ppf, tree_of_constructor(cstr));
+
+let string_of_constructor = cstr => {
+  let str = asprintf("%a", constructor, cstr);
+  // Hacky workaround to avoid having to make invasive changes in Oprint
+  Str.global_replace(Str.regexp("^  "), "", str);
+};
+
 /* Print an extension declaration */
 
 let tree_of_extension_constructor = (id, ext, es) => {

compiler/src/typed/printtyp.rei

@@ -56,6 +56,7 @@ let tree_of_type_declaration:
   (Ident.t, type_declaration, rec_status) => out_sig_item;
 let type_declaration: (Ident.t, formatter, type_declaration) => unit;
 let string_of_type_declaration: (~ident: Ident.t, type_declaration) => string;
+let string_of_constructor: constructor_declaration => string;
 let extension_constructor: (Ident.t, formatter, extension_constructor) => unit;
 let string_of_extension_constructor:
   (~ident: Ident.t, extension_constructor) => string;

compiler/src/utils/markdown.re

@@ -20,6 +20,15 @@ let table = (~headers: list(string), rows) => {
   let all_match = List.for_all(row => List.length(row) == header_len, rows);
   if (all_match) {
     let header = String.concat("|", headers);
+    let rows =
+      List.map(
+        row =>
+          List.map(
+            cell => Str.global_replace(Str.regexp("\n"), "<br/>", cell),
+            row,
+          ),
+        rows,
+      );
     let separator =
       String.concat(
         "|",