From 2efb5b0710e21ba36d6e229ad83659c33340242d Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Sun, 19 Dec 2021 14:31:46 -0500 Subject: [PATCH 1/9] Add support for tagged template strings [WIP] --- src/res_core.ml | 88 ++++++++++++++++++- src/res_parsetree_viewer.ml | 4 + src/res_parsetree_viewer.mli | 1 + src/res_printer.ml | 43 +++++++++ .../errors/structure/expected/gh16B.res.txt | 12 +-- .../expressions/expected/es6template.res.txt | 70 +++++++-------- .../expr/expected/templateLiteral.res.txt | 6 +- 7 files changed, 180 insertions(+), 44 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index c8532e01..8d7a82c3 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -14,6 +14,12 @@ let mkLoc startLoc endLoc = Location.{ loc_ghost = false; } +let rec filter_map xs (f : 'a -> 'b option) = + match xs with + | [] -> [] + | y :: ys -> ( + match f y with None -> filter_map ys f | Some z -> z :: filter_map ys f) + module Recover = struct let defaultExpr () = let id = Location.mknoloc "rescript.exprhole" in @@ -137,6 +143,7 @@ let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr []) let suppressFragileMatchWarningAttr = (Location.mknoloc "warning", Parsetree.PStr [Ast_helper.Str.eval (Ast_helper.Exp.constant (Pconst_string ("-4", None)))]) let makeBracesAttr loc = (Location.mkloc "ns.braces" loc, Parsetree.PStr []) let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) +let taggedTemplateLiteralAttr = (Location.mknoloc "res.taggedTemplate", Parsetree.PStr []) type stringLiteralState = | Start @@ -2217,6 +2224,85 @@ and parseBinaryExpr ?(context=OrdinaryExpr) ?a p prec = (* ) *) and parseTemplateExpr ?(prefix="js") p = + (* TODO: include the location in the parts *) + let partPrefix = if prefix = "js" || prefix = "j" then Some(prefix) else None in + + let rec parseParts p = + let startPos = p.Parser.startPos in + Parser.nextTemplateLiteralToken p; + match p.token with + | TemplateTail txt -> + Parser.next p; + let loc = mkLoc startPos p.prevEndPos in + let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in + let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, partPrefix)) in + (* Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator *) + [(str, None)] + | TemplatePart txt -> + Parser.next p; + let loc = mkLoc startPos p.prevEndPos in + let expr = parseExprBlock p in + (* let fullLoc = mkLoc startPos p.prevEndPos in *) + let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in + let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, partPrefix)) in + (* let next = + let a = Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc:fullLoc hiddenOperator [Nolabel, acc; Nolabel, str] in + Ast_helper.Exp.apply ~loc:fullLoc hiddenOperator + [Nolabel, a; Nolabel, expr] + in *) + let next = parseParts p in + (str, Some(expr)) :: next + | token -> + Parser.err p (Diagnostics.unexpected token p.breadcrumbs); + (* Ast_helper.Exp.constant (Pconst_string("", None)) *) + [] + in + let parts = parseParts p in + let strings = List.map fst parts in + let values = filter_map parts snd in + + let genTaggedTemplateCall () = + let lident = Longident.Lident prefix in + let ident = Ast_helper.Exp.ident ~attrs:[] ~loc:Location.none (Location.mknoloc lident) in + let strings_array = Ast_helper.Exp.array ~attrs:[] ~loc:Location.none strings in + let values_array = Ast_helper.Exp.array ~attrs:[] ~loc:Location.none values in + Ast_helper.Exp.apply + ~attrs:[taggedTemplateLiteralAttr] + ~loc:Location.none ident + [(Nolabel, strings_array); (Nolabel, values_array)] + in + + let hiddenOperator = + let op = Location.mknoloc (Longident.Lident "^") in + Ast_helper.Exp.ident op + in + let genInterpolatedString () = + let fn acc part = + let (str, value) = part in + let loc = Location.none in + let next = match acc with + | Some(expr) -> Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator + [Nolabel, expr; Nolabel, str] + | None -> str + in + let result = match value with + | Some(expr) -> Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator + [Nolabel, next; Nolabel, expr] + | None -> next + in + Some(result) + in + List.fold_left fn None parts + in + + if prefix = "js" || prefix = "j" then + match genInterpolatedString () with + | Some(expr) -> expr + | None -> Ast_helper.Exp.constant (Pconst_string("", None)) + else + genTaggedTemplateCall (); + +(* and parseTemplateExpr ?(prefix="js") p = let hiddenOperator = let op = Location.mknoloc (Longident.Lident "^") in Ast_helper.Exp.ident op @@ -2269,7 +2355,7 @@ and parseTemplateExpr ?(prefix="js") p = parseParts next | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Ast_helper.Exp.constant (Pconst_string("", None)) + Ast_helper.Exp.constant (Pconst_string("", None)) *) (* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int => * Also overparse constraints: diff --git a/src/res_parsetree_viewer.ml b/src/res_parsetree_viewer.ml index 3bb2da3d..49463f8c 100644 --- a/src/res_parsetree_viewer.ml +++ b/src/res_parsetree_viewer.ml @@ -516,6 +516,10 @@ let hasTemplateLiteralAttr attrs = List.exists (fun attr -> match attr with | ({Location.txt = "res.template"}, _) -> true | _ -> false) attrs +let hasTaggedTemplateLiteralAttr attrs = List.exists (fun attr -> match attr with +| ({Location.txt = "res.taggedTemplate"}, _) -> true +| _ -> false) attrs + let isTemplateLiteral expr = match expr.pexp_desc with | Pexp_apply ( diff --git a/src/res_parsetree_viewer.mli b/src/res_parsetree_viewer.mli index 65a67367..d9437e7b 100644 --- a/src/res_parsetree_viewer.mli +++ b/src/res_parsetree_viewer.mli @@ -110,6 +110,7 @@ val isBlockExpr : Parsetree.expression -> bool val isTemplateLiteral: Parsetree.expression -> bool val hasTemplateLiteralAttr: Parsetree.attributes -> bool +val hasTaggedTemplateLiteralAttr: Parsetree.attributes -> bool val collectOrPatternChain: Parsetree.pattern -> Parsetree.pattern list diff --git a/src/res_printer.ml b/src/res_printer.ml index 42d2de77..a5603672 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -3399,6 +3399,46 @@ and printTemplateLiteral expr cmtTbl = Doc.text "`" ] +and printTaggedTemplateLiteral callExpr args cmtTbl = + let (stringsList, valuesList) = match args with + | [ + (_, {Parsetree.pexp_desc = Pexp_array strings}); + (_, {Parsetree.pexp_desc = Pexp_array values}) + ] -> (strings, values) + | _ -> assert false + in + + let strings = List.map ( + fun x -> match x with + | {Parsetree.pexp_desc = Pexp_constant (Pconst_string (txt, _))} -> + printStringContents txt + | _ -> assert false + ) stringsList in + + let values = List.map (fun x -> + Doc.concat [ + Doc.text "${"; + printExpressionWithComments x cmtTbl; + Doc.text "}" + ]) valuesList in + + let rec process first second = + match first, second with + | [], [] -> Doc.text "" + | a_head :: a_rest, b -> Doc.concat [a_head; process b a_rest] + | _ -> assert false + in + + let content = process strings values in + + let tag = printExpressionWithComments callExpr cmtTbl in + Doc.concat [ + tag; + Doc.text "`"; + content; + Doc.text "`"; + ] + and printUnaryExpression expr cmtTbl = let printUnaryOperator op = Doc.text ( match op with @@ -3821,6 +3861,9 @@ and printPexpApply expr cmtTbl = args ) when ParsetreeViewer.isJsxExpression expr -> printJsxExpression lident args cmtTbl + | Pexp_apply (callExpr, args) + when ParsetreeViewer.hasTaggedTemplateLiteralAttr expr.pexp_attributes -> + printTaggedTemplateLiteral callExpr args cmtTbl | Pexp_apply (callExpr, args) -> let args = List.map (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg) diff --git a/tests/parsing/errors/structure/expected/gh16B.res.txt b/tests/parsing/errors/structure/expected/gh16B.res.txt index 23cfa8a5..3580faf6 100644 --- a/tests/parsing/errors/structure/expected/gh16B.res.txt +++ b/tests/parsing/errors/structure/expected/gh16B.res.txt @@ -19,12 +19,12 @@ let log msg = (((((({js|> Server: |js})[@res.template ]) ^ msg)[@res.template ]) ^ (({js||js})[@res.template ]))[@res.template ]) ;;log - (((((((((((({js|Running on: |js})[@res.template ]) ^ address.address) - [@res.template ]) ^ (({js|:|js})[@res.template ])) - [@res.template ]) ^ (address.port |. string_of_int)) - ^ (({js| (|js})[@res.template ])) - [@res.template ]) ^ address.family) - ^ (({js|)|js})[@res.template ]))[@res.template ]) + (((((((((((((({js|Running on: |js})[@res.template ]) ^ address.address) + [@res.template ]) ^ (({js|:|js})[@res.template ])) + [@res.template ]) ^ (address.port |. string_of_int)) + [@res.template ]) ^ (({js| (|js})[@res.template ])) + [@res.template ]) ^ address.family) + [@res.template ]) ^ (({js|)|js})[@res.template ]))[@res.template ]) module ClientSet = struct module T = diff --git a/tests/parsing/grammar/expressions/expected/es6template.res.txt b/tests/parsing/grammar/expressions/expected/es6template.res.txt index a179529e..aa040cc7 100644 --- a/tests/parsing/grammar/expressions/expected/es6template.res.txt +++ b/tests/parsing/grammar/expressions/expected/es6template.res.txt @@ -33,46 +33,46 @@ let s = (({js| after|js})[@res.template ])) [@res.template ]) let s = - ((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ (({js||js}) - [@res.template ])) - [@res.template ]) ^ bar) - ^ (({js||js})[@res.template ])) + (((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ (({js||js}) + [@res.template ])) + [@res.template ]) ^ bar) + [@res.template ]) ^ (({js||js})[@res.template ])) [@res.template ]) let s = - (((((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ - (({js||js})[@res.template ])) - [@res.template ]) ^ bar) - ^ (({js||js})[@res.template ])) - [@res.template ]) ^ baz) - ^ (({js||js})[@res.template ])) + (((((((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ + (({js||js})[@res.template ])) + [@res.template ]) ^ bar) + [@res.template ]) ^ (({js||js})[@res.template ])) + [@res.template ]) ^ baz) + [@res.template ]) ^ (({js||js})[@res.template ])) [@res.template ]) let s = - ((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ (({js| |js}) - [@res.template ])) - [@res.template ]) ^ bar) - ^ (({js||js})[@res.template ])) + (((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ (({js| |js}) + [@res.template ])) + [@res.template ]) ^ bar) + [@res.template ]) ^ (({js||js})[@res.template ])) [@res.template ]) let s = - (((((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ - (({js| |js})[@res.template ])) - [@res.template ]) ^ bar) - ^ (({js| |js})[@res.template ])) - [@res.template ]) ^ baz) - ^ (({js||js})[@res.template ])) + (((((((((((((({js||js})[@res.template ]) ^ foo)[@res.template ]) ^ + (({js| |js})[@res.template ])) + [@res.template ]) ^ bar) + [@res.template ]) ^ (({js| |js})[@res.template ])) + [@res.template ]) ^ baz) + [@res.template ]) ^ (({js||js})[@res.template ])) [@res.template ]) let s = - ((((((((({js| before |js})[@res.template ]) ^ foo)[@res.template ]) ^ - (({js| |js})[@res.template ])) - [@res.template ]) ^ bar) - ^ (({js| after |js})[@res.template ])) + (((((((((({js| before |js})[@res.template ]) ^ foo)[@res.template ]) ^ + (({js| |js})[@res.template ])) + [@res.template ]) ^ bar) + [@res.template ]) ^ (({js| after |js})[@res.template ])) [@res.template ]) let s = - (((((((((((({js|before |js})[@res.template ]) ^ foo)[@res.template ]) ^ - (({js| middle |js})[@res.template ])) - [@res.template ]) ^ bar) - ^ (({js| |js})[@res.template ])) - [@res.template ]) ^ baz) - ^ (({js| wow |js})[@res.template ])) + (((((((((((((({js|before |js})[@res.template ]) ^ foo)[@res.template ]) ^ + (({js| middle |js})[@res.template ])) + [@res.template ]) ^ bar) + [@res.template ]) ^ (({js| |js})[@res.template ])) + [@res.template ]) ^ baz) + [@res.template ]) ^ (({js| wow |js})[@res.template ])) [@res.template ]) let s = (({js| @@ -90,13 +90,13 @@ let s = |js}) [@res.template ]) let s = (({js|$dollar without $braces $interpolation|js})[@res.template ]) -let s = (({json|null|json})[@res.template ]) +let s = ((json [|(("null")[@res.template ])|] [||])[@res.taggedTemplate ]) let x = (({js|foo`bar$\foo|js})[@res.template ]) let x = - ((((((((({js|foo`bar$\foo|js})[@res.template ]) ^ a)[@res.template ]) ^ - (({js| ` |js})[@res.template ])) - [@res.template ]) ^ b) - ^ (({js| ` xx|js})[@res.template ])) + (((((((((({js|foo`bar$\foo|js})[@res.template ]) ^ a)[@res.template ]) ^ + (({js| ` |js})[@res.template ])) + [@res.template ]) ^ b) + [@res.template ]) ^ (({js| ` xx|js})[@res.template ])) [@res.template ]) let thisIsFine = (({js|$something|js})[@res.template ]) let thisIsAlsoFine = (({js|fine$|js})[@res.template ]) diff --git a/tests/printer/expr/expected/templateLiteral.res.txt b/tests/printer/expr/expected/templateLiteral.res.txt index 740691ac..db9a0a43 100644 --- a/tests/printer/expr/expected/templateLiteral.res.txt +++ b/tests/printer/expr/expected/templateLiteral.res.txt @@ -73,7 +73,8 @@ module X = %graphql(" } ") -let cn = css` +let cn = + css` display: block; color: ${Color.text}; background-color: ${Color.bg}; @@ -91,7 +92,8 @@ let cn = css` padding: ${Size.md + 1 - 2.3 * pad / 4}px; ` -let box = css` +let box = + css` margin: ${ten()}px; padding: ${pad}px; border: 6px solid ${Color.Border.bg->Polished.lighten(0.3)}; From 2985c6c5997ef5a9b0684f06a2134aff2c389741 Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Sun, 19 Dec 2021 19:07:39 -0500 Subject: [PATCH 2/9] move location of printTaggedTemplateLiteral, inline some helper functions --- src/res_core.ml | 35 +++++++++++++++++------------------ src/res_parsetree_viewer.ml | 5 +++++ src/res_parsetree_viewer.mli | 2 +- src/res_printer.ml | 7 +++---- 4 files changed, 26 insertions(+), 23 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 8d7a82c3..b2ebc2d9 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2250,8 +2250,7 @@ and parseTemplateExpr ?(prefix="js") p = Ast_helper.Exp.apply ~loc:fullLoc hiddenOperator [Nolabel, a; Nolabel, expr] in *) - let next = parseParts p in - (str, Some(expr)) :: next + (str, Some(expr)) :: parseParts p | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); (* Ast_helper.Exp.constant (Pconst_string("", None)) *) @@ -2272,27 +2271,27 @@ and parseTemplateExpr ?(prefix="js") p = [(Nolabel, strings_array); (Nolabel, values_array)] in + let loc = Location.none in let hiddenOperator = let op = Location.mknoloc (Longident.Lident "^") in Ast_helper.Exp.ident op in let genInterpolatedString () = - let fn acc part = - let (str, value) = part in - let loc = Location.none in - let next = match acc with - | Some(expr) -> Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator - [Nolabel, expr; Nolabel, str] - | None -> str - in - let result = match value with - | Some(expr) -> Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator - [Nolabel, next; Nolabel, expr] - | None -> next - in - Some(result) - in - List.fold_left fn None parts + let subparts = List.flatten ( + List.map (fun part -> + match part with + | (s, Some(v)) -> [s; v] + | (s, None) -> [s] + ) + parts) in + List.fold_left (fun acc subpart -> + match acc with + | Some(expr) -> Some( + Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator + [Nolabel, expr; Nolabel, subpart] + ) + | None -> Some(subpart) + ) None subparts in if prefix = "js" || prefix = "j" then diff --git a/src/res_parsetree_viewer.ml b/src/res_parsetree_viewer.ml index 49463f8c..09f17cd9 100644 --- a/src/res_parsetree_viewer.ml +++ b/src/res_parsetree_viewer.ml @@ -530,6 +530,11 @@ let isTemplateLiteral expr = | Pexp_constant _ when hasTemplateLiteralAttr expr.pexp_attributes -> true | _ -> false +let isTaggedTemplateLiteral expr = + match expr with + | {pexp_desc = Pexp_apply _; pexp_attributes = attrs} -> hasTaggedTemplateLiteralAttr attrs + | _ -> false + (* Blue | Red | Green -> [Blue; Red; Green] *) let collectOrPatternChain pat = let rec loop pattern chain = diff --git a/src/res_parsetree_viewer.mli b/src/res_parsetree_viewer.mli index d9437e7b..b75f63dc 100644 --- a/src/res_parsetree_viewer.mli +++ b/src/res_parsetree_viewer.mli @@ -109,8 +109,8 @@ val collectPatternsFromListConstruct: val isBlockExpr : Parsetree.expression -> bool val isTemplateLiteral: Parsetree.expression -> bool +val isTaggedTemplateLiteral: Parsetree.expression -> bool val hasTemplateLiteralAttr: Parsetree.attributes -> bool -val hasTaggedTemplateLiteralAttr: Parsetree.attributes -> bool val collectOrPatternChain: Parsetree.pattern -> Parsetree.pattern list diff --git a/src/res_printer.ml b/src/res_printer.ml index a5603672..70a48531 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -2853,11 +2853,13 @@ and printExpression (e : Parsetree.expression) cmtTbl = | extension -> printExtension ~atModuleLvl:false extension cmtTbl end - | Pexp_apply _ -> + | Pexp_apply (callExpr, args) -> if ParsetreeViewer.isUnaryExpression e then printUnaryExpression e cmtTbl else if ParsetreeViewer.isTemplateLiteral e then printTemplateLiteral e cmtTbl + else if ParsetreeViewer.isTaggedTemplateLiteral e then + printTaggedTemplateLiteral callExpr args cmtTbl else if ParsetreeViewer.isBinaryExpression e then printBinaryExpression e cmtTbl else @@ -3861,9 +3863,6 @@ and printPexpApply expr cmtTbl = args ) when ParsetreeViewer.isJsxExpression expr -> printJsxExpression lident args cmtTbl - | Pexp_apply (callExpr, args) - when ParsetreeViewer.hasTaggedTemplateLiteralAttr expr.pexp_attributes -> - printTaggedTemplateLiteral callExpr args cmtTbl | Pexp_apply (callExpr, args) -> let args = List.map (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg) From e1cd14d43136a39e7d8d54479c74b03378766e4a Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Wed, 22 Dec 2021 22:34:15 -0500 Subject: [PATCH 3/9] Add parsing test for tagged template with interpolations, add location data to nodes in parseTemplateExpr --- src/res_core.ml | 15 +++++++++++---- tests/parsing/grammar/expressions/es6template.res | 2 ++ .../expressions/expected/es6template.res.txt | 5 +++++ 3 files changed, 18 insertions(+), 4 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index b2ebc2d9..b83ddc33 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2226,6 +2226,7 @@ and parseBinaryExpr ?(context=OrdinaryExpr) ?a p prec = and parseTemplateExpr ?(prefix="js") p = (* TODO: include the location in the parts *) let partPrefix = if prefix = "js" || prefix = "j" then Some(prefix) else None in + let startPos = p.Parser.startPos in let rec parseParts p = let startPos = p.Parser.startPos in @@ -2259,6 +2260,7 @@ and parseTemplateExpr ?(prefix="js") p = let parts = parseParts p in let strings = List.map fst parts in let values = filter_map parts snd in + let endPos = p.Parser.endPos in let genTaggedTemplateCall () = let lident = Longident.Lident prefix in @@ -2267,11 +2269,10 @@ and parseTemplateExpr ?(prefix="js") p = let values_array = Ast_helper.Exp.array ~attrs:[] ~loc:Location.none values in Ast_helper.Exp.apply ~attrs:[taggedTemplateLiteralAttr] - ~loc:Location.none ident - [(Nolabel, strings_array); (Nolabel, values_array)] + ~loc:(mkLoc startPos endPos) + ident [(Nolabel, strings_array); (Nolabel, values_array)] in - let loc = Location.none in let hiddenOperator = let op = Location.mknoloc (Longident.Lident "^") in Ast_helper.Exp.ident op @@ -2286,7 +2287,12 @@ and parseTemplateExpr ?(prefix="js") p = parts) in List.fold_left (fun acc subpart -> match acc with - | Some(expr) -> Some( + | Some(expr) -> + let loc = (mkLoc + (expr.Parsetree.pexp_loc.Location.loc_start) + (subpart.Parsetree.pexp_loc.Location.loc_end) + ) in + Some( Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator [Nolabel, expr; Nolabel, subpart] ) @@ -2301,6 +2307,7 @@ and parseTemplateExpr ?(prefix="js") p = else genTaggedTemplateCall (); +(* TODO: Use Res_doc.debug to determine why the old implementation doesn't have an extra space *) (* and parseTemplateExpr ?(prefix="js") p = let hiddenOperator = let op = Location.mknoloc (Longident.Lident "^") in diff --git a/tests/parsing/grammar/expressions/es6template.res b/tests/parsing/grammar/expressions/es6template.res index a110baff..5937eb95 100644 --- a/tests/parsing/grammar/expressions/es6template.res +++ b/tests/parsing/grammar/expressions/es6template.res @@ -43,6 +43,8 @@ let s = `$dollar without $braces $interpolation` let s = json`null` +let x = sql`select ${column} from ${table}` + let x = `foo\`bar\$\\foo` let x = `foo\`bar\$\\foo${a} \` ${b} \` xx` diff --git a/tests/parsing/grammar/expressions/expected/es6template.res.txt b/tests/parsing/grammar/expressions/expected/es6template.res.txt index aa040cc7..b1d33d1c 100644 --- a/tests/parsing/grammar/expressions/expected/es6template.res.txt +++ b/tests/parsing/grammar/expressions/expected/es6template.res.txt @@ -91,6 +91,11 @@ let s = [@res.template ]) let s = (({js|$dollar without $braces $interpolation|js})[@res.template ]) let s = ((json [|(("null")[@res.template ])|] [||])[@res.taggedTemplate ]) +let x = + ((sql + [|(("select ")[@res.template ]);((" from ")[@res.template ]);(("") + [@res.template ])|] [|column;table|]) + [@res.taggedTemplate ]) let x = (({js|foo`bar$\foo|js})[@res.template ]) let x = (((((((((({js|foo`bar$\foo|js})[@res.template ]) ^ a)[@res.template ]) ^ From 6a8dc57068e27a9274fc174fcb827de62bb00192 Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Wed, 22 Dec 2021 23:26:15 -0500 Subject: [PATCH 4/9] make helper functions taill-recursive --- src/res_core.ml | 70 +++++++++++++++++++++++----------------------- src/res_printer.ml | 15 ++++++---- 2 files changed, 44 insertions(+), 41 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index b83ddc33..eb2e0a2c 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -14,11 +14,15 @@ let mkLoc startLoc endLoc = Location.{ loc_ghost = false; } -let rec filter_map xs (f : 'a -> 'b option) = - match xs with - | [] -> [] +let filter_map (f : 'a -> 'b option) xs = + let rec aux acc = function + | [] -> List.rev acc | y :: ys -> ( - match f y with None -> filter_map ys f | Some z -> z :: filter_map ys f) + match f y with + | None -> aux acc ys + | Some z -> aux (z :: acc) ys + ) + in aux [] xs module Recover = struct let defaultExpr () = @@ -2224,42 +2228,38 @@ and parseBinaryExpr ?(context=OrdinaryExpr) ?a p prec = (* ) *) and parseTemplateExpr ?(prefix="js") p = - (* TODO: include the location in the parts *) - let partPrefix = if prefix = "js" || prefix = "j" then Some(prefix) else None in + let partPrefix = match prefix with + | "js" | "j" -> Some(prefix) + | _ -> None + in let startPos = p.Parser.startPos in - let rec parseParts p = - let startPos = p.Parser.startPos in - Parser.nextTemplateLiteralToken p; - match p.token with - | TemplateTail txt -> - Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in - let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, partPrefix)) in - (* Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator *) - [(str, None)] - | TemplatePart txt -> - Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let expr = parseExprBlock p in - (* let fullLoc = mkLoc startPos p.prevEndPos in *) - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in - let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, partPrefix)) in - (* let next = - let a = Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc:fullLoc hiddenOperator [Nolabel, acc; Nolabel, str] in - Ast_helper.Exp.apply ~loc:fullLoc hiddenOperator - [Nolabel, a; Nolabel, expr] - in *) - (str, Some(expr)) :: parseParts p - | token -> - Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - (* Ast_helper.Exp.constant (Pconst_string("", None)) *) - [] + let parseParts p = + let rec aux acc = + let startPos = p.Parser.startPos in + Parser.nextTemplateLiteralToken p; + match p.token with + | TemplateTail txt -> + Parser.next p; + let loc = mkLoc startPos p.prevEndPos in + let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in + let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, partPrefix)) in + List.rev ((str, None) :: acc) + | TemplatePart txt -> + Parser.next p; + let loc = mkLoc startPos p.prevEndPos in + let expr = parseExprBlock p in + let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in + let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, partPrefix)) in + aux ((str, Some(expr)) :: acc) + | token -> + Parser.err p (Diagnostics.unexpected token p.breadcrumbs); + [] + in aux [] in let parts = parseParts p in let strings = List.map fst parts in - let values = filter_map parts snd in + let values = filter_map snd parts in let endPos = p.Parser.endPos in let genTaggedTemplateCall () = diff --git a/src/res_printer.ml b/src/res_printer.ml index 70a48531..08728cda 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -3424,14 +3424,17 @@ and printTaggedTemplateLiteral callExpr args cmtTbl = Doc.text "}" ]) valuesList in - let rec process first second = - match first, second with - | [], [] -> Doc.text "" - | a_head :: a_rest, b -> Doc.concat [a_head; process b a_rest] - | _ -> assert false + let process strings values = + let rec aux acc = function + | [], [] -> acc + | a_head :: a_rest, b -> + aux (Doc.concat [acc; a_head]) (b, a_rest) + | _ -> assert false + in + aux Doc.nil (strings, values) in - let content = process strings values in + let content: Doc.t = process strings values in let tag = printExpressionWithComments callExpr cmtTbl in Doc.concat [ From 7e97d58f494e6bfd126837c5f2e8cb9e48012966 Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Wed, 22 Dec 2021 23:30:21 -0500 Subject: [PATCH 5/9] remove commented out code --- src/res_core.ml | 56 ------------------------------------------------- 1 file changed, 56 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index eb2e0a2c..4137239e 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2307,62 +2307,6 @@ and parseTemplateExpr ?(prefix="js") p = else genTaggedTemplateCall (); -(* TODO: Use Res_doc.debug to determine why the old implementation doesn't have an extra space *) -(* and parseTemplateExpr ?(prefix="js") p = - let hiddenOperator = - let op = Location.mknoloc (Longident.Lident "^") in - Ast_helper.Exp.ident op - in - let rec parseParts acc = - let startPos = p.Parser.startPos in - Parser.nextTemplateLiteralToken p; - match p.token with - | TemplateTail txt -> - Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in - let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, Some prefix)) in - Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator - [Nolabel, acc; Nolabel, str] - | TemplatePart txt -> - Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let expr = parseExprBlock p in - let fullLoc = mkLoc startPos p.prevEndPos in - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in - let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc (Pconst_string(txt, Some prefix)) in - let next = - let a = Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc:fullLoc hiddenOperator [Nolabel, acc; Nolabel, str] in - Ast_helper.Exp.apply ~loc:fullLoc hiddenOperator - [Nolabel, a; Nolabel, expr] - in - parseParts next - | token -> - Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Ast_helper.Exp.constant (Pconst_string("", None)) - in - let startPos = p.startPos in - Parser.nextTemplateLiteralToken p; - match p.token with - | TemplateTail txt -> - Parser.next p; - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in - Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc:(mkLoc startPos p.prevEndPos) (Pconst_string(txt, Some prefix)) - | TemplatePart txt -> - Parser.next p; - let constantLoc = mkLoc startPos p.prevEndPos in - let expr = parseExprBlock p in - let fullLoc = mkLoc startPos p.prevEndPos in - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in - let str = Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc:constantLoc (Pconst_string(txt, Some prefix)) in - let next = - Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc:fullLoc hiddenOperator [Nolabel, str; Nolabel, expr] - in - parseParts next - | token -> - Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Ast_helper.Exp.constant (Pconst_string("", None)) *) - (* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int => * Also overparse constraints: * let x = { From b2a460752fa495b2a29a70a573c8e3f1272595fc Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Wed, 22 Dec 2021 23:38:10 -0500 Subject: [PATCH 6/9] replace if-else at the end of parseTemplateExpr with match --- src/res_core.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index 4137239e..e80799d1 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2300,12 +2300,13 @@ and parseTemplateExpr ?(prefix="js") p = ) None subparts in - if prefix = "js" || prefix = "j" then + match prefix with + | "js" | "j" -> begin match genInterpolatedString () with | Some(expr) -> expr | None -> Ast_helper.Exp.constant (Pconst_string("", None)) - else - genTaggedTemplateCall (); + end + | _ -> genTaggedTemplateCall () (* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int => * Also overparse constraints: From 1bcd1442688dac0827f2d023a0df9a7133195d5f Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Wed, 22 Dec 2021 23:44:51 -0500 Subject: [PATCH 7/9] reorganize the code in parseTemplateExpr a bit more --- src/res_core.ml | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/res_core.ml b/src/res_core.ml index e80799d1..e0129f79 100644 --- a/src/res_core.ml +++ b/src/res_core.ml @@ -2284,28 +2284,30 @@ and parseTemplateExpr ?(prefix="js") p = | (s, Some(v)) -> [s; v] | (s, None) -> [s] ) - parts) in - List.fold_left (fun acc subpart -> - match acc with - | Some(expr) -> - let loc = (mkLoc - (expr.Parsetree.pexp_loc.Location.loc_start) - (subpart.Parsetree.pexp_loc.Location.loc_end) - ) in + parts) + in + let exprOption = List.fold_left ( + fun acc subpart -> Some( - Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator - [Nolabel, expr; Nolabel, subpart] + match acc with + | Some(expr) -> + let loc = (mkLoc + (expr.Parsetree.pexp_loc.Location.loc_start) + (subpart.Parsetree.pexp_loc.Location.loc_end) + ) in + Ast_helper.Exp.apply + ~attrs:[templateLiteralAttr] ~loc hiddenOperator [Nolabel, expr; Nolabel, subpart] + | None -> subpart ) - | None -> Some(subpart) - ) None subparts + ) + None subparts + in match exprOption with + | Some(expr) -> expr + | None -> Ast_helper.Exp.constant (Pconst_string("", None)) in match prefix with - | "js" | "j" -> begin - match genInterpolatedString () with - | Some(expr) -> expr - | None -> Ast_helper.Exp.constant (Pconst_string("", None)) - end + | "js" | "j" -> genInterpolatedString () | _ -> genTaggedTemplateCall () (* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int => From b9e490b107399d453f751433e52aa14e7dc885a4 Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Thu, 23 Dec 2021 17:15:28 -0500 Subject: [PATCH 8/9] remove extra new line when printing tagged template literals --- src/res_printer.ml | 11 ++++++----- tests/printer/expr/expected/templateLiteral.res.txt | 6 ++---- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/src/res_printer.ml b/src/res_printer.ml index 08728cda..b1f1935f 100644 --- a/src/res_printer.ml +++ b/src/res_printer.ml @@ -1999,11 +1999,12 @@ and printValueBinding ~recFlag vb cmtTbl i = pexp_desc = Pexp_ifthenelse (ifExpr, _, _) } -> ParsetreeViewer.isBinaryExpression ifExpr || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes - | { pexp_desc = Pexp_newtype _} -> false - | e -> - ParsetreeViewer.hasAttributes e.pexp_attributes || - ParsetreeViewer.isArrayAccess e - ) + | { pexp_desc = Pexp_newtype _} -> false + | { pexp_attributes = [({Location.txt="res.taggedTemplate"}, _)] } -> false + | e -> + ParsetreeViewer.hasAttributes e.pexp_attributes || + ParsetreeViewer.isArrayAccess e + ) in Doc.group ( Doc.concat [ diff --git a/tests/printer/expr/expected/templateLiteral.res.txt b/tests/printer/expr/expected/templateLiteral.res.txt index db9a0a43..740691ac 100644 --- a/tests/printer/expr/expected/templateLiteral.res.txt +++ b/tests/printer/expr/expected/templateLiteral.res.txt @@ -73,8 +73,7 @@ module X = %graphql(" } ") -let cn = - css` +let cn = css` display: block; color: ${Color.text}; background-color: ${Color.bg}; @@ -92,8 +91,7 @@ let cn = padding: ${Size.md + 1 - 2.3 * pad / 4}px; ` -let box = - css` +let box = css` margin: ${ten()}px; padding: ${pad}px; border: 6px solid ${Color.Border.bg->Polished.lighten(0.3)}; From 6e489d1b5be109ad76d7b7f0d052eea9b2b4af60 Mon Sep 17 00:00:00 2001 From: Kevin Barabash Date: Thu, 23 Dec 2021 21:30:36 -0500 Subject: [PATCH 9/9] convert ocamlString.ml test to .res --- ...ocamlString.ml.txt => ocamlString.res.txt} | 10 +++---- tests/printer/other/ocamlString.ml | 27 ------------------- tests/printer/other/ocamlString.res | 27 +++++++++++++++++++ 3 files changed, 32 insertions(+), 32 deletions(-) rename tests/printer/other/expected/{ocamlString.ml.txt => ocamlString.res.txt} (68%) delete mode 100644 tests/printer/other/ocamlString.ml create mode 100644 tests/printer/other/ocamlString.res diff --git a/tests/printer/other/expected/ocamlString.ml.txt b/tests/printer/other/expected/ocamlString.res.txt similarity index 68% rename from tests/printer/other/expected/ocamlString.ml.txt rename to tests/printer/other/expected/ocamlString.res.txt index 15048c77..54b25701 100644 --- a/tests/printer/other/expected/ocamlString.ml.txt +++ b/tests/printer/other/expected/ocamlString.res.txt @@ -9,18 +9,18 @@ let x = "foo\o012bar" let x = "😁 this works now 😆" let x = `😁 this works now 😆` -/* The `//` should not result into an extra comment */ +// The `//` should not result into an extra comment let x = j`https://www.apple.com` let x = `https://www.apple.com` let x = `https://www.apple.com` -let x = `https://www.apple.com` +let x = "https://www.apple.com" let x = sql`https://www.apple.com` -/* /* */ should not result in an extra comments */ +// /* */ should not result in an extra comments let x = j`/* https://www.apple.com */` let x = `/* https://www.apple.com*/` let x = `/*https://www.apple.com*/` -let x = `/*https://www.apple.com*/` +let x = "/*https://www.apple.com*/" let x = sql`/*https://www.apple.com*/` -let x = `\`https://\${appleWebsite}\`` +let x = `https://${appleWebsite}` diff --git a/tests/printer/other/ocamlString.ml b/tests/printer/other/ocamlString.ml deleted file mode 100644 index a054d8c7..00000000 --- a/tests/printer/other/ocamlString.ml +++ /dev/null @@ -1,27 +0,0 @@ -let x = "\132\149\166" - -let s = "\123 \o111 \xA0" - -let x = "foo\010bar" -let x = "foo\x0Abar" -let x = "foo\o012bar" - -let x = "😁 this works now 😆" -let x = {|😁 this works now 😆|} - - -(* The `//` should not result into an extra comment *) -let x = {j|https://www.apple.com|j} -let x = {|https://www.apple.com|} -let x = {js|https://www.apple.com|js} -let x = {|https://www.apple.com|} -let x = {sql|https://www.apple.com|sql} - -(* /* */ should not result in an extra comments *) -let x = {j|/* https://www.apple.com */|j} -let x = {|/* https://www.apple.com*/|} -let x = {js|/*https://www.apple.com*/|js} -let x = {|/*https://www.apple.com*/|} -let x = {sql|/*https://www.apple.com*/|sql} - -let x = {js|`https://${appleWebsite}`|js} diff --git a/tests/printer/other/ocamlString.res b/tests/printer/other/ocamlString.res new file mode 100644 index 00000000..8f638b19 --- /dev/null +++ b/tests/printer/other/ocamlString.res @@ -0,0 +1,27 @@ +let x = "\132\149\166" + +let s = "\123 \o111 \xA0" + +let x = "foo\010bar" +let x = "foo\x0Abar" +let x = "foo\o012bar" + +let x = "😁 this works now 😆" +let x = `😁 this works now 😆` + + +// The `//` should not result into an extra comment +let x = j`https://www.apple.com` +let x = `https://www.apple.com` +let x = js`https://www.apple.com` +let x = "https://www.apple.com" +let x = sql`https://www.apple.com` + +// /* */ should not result in an extra comments +let x = j`/* https://www.apple.com */` +let x = `/* https://www.apple.com*/` +let x = js`/*https://www.apple.com*/` +let x = "/*https://www.apple.com*/" +let x = sql`/*https://www.apple.com*/` + +let x = js`https://${appleWebsite}`