Clean up Js.t object parsing, printing and converting

Fixes #277
Fixes #263

Now that rescript-lang/rescript#4967 has landed:
- Parse `{"foo": int}` as ocaml `{. foo: int}`. Previously it parsed into ocaml `{. foo: int} Js.t`
- Remove a tiny printing optimizations for `Js.t`.
- For React's PPX 3, generate objects directly instead of `Js.t` objects. cc @rickyvetter @ryyppy for ppx4.
- The re->res converter automatically removes the `Js.t` part.
- Said converter has a bug (#263) that converts `Js.t({..}) as 'a` into `{..} as 'a` from naturally forgetting to special-case that path. Now this bug is conveniently ~~made into a feature~~ obsolete.

Author: chenglou

src/reactjs_jsx_ppx_v3.ml

@@ -216,23 +216,14 @@ let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType =
   { psig_loc = loc; psig_desc = Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType) }
   [@@raises Invalid_argument]
 
-(* Build an AST node for the props name when converted to a Js.t inside the function signature  *)
+(* Build an AST node for the props name when converted to an object inside the function signature  *)
 let makePropsName ~loc name = { ppat_desc = Ppat_var { txt = name; loc }; ppat_loc = loc; ppat_attributes = [] }
 
 let makeObjectField loc (str, attrs, type_) = Otag ({ loc; txt = str }, attrs, type_)
 
-(* Build an AST node representing a "closed" Js.t object representing a component's props *)
+(* Build an AST node representing a "closed" object representing a component's props *)
 let makePropsType ~loc namedTypeList =
-  Typ.mk ~loc
-    (Ptyp_constr
-       ( { txt = Ldot (Lident "Js", "t"); loc },
-         [
-           {
-             ptyp_desc = Ptyp_object (List.map (makeObjectField loc) namedTypeList, Closed);
-             ptyp_loc = loc;
-             ptyp_attributes = [];
-           };
-         ] ))
+  Typ.mk ~loc (Ptyp_object (List.map (makeObjectField loc) namedTypeList, Closed))
 
 (* Builds an AST node for the entire `external` definition of props *)
 let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList =

src/res_ast_conversion.ml

@@ -383,6 +383,23 @@ let normalize =
       | _ ->
         default_mapper.pat mapper p
     end;
+    typ = (fun mapper typ ->
+      match typ.ptyp_desc with
+      | Ptyp_constr(
+          {txt = Longident.Ldot(Longident.Lident "Js", "t")},
+          [{ptyp_desc = Ptyp_object (fields, openFlag)} as objectType]
+        ) ->
+        (* Js.t({"a": b}) -> {"a": b}. Since compiler >9.0.1 objects don't
+           need Js.t wrapping anymore *)
+        let newFields = fields |> List.map (fun (field: Parsetree.object_field) ->
+          match field with
+          | Otag (label, attributes, typ) -> Parsetree.Otag (label, attributes, mapper.typ mapper typ)
+          | Oinherit typ -> Oinherit (mapper.typ mapper typ)
+        )
+        in
+        {objectType with ptyp_desc = Ptyp_object (newFields, openFlag)}
+      | _ -> default_mapper.typ mapper typ
+    );
     expr = (fun mapper expr ->
       match expr.pexp_desc with
       | Pexp_constant (Pconst_string (txt, None)) ->
@@ -569,4 +586,3 @@ let replaceStringLiteralStructure stringData structure =
 let replaceStringLiteralSignature stringData signature =
   let mapper = stringLiteralMapper stringData in
   mapper.Ast_mapper.signature mapper signature
-

src/res_core.ml

@@ -375,17 +375,6 @@ let makeListPattern loc seq ext_opt =
   in
   handle_seq seq
 
-
-(* {"foo": bar} -> Js.t({. foo: bar})
- * {.. "foo": bar} -> Js.t({.. foo: bar})
- * {..} -> Js.t({..}) *)
-let makeBsObjType ~attrs ~loc ~closed rows =
-  let obj = Ast_helper.Typ.object_ ~loc rows closed in
-  let jsDotTCtor =
-    Location.mkloc (Longident.Ldot (Longident.Lident "Js", "t")) loc
-  in
-  Ast_helper.Typ.constr ~loc ~attrs jsDotTCtor [obj]
-
 (* TODO: diagnostic reporting *)
 let lidentOfPath longident =
   match Longident.flatten longident |> List.rev with
@@ -3816,7 +3805,7 @@ and parseRecordOrBsObjectType ~attrs p =
   in
   Parser.expect Rbrace p;
   let loc = mkLoc startPos p.prevEndPos in
-  makeBsObjType ~attrs ~loc ~closed:closedFlag fields
+  Ast_helper.Typ.object_ ~loc ~attrs fields closedFlag
 
 (* TODO: check associativity in combination with attributes *)
 and parseTypeAlias p typ =
@@ -4218,7 +4207,7 @@ and parseConstrDeclArgs p =
         in
         Parser.expect Rbrace p;
         let loc = mkLoc startPos p.prevEndPos in
-        let typ = makeBsObjType ~attrs:[] ~loc ~closed:closedFlag fields in
+        let typ = Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag in
         Parser.optional p Comma |> ignore;
         let moreArgs =
           parseCommaDelimitedRegion
@@ -4269,7 +4258,7 @@ and parseConstrDeclArgs p =
             ) in
             Parser.expect Rbrace p;
             let loc = mkLoc startPos p.prevEndPos in
-            let typ = makeBsObjType ~attrs:[]  ~loc ~closed:closedFlag fields in
+            let typ = Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag in
             Parser.optional p Comma |> ignore;
             let moreArgs =
               parseCommaDelimitedRegion
@@ -4601,7 +4590,7 @@ and parseRecordOrBsObjectDecl p =
     Parser.expect Rbrace p;
     let loc = mkLoc startPos p.prevEndPos in
     let typ =
-      makeBsObjType ~attrs:[] ~loc ~closed:closedFlag fields
+      Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag
       |> parseTypeAlias p
     in
     let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in
@@ -4648,7 +4637,7 @@ and parseRecordOrBsObjectDecl p =
         Parser.expect Rbrace p;
         let loc = mkLoc startPos p.prevEndPos in
         let typ =
-          makeBsObjType ~attrs:[] ~loc ~closed:closedFlag fields |> parseTypeAlias p
+          Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag |> parseTypeAlias p
         in
         let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in
         (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)

src/res_printer.ml

@@ -1423,16 +1423,22 @@ and printTypExpr (typExpr : Parsetree.core_type) cmtTbl =
         doc
     in
     Doc.concat [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]]
-  | Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")}, [{ptyp_desc = Ptyp_object (_fields, _openFlag)} as typ]) ->
-    let bsObject = printTypExpr typ cmtTbl in
-    begin match typExpr.ptyp_attributes with
-    | [] -> bsObject
-    | attrs ->
-      Doc.concat [
-        printAttributes ~inline:true attrs cmtTbl;
-        printTypExpr typ cmtTbl;
-      ]
-    end
+
+  (* object printings *)
+  | Ptyp_object (fields, openFlag) ->
+    (* TODO: remove this once Js.t is gone for good *)
+    printBsObjectSugar ~inline:false fields openFlag cmtTbl
+  | Ptyp_constr(longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}]) ->
+    (* for foo<{"a": b}>, when the object is long and needs a line break, we
+       want the <{ and }> to stay hugged together *)
+    let constrName = printLidentPath longidentLoc cmtTbl in
+    Doc.concat([
+      constrName;
+      Doc.lessThan;
+      printBsObjectSugar ~inline:true fields openFlag cmtTbl;
+      Doc.greaterThan;
+    ])
+
   | Ptyp_constr(longidentLoc, [{ ptyp_desc = Parsetree.Ptyp_tuple tuple }]) ->
     let constrName = printLidentPath longidentLoc cmtTbl in
     Doc.group(
@@ -1447,17 +1453,6 @@ and printTypExpr (typExpr : Parsetree.core_type) cmtTbl =
     let constrName = printLidentPath longidentLoc cmtTbl in
     begin match constrArgs with
     | [] -> constrName
-    | [{
-        Parsetree.ptyp_desc =
-          Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")},
-        [{ptyp_desc = Ptyp_object (fields, openFlag)}])
-      }] ->
-      Doc.concat([
-        constrName;
-        Doc.lessThan;
-        printBsObjectSugar ~inline:true fields openFlag cmtTbl;
-        Doc.greaterThan;
-      ])
     | _args -> Doc.group(
       Doc.concat([
         constrName;
@@ -1561,8 +1556,6 @@ and printTypExpr (typExpr : Parsetree.core_type) cmtTbl =
       )
     end
   | Ptyp_tuple types -> printTupleType ~inline:false types cmtTbl
-  | Ptyp_object (fields, openFlag) ->
-    printBsObjectSugar ~inline:false fields openFlag cmtTbl
   | Ptyp_poly([], typ) ->
     printTypExpr typ cmtTbl
   | Ptyp_poly(stringLocs, typ) ->

tests/parsing/errors/typeDef/__snapshots__/parse.spec.js.snap

@@ -42,15 +42,14 @@ exports[`inlineRecord.res 1`] = `
 "=====Parsetree==========================================
 type nonrec entity =
   | Director 
-  | Student of
-  {
+  | Student of {
   name: string ;
-  reportCard: < passing: bool  ;score: int   >  Js.t } 
+  reportCard: < passing: bool  ;score: int   >  } 
 type nonrec user =
   {
   name: string ;
-  address: < street: string  ;country: string   >  Js.t }
-let make (props : < handleClick: Click.t -> unit  ;value: string   >  Js.t) =
+  address: < street: string  ;country: string   >  }
+let make (props : < handleClick: Click.t -> unit  ;value: string   > ) =
   render props
 =====Errors=============================================
 

tests/parsing/errors/typexpr/__snapshots__/parse.spec.js.snap

@@ -59,24 +59,22 @@ module Error3 =
 exports[`bsObjSugar.js 1`] = `
 "=====Parsetree==========================================
 type nonrec state =
-  < url: [%rescript.typehole ]  ;protocols: string array   >  Js.t
+  < url: [%rescript.typehole ]  ;protocols: string array   > 
 type nonrec state =
-  < url: [%rescript.typehole ] [@attr ] ;protocols: string array   >  Js.t
+  < url: [%rescript.typehole ] [@attr ] ;protocols: string array   > 
 type nonrec state =
   < url: string  ;protocols: [%rescript.typehole ]  ;websocket: Websocket.t  
-    >  Js.t
+    > 
+type nonrec state = < url: string  ;protocols: [%rescript.typehole ]   > 
+type nonrec state = < send: string -> [%rescript.typehole ] [@bs.meth ]  > 
+type nonrec state = < age: [%rescript.typehole ]  ;name: string   > 
 type nonrec state =
-  < url: string  ;protocols: [%rescript.typehole ]   >  Js.t
-type nonrec state =
-  < send: string -> [%rescript.typehole ] [@bs.meth ]  >  Js.t
-type nonrec state = < age: [%rescript.typehole ]  ;name: string   >  Js.t
-type nonrec state =
-  < age: [%rescript.typehole ] [@bs.set ] ;name: string   >  Js.t
-type nonrec state = < age: [%rescript.typehole ]   ;.. >  Js.t
-type nonrec state = < age: [%rescript.typehole ]  ;name: string   ;.. >  Js.t
+  < age: [%rescript.typehole ] [@bs.set ] ;name: string   > 
+type nonrec state = < age: [%rescript.typehole ]   ;.. > 
+type nonrec state = < age: [%rescript.typehole ]  ;name: string   ;.. > 
 type nonrec websocket =
-  < id: [%rescript.typehole ]  ;channel: channelTyp   >  Js.t
-type nonrec websocket = < id: [%rescript.typehole ]   >  Js.t
+  < id: [%rescript.typehole ]  ;channel: channelTyp   > 
+type nonrec websocket = < id: [%rescript.typehole ]   > 
 =====Errors=============================================
 
   Syntax error!

tests/parsing/grammar/structure/__snapshots__/parse.spec.js.snap

@@ -5,23 +5,22 @@ exports[`exceptionDefinition.js 1`] = `
 exception ExitEarly of int 
 exception ExitEarly of {
   x: int } 
-exception ExitEarly of < jsExit: int   >  Js.t 
-exception ExitEarly of < jsExit: int [@attr ]  >  Js.t 
-exception ExitEarly of < jsExit: int [@attr ]  >  Js.t 
-exception ExitEarly of < jsExit: int [@attr ] ;code: int [@attr ]  >  Js.t 
-exception ExitEarly of < jsExit: int   >  Js.t 
-exception ExitEarly of < jsExit: int   >  Js.t * < code: int   >  Js.t 
-exception ExitEarly of < jsExit: int   >  Js.t * int * < code: int   >  Js.t 
-exception ExitEarly of < jsExit: int [@attr ] ;code: int [@attr ]  >  Js.t *
-  < jsExit: int [@attr ] ;code: int [@attr ]  >  Js.t 
-exception ExitJsStyle of < .. >  Js.t 
-exception ExitJsStyle of < code: int   ;.. >  Js.t 
-exception ExitJsStyle of < code: int   ;.. >  Js.t 
-exception ExitJsStyle of < code: int [@attr ]  ;.. >  Js.t 
-exception ExitJsStyle of < code: int [@attr ]  ;.. >  Js.t 
-exception ExitJsStyle of < code: int  ;time: int   ;.. >  Js.t 
-exception ExitJsStyle of < code: int [@attr ] ;time: int [@attr ]  ;.. > 
-  Js.t 
+exception ExitEarly of < jsExit: int   >  
+exception ExitEarly of < jsExit: int [@attr ]  >  
+exception ExitEarly of < jsExit: int [@attr ]  >  
+exception ExitEarly of < jsExit: int [@attr ] ;code: int [@attr ]  >  
+exception ExitEarly of < jsExit: int   >  
+exception ExitEarly of < jsExit: int   >  * < code: int   >  
+exception ExitEarly of < jsExit: int   >  * int * < code: int   >  
+exception ExitEarly of < jsExit: int [@attr ] ;code: int [@attr ]  >  *
+  < jsExit: int [@attr ] ;code: int [@attr ]  >  
+exception ExitJsStyle of < .. >  
+exception ExitJsStyle of < code: int   ;.. >  
+exception ExitJsStyle of < code: int   ;.. >  
+exception ExitJsStyle of < code: int [@attr ]  ;.. >  
+exception ExitJsStyle of < code: int [@attr ]  ;.. >  
+exception ExitJsStyle of < code: int  ;time: int   ;.. >  
+exception ExitJsStyle of < code: int [@attr ] ;time: int [@attr ]  ;.. >  
 exception ExitEarly [@onConstructor ]
 exception ExitEarly of int [@onConstructor ]
 exception Exit = Terminate