allow hyphens in jsx tag names

Author: tsnobip

jscomp/syntax/src/res_core.ml

@@ -2617,10 +2617,11 @@ and parseJsxOpeningOrSelfClosingElement ~startPos p =
     | GreaterThan -> (
       (* <foo a=b> bar </foo> *)
       let childrenStartPos = p.Parser.startPos in
-      Scanner.setJsxMode p.scanner;
       Parser.next p;
       let spread, children = parseJsxChildren p in
       let childrenEndPos = p.Parser.startPos in
+      Scanner.popMode p.scanner Jsx;
+      Scanner.setJsxMode p.scanner;
       let () =
         match p.token with
         | LessThanSlash -> Parser.next p
@@ -2685,6 +2686,8 @@ and parseJsxOpeningOrSelfClosingElement ~startPos p =
  *  jsx-children ::= primary-expr*          * => 0 or more
  *)
 and parseJsx p =
+  Scanner.popMode p.scanner Jsx;
+  Scanner.setJsxMode p.Parser.scanner;
   Parser.leaveBreadcrumb p Grammar.Jsx;
   let startPos = p.Parser.startPos in
   Parser.expect LessThan p;
@@ -2696,6 +2699,7 @@ and parseJsx p =
       parseJsxFragment p
     | _ -> parseJsxName p
   in
+  Scanner.popMode p.scanner Jsx;
   Parser.eatBreadcrumb p;
   {jsxExpr with pexp_attributes = [jsxAttr]}
 
@@ -2706,12 +2710,12 @@ and parseJsx p =
  *)
 and parseJsxFragment p =
   let childrenStartPos = p.Parser.startPos in
-  Scanner.setJsxMode p.scanner;
   Parser.expect GreaterThan p;
   let _spread, children = parseJsxChildren p in
   let childrenEndPos = p.Parser.startPos in
   Parser.expect LessThanSlash p;
   Parser.expect GreaterThan p;
+  Scanner.popMode p.scanner Jsx;
   let loc = mkLoc childrenStartPos childrenEndPos in
   makeListExpression loc children None
 
@@ -2743,6 +2747,7 @@ and parseJsxProp p =
         Parser.next p;
         (* no punning *)
         let optional = Parser.optional p Question in
+        Scanner.popMode p.scanner Jsx;
         let attrExpr =
           let e = parsePrimaryExpr ~operand:(parseAtomicExpr p) p in
           {e with pexp_attributes = propLocAttr :: e.pexp_attributes}
@@ -2765,6 +2770,7 @@ and parseJsxProp p =
     Parser.next p;
     match p.Parser.token with
     | DotDotDot -> (
+      Scanner.popMode p.scanner Jsx;
       Parser.next p;
       let loc = mkLoc p.Parser.startPos p.prevEndPos in
       let propLocAttr =
@@ -2790,9 +2796,7 @@ and parseJsxProps p =
 and parseJsxChildren p =
   let rec loop p children =
     match p.Parser.token with
-    | Token.Eof | LessThanSlash ->
-      Scanner.popMode p.scanner Jsx;
-      List.rev children
+    | Token.Eof | LessThanSlash -> children
     | LessThan ->
       (* Imagine: <div> <Navbar /> <
        * is `<` the start of a jsx-child? <div …
@@ -2808,23 +2812,23 @@ and parseJsxChildren p =
       else
         (* LessThanSlash *)
         let () = p.token <- token in
-        let () = Scanner.popMode p.scanner Jsx in
-        List.rev children
+        children
     | token when Grammar.isJsxChildStart token ->
       let () = Scanner.popMode p.scanner Jsx in
       let child =
         parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p
       in
       loop p (child :: children)
-    | _ ->
-      Scanner.popMode p.scanner Jsx;
-      List.rev children
+    | _ -> children
   in
   match p.Parser.token with
   | DotDotDot ->
     Parser.next p;
     (true, [parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p])
-  | _ -> (false, loop p [])
+  | _ ->
+    let children = List.rev (loop p []) in
+    Scanner.popMode p.scanner Jsx;
+    (false, children)
 
 and parseBracedOrRecordExpr p =
   let startPos = p.Parser.startPos in

jscomp/syntax/src/res_printer.ml

@@ -421,7 +421,7 @@ let printLongident = function
 
 type identifierStyle = ExoticIdent | NormalIdent
 
-let classifyIdentContent ?(allowUident = false) txt =
+let classifyIdentContent ?(allowUident = false) ?(allowHyphen = false) txt =
   if Token.isKeywordTxt txt then ExoticIdent
   else
     let len = String.length txt in
@@ -431,16 +431,18 @@ let classifyIdentContent ?(allowUident = false) txt =
         match String.unsafe_get txt i with
         | 'A' .. 'Z' when allowUident -> loop (i + 1)
         | 'a' .. 'z' | '_' -> loop (i + 1)
+        | '-' when allowHyphen -> loop (i + 1)
         | _ -> ExoticIdent
       else
         match String.unsafe_get txt i with
         | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '\'' | '_' -> loop (i + 1)
+        | '-' when allowHyphen -> loop (i + 1)
         | _ -> ExoticIdent
     in
     loop 0
 
-let printIdentLike ?allowUident txt =
-  match classifyIdentContent ?allowUident txt with
+let printIdentLike ?allowUident ?allowHyphen txt =
+  match classifyIdentContent ?allowUident ?allowHyphen txt with
   | ExoticIdent -> Doc.concat [Doc.text "\\\""; Doc.text txt; Doc.text "\""]
   | NormalIdent -> Doc.text txt
 
@@ -4462,7 +4464,7 @@ and printJsxProp ~state arg cmtTbl =
  * Navabar.createElement -> Navbar
  * Staff.Users.createElement -> Staff.Users *)
 and printJsxName {txt = lident} =
-  let printIdent = printIdentLike ~allowUident:true in
+  let printIdent = printIdentLike ~allowUident:true ~allowHyphen:true in
   let rec flatten acc lident =
     match lident with
     | Longident.Lident txt -> printIdent txt :: acc

jscomp/syntax/src/res_scanner.ml

@@ -182,8 +182,11 @@ let digitValue ch =
 let scanIdentifier scanner =
   let startOff = scanner.offset in
   let rec skipGoodChars scanner =
-    match scanner.ch with
-    | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '\'' ->
+    match (scanner.ch, inJsxMode scanner) with
+    | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '\''), false ->
+      next scanner;
+      skipGoodChars scanner
+    | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '\'' | '-'), true ->
       next scanner;
       skipGoodChars scanner
     | _ -> ()

jscomp/syntax/tests/parsing/errors/expressions/expected/jsx.res.txt

@@ -1,14 +1,4 @@
 
-  Syntax error!
-  tests/parsing/errors/expressions/jsx.res:1:12
-
-  1 │ let x = <di-v />
-  2 │ let x = <Unclosed >;
-  3 │ let x = <Foo.Bar></Free.Will>;
-
-  I'm not sure what to parse here when looking at "-".
-
-
   Syntax error!
   tests/parsing/errors/expressions/jsx.res:2:20
 
@@ -66,7 +56,7 @@
 
   I'm not sure what to parse here when looking at ".".
 
-let x = ((di ~children:[] ())[@JSX ]) - (v / ([%rescript.exprhole ]))
+let x = ((di-v ~children:[] ())[@JSX ])
 let x = ((Unclosed.createElement ~children:[] ())[@JSX ])
 let x =
   ((Foo.Bar.createElement ~children:[] ())[@JSX ]) > ([%rescript.exprhole ])

jscomp/syntax/tests/printer/expr/expected/jsx.res.txt

@@ -4,8 +4,7 @@ let x = <Foo.Bar className="container" />
 let x = <Foo.Bar.Baz className="container" />
 let x = <Foo.bar className="container" />
 let x = <Foo.baz className="multiline" />
-let x = <\"custom-tag" className="container" />
-let x = <Foo.\"custom-tag" className="container" />
+let x = <custom-tag className="container" />
 
 // https://github.com/rescript-lang/syntax/issues/570
 let x =
@@ -38,15 +37,10 @@ let x =
     {b}
   </A>
 let x =
-  <\"custom-tag" className="container">
+  <custom-tag className="container">
     {a}
     <B />
-  </\"custom-tag">
-let x =
-  <Foo.\"custom-tag" className="container">
-    {a}
-    <B />
-  </Foo.\"custom-tag">
+  </custom-tag>
 
 let x = <div className="container" className2="container2" className3="container3" onClick />
 

jscomp/syntax/tests/printer/expr/jsx.res

@@ -6,17 +6,15 @@ let x = <Foo.bar className="container" />
 let x = <Foo.baz
  className="multiline"
 />
-let x = <\"custom-tag" className="container" />
-let x = <Foo.\"custom-tag" className="container" />
+let x = <custom-tag className="container" />
 
 // https://github.com/rescript-lang/syntax/issues/570
 let x = <A> <B> <C> <D /> <E /> </C> <F> <G /> <H /> </F> </B> </A>
 let x = <A> {children} <B/> </A>
 let x = <A> <B/> {children} </A>
 let x = <A> {a} </A>
 let x = <A> {a} {b} </A>
-let x = <\"custom-tag" className="container" > {a} <B/> </\"custom-tag">
-let x = <Foo.\"custom-tag" className="container" > {a} <B/> </Foo.\"custom-tag">
+let x = <custom-tag className="container" > {a} <B/> </custom-tag>
 
 let x =
   <div