Skip to content
This repository has been archived by the owner on Jun 15, 2023. It is now read-only.

Clean up Js.t object parsing, printing and converting #291

Merged
merged 3 commits into from
Feb 27, 2021
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 3 additions & 12 deletions src/reactjs_jsx_ppx_v3.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
18 changes: 17 additions & 1 deletion src/res_ast_conversion.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)) ->
Expand Down Expand Up @@ -569,4 +586,3 @@ let replaceStringLiteralStructure stringData structure =
let replaceStringLiteralSignature stringData signature =
let mapper = stringLiteralMapper stringData in
mapper.Ast_mapper.signature mapper signature

21 changes: 5 additions & 16 deletions src/res_core.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
38 changes: 15 additions & 23 deletions src/res_printer.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1423,16 +1423,21 @@ 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) ->
printBsObjectSugar ~inline:false fields openFlag cmtTbl
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should we improve the name of this function?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Was thinking of unifying this with record printing, which we can discuss later. I'll do this now.

| 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(
Expand All @@ -1447,17 +1452,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;
Expand Down Expand Up @@ -1561,8 +1555,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) ->
Expand Down
9 changes: 4 additions & 5 deletions tests/parsing/errors/typeDef/__snapshots__/parse.spec.js.snap
Original file line number Diff line number Diff line change
Expand Up @@ -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=============================================

Expand Down
24 changes: 11 additions & 13 deletions tests/parsing/errors/typexpr/__snapshots__/parse.spec.js.snap
Original file line number Diff line number Diff line change
Expand Up @@ -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!
Expand Down
33 changes: 16 additions & 17 deletions tests/parsing/grammar/structure/__snapshots__/parse.spec.js.snap
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
// Jest Snapshot v1, https://goo.gl/fbAQLP

exports[`bsObject.js 1`] = `
"type nonrec 'a foo = < foo: int ;.. > Js.t as 'a
type nonrec 'a foo = < foo: int > Js.t as 'a"
"type nonrec 'a foo = < foo: int ;.. > as 'a
type nonrec 'a foo = < foo: int > as 'a"
`;

exports[`constructorDeclaration.js 1`] = `
Expand All @@ -25,23 +25,23 @@ type nonrec t =
g: int ;
b: int ;
a: int }
| JsColor of < gradient: int > Js.t
| JsColor of < gradient: int > Js.t
| JsColor of < gradient: int > Js.t
| JsColor of < gradient: int [@attr ] > Js.t
| JsColor of < gradient: int > Js.t * color
| JsColor of < gradient: int > Js.t * color
| JsColor of < gradient: int > Js.t * < hex: string > Js.t * int
| JsColor of < gradient: int [@attr ] > Js.t * < hex: string [@attr ] >
Js.t * int
| JsT of < .. > Js.t
| JsT of < gradient: int ;.. > Js.t
| JsT of < gradient: int ;.. > Js.t
| JsT of < gradient: int [@attr ] ;.. > Js.t
| JsT of < gradient: int ;hex: string ;.. > Js.t *
< gradient: int ;hex: string ;.. > Js.t
| JsT of < gradient: int [@attr ] ;hex: string [@attr ] ;.. > Js.t *
< gradient: int [@attr ] ;hex: string [@attr ] ;.. > Js.t
| JsColor of < gradient: int >
| JsColor of < gradient: int >
| JsColor of < gradient: int >
| JsColor of < gradient: int [@attr ] >
| JsColor of < gradient: int > * color
| JsColor of < gradient: int > * color
| JsColor of < gradient: int > * < hex: string > * int
| JsColor of < gradient: int [@attr ] > * < hex: string [@attr ] > *
int
| JsT of < .. >
| JsT of < gradient: int ;.. >
| JsT of < gradient: int ;.. >
| JsT of < gradient: int [@attr ] ;.. >
| JsT of < gradient: int ;hex: string ;.. > *
< gradient: int ;hex: string ;.. >
| JsT of < gradient: int [@attr ] ;hex: string [@attr ] ;.. > *
< gradient: int [@attr ] ;hex: string [@attr ] ;.. >
type nonrec t =
| Rgb: t
type nonrec t =
Expand All @@ -61,24 +61,24 @@ type nonrec t =
g: int ;
b: int ;
a: int } -> t
| JsColor: < gradient: int > Js.t -> t
| JsColor: < gradient: int > Js.t -> t
| JsColor: < gradient: int > Js.t -> t
| JsColor: < gradient: int > Js.t -> t
| JsColor: < gradient: int [@attr ] > Js.t -> t
| JsColor: < gradient: int > Js.t * color -> t
| JsColor: < gradient: int > Js.t * color -> t
| JsColor: < gradient: int > Js.t * < hex: string > Js.t * int -> t
| JsT: < .. > Js.t -> t
| JsT: < gradient: int ;.. > Js.t -> t
| JsT: < gradient: int [@attr ] ;.. > Js.t -> t
| JsT: < gradient: int ;.. > Js.t -> t
| JsT: < gradient: int [@attr ] ;.. > Js.t -> t
| JsT: < gradient: int ;.. > Js.t -> t
| JsT: < gradient: int ;hex: string ;.. > Js.t *
< gradient: int ;hex: string ;.. > Js.t -> t
| JsT: < gradient: int [@attr ] ;hex: string [@attr ] ;.. > Js.t *
< gradient: int [@attr ] ;hex: string [@attr ] ;.. > Js.t -> t
| JsColor: < gradient: int > -> t
| JsColor: < gradient: int > -> t
| JsColor: < gradient: int > -> t
| JsColor: < gradient: int > -> t
| JsColor: < gradient: int [@attr ] > -> t
| JsColor: < gradient: int > * color -> t
| JsColor: < gradient: int > * color -> t
| JsColor: < gradient: int > * < hex: string > * int -> t
| JsT: < .. > -> t
| JsT: < gradient: int ;.. > -> t
| JsT: < gradient: int [@attr ] ;.. > -> t
| JsT: < gradient: int ;.. > -> t
| JsT: < gradient: int [@attr ] ;.. > -> t
| JsT: < gradient: int ;.. > -> t
| JsT: < gradient: int ;hex: string ;.. > *
< gradient: int ;hex: string ;.. > -> t
| JsT: < gradient: int [@attr ] ;hex: string [@attr ] ;.. > *
< gradient: int [@attr ] ;hex: string [@attr ] ;.. > -> t
type nonrec t =
| EmptyColor [@attr ]
| White: grayscale -> ((t)[@onGadt ]) [@onConstr ]
Expand Down Expand Up @@ -214,18 +214,18 @@ type nonrec t = {
type nonrec t = {
mutable form: form ;
mutable answers: answers }
type nonrec t = < age: int > Js.t
type nonrec t = < .. > Js.t
type nonrec t = < age: int > Js.t
type nonrec t = < age: int ;.. > Js.t
type nonrec t = < age: int ;name: string ;.. > Js.t
type nonrec t = < age: int [@attr ] ;.. > Js.t
type nonrec t = < age: int [@attr ] ;.. > Js.t
type nonrec t = < age: int [@attr ] ;name: string [@attr ] ;.. > Js.t
type nonrec t = < age: int [@attr ] > Js.t
type nonrec t = < age: int [@attr ] > Js.t
type nonrec t = < age: int [@attr ] ;name: string > Js.t
type nonrec t = < age: int [@attr ] ;name: string [@attr2 ] > Js.t
type nonrec t = < age: int >
type nonrec t = < .. >
type nonrec t = < age: int >
type nonrec t = < age: int ;.. >
type nonrec t = < age: int ;name: string ;.. >
type nonrec t = < age: int [@attr ] ;.. >
type nonrec t = < age: int [@attr ] ;.. >
type nonrec t = < age: int [@attr ] ;name: string [@attr ] ;.. >
type nonrec t = < age: int [@attr ] >
type nonrec t = < age: int [@attr ] >
type nonrec t = < age: int [@attr ] ;name: string >
type nonrec t = < age: int [@attr ] ;name: string [@attr2 ] >
type nonrec domProps =
{
label: string [@bs.optional ];
Expand Down
Loading