Add support for doc comments.

src/res_core.ml

@@ -6389,6 +6389,10 @@ and parseAttribute p =
     let attrId = parseAttributeId ~startPos p in
     let payload = parsePayload p in
     Some(attrId, payload)
+  | DocComment (loc, s) -> 
+    Parser.next p;
+    Some ({txt="ns.doc"; loc},
+    PStr [Ast_helper.Str.eval ~loc (Ast_helper.Exp.constant ~loc (Pconst_string(s, None)) )])
   | _ -> None
 
 and parseAttributes p =

src/res_parser.ml

@@ -26,105 +26,117 @@ type t = {
 
 let err ?startPos ?endPos p error =
   match p.regions with
-  | {contents = Report} as region::_ ->
+  | ({contents = Report} as region) :: _ ->
     let d =
       Diagnostics.make
-        ~startPos:(match startPos with | Some pos -> pos | None -> p.startPos)
-        ~endPos:(match endPos with | Some pos -> pos | None -> p.endPos)
+        ~startPos:
+          (match startPos with
+          | Some pos -> pos
+          | None -> p.startPos)
+        ~endPos:
+          (match endPos with
+          | Some pos -> pos
+          | None -> p.endPos)
         error
-    in (
-      p.diagnostics <- d::p.diagnostics;
-      region := Silent
-    )
+    in
+    p.diagnostics <- d :: p.diagnostics;
+    region := Silent
   | _ -> ()
 
-let beginRegion p =
-  p.regions <- ref Report :: p.regions
+let beginRegion p = p.regions <- ref Report :: p.regions
 let endRegion p =
   match p.regions with
   | [] -> ()
-  | _::rest -> p.regions <- rest
+  | _ :: rest -> p.regions <- rest
+
+let docCommentToAttributeToken comment =
+  let txt = Comment.txt comment in
+  let loc = Comment.loc comment in
+  Token.DocComment (loc, txt)
 
 (* Advance to the next non-comment token and store any encountered comment
-* in the parser's state. Every comment contains the end position of its
-* previous token to facilite comment interleaving *)
+   * in the parser's state. Every comment contains the end position of its
+   * previous token to facilite comment interleaving *)
 let rec next ?prevEndPos p =
- if p.token = Eof then assert false;
- let prevEndPos = match prevEndPos with Some pos -> pos | None -> p.endPos in
- let (startPos, endPos, token) = Scanner.scan p.scanner in
- match token with
- | Comment c ->
-   Comment.setPrevTokEndPos c p.endPos;
-   p.comments <- c::p.comments;
-   p.prevEndPos <- p.endPos;
-   p.endPos <- endPos;
-   next ~prevEndPos p
- | _ ->
-   p.token <- token;
-   (* p.prevEndPos <- prevEndPos; *)
-   p.prevEndPos <- prevEndPos;
-   p.startPos <- startPos;
-   p.endPos <- endPos
-
-let nextUnsafe p =
-  if p.token <> Eof then next p
+  if p.token = Eof then assert false;
+  let prevEndPos =
+    match prevEndPos with
+    | Some pos -> pos
+    | None -> p.endPos
+  in
+  let startPos, endPos, token = Scanner.scan p.scanner in
+  match token with
+  | Comment c ->
+    if Comment.isDocComment c then (
+      p.token <- docCommentToAttributeToken c;
+      p.prevEndPos <- prevEndPos;
+      p.startPos <- startPos;
+      p.endPos <- endPos)
+    else (
+      Comment.setPrevTokEndPos c p.endPos;
+      p.comments <- c :: p.comments;
+      p.prevEndPos <- p.endPos;
+      p.endPos <- endPos;
+      next ~prevEndPos p)
+  | _ ->
+    p.token <- token;
+    p.prevEndPos <- prevEndPos;
+    p.startPos <- startPos;
+    p.endPos <- endPos
+
+let nextUnsafe p = if p.token <> Eof then next p
 
 let nextTemplateLiteralToken p =
-  let (startPos, endPos, token) = Scanner.scanTemplateLiteralToken p.scanner in
+  let startPos, endPos, token = Scanner.scanTemplateLiteralToken p.scanner in
   p.token <- token;
   p.prevEndPos <- p.endPos;
   p.startPos <- startPos;
   p.endPos <- endPos
 
 let checkProgress ~prevEndPos ~result p =
-  if p.endPos == prevEndPos
-  then None
-  else Some result
+  if p.endPos == prevEndPos then None else Some result
 
-let make ?(mode=ParseForTypeChecker) src filename =
+let make ?(mode = ParseForTypeChecker) src filename =
   let scanner = Scanner.make ~filename src in
-  let parserState = {
-    mode;
-    scanner;
-    token = Token.Semicolon;
-    startPos = Lexing.dummy_pos;
-    prevEndPos = Lexing.dummy_pos;
-    endPos = Lexing.dummy_pos;
-    breadcrumbs = [];
-    errors = [];
-    diagnostics = [];
-    comments = [];
-    regions = [ref Report];
-  } in
-  parserState.scanner.err <- (fun ~startPos ~endPos error ->
-    let diagnostic = Diagnostics.make
-      ~startPos
-      ~endPos
-      error
-    in
-    parserState.diagnostics <- diagnostic::parserState.diagnostics
-  );
+  let parserState =
+    {
+      mode;
+      scanner;
+      token = Token.Semicolon;
+      startPos = Lexing.dummy_pos;
+      prevEndPos = Lexing.dummy_pos;
+      endPos = Lexing.dummy_pos;
+      breadcrumbs = [];
+      errors = [];
+      diagnostics = [];
+      comments = [];
+      regions = [ref Report];
+    }
+  in
+  parserState.scanner.err <-
+    (fun ~startPos ~endPos error ->
+      let diagnostic = Diagnostics.make ~startPos ~endPos error in
+      parserState.diagnostics <- diagnostic :: parserState.diagnostics);
   next parserState;
   parserState
 
 let leaveBreadcrumb p circumstance =
   let crumb = (circumstance, p.startPos) in
-  p.breadcrumbs <- crumb::p.breadcrumbs
+  p.breadcrumbs <- crumb :: p.breadcrumbs
 
 let eatBreadcrumb p =
   match p.breadcrumbs with
   | [] -> ()
-  | _::crumbs -> p.breadcrumbs <- crumbs
+  | _ :: crumbs -> p.breadcrumbs <- crumbs
 
 let optional p token =
   if p.token = token then
-    let () = next p in true
-  else
-    false
+    let () = next p in
+    true
+  else false
 
 let expect ?grammar token p =
-  if p.token = token then
-    next p
+  if p.token = token then next p
   else
     let error = Diagnostics.expected ?grammar p.prevEndPos token in
     err ~startPos:p.prevEndPos p error

src/res_printer.ml

@@ -99,7 +99,7 @@ let hasCommentBelow tbl loc =
   | [] -> false
   | exception Not_found -> false
 
-let printMultilineCommentContent ~docComment txt =
+let printMultilineCommentContent txt =
   (* Turns
    *         |* first line
    *  * second line
@@ -139,11 +139,7 @@ let printMultilineCommentContent ~docComment txt =
   | [] -> Doc.text "/* */"
   | [line] ->
     Doc.concat
-      [
-        Doc.text (if docComment then "/*" else "/* ");
-        Doc.text (Comment.trimSpaces line);
-        Doc.text " */";
-      ]
+      [Doc.text "/* "; Doc.text (Comment.trimSpaces line); Doc.text " */"]
   | first :: rest ->
     let firstLine = Comment.trimSpaces first in
     Doc.concat
@@ -158,11 +154,10 @@ let printMultilineCommentContent ~docComment txt =
 
 let printTrailingComment (prevLoc : Location.t) (nodeLoc : Location.t) comment =
   let singleLine = Comment.isSingleLineComment comment in
-  let docComment = Comment.isDocComment comment in
   let content =
     let txt = Comment.txt comment in
     if singleLine then Doc.text ("//" ^ txt)
-    else printMultilineCommentContent ~docComment txt
+    else printMultilineCommentContent txt
   in
   let diff =
     let cmtStart = (Comment.loc comment).loc_start in
@@ -188,11 +183,10 @@ let printTrailingComment (prevLoc : Location.t) (nodeLoc : Location.t) comment =
 
 let printLeadingComment ?nextComment comment =
   let singleLine = Comment.isSingleLineComment comment in
-  let docComment = Comment.isDocComment comment in
   let content =
     let txt = Comment.txt comment in
     if singleLine then Doc.text ("//" ^ txt)
-    else printMultilineCommentContent ~docComment txt
+    else printMultilineCommentContent txt
   in
   let separator =
     Doc.concat
@@ -4769,13 +4763,10 @@ and printAttribute ?(standalone = false) ((id, payload) : Parsetree.attribute)
         [
           {
             pstr_desc =
-              Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (s, _))}, _);
+              Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (txt, _))}, _);
           };
         ] ) ->
-    let comment =
-      Comment.makeMultiLineComment ~loc:id.loc ~docComment:true ("*" ^ s)
-    in
-    printLeadingComment comment
+    Doc.concat [Doc.text "/**"; Doc.text txt; Doc.text "*/"]
   | _ ->
     Doc.group
       (Doc.concat

src/res_scanner.ml

@@ -480,12 +480,12 @@ let scanSingleLineComment scanner =
 
 let scanMultiLineComment scanner =
   (* assumption: we're only ever using this helper in `scan` after detecting a comment *)
-  let contentStartOff = scanner.offset + 2 in
-  let startPos = position scanner in
   let docComment =
     peek2 scanner = '*' &&
     peek3 scanner <> '/' (* no /**/ *) &&
     peek3 scanner <> '*' (* no /*** *) in
+  let contentStartOff = scanner.offset + (if docComment then 3 else 2) in
+  let startPos = position scanner in
   let rec scan ~depth =
     (* invariant: depth > 0 right after this match. See assumption *)
     match scanner.ch, peek scanner with

src/res_token.ml

@@ -71,6 +71,7 @@ type t =
   | Try
   | Import
   | Export
+  | DocComment of Location.t * string
 
 let precedence = function
   | HashEqual | ColonEqual -> 1
@@ -158,6 +159,7 @@ let toString = function
   | Try -> "try"
   | Import -> "import"
   | Export -> "export"
+  | DocComment (_loc, s) -> "DocComment " ^ s
 
 let keywordTable = function
 | "and" -> And

tests/idempotency/napkinscript/docComments.res

@@ -0,0 +1,11 @@
+/** This is a doc ✅ comment */
+let z = 34
+
+@ns.doc("And this is a ns.doc ✅ annotation")
+let q = 11
+
+/** This
+  * is a multi-line
+  multiline doc comment
+  */
+type h = int

tests/parsing/other/docComments.res

@@ -0,0 +1,11 @@
+/** This is a doc ✅ comment */
+let z = 34
+
+@ns.doc("And this is a ns.doc ✅ annotation")
+let q = 11
+
+/** This
+  * is a multi-line
+  multiline doc comment
+  */
+type h = int

tests/parsing/other/expected/docComments.res.txt

@@ -0,0 +1,4 @@
+let z = 34[@@ns.doc " This is a doc \226\156\133 comment "]
+let q = 11[@@ns.doc {js|And this is a ns.doc ✅ annotation|js}]
+type nonrec h = int[@@ns.doc
+                     " This\n  * is a multi-line\n  multiline doc comment\n  "]

tests/printer/comments/docComments.res

@@ -0,0 +1,11 @@
+/** This is a doc ✅ comment */
+let z = 34
+
+@ns.doc("And this is a ns.doc ✅ annotation")
+let q = 11
+
+/** This
+  * is a multi-line
+  multiline doc comment
+  */
+type h = int

tests/printer/comments/expected/docComments.res.txt

@@ -1,9 +1,11 @@
-/**This is one */ /**And this is another one */
-let x = 42
+/** This is a doc ✅ comment */
+let z = 34
 
-/*  */ // But this is not
+/**And this is a ns.doc ✅ annotation*/
+let q = 11
 
-/* **This is also not a doc comment */
-
-/**Great Type */
-type myType = int
+/** This
+  * is a multi-line
+  multiline doc comment
+  */
+type h = int

tests/printer/comments/expected/multiline.res.txt

@@ -17,7 +17,7 @@ let f = () => ()
 /*  */
 /*  */
 
-/**
+/*
  * test
  */
 

tests/printer/comments/expected/structure4.res.txt

@@ -4,10 +4,10 @@ let user = {
 }
 
 /* A comment */
-/**
+/*
  * A type that can be written to a buffer.
  */
-/**
+/*
  * Describes the connection status of a ReactiveSocket/DuplexConnection.
  * - NOT_CONNECTED: no connection established or pending.
  * - CONNECTING: when `connect()` has been called but a connection is not yet
@@ -16,10 +16,10 @@ let user = {
  * - CLOSED: when the connection has been explicitly closed via `close()`.
  * - ERROR: when the connection has been closed for any other reason.
  */
-/**
+/*
  * A contract providing different interaction models per the [ReactiveSocket protocol]
  * (https://github.com/ReactiveSocket/reactivesocket/blob/master/Protocol.md).
  */
-/**
+/*
  * A single unit of data exchanged between the peers of a `ReactiveSocket`.
  */