Include comment body in tokens

A boring change on its own, but should make it easier to flatten the
trivia structure in the future.

Author: SquidDev

src/core/emit.ml

@@ -291,10 +291,7 @@ let tprintf kind out fmt =
   Format.kfprintf (fun x -> Format.pp_close_stag x ()) out fmt
 
 let trivial out = function
-  | Node.LineComment x -> tprintf Comment out "--%s" x
-  | BlockComment (n, x) ->
-      let eq = String.make n '=' in
-      tprintf Comment out "--[%s[%s]%s]" eq x eq
+  | Node.LineComment x | BlockComment x -> tprintf Comment out "%s" x
   | Whitespace x -> Format.fprintf out "%s" x
 
 let trivial_span out { Span.value; _ } = trivial out value

src/core/node.ml

@@ -7,7 +7,7 @@
     may be useful for understanding or recreating it. *)
 type trivial =
   | LineComment of string  (** A short, comment which is terminated by a newline. *)
-  | BlockComment of int * string  (** A long comment, which may span multiple lines. *)
+  | BlockComment of string  (** A long comment, which may span multiple lines. *)
   | Whitespace of string  (** Any whitespace, such as spaces, newlines or tabs. *)
 [@@deriving show]
 

src/lint/lint_bracket_spacing.ml

@@ -27,7 +27,7 @@ module ActualSpacing = struct
   let rec get t : Node.trivial Span.spanned list -> t = function
     | [] -> t
     | { value = LineComment _; _ } :: _ -> Newline
-    | { value = BlockComment (_, s) | Whitespace s; _ } :: _ when String.contains s '\n' -> Newline
+    | { value = BlockComment s | Whitespace s; _ } :: _ when String.contains s '\n' -> Newline
     | { value = BlockComment _; _ } :: xs -> get t xs
     | { value = Whitespace _; _ } :: xs -> get Space xs
 

src/parser/lexer.mll

@@ -24,10 +24,13 @@
     Buffer.add_char b char;
     b
 
-  let mk_long_comment eqs c = Trivial (BlockComment (eqs, c))
-  let mk_long_string eqs c =
-    let eqs = String.make eqs '=' in
-    Token (String ("[" ^ eqs ^ "[" ^ c ^ "]" ^ eqs ^ "]"))
+  let buffer_with' len str =
+    let b = Buffer.create len in
+    Buffer.add_string b str;
+    b
+
+  let mk_long_comment c = Trivial (BlockComment c)
+  let mk_long_string c = Token (String c)
 }
 
 let white = [' ' '\t']
@@ -44,7 +47,7 @@ rule token l = parse
 | white+ as x           { Trivial (Whitespace x) }
 | '\n'                  { new_line l; Trivial (Whitespace "\n") }
 | '\r' '\n'             { new_line l; Trivial (Whitespace "\r\n") }
-| "--[" ('='* as x) '[' { long_string (Buffer.create 16) (String.length x) mk_long_comment l lexbuf }
+| ("--[" '='* '[') as x { long_string (buffer_with' 16 x) (String.length x - 4) mk_long_comment l lexbuf }
 (* We split line comments into two parts. Otherwise "--[^\n]*" would match "--[[foo]]". *)
 | "--"                  { line_comment lexbuf }
 
@@ -108,7 +111,7 @@ rule token l = parse
 
 | '\"'          { string (buffer_with 17 '\"') '\"' lexbuf }
 | '\''          { string (buffer_with 17 '\'') '\'' lexbuf }
-| '[' ('='* as x) '[' { long_string (Buffer.create 16) (String.length x) mk_long_string l lexbuf }
+| ('[' '='* '[') as x { long_string (buffer_with' 16 x) (String.length x - 2) mk_long_string l lexbuf }
 
 | eof { Token EoF }
 
@@ -155,13 +158,14 @@ and string contents c = parse
 
 and long_string buf eqs term l = parse
 | [^']' '\r' '\n']+ as x { Buffer.add_string buf x;              long_string buf eqs term l lexbuf }
-| ']' '='* ']' as x      { if String.length x == eqs + 2
-                           then term eqs (Buffer.contents buf)
-                           else (Buffer.add_string buf x;        long_string buf eqs term l lexbuf) }
+| ']' '='* ']' as x      { Buffer.add_string buf x;
+                           if String.length x == eqs + 2
+                           then term (Buffer.contents buf)
+                           else long_string buf eqs term l lexbuf }
 | ']'                    { Buffer.add_char buf ']';              long_string buf eqs term l lexbuf }
 | '\n'                   { Buffer.add_char buf '\n'; new_line l; long_string buf eqs term l lexbuf }
 | '\r' '\n'              { Buffer.add_string buf "\r\n"; new_line l; long_string buf eqs term l lexbuf }
 | eof                    { unterminated_string ~eol:false lexbuf }
 
 and line_comment = parse
-| [^'\r' '\n']* as x     { Trivial (LineComment x) }
+| [^'\r' '\n']* as x     { Trivial (LineComment ("--" ^ x)) }

src/semantics/doc_parser.ml

@@ -802,34 +802,45 @@ let rec extract_block line column lines = function
   (* Skip whitespace *)
   | { Span.value = Node.Whitespace _; _ } :: xs -> extract_block line column lines xs
   (* Comments aligned with this one on successive lines are included *)
-  | { Span.value = Node.LineComment value; span } :: xs
+  | { Span.value = Node.LineComment contents; span } :: xs
     when Span.start_line span = line + 1 && Span.start_col span = column ->
       let span = span |> Illuaminate.Lens.(Span.start_offset %= fun p -> p + 2) in
+      let value = CCString.drop 2 contents in
       extract_block (line + 1) column ({ Span.span; value } :: lines) xs
   | xs -> (List.rev lines, (List.hd lines).span, xs)
 
+let get_block_comment_start str =
+  let rec worker str i =
+    match str.[i] with
+    | '=' -> worker str (i + 1)
+    | '[' -> i + 1
+    | _ -> failwith "Invalid block comment"
+  in
+  worker str 3
+
 let extract node =
   (* Extract all comments before this token *)
   let rec extract_comments cs = function
     | [] -> cs
-    | { Span.value = Node.BlockComment (n, c); span } :: xs when String.length c > 0 && c.[0] == '-'
-      ->
-        let documented =
-          split_lines (CCString.drop 1 c)
-            (Illuaminate.Lens.(Span.start_offset %= fun p -> p + n + 5) span)
-          |> Indent.drop_rest |> Lex.lex_of_lines |> Parse.comment span
-        in
-        extract_comments (documented :: cs) xs
-    | { Span.value = Node.LineComment c; span } :: xs
-      when String.length c > 0
-           && c.[0] == '-'
-           &&
+    | { Span.value = Node.BlockComment contents; span } :: xs ->
+        let start = get_block_comment_start contents in
+        if contents.[start] == '-' then
+          let documented =
+            split_lines
+              (String.sub contents (start + 1) (String.length contents - start - (start - 1)))
+              (Illuaminate.Lens.(Span.start_offset %= fun p -> p + start + 1) span)
+            |> Indent.drop_rest |> Lex.lex_of_lines |> Parse.comment span
+          in
+          extract_comments (documented :: cs) xs
+        else extract_comments cs xs
+    | { Span.value = Node.LineComment contents; span } :: xs
+      when String.starts_with ~prefix:"---" contents
            (* Skip comments which start with a line entirely composed of '-'. *)
-           (String.length c = 1 || CCString.exists (fun x -> x <> '-') c) ->
+           && (String.length contents = 3 || CCString.exists (fun x -> x <> '-') contents) ->
         let lines, last, xs =
           extract_block (Span.start_line span) (Span.start_col span)
             [ { span = (span |> Illuaminate.Lens.(Span.start_offset %= fun p -> p + 3));
-                value = CCString.drop 1 c
+                value = CCString.drop 3 contents
               }
             ]
             xs

test/data/parser/pass_multiline_string.out

@@ -3,13 +3,13 @@
       { Syntax.local_local =
         Node.Node {
           leading_trivia =
-          [{ Span.value = (Node.BlockComment (0, " One line "));
+          [{ Span.value = (Node.BlockComment "--[[ One line ]]");
              span = pass_multiline_string.lua[1:1-1:16] };
             { Span.value = (Node.Whitespace "\n");
               span = pass_multiline_string.lua[1:17-1:17] };
             { Span.value = (Node.Whitespace "\n");
               span = pass_multiline_string.lua[2:1-2:1] };
-            { Span.value = (Node.BlockComment (0, "\nMulti-line\n"));
+            { Span.value = (Node.BlockComment "--[[\nMulti-line\n]]");
               span = pass_multiline_string.lua[3:1-5:2] };
             { Span.value = (Node.Whitespace "\n");
               span = pass_multiline_string.lua[5:3-5:3] };

test/data/parser/pass_simple.out

@@ -49,7 +49,7 @@
                   trailing_trivia =
                   [{ Span.value = (Node.Whitespace " ");
                      span = pass_simple.lua[1:28-1:28] };
-                    { Span.value = (Node.LineComment "- @local");
+                    { Span.value = (Node.LineComment "--- @local");
                       span = pass_simple.lua[1:29-1:38] };
                     { Span.value = (Node.Whitespace "\n");
                       span = pass_simple.lua[1:39-1:39] }

test/lexer.ml

@@ -43,7 +43,7 @@ let tests =
                  [| Token (Ident "x");
                     Trivial (Whitespace "\r\n");
                     Token (Ident "y");
-                    Trivial (LineComment "foo");
+                    Trivial (LineComment "--foo");
                     Trivial (Whitespace "\r\n");
                     Token (String "[[x\r\ny]]");
                     Token EoF

test/lint/fragment_linter.ml

@@ -19,9 +19,9 @@ let schema =
   |> Schema.union (Schema.singleton Doc.Extract.Config.key)
 
 let parse_schema : Node.trivial Span.spanned -> _ = function
-  | { value = LineComment c | BlockComment (_, c); _ } ->
-      c
-      |> CCString.drop_while (fun c -> c == '-')
+  | { value = LineComment contents | BlockComment contents; _ } ->
+      contents
+      |> CCString.drop_while (fun c -> c == '-' || c == '[')
       |> String.trim
       |> CCString.chop_prefix ~pre:"config:"
       |> Option.map @@ fun c ->