Skip to content

Commit 85ccab4

Browse files
nojafnojaf
committed
Streamline automatic element calls
1 parent c91aeda commit 85ccab4

File tree

2 files changed

+113
-210
lines changed

2 files changed

+113
-210
lines changed

‎compiler/syntax/src/jsx_v4.ml‎

Lines changed: 112 additions & 205 deletions
Original file line numberDiff line numberDiff line change
@@ -1543,6 +1543,12 @@ let starts_with_uppercase s =
15431543
Char.uppercase_ascii c = c
15441544

15451545
module AutomaticExpr = struct
1546+
(* There appear to be slightly different rules of transformation whether the component is upper-, lowercase or a fragment *)
1547+
type componentDescription =
1548+
| LowercasedComponent
1549+
| UppercasedComponent
1550+
| FragmentComponent
1551+
15461552
let loc_from_prop = function
15471553
| JSXPropPunning (_, {loc}) -> loc
15481554
| JSXPropValue (_, _, {pexp_loc}) -> pexp_loc
@@ -1608,39 +1614,55 @@ module AutomaticExpr = struct
16081614
pexp_attributes = [];
16091615
}
16101616

1611-
let mk_children_props (config : Jsx_common.jsx_config) mapper
1612-
(children : jsx_children) =
1613-
let record_of_children children =
1614-
Exp.record [(Location.mknoloc (Lident "children"), children, false)] None
1615-
in
1616-
let apply_jsx_array expr =
1617-
Exp.apply
1618-
(Exp.ident
1619-
{txt = module_access_name config "array"; loc = Location.none})
1620-
[(Nolabel, expr)]
1621-
in
1617+
let append_children_prop (config : Jsx_common.jsx_config) mapper
1618+
(component_description : componentDescription) (props : jsx_props)
1619+
(children : jsx_children) : jsx_props =
16221620
match children with
1623-
| JSXChildrenItems [] -> empty_record ~loc:Location.none
1621+
| JSXChildrenItems [] -> props
16241622
| JSXChildrenItems [child] | JSXChildrenSpreading child ->
1625-
record_of_children (mapper.expr mapper child)
1623+
let expr =
1624+
(* I don't quite know why fragment and uppercase don't do this additional ReactDOM.someElement wrapping *)
1625+
match component_description with
1626+
| FragmentComponent | UppercasedComponent -> mapper.expr mapper child
1627+
| LowercasedComponent ->
1628+
let element_binding =
1629+
match config.module_ |> String.lowercase_ascii with
1630+
| "react" -> Lident "ReactDOM"
1631+
| _generic -> module_access_name config "Elements"
1632+
in
1633+
Exp.apply
1634+
(Exp.ident
1635+
{
1636+
txt = Ldot (element_binding, "someElement");
1637+
loc = Location.none;
1638+
})
1639+
[(Nolabel, child)]
1640+
in
1641+
let is_optional =
1642+
match component_description with
1643+
| LowercasedComponent -> true
1644+
| FragmentComponent | UppercasedComponent -> false
1645+
in
1646+
props
1647+
@ [
1648+
JSXPropValue
1649+
({txt = "children"; loc = Location.none}, is_optional, expr);
1650+
]
16261651
| JSXChildrenItems xs ->
1627-
record_of_children
1628-
@@ apply_jsx_array (Exp.array (List.map (mapper.expr mapper) xs))
1629-
1630-
let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs
1631-
(elementTag : expression) (children : jsx_children) : expression =
1632-
let more_than_one_children =
1633-
match children with
1634-
| JSXChildrenSpreading _ -> false
1635-
| JSXChildrenItems xs -> List.length xs > 1
1636-
in
1637-
let children_props = mk_children_props config mapper children in
1638-
let args = [(nolabel, elementTag); (nolabel, children_props)] in
1639-
Exp.apply ~loc ~attrs (* ReactDOM.jsx *)
1640-
(if more_than_one_children then
1641-
Exp.ident ~loc {loc; txt = module_access_name config "jsxs"}
1642-
else Exp.ident ~loc {loc; txt = module_access_name config "jsx"})
1643-
args
1652+
(* this is a hack to support react components that introspect into their children *)
1653+
props
1654+
@ [
1655+
JSXPropValue
1656+
( {txt = "children"; loc = Location.none},
1657+
false,
1658+
Exp.apply
1659+
(Exp.ident
1660+
{
1661+
txt = module_access_name config "array";
1662+
loc = Location.none;
1663+
})
1664+
[(Nolabel, Exp.array (List.map (mapper.expr mapper) xs))] );
1665+
]
16441666

16451667
let try_find_key_prop (props : jsx_props) : (arg_label * expression) option =
16461668
props
@@ -1654,6 +1676,56 @@ module AutomaticExpr = struct
16541676
Some (arg_label, expr)
16551677
| _ -> None)
16561678

1679+
let mk_react_jsx (config : Jsx_common.jsx_config) mapper loc attrs
1680+
(component_description : componentDescription) (elementTag : expression)
1681+
(props : jsx_props) (children : jsx_children) : expression =
1682+
let more_than_one_children =
1683+
match children with
1684+
| JSXChildrenSpreading _ -> false
1685+
| JSXChildrenItems xs -> List.length xs > 1
1686+
in
1687+
let props_with_children =
1688+
append_children_prop config mapper component_description props children
1689+
in
1690+
let props_record = mk_record_from_props mapper loc props_with_children in
1691+
let jsx_expr, key_and_unit =
1692+
let mk_element_bind (jsx_part : string) : Longident.t =
1693+
match component_description with
1694+
| FragmentComponent | UppercasedComponent ->
1695+
module_access_name config jsx_part
1696+
| LowercasedComponent ->
1697+
let element_binding =
1698+
match config.module_ |> String.lowercase_ascii with
1699+
| "react" -> Lident "ReactDOM"
1700+
| _generic -> module_access_name config "Elements"
1701+
in
1702+
Ldot (element_binding, jsx_part)
1703+
in
1704+
match try_find_key_prop props with
1705+
| None ->
1706+
( Exp.ident
1707+
{
1708+
loc = Location.none;
1709+
txt =
1710+
mk_element_bind
1711+
(if more_than_one_children then "jsxs" else "jsx");
1712+
},
1713+
[] )
1714+
| Some key_prop ->
1715+
( Exp.ident
1716+
{
1717+
loc = Location.none;
1718+
txt =
1719+
mk_element_bind
1720+
(if more_than_one_children then "jsxsKeyed" else "jsxKeyed");
1721+
},
1722+
[key_prop; (nolabel, unit_expr ~loc:Location.none)] )
1723+
in
1724+
let args =
1725+
[(nolabel, elementTag); (nolabel, props_record)] @ key_and_unit
1726+
in
1727+
Exp.apply ~loc ~attrs jsx_expr args
1728+
16571729
let expr ~(config : Jsx_common.jsx_config) mapper expression =
16581730
match expression with
16591731
| {
@@ -1665,7 +1737,8 @@ module AutomaticExpr = struct
16651737
let fragment =
16661738
Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"}
16671739
in
1668-
mk_react_jsx config mapper loc attrs fragment children
1740+
mk_react_jsx config mapper loc attrs FragmentComponent fragment []
1741+
children
16691742
| {
16701743
pexp_desc =
16711744
Pexp_jsx_unary_element
@@ -1681,49 +1754,16 @@ module AutomaticExpr = struct
16811754
if starts_with_lowercase name then
16821755
(* For example 'input' *)
16831756
let component_name_expr = constant_string ~loc:tag_name.loc name in
1684-
let element_binding =
1685-
match config.module_ |> String.lowercase_ascii with
1686-
| "react" -> Lident "ReactDOM"
1687-
| _generic -> module_access_name config "Elements"
1688-
in
1689-
let jsx_expr, key_and_unit =
1690-
match try_find_key_prop props with
1691-
| None ->
1692-
( Exp.ident
1693-
{loc = Location.none; txt = Ldot (element_binding, "jsx")},
1694-
[] )
1695-
| Some key_prop ->
1696-
( Exp.ident
1697-
{loc = Location.none; txt = Ldot (element_binding, "jsxKeyed")},
1698-
[key_prop; (nolabel, unit_expr ~loc:Location.none)] )
1699-
in
1700-
let props = mk_record_from_props mapper loc props in
1701-
1702-
Exp.apply ~loc ~attrs jsx_expr
1703-
([(nolabel, component_name_expr); (nolabel, props)] @ key_and_unit)
1757+
mk_react_jsx config mapper loc attrs LowercasedComponent
1758+
component_name_expr props (JSXChildrenItems [])
17041759
else if starts_with_uppercase name then
17051760
(* MyModule.make *)
17061761
let make_id =
17071762
Exp.ident ~loc:tag_name.loc
17081763
{txt = Ldot (tag_name.txt, "make"); loc = tag_name.loc}
17091764
in
1710-
let jsx_expr, key_and_unit =
1711-
match try_find_key_prop props with
1712-
| None ->
1713-
( Exp.ident
1714-
{loc = Location.none; txt = module_access_name config "jsx"},
1715-
[] )
1716-
| Some key_prop ->
1717-
( Exp.ident
1718-
{
1719-
loc = Location.none;
1720-
txt = module_access_name config "jsxKeyed";
1721-
},
1722-
[key_prop; (nolabel, unit_expr ~loc:Location.none)] )
1723-
in
1724-
let props = mk_record_from_props mapper loc props in
1725-
Exp.apply ~loc ~attrs jsx_expr
1726-
([(nolabel, make_id); (nolabel, props)] @ key_and_unit)
1765+
mk_react_jsx config mapper loc attrs UppercasedComponent make_id props
1766+
(JSXChildrenItems [])
17271767
else
17281768
Jsx_common.raise_error ~loc
17291769
"JSX: element name is neither upper- or lowercase, got \"%s\""
@@ -1744,151 +1784,18 @@ module AutomaticExpr = struct
17441784
(* For example: <div> <h1></h1> <br /> </div>
17451785
This has an impact if we want to use ReactDOM.jsx or ReactDOM.jsxs
17461786
*)
1747-
let has_multiple_literal_children =
1748-
match children with
1749-
| JSXChildrenItems (_ :: _ :: _) -> true
1750-
| _ -> false
1751-
in
17521787
if starts_with_lowercase name then
17531788
let component_name_expr = constant_string ~loc:tag_name.loc name in
1754-
let element_binding =
1755-
match config.module_ |> String.lowercase_ascii with
1756-
| "react" -> Lident "ReactDOM"
1757-
| _generic -> module_access_name config "Elements"
1758-
in
1759-
let props_record =
1760-
(* Append current props with JSXPropValue("children")
1761-
This will later be transformed correctly into a record. *)
1762-
let props_with_children =
1763-
match children with
1764-
| JSXChildrenItems [] -> props
1765-
| JSXChildrenItems [expr] | JSXChildrenSpreading expr ->
1766-
props
1767-
@ [
1768-
JSXPropValue
1769-
( {txt = "children"; loc = Location.none},
1770-
true,
1771-
Exp.apply
1772-
(Exp.ident
1773-
{
1774-
txt = Ldot (element_binding, "someElement");
1775-
loc = Location.none;
1776-
})
1777-
[(Nolabel, expr)] );
1778-
]
1779-
| JSXChildrenItems xs ->
1780-
(* this is a hack to support react components that introspect into their children *)
1781-
props
1782-
@ [
1783-
JSXPropValue
1784-
( {txt = "children"; loc = Location.none},
1785-
false,
1786-
Exp.apply
1787-
(Exp.ident
1788-
{
1789-
txt = module_access_name config "array";
1790-
loc = Location.none;
1791-
})
1792-
[
1793-
(Nolabel, Exp.array (List.map (mapper.expr mapper) xs));
1794-
] );
1795-
]
1796-
in
1797-
mk_record_from_props mapper loc props_with_children
1798-
in
1799-
let jsx_expr, key_and_unit =
1800-
match try_find_key_prop props with
1801-
| None ->
1802-
( Exp.ident
1803-
{
1804-
loc = Location.none;
1805-
txt =
1806-
Ldot
1807-
( element_binding,
1808-
if has_multiple_literal_children then "jsxs" else "jsx"
1809-
);
1810-
},
1811-
[] )
1812-
| Some key_prop ->
1813-
( Exp.ident
1814-
{
1815-
loc = Location.none;
1816-
txt =
1817-
Ldot
1818-
( element_binding,
1819-
if has_multiple_literal_children then "jsxsKeyed"
1820-
else "jsxKeyed" );
1821-
},
1822-
[key_prop; (nolabel, unit_expr ~loc:Location.none)] )
1823-
in
1824-
1825-
Exp.apply ~loc ~attrs jsx_expr
1826-
([(nolabel, component_name_expr); (nolabel, props_record)]
1827-
@ key_and_unit)
1789+
mk_react_jsx config mapper loc attrs LowercasedComponent
1790+
component_name_expr props children
18281791
else if starts_with_uppercase name then
18291792
(* MyModule.make *)
18301793
let make_id =
18311794
Exp.ident ~loc:tag_name.loc
18321795
{txt = Ldot (tag_name.txt, "make"); loc = tag_name.loc}
18331796
in
1834-
let props_record =
1835-
(* Append current props with JSXPropValue("children")
1836-
This will later be transformed correctly into a record. *)
1837-
let props_with_children =
1838-
match children with
1839-
| JSXChildrenItems [] -> props
1840-
| JSXChildrenItems [expr] | JSXChildrenSpreading expr ->
1841-
props
1842-
@ [
1843-
JSXPropValue
1844-
( {txt = "children"; loc = Location.none},
1845-
false,
1846-
mapper.expr mapper expr );
1847-
]
1848-
| JSXChildrenItems xs ->
1849-
(* this is a hack to support react components that introspect into their children *)
1850-
props
1851-
@ [
1852-
JSXPropValue
1853-
( {txt = "children"; loc = Location.none},
1854-
false,
1855-
Exp.apply
1856-
(Exp.ident
1857-
{
1858-
txt = module_access_name config "array";
1859-
loc = Location.none;
1860-
})
1861-
[
1862-
(Nolabel, Exp.array (List.map (mapper.expr mapper) xs));
1863-
] );
1864-
]
1865-
in
1866-
mk_record_from_props mapper loc props_with_children
1867-
in
1868-
let jsx_expr, key_and_unit =
1869-
match try_find_key_prop props with
1870-
| None ->
1871-
( Exp.ident
1872-
{
1873-
loc = Location.none;
1874-
txt =
1875-
module_access_name config
1876-
(if has_multiple_literal_children then "jsxs" else "jsx");
1877-
},
1878-
[] )
1879-
| Some key_prop ->
1880-
( Exp.ident
1881-
{
1882-
loc = Location.none;
1883-
txt =
1884-
module_access_name config
1885-
(if has_multiple_literal_children then "jsxsKeyed"
1886-
else "jsxKeyed");
1887-
},
1888-
[key_prop; (nolabel, unit_expr ~loc:Location.none)] )
1889-
in
1890-
Exp.apply ~loc ~attrs jsx_expr
1891-
([(nolabel, make_id); (nolabel, props_record)] @ key_and_unit)
1797+
mk_react_jsx config mapper loc attrs UppercasedComponent make_id props
1798+
children
18921799
else
18931800
Jsx_common.raise_error ~loc
18941801
"JSX: element name is neither upper- or lowercase, got \"%s\""

‎compiler/syntax/src/res_core.ml‎

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2653,11 +2653,7 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p :
26532653
(Diagnostics.message msg);
26542654
Parser.expect GreaterThan p
26552655
in
2656-
failwith "Unsure how you can get here"
2657-
(* let loc = mk_loc children_start_pos children_end_pos in
2658-
match (spread, children) with
2659-
| true, child :: _ -> child
2660-
| _ -> Ast_helper.Exp.make_list_expression loc children None)) *)
2656+
Ast_helper.Exp.make_list_expression (mk_loc p.start_pos p.end_pos) [] None
26612657
)
26622658
| token ->
26632659
Scanner.pop_mode p.scanner Jsx;

0 commit comments

Comments
 (0)