Merge branch 'master' into react-ppx

Author: jchavarri

README.md

@@ -1,6 +1,6 @@
 # ReScript Syntax ![Tests](https://github.com/rescript-lang/syntax/workflows/CI/badge.svg)
 
-Blog post: https://reasonml.org/blog/bucklescript-8-1-new-syntax
+Blog post: https://rescript-lang.org/blog/bucklescript-8-1-new-syntax
 
 Documentation: https://rescript-lang.org/docs/manual/latest/overview
 

src/res_cli.ml

@@ -237,13 +237,11 @@ module CliArgProcessor = struct
           backend.stringOfDiagnostics
             ~source:parseResult.source
             ~filename:parseResult.filename
-            parseResult.diagnostics;
-          if react then
-            exit 1
-          else if recover then
+            parseResult.diagnostics; 
+          if recover then
             printEngine.printInterface
               ~width ~filename ~comments:parseResult.comments parseResult.parsetree
-          else ()
+          else exit 1
         end
         else
           let parsetree =
@@ -258,12 +256,10 @@ module CliArgProcessor = struct
             ~source:parseResult.source
             ~filename:parseResult.filename
             parseResult.diagnostics;
-          if react then
-            exit 1
-          else if recover then
+          if recover then
             printEngine.printImplementation
               ~width ~filename ~comments:parseResult.comments parseResult.parsetree
-          else ()
+          else exit 1
         end
         else
           let parsetree =

src/res_comments_table.ml

@@ -85,6 +85,7 @@ let log t =
     ]
   ) |> Doc.toString ~width:80 |> print_endline
   [@@live]
+
 let attach tbl loc comments =
   match comments with
   | [] -> ()
@@ -776,6 +777,12 @@ let rec walkStructure s t comments =
         partitionLeadingTrailing comments longident.loc in
       attach t.leading longident.loc leading;
       attach t.trailing longident.loc trailing;
+    | Pexp_let (
+        _recFlag,
+        valueBindings,
+        {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None)}
+      ) ->
+      walkValueBindings valueBindings t comments
     | Pexp_let (_recFlag, valueBindings, expr2) ->
       let comments = visitListButContinueWithRemainingComments
         ~getLoc:(fun n ->
@@ -1423,6 +1430,8 @@ and walkExprArgument (_argLabel, expr) t comments =
       let (before, after) = partitionLeadingTrailing comments longident.loc in
       attach t.leading longident.loc before;
       attach t.trailing longident.loc after
+    | Pmod_structure [] ->
+      attach t.inside modExpr.pmod_loc comments
     | Pmod_structure structure ->
       walkStructure structure t comments
     | Pmod_extension extension ->
@@ -1516,6 +1525,8 @@ and walkExprArgument (_argLabel, expr) t comments =
       let (leading, trailing) = partitionLeadingTrailing comments longident.loc in
       attach t.leading longident.loc leading;
       attach t.trailing longident.loc trailing;
+    | Pmty_signature [] ->
+      attach t.inside modType.pmty_loc comments
     | Pmty_signature signature ->
       walkSignature signature t comments
     | Pmty_extension extension ->

src/res_core.ml

@@ -618,7 +618,7 @@ let verifyJsxOpeningClosingName p nameExpr =
   let closing = match p.Parser.token with
   | Lident lident -> Parser.next p; Longident.Lident lident
   | Uident _ ->
-    (parseModuleLongIdent ~lowercase:false p).txt
+    (parseModuleLongIdent ~lowercase:true p).txt
   | _ -> Longident.Lident ""
   in
   match nameExpr.Parsetree.pexp_desc with
@@ -2422,7 +2422,7 @@ and parseJsxName p =
     let loc = mkLoc identStart identEnd in
     Location.mkloc (Longident.Lident ident) loc
   | Uident _ ->
-    let longident = parseModuleLongIdent ~lowercase:false p in
+    let longident = parseModuleLongIdent ~lowercase:true p in
     Location.mkloc (Longident.Ldot (longident.txt, "createElement")) longident.loc
   | _ ->
     let msg = "A jsx name should start with a lowercase or uppercase identifier, like: div in <div /> or Navbar in <Navbar />"

src/res_diagnostics.ml

@@ -72,10 +72,10 @@ let explain t =
     end
   | Expected {context; token = t} ->
     let hint = match context with
-    | Some grammar -> "It signals the start of " ^ (Grammar.toString grammar)
+    | Some grammar -> " It signals the start of " ^ (Grammar.toString grammar)
     | None -> ""
     in
-    "Did you forget a `" ^ (Token.toString t) ^ "` here? " ^ hint
+    "Did you forget a `" ^ (Token.toString t) ^ "` here?" ^ hint
   | Unexpected {token = t; context = breadcrumbs} ->
     let name = (Token.toString t) in
     begin match breadcrumbs with
@@ -142,15 +142,24 @@ let make ~startPos ~endPos category = {
 }
 
 let printReport diagnostics src =
+  let rec print diagnostics src =
+    match diagnostics with
+    | [] -> ()
+    | d::rest ->
+      Res_diagnostics_printing_utils.Super_location.super_error_reporter
+        Format.err_formatter
+        ~src
+        ~startPos:d.startPos
+        ~endPos:d.endPos
+        ~msg:(explain d);
+      begin match rest with
+      | [] -> ()
+      | _ -> Format.fprintf Format.err_formatter "@."
+      end;
+      print rest src
+  in
   Format.fprintf Format.err_formatter "@[<v>";
-  List.rev diagnostics |> List.iter (fun d -> 
-    Res_diagnostics_printing_utils.Super_location.super_error_reporter
-      Format.err_formatter
-      ~src
-      ~startPos:d.startPos
-      ~endPos:d.endPos
-      ~msg:(explain d)
-  );
+  print (List.rev diagnostics) src;
   Format.fprintf Format.err_formatter "@]@."
 
 let unexpected token context =

src/res_diagnostics_printing_utils.ml

@@ -176,11 +176,11 @@ let print_loc ~normalizedRange ppf (startPos: Lexing.position) =
     | Some ((start_line, start_line_start_char), (end_line, end_line_end_char)) ->
       if start_line = end_line then
         if start_line_start_char = end_line_end_char then
-          fprintf ppf " @{<dim>%i:%i@}" start_line start_line_start_char
+          fprintf ppf ":@{<dim>%i:%i@}" start_line start_line_start_char
         else
-          fprintf ppf " @{<dim>%i:%i-%i@}" start_line start_line_start_char end_line_end_char
+          fprintf ppf ":@{<dim>%i:%i-%i@}" start_line start_line_start_char end_line_end_char
       else
-        fprintf ppf " @{<dim>%i:%i-%i:%i@}" start_line start_line_start_char end_line end_line_end_char
+        fprintf ppf ":@{<dim>%i:%i-%i:%i@}" start_line start_line_start_char end_line end_line_end_char
   in
   fprintf ppf "@{<filename>%a@}%a" Location.print_filename startPos.pos_fname dim_loc normalizedRange
 ;;

src/res_doc.ml

@@ -209,10 +209,6 @@ let toString ~width doc =
       end
   in
   process ~pos:0 [] [0, Flat, doc];
-
-  let len = MiniBuffer.length buffer in
-  if len > 0 && MiniBuffer.unsafe_get buffer (len - 1) != '\n' then
-    MiniBuffer.add_char buffer '\n';
   MiniBuffer.contents buffer
 
 

src/res_minibuffer.ml

@@ -11,11 +11,6 @@ let create n =
 
 let contents b = Bytes.sub_string b.buffer 0 b.position
 
-let unsafe_get b ofs =
-  Bytes.unsafe_get b.buffer ofs
-
-let length b = b.position
-
 (* Can't be called directly, don't add to the interface *)
 let resize_internal b more =
   let len = b.length in
@@ -52,4 +47,4 @@ let flush_newline b =
     position := !position - 1;
   done;
   b.position <- !position;
-  add_char b '\n'
+  add_char b '\n'

src/res_minibuffer.mli

@@ -1,8 +1,5 @@
 type t
-val add_char : t -> char -> unit
 val add_string : t -> string -> unit
 val contents : t -> string
 val create : int -> t
 val flush_newline : t -> unit
-val length : t -> int
-val unsafe_get : t -> int -> char

src/res_printer.ml

@@ -90,7 +90,7 @@ let printMultilineCommentContent txt =
       Doc.text "*/";
     ]
 
-let printTrailingComment (nodeLoc : Location.t) comment =
+let printTrailingComment (prevLoc: Location.t) (nodeLoc : Location.t) comment =
   let singleLine = Comment.isSingleLineComment comment in
   let content =
     let txt = Comment.txt comment in
@@ -101,8 +101,7 @@ let printTrailingComment (nodeLoc : Location.t) comment =
   in
   let diff =
     let cmtStart = (Comment.loc comment).loc_start in
-    let prevTokEndPos = Comment.prevTokEndPos comment in
-    cmtStart.pos_lnum - prevTokEndPos.pos_lnum
+    cmtStart.pos_lnum - prevLoc.loc_end.pos_lnum
   in
   let isBelow =
     (Comment.loc comment).loc_start.pos_lnum > nodeLoc.loc_end.pos_lnum in
@@ -224,12 +223,12 @@ let printLeadingComments node tbl loc =
     loop [] comments
 
 let printTrailingComments node tbl loc =
-  let rec loop acc comments =
+  let rec loop prev acc comments =
     match comments with
     | [] -> Doc.concat (List.rev acc)
     | comment::comments ->
-      let cmtDoc = printTrailingComment loc comment in
-      loop (cmtDoc::acc) comments
+      let cmtDoc = printTrailingComment prev loc comment in
+      loop (Comment.loc comment) (cmtDoc::acc) comments
   in
   match Hashtbl.find tbl loc with
   | exception Not_found -> node
@@ -238,7 +237,7 @@ let printTrailingComments node tbl loc =
    (* Remove comments from tbl: Some ast nodes have the same location.
     * We only want to print comments once *)
     Hashtbl.remove tbl loc;
-    let cmtsDoc = loop [] comments in
+    let cmtsDoc = loop loc [] comments in
     Doc.concat [
       node;
       cmtsDoc;
@@ -583,6 +582,23 @@ and printModType modType cmtTbl =
       printAttributes ~loc:longident.loc modType.pmty_attributes cmtTbl;
       printLongidentLocation longident cmtTbl
     ]
+  | Pmty_signature [] ->
+    let shouldBreak =
+      modType.pmty_loc.loc_start.pos_lnum < modType.pmty_loc.loc_end.pos_lnum
+    in
+    Doc.breakableGroup ~forceBreak:shouldBreak (
+      Doc.concat [
+        Doc.lbrace;
+        Doc.indent (
+          Doc.concat [
+            Doc.softLine;
+            printCommentsInside cmtTbl modType.pmty_loc;
+          ];
+        );
+        Doc.softLine;
+        Doc.rbrace;
+      ]
+    )
   | Pmty_signature signature ->
     let signatureDoc = Doc.breakableGroup ~forceBreak:true (
       Doc.concat [
@@ -4678,6 +4694,23 @@ and printModExpr modExpr cmtTbl =
   let doc = match modExpr.pmod_desc with
   | Pmod_ident longidentLoc ->
     printLongidentLocation longidentLoc cmtTbl
+  | Pmod_structure [] ->
+    let shouldBreak =
+      modExpr.pmod_loc.loc_start.pos_lnum < modExpr.pmod_loc.loc_end.pos_lnum
+    in
+    Doc.breakableGroup ~forceBreak:shouldBreak (
+      Doc.concat [
+        Doc.lbrace;
+        Doc.indent (
+          Doc.concat [
+            Doc.softLine;
+            printCommentsInside cmtTbl modExpr.pmod_loc;
+          ];
+        );
+        Doc.softLine;
+        Doc.rbrace;
+      ]
+    )
   | Pmod_structure structure ->
     Doc.breakableGroup ~forceBreak:true (
       Doc.concat [
@@ -4970,9 +5003,9 @@ let printImplementation ~width (s: Parsetree.structure) ~comments =
   (* CommentTable.log cmtTbl; *)
   let doc = printStructure s cmtTbl in
   (* Doc.debug doc; *)
-  Doc.toString ~width doc
+  Doc.toString ~width doc ^ "\n"
 
 let printInterface ~width (s: Parsetree.signature) ~comments =
   let cmtTbl = CommentTable.make () in
   CommentTable.walkSignature s cmtTbl comments;
-  Doc.toString ~width (printSignature s cmtTbl)
+  Doc.toString ~width (printSignature s cmtTbl) ^ "\n"

tests/conversion/reason/__snapshots__/render.spec.js.snap

@@ -997,6 +997,7 @@ module type my_module_type = {
   module M: {
     @ocaml.doc(\\" The comment for value y. \\")
     let y: int
+
     /* ... */
   }
 }
@@ -1237,6 +1238,65 @@ let () = switch [Color.red, Color.blue, Color.green] {
 "
 `;
 
+exports[`ppx.re 1`] = `
+"%graphql(
+  \`
+  query Site {
+    site {
+      siteMetadata {
+        title
+        description
+        siteUrl
+      }
+    }
+  }
+\`
+  {taggedTemplate: false}
+)
+
+module Form = %form(
+  type input = {
+    name: string,
+    email: string,
+    message: string,
+    @bs.as(\\"form-name\\")
+    formName: string,
+  }
+  type output = input
+  let validators = {
+    name: {
+      strategy: OnFirstBlur,
+      validate: ({name, _}) =>
+        switch name {
+        | \\"\\" => Error(\\"Name is required.\\")
+        | name => Ok(name)
+        },
+    },
+    email: {
+      strategy: OnFirstBlur,
+      validate: ({email, _}) =>
+        switch email {
+        | \\"\\" => Error(\\"Email is required.\\")
+        | email => Ok(email)
+        },
+    },
+    message: {
+      strategy: OnFirstBlur,
+      validate: ({message, _}) =>
+        switch message {
+        | \\"\\" => Error(\\"Message is required.\\")
+        | message => Ok(message)
+        },
+    },
+    formName: {
+      strategy: OnSubmit,
+      validate: ({formName, _}) => Ok(formName),
+    },
+  }
+)
+"
+`;
+
 exports[`recursiveType.ml 1`] = `
 "type rec tree = {\\"label\\": string, \\"left\\": option<tree>, \\"right\\": option<tree>}
 "