diff --git a/analysis/vendor/res_syntax/react_jsx_common.ml b/analysis/vendor/res_syntax/jsx_common.ml
similarity index 88%
rename from analysis/vendor/res_syntax/react_jsx_common.ml
rename to analysis/vendor/res_syntax/jsx_common.ml
index 51c471103..4281f0580 100644
--- a/analysis/vendor/res_syntax/react_jsx_common.ml
+++ b/analysis/vendor/res_syntax/jsx_common.ml
@@ -6,11 +6,14 @@ type jsxConfig = {
mutable module_: string;
mutable mode: string;
mutable nestedModules: string list;
- mutable hasReactComponent: bool;
+ mutable hasComponent: bool;
}
(* Helper method to look up the [@react.component] attribute *)
-let hasAttr (loc, _) = loc.txt = "react.component"
+let hasAttr (loc, _) =
+ match loc.txt with
+ | "react.component" | "jsx.component" -> true
+ | _ -> false
(* Iterate over the attributes and try to find the [@react.component] attribute *)
let hasAttrOnBinding {pvb_attributes} =
@@ -20,7 +23,7 @@ let coreTypeOfAttrs attributes =
List.find_map
(fun ({txt}, payload) ->
match (txt, payload) with
- | "react.component", PTyp coreType -> Some coreType
+ | ("react.component" | "jsx.component"), PTyp coreType -> Some coreType
| _ -> None)
attributes
@@ -37,7 +40,7 @@ let typVarsOfCoreType {ptyp_desc} =
let raiseError ~loc msg = Location.raise_errorf ~loc msg
-let raiseErrorMultipleReactComponent ~loc =
+let raiseErrorMultipleComponent ~loc =
raiseError ~loc
"Only one component definition is allowed for each module. Move to a \
submodule or other file if necessary."
diff --git a/analysis/vendor/res_syntax/reactjs_jsx_ppx.ml b/analysis/vendor/res_syntax/jsx_ppx.ml
similarity index 88%
rename from analysis/vendor/res_syntax/reactjs_jsx_ppx.ml
rename to analysis/vendor/res_syntax/jsx_ppx.ml
index f6449a6cc..e362a9c0a 100644
--- a/analysis/vendor/res_syntax/reactjs_jsx_ppx.ml
+++ b/analysis/vendor/res_syntax/jsx_ppx.ml
@@ -50,8 +50,8 @@ let updateConfig config payload =
let fields = getPayloadFields payload in
(match getInt ~key:"version" fields with
| None -> ()
- | Some i -> config.React_jsx_common.version <- i);
- (match getString ~key:"module" fields with
+ | Some i -> config.Jsx_common.version <- i);
+ (match getString ~key:"module_" fields with
| None -> ()
| Some s -> config.module_ <- s);
match getString ~key:"mode" fields with
@@ -68,7 +68,7 @@ let getMapper ~config =
Reactjs_jsx_v3.jsxMapper ~config
in
let expr4, module_binding4, transformSignatureItem4, transformStructureItem4 =
- Reactjs_jsx_v4.jsxMapper ~config
+ Jsx_v4.jsxMapper ~config
in
let expr mapper e =
@@ -89,18 +89,18 @@ let getMapper ~config =
version = config.version;
module_ = config.module_;
mode = config.mode;
- hasReactComponent = config.hasReactComponent;
+ hasComponent = config.hasComponent;
}
in
let restoreConfig oldConfig =
- config.version <- oldConfig.React_jsx_common.version;
+ config.version <- oldConfig.Jsx_common.version;
config.module_ <- oldConfig.module_;
config.mode <- oldConfig.mode;
- config.hasReactComponent <- oldConfig.hasReactComponent
+ config.hasComponent <- oldConfig.hasComponent
in
let signature mapper items =
let oldConfig = saveConfig () in
- config.hasReactComponent <- false;
+ config.hasComponent <- false;
let result =
List.map
(fun item ->
@@ -119,7 +119,7 @@ let getMapper ~config =
in
let structure mapper items =
let oldConfig = saveConfig () in
- config.hasReactComponent <- false;
+ config.hasComponent <- false;
let result =
List.map
(fun item ->
@@ -143,11 +143,11 @@ let rewrite_implementation ~jsxVersion ~jsxModule ~jsxMode
(code : Parsetree.structure) : Parsetree.structure =
let config =
{
- React_jsx_common.version = jsxVersion;
+ Jsx_common.version = jsxVersion;
module_ = jsxModule;
mode = jsxMode;
nestedModules = [];
- hasReactComponent = false;
+ hasComponent = false;
}
in
let mapper = getMapper ~config in
@@ -157,11 +157,11 @@ let rewrite_signature ~jsxVersion ~jsxModule ~jsxMode
(code : Parsetree.signature) : Parsetree.signature =
let config =
{
- React_jsx_common.version = jsxVersion;
+ Jsx_common.version = jsxVersion;
module_ = jsxModule;
mode = jsxMode;
nestedModules = [];
- hasReactComponent = false;
+ hasComponent = false;
}
in
let mapper = getMapper ~config in
diff --git a/analysis/vendor/res_syntax/reactjs_jsx_ppx.mli b/analysis/vendor/res_syntax/jsx_ppx.mli
similarity index 100%
rename from analysis/vendor/res_syntax/reactjs_jsx_ppx.mli
rename to analysis/vendor/res_syntax/jsx_ppx.mli
diff --git a/analysis/vendor/res_syntax/reactjs_jsx_v4.ml b/analysis/vendor/res_syntax/jsx_v4.ml
similarity index 90%
rename from analysis/vendor/res_syntax/reactjs_jsx_v4.ml
rename to analysis/vendor/res_syntax/jsx_v4.ml
index 1801edd01..5246bbd31 100644
--- a/analysis/vendor/res_syntax/reactjs_jsx_v4.ml
+++ b/analysis/vendor/res_syntax/jsx_v4.ml
@@ -4,6 +4,8 @@ open Asttypes
open Parsetree
open Longident
+let moduleAccessName config = String.capitalize_ascii config.Jsx_common.module_
+
let nolabel = Nolabel
let labelled str = Labelled str
@@ -27,7 +29,7 @@ let getLabel str =
| Optional str | Labelled str -> str
| Nolabel -> ""
-let optionalAttrs = [React_jsx_common.optionalAttr]
+let optionalAttrs = [Jsx_common.optionalAttr]
let constantString ~loc str =
Ast_helper.Exp.constant ~loc (Pconst_string (str, None))
@@ -93,7 +95,7 @@ let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren =
| [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] ->
acc
| (Nolabel, {pexp_loc}) :: _rest ->
- React_jsx_common.raiseError ~loc:pexp_loc
+ Jsx_common.raiseError ~loc:pexp_loc
"JSX: found non-labelled argument before the last position"
| arg :: rest -> allButLast_ rest (arg :: acc)
in
@@ -110,13 +112,16 @@ let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren =
| [(_, childrenExpr)], props ->
(childrenExpr, if removeLastPositionUnit then allButLast props else props)
| _ ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: somehow there's more than one `children` label"
let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, PStr [])
(* Helper method to filter out any attribute that isn't [@react.component] *)
-let otherAttrsPure (loc, _) = loc.txt <> "react.component"
+let otherAttrsPure (loc, _) =
+ match loc.txt with
+ | "react.component" | "jsx.component" -> false
+ | _ -> true
(* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *)
let rec getFnName binding =
@@ -124,8 +129,8 @@ let rec getFnName binding =
| {ppat_desc = Ppat_var {txt}} -> txt
| {ppat_desc = Ppat_constraint (pat, _)} -> getFnName pat
| {ppat_loc} ->
- React_jsx_common.raiseError ~loc:ppat_loc
- "react.component calls cannot be destructured."
+ Jsx_common.raiseError ~loc:ppat_loc
+ "JSX component calls cannot be destructured."
let makeNewBinding binding expression newName =
match binding with
@@ -138,8 +143,8 @@ let makeNewBinding binding expression newName =
pvb_attributes = [merlinFocus];
}
| {pvb_loc} ->
- React_jsx_common.raiseError ~loc:pvb_loc
- "react.component calls cannot be destructured."
+ Jsx_common.raiseError ~loc:pvb_loc
+ "JSX component calls cannot be destructured."
(* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *)
let filenameFromLoc (pstr_loc : Location.t) =
@@ -184,7 +189,7 @@ let recordFromProps ~loc ~removeKey callArguments =
| [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] ->
acc
| (Nolabel, {pexp_loc}) :: _rest ->
- React_jsx_common.raiseError ~loc:pexp_loc
+ Jsx_common.raiseError ~loc:pexp_loc
"JSX: found non-labelled argument before the last position"
| ((Labelled txt, {pexp_loc}) as prop) :: rest
| ((Optional txt, {pexp_loc}) as prop) :: rest ->
@@ -192,7 +197,7 @@ let recordFromProps ~loc ~removeKey callArguments =
match acc with
| [] -> removeLastPositionUnitAux rest (prop :: acc)
| _ ->
- React_jsx_common.raiseError ~loc:pexp_loc
+ Jsx_common.raiseError ~loc:pexp_loc
"JSX: use {...p} {x: v} not {x: v} {...p} \n\
\ multiple spreads {...p} {...p} not allowed."
else removeLastPositionUnitAux rest (prop :: acc)
@@ -297,8 +302,7 @@ let makeLabelDecls namedTypeList =
| hd :: tl ->
if mem_label hd tl then
let _, label, _, loc, _ = hd in
- React_jsx_common.raiseError ~loc "JSX: found the duplicated prop `%s`"
- label
+ Jsx_common.raiseError ~loc "JSX: found the duplicated prop `%s`" label
else checkDuplicatedLabel tl
in
let () = namedTypeList |> List.rev |> checkDuplicatedLabel in
@@ -374,13 +378,16 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc
| ListLiteral expression -> (
(* this is a hack to support react components that introspect into their children *)
childrenArg := Some expression;
- match config.React_jsx_common.mode with
+ match config.Jsx_common.mode with
| "automatic" ->
[
( labelled "children",
Exp.apply
(Exp.ident
- {txt = Ldot (Lident "React", "array"); loc = Location.none})
+ {
+ txt = Ldot (Lident (moduleAccessName config), "array");
+ loc = Location.none;
+ })
[(Nolabel, expression)] );
]
| _ ->
@@ -424,16 +431,31 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc
match (!childrenArg, keyProp) with
| None, key :: _ ->
( Exp.ident
- {loc = Location.none; txt = Ldot (Lident "React", "jsxKeyed")},
+ {
+ loc = Location.none;
+ txt = Ldot (Lident (moduleAccessName config), "jsxKeyed");
+ },
[key; (nolabel, unitExpr ~loc:Location.none)] )
| None, [] ->
- (Exp.ident {loc = Location.none; txt = Ldot (Lident "React", "jsx")}, [])
+ ( Exp.ident
+ {
+ loc = Location.none;
+ txt = Ldot (Lident (moduleAccessName config), "jsx");
+ },
+ [] )
| Some _, key :: _ ->
( Exp.ident
- {loc = Location.none; txt = Ldot (Lident "React", "jsxsKeyed")},
+ {
+ loc = Location.none;
+ txt = Ldot (Lident (moduleAccessName config), "jsxsKeyed");
+ },
[key; (nolabel, unitExpr ~loc:Location.none)] )
| Some _, [] ->
- ( Exp.ident {loc = Location.none; txt = Ldot (Lident "React", "jsxs")},
+ ( Exp.ident
+ {
+ loc = Location.none;
+ txt = Ldot (Lident (moduleAccessName config), "jsxs");
+ },
[] )
in
Exp.apply ~loc:jsxExprLoc ~attrs jsxExpr
@@ -474,9 +496,15 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc
let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs
callArguments id =
let componentNameExpr = constantString ~loc:callExprLoc id in
- match config.React_jsx_common.mode with
+ match config.Jsx_common.mode with
(* the new jsx transform *)
| "automatic" ->
+ let elementBinding =
+ match moduleAccessName config with
+ | "React" -> Lident "ReactDOM"
+ | generic -> Ldot (Lident generic, "DOM")
+ in
+
let children, nonChildrenProps =
extractChildren ~removeLastPositionUnit:true ~loc:jsxExprLoc callArguments
in
@@ -498,7 +526,7 @@ let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs
Exp.apply ~attrs:optionalAttrs
(Exp.ident
{
- txt = Ldot (Lident "ReactDOM", "someElement");
+ txt = Ldot (elementBinding, "someElement");
loc = Location.none;
})
[(Nolabel, children)] );
@@ -511,7 +539,10 @@ let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs
( labelled "children",
Exp.apply
(Exp.ident
- {txt = Ldot (Lident "React", "array"); loc = Location.none})
+ {
+ txt = Ldot (Lident (moduleAccessName config), "array");
+ loc = Location.none;
+ })
[(Nolabel, expression)] );
]
in
@@ -531,17 +562,16 @@ let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs
match (!childrenArg, keyProp) with
| None, key :: _ ->
( Exp.ident
- {loc = Location.none; txt = Ldot (Lident "ReactDOM", "jsxKeyed")},
+ {loc = Location.none; txt = Ldot (elementBinding, "jsxKeyed")},
[key; (nolabel, unitExpr ~loc:Location.none)] )
| None, [] ->
- ( Exp.ident {loc = Location.none; txt = Ldot (Lident "ReactDOM", "jsx")},
- [] )
+ (Exp.ident {loc = Location.none; txt = Ldot (elementBinding, "jsx")}, [])
| Some _, key :: _ ->
( Exp.ident
- {loc = Location.none; txt = Ldot (Lident "ReactDOM", "jsxsKeyed")},
+ {loc = Location.none; txt = Ldot (elementBinding, "jsxsKeyed")},
[key; (nolabel, unitExpr ~loc:Location.none)] )
| Some _, [] ->
- ( Exp.ident {loc = Location.none; txt = Ldot (Lident "ReactDOM", "jsxs")},
+ ( Exp.ident {loc = Location.none; txt = Ldot (elementBinding, "jsxs")},
[] )
in
Exp.apply ~loc:jsxExprLoc ~attrs jsxExpr
@@ -562,7 +592,7 @@ let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs
"createDOMElementVariadic"
(* [@JSX] div(~children= value), coming from
...(value)
*)
| {pexp_loc} ->
- React_jsx_common.raiseError ~loc:pexp_loc
+ Jsx_common.raiseError ~loc:pexp_loc
"A spread as a DOM element's children don't make sense written \
together. You can simply remove the spread."
in
@@ -601,11 +631,11 @@ let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType =
match expr.pexp_desc with
(* TODO: make this show up with a loc. *)
| Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) ->
- React_jsx_common.raiseError ~loc:expr.pexp_loc
+ Jsx_common.raiseError ~loc:expr.pexp_loc
"Key cannot be accessed inside of a component. Don't worry - you can \
always key a component from its parent!"
| Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) ->
- React_jsx_common.raiseError ~loc:expr.pexp_loc
+ Jsx_common.raiseError ~loc:expr.pexp_loc
"Ref cannot be passed as a normal prop. Please use `forwardRef` API \
instead."
| Pexp_fun (arg, default, pattern, expression)
@@ -628,7 +658,7 @@ let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType =
(Preprocessor
(Printf.sprintf
"React: optional argument annotations must have explicit \
- `option`. Did you mean `option(%s)=?`?"
+ `option`. Did you mean `option<%s>=?`?"
currentType)))
| _ -> ()
in
@@ -721,18 +751,18 @@ let argToConcreteType types (name, attrs, loc, type_) =
let check_string_int_attribute_iter =
let attribute _ ({txt; loc}, _) =
if txt = "string" || txt = "int" then
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"@string and @int attributes not supported. See \
https://github.com/rescript-lang/rescript-compiler/issues/5724"
in
{Ast_iterator.default_iterator with attribute}
-let checkMultipleReactComponents ~config ~loc =
- (* If there is another @react.component, throw error *)
- if config.React_jsx_common.hasReactComponent then
- React_jsx_common.raiseErrorMultipleReactComponent ~loc
- else config.hasReactComponent <- true
+let checkMultipleComponents ~config ~loc =
+ (* If there is another component, throw error *)
+ if config.Jsx_common.hasComponent then
+ Jsx_common.raiseErrorMultipleComponent ~loc
+ else config.hasComponent <- true
let modifiedBindingOld binding =
let expression = binding.pvb_expr in
@@ -757,9 +787,9 @@ let modifiedBindingOld binding =
| {pexp_desc = Pexp_constraint (innerFunctionExpression, _typ)} ->
spelunkForFunExpression innerFunctionExpression
| {pexp_loc} ->
- React_jsx_common.raiseError ~loc:pexp_loc
- "react.component calls can only be on function definitions or \
- component wrappers (forwardRef, memo)."
+ Jsx_common.raiseError ~loc:pexp_loc
+ "JSX component calls can only be on function definitions or component \
+ wrappers (forwardRef, memo)."
in
spelunkForFunExpression expression
@@ -882,15 +912,13 @@ let vbMatchExpr namedArgList expr =
aux (List.rev namedArgList)
let mapBinding ~config ~emptyLoc ~pstr_loc ~fileName ~recFlag binding =
- if React_jsx_common.hasAttrOnBinding binding then (
- checkMultipleReactComponents ~config ~loc:pstr_loc;
- let binding = React_jsx_common.removeArity binding in
- let coreTypeOfAttr =
- React_jsx_common.coreTypeOfAttrs binding.pvb_attributes
- in
+ if Jsx_common.hasAttrOnBinding binding then (
+ checkMultipleComponents ~config ~loc:pstr_loc;
+ let binding = Jsx_common.removeArity binding in
+ let coreTypeOfAttr = Jsx_common.coreTypeOfAttrs binding.pvb_attributes in
let typVarsOfCoreType =
coreTypeOfAttr
- |> Option.map React_jsx_common.typVarsOfCoreType
+ |> Option.map Jsx_common.typVarsOfCoreType
|> Option.value ~default:[]
in
let bindingLoc = binding.pvb_loc in
@@ -947,7 +975,7 @@ let mapBinding ~config ~emptyLoc ~pstr_loc ~fileName ~recFlag binding =
(Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()])
in
let innerExpression =
- React_jsx_common.async_component ~async:isAsync innerExpression
+ Jsx_common.async_component ~async:isAsync innerExpression
in
let fullExpression =
(* React component name should start with uppercase letter *)
@@ -960,15 +988,16 @@ let mapBinding ~config ~emptyLoc ~pstr_loc ~fileName ~recFlag binding =
| None -> makePropsPattern namedTypeList
| Some _ -> makePropsPattern typVarsOfCoreType)
(if hasForwardRef then
- Exp.fun_ nolabel None
- (Pat.var @@ Location.mknoloc "ref")
- innerExpression
- else innerExpression)
+ Exp.fun_ nolabel None
+ (Pat.var @@ Location.mknoloc "ref")
+ innerExpression
+ else innerExpression)
in
let fullExpression =
if !Config.uncurried = Uncurried then
fullExpression
- |> Ast_uncurried.uncurriedFun ~loc:fullExpression.pexp_loc ~arity:1
+ |> Ast_uncurried.uncurriedFun ~loc:fullExpression.pexp_loc
+ ~arity:(if hasForwardRef then 2 else 1)
else fullExpression
in
let fullExpression =
@@ -1128,17 +1157,17 @@ let transformStructureItem ~config item =
pstr_desc =
Pstr_primitive ({pval_attributes; pval_type} as value_description);
} as pstr -> (
- match List.filter React_jsx_common.hasAttr pval_attributes with
+ match List.filter Jsx_common.hasAttr pval_attributes with
| [] -> [item]
| [_] ->
- checkMultipleReactComponents ~config ~loc:pstr_loc;
+ checkMultipleComponents ~config ~loc:pstr_loc;
check_string_int_attribute_iter.structure_item
check_string_int_attribute_iter item;
- let pval_type = React_jsx_common.extractUncurried pval_type in
- let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in
+ let pval_type = Jsx_common.extractUncurried pval_type in
+ let coreTypeOfAttr = Jsx_common.coreTypeOfAttrs pval_attributes in
let typVarsOfCoreType =
coreTypeOfAttr
- |> Option.map React_jsx_common.typVarsOfCoreType
+ |> Option.map Jsx_common.typVarsOfCoreType
|> Option.value ~default:[]
in
let rec getPropTypes types
@@ -1174,7 +1203,10 @@ let transformStructureItem ~config item =
(* can't be an arrow because it will defensively uncurry *)
let newExternalType =
Ptyp_constr
- ( {loc = pstr_loc; txt = Ldot (Lident "React", "componentLike")},
+ ( {
+ loc = pstr_loc;
+ txt = Ldot (Lident (moduleAccessName config), "componentLike");
+ },
[retPropsType; innerType] )
in
let newStructure =
@@ -1191,8 +1223,8 @@ let transformStructureItem ~config item =
in
[propsRecordType; newStructure]
| _ ->
- React_jsx_common.raiseError ~loc:pstr_loc
- "Only one react.component call can exist on a component at one time")
+ Jsx_common.raiseError ~loc:pstr_loc
+ "Only one JSX component call can exist on a component at one time")
(* let component = ... *)
| {pstr_loc; pstr_desc = Pstr_value (recFlag, valueBindings)} -> (
let fileName = filenameFromLoc pstr_loc in
@@ -1231,18 +1263,18 @@ let transformSignatureItem ~config item =
psig_loc;
psig_desc = Psig_value ({pval_attributes; pval_type} as psig_desc);
} as psig -> (
- match List.filter React_jsx_common.hasAttr pval_attributes with
+ match List.filter Jsx_common.hasAttr pval_attributes with
| [] -> [item]
| [_] ->
- checkMultipleReactComponents ~config ~loc:psig_loc;
- let pval_type = React_jsx_common.extractUncurried pval_type in
+ checkMultipleComponents ~config ~loc:psig_loc;
+ let pval_type = Jsx_common.extractUncurried pval_type in
check_string_int_attribute_iter.signature_item
check_string_int_attribute_iter item;
let hasForwardRef = ref false in
- let coreTypeOfAttr = React_jsx_common.coreTypeOfAttrs pval_attributes in
+ let coreTypeOfAttr = Jsx_common.coreTypeOfAttrs pval_attributes in
let typVarsOfCoreType =
coreTypeOfAttr
- |> Option.map React_jsx_common.typVarsOfCoreType
+ |> Option.map Jsx_common.typVarsOfCoreType
|> Option.value ~default:[]
in
let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) =
@@ -1282,14 +1314,17 @@ let transformSignatureItem ~config item =
psig_loc
((* If there is Nolabel arg, regard the type as ref in forwardRef *)
(if !hasForwardRef then
- [(true, "ref", [], Location.none, refType Location.none)]
- else [])
+ [(true, "ref", [], Location.none, refType Location.none)]
+ else [])
@ namedTypeList)
in
(* can't be an arrow because it will defensively uncurry *)
let newExternalType =
Ptyp_constr
- ( {loc = psig_loc; txt = Ldot (Lident "React", "componentLike")},
+ ( {
+ loc = psig_loc;
+ txt = Ldot (Lident (moduleAccessName config), "componentLike");
+ },
[retPropsType; innerType] )
in
let newStructure =
@@ -1306,8 +1341,8 @@ let transformSignatureItem ~config item =
in
[propsRecordType; newStructure]
| _ ->
- React_jsx_common.raiseError ~loc:psig_loc
- "Only one react.component call can exist on a component at one time")
+ Jsx_common.raiseError ~loc:psig_loc
+ "Only one JSX component call can exist on a component at one time")
| _ -> [item]
let transformJsxCall ~config mapper callExpression callArguments jsxExprLoc
@@ -1316,7 +1351,7 @@ let transformJsxCall ~config mapper callExpression callArguments jsxExprLoc
| Pexp_ident caller -> (
match caller with
| {txt = Lident "createElement"; loc} ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: `createElement` should be preceeded by a module name."
(* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *)
| {loc; txt = Ldot (modulePath, ("createElement" | "make"))} ->
@@ -1329,18 +1364,18 @@ let transformJsxCall ~config mapper callExpression callArguments jsxExprLoc
transformLowercaseCall3 ~config mapper jsxExprLoc loc attrs callArguments
id
| {txt = Ldot (_, anythingNotCreateElementOrMake); loc} ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: the JSX attribute should be attached to a \
`YourModuleName.createElement` or `YourModuleName.make` call. We saw \
`%s` instead"
anythingNotCreateElementOrMake
| {txt = Lapply _; loc} ->
(* don't think there's ever a case where this is reached *)
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: encountered a weird case while processing the code. Please \
report this!")
| _ ->
- React_jsx_common.raiseError ~loc:callExpression.pexp_loc
+ Jsx_common.raiseError ~loc:callExpression.pexp_loc
"JSX: `createElement` should be preceeded by a simple, direct module \
name."
@@ -1384,7 +1419,8 @@ let expr ~config mapper expression =
let fragment =
match config.mode with
| "automatic" ->
- Exp.ident ~loc {loc; txt = Ldot (Lident "React", "jsxFragment")}
+ Exp.ident ~loc
+ {loc; txt = Ldot (Lident (moduleAccessName config), "jsxFragment")}
| "classic" | _ ->
Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")}
in
@@ -1392,10 +1428,13 @@ let expr ~config mapper expression =
let recordOfChildren children =
Exp.record [(Location.mknoloc (Lident "children"), children)] None
in
- let applyReactArray expr =
+ let applyJsxArray expr =
Exp.apply
(Exp.ident
- {txt = Ldot (Lident "React", "array"); loc = Location.none})
+ {
+ txt = Ldot (Lident (moduleAccessName config), "array");
+ loc = Location.none;
+ })
[(Nolabel, expr)]
in
let countOfChildren = function
@@ -1410,11 +1449,11 @@ let expr ~config mapper expression =
| [child] -> recordOfChildren child
| _ -> (
match config.mode with
- | "automatic" -> recordOfChildren @@ applyReactArray childrenExpr
+ | "automatic" -> recordOfChildren @@ applyJsxArray childrenExpr
| "classic" | _ -> emptyRecord ~loc:Location.none))
| _ -> (
match config.mode with
- | "automatic" -> recordOfChildren @@ applyReactArray childrenExpr
+ | "automatic" -> recordOfChildren @@ applyJsxArray childrenExpr
| "classic" | _ -> emptyRecord ~loc:Location.none)
in
let args =
@@ -1433,8 +1472,11 @@ let expr ~config mapper expression =
(match config.mode with
| "automatic" ->
if countOfChildren childrenExpr > 1 then
- Exp.ident ~loc {loc; txt = Ldot (Lident "React", "jsxs")}
- else Exp.ident ~loc {loc; txt = Ldot (Lident "React", "jsx")}
+ Exp.ident ~loc
+ {loc; txt = Ldot (Lident (moduleAccessName config), "jsxs")}
+ else
+ Exp.ident ~loc
+ {loc; txt = Ldot (Lident (moduleAccessName config), "jsx")}
| "classic" | _ ->
if countOfChildren childrenExpr > 1 then
Exp.ident ~loc
@@ -1445,8 +1487,7 @@ let expr ~config mapper expression =
(* Delegate to the default mapper, a deep identity traversal *)
| e -> default_mapper.expr mapper e
-let module_binding ~(config : React_jsx_common.jsxConfig) mapper module_binding
- =
+let module_binding ~(config : Jsx_common.jsxConfig) mapper module_binding =
config.nestedModules <- module_binding.pmb_name.txt :: config.nestedModules;
let mapped = default_mapper.module_binding mapper module_binding in
let () =
diff --git a/analysis/vendor/res_syntax/reactjs_jsx_v3.ml b/analysis/vendor/res_syntax/reactjs_jsx_v3.ml
index b1ca0e281..83316c9d5 100644
--- a/analysis/vendor/res_syntax/reactjs_jsx_v3.ml
+++ b/analysis/vendor/res_syntax/reactjs_jsx_v3.ml
@@ -87,7 +87,7 @@ let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren =
| [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] ->
acc
| (Nolabel, {pexp_loc}) :: _rest ->
- React_jsx_common.raiseError ~loc:pexp_loc
+ Jsx_common.raiseError ~loc:pexp_loc
"JSX: found non-labelled argument before the last position"
| arg :: rest -> allButLast_ rest (arg :: acc)
in
@@ -104,7 +104,7 @@ let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren =
| [(_, childrenExpr)], props ->
(childrenExpr, if removeLastPositionUnit then allButLast props else props)
| _ ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: somehow there's more than one `children` label"
let unerasableIgnore loc =
@@ -122,7 +122,7 @@ let rec getFnName binding =
| {ppat_desc = Ppat_var {txt}} -> txt
| {ppat_desc = Ppat_constraint (pat, _)} -> getFnName pat
| {ppat_loc} ->
- React_jsx_common.raiseError ~loc:ppat_loc
+ Jsx_common.raiseError ~loc:ppat_loc
"react.component calls cannot be destructured."
let makeNewBinding binding expression newName =
@@ -136,7 +136,7 @@ let makeNewBinding binding expression newName =
pvb_attributes = [merlinFocus];
}
| {pvb_loc} ->
- React_jsx_common.raiseError ~loc:pvb_loc
+ Jsx_common.raiseError ~loc:pvb_loc
"react.component calls cannot be destructured."
(* Lookup the value of `props` otherwise raise Invalid_argument error *)
@@ -145,7 +145,7 @@ let getPropsNameValue _acc (loc, exp) =
| {txt = Lident "props"}, {pexp_desc = Pexp_ident {txt = Lident str}} ->
{propsName = str}
| {txt; loc}, _ ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"react.component only accepts props as an option, given: { %s }"
(Longident.last txt)
@@ -170,7 +170,7 @@ let getPropsAttr payload =
:: _rest)) ->
{propsName = "props"}
| Some (PStr ({pstr_desc = Pstr_eval (_, _); pstr_loc} :: _rest)) ->
- React_jsx_common.raiseError ~loc:pstr_loc
+ Jsx_common.raiseError ~loc:pstr_loc
"react.component accepts a record config with props as an options."
| _ -> defaultProps
@@ -228,7 +228,7 @@ let rec recursivelyMakeNamedArgsForExternal list args =
}
(* ~foo: int=1 *)
| _label, Some type_, Some _ -> type_
- (* ~foo: option(int)=? *)
+ (* ~foo: option=? *)
| ( label,
Some {ptyp_desc = Ptyp_constr ({txt = Lident "option"}, [type_])},
_ )
@@ -368,7 +368,7 @@ let jsxMapper ~config =
| Lident path -> Lident (path ^ "Props")
| Ldot (ident, path) -> Ldot (ident, path ^ "Props")
| _ ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX name can't be the result of function applications"
in
let props =
@@ -407,7 +407,7 @@ let jsxMapper ~config =
"createDOMElementVariadic"
(* [@JSX] div(~children= value), coming from ...(value)
*)
| {pexp_loc} ->
- React_jsx_common.raiseError ~loc:pexp_loc
+ Jsx_common.raiseError ~loc:pexp_loc
"A spread as a DOM element's children don't make sense written \
together. You can simply remove the spread."
in
@@ -450,11 +450,11 @@ let jsxMapper ~config =
match expr.pexp_desc with
(* TODO: make this show up with a loc. *)
| Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) ->
- React_jsx_common.raiseError ~loc:expr.pexp_loc
+ Jsx_common.raiseError ~loc:expr.pexp_loc
"Key cannot be accessed inside of a component. Don't worry - you can \
always key a component from its parent!"
| Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) ->
- React_jsx_common.raiseError ~loc:expr.pexp_loc
+ Jsx_common.raiseError ~loc:expr.pexp_loc
"Ref cannot be passed as a normal prop. Either give the prop a \
different name or use the `forwardRef` API instead."
| Pexp_fun (arg, default, pattern, expression)
@@ -477,7 +477,7 @@ let jsxMapper ~config =
(Preprocessor
(Printf.sprintf
"React: optional argument annotations must have explicit \
- `option`. Did you mean `option(%s)=?`?"
+ `option`. Did you mean `option<%s>=?`?"
currentType)))
| _ -> ()
in
@@ -592,12 +592,12 @@ let jsxMapper ~config =
pstr_desc =
Pstr_primitive
({pval_name = {txt = fnName}; pval_attributes; pval_type} as
- value_description);
+ value_description);
} as pstr -> (
- match List.filter React_jsx_common.hasAttr pval_attributes with
+ match List.filter Jsx_common.hasAttr pval_attributes with
| [] -> [item]
| [_] ->
- let pval_type = React_jsx_common.extractUncurried pval_type in
+ let pval_type = Jsx_common.extractUncurried pval_type in
let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) =
match ptyp_desc with
| Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest))
@@ -641,15 +641,15 @@ let jsxMapper ~config =
in
[externalPropsDecl; newStructure]
| _ ->
- React_jsx_common.raiseError ~loc:pstr_loc
+ Jsx_common.raiseError ~loc:pstr_loc
"Only one react.component call can exist on a component at one time")
(* let component = ... *)
| {pstr_loc; pstr_desc = Pstr_value (recFlag, valueBindings)} -> (
let fileName = filenameFromLoc pstr_loc in
let emptyLoc = Location.in_file fileName in
let mapBinding binding =
- if React_jsx_common.hasAttrOnBinding binding then
- let binding = React_jsx_common.removeArity binding in
+ if Jsx_common.hasAttrOnBinding binding then
+ let binding = Jsx_common.removeArity binding in
let bindingLoc = binding.pvb_loc in
let bindingPatLoc = binding.pvb_pat.ppat_loc in
let binding =
@@ -689,7 +689,7 @@ let jsxMapper ~config =
| {pexp_desc = Pexp_constraint (innerFunctionExpression, _typ)} ->
spelunkForFunExpression innerFunctionExpression
| {pexp_loc} ->
- React_jsx_common.raiseError ~loc:pexp_loc
+ Jsx_common.raiseError ~loc:pexp_loc
"react.component calls can only be on function definitions \
or component wrappers (forwardRef, memo)."
in
@@ -814,7 +814,7 @@ let jsxMapper ~config =
in
let bindingWrapper, hasUnit, expression = modifiedBinding binding in
let reactComponentAttribute =
- try Some (List.find React_jsx_common.hasAttr binding.pvb_attributes)
+ try Some (List.find Jsx_common.hasAttr binding.pvb_attributes)
with Not_found -> None
in
let _attr_loc, payload =
@@ -1035,12 +1035,12 @@ let jsxMapper ~config =
psig_desc =
Psig_value
({pval_name = {txt = fnName}; pval_attributes; pval_type} as
- psig_desc);
+ psig_desc);
} as psig -> (
- match List.filter React_jsx_common.hasAttr pval_attributes with
+ match List.filter Jsx_common.hasAttr pval_attributes with
| [] -> [item]
| [_] ->
- let pval_type = React_jsx_common.extractUncurried pval_type in
+ let pval_type = Jsx_common.extractUncurried pval_type in
let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) =
match ptyp_desc with
| Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest))
@@ -1084,7 +1084,7 @@ let jsxMapper ~config =
in
[externalPropsDecl; newStructure]
| _ ->
- React_jsx_common.raiseError ~loc:psig_loc
+ Jsx_common.raiseError ~loc:psig_loc
"Only one react.component call can exist on a component at one time")
| _ -> [item]
in
@@ -1094,37 +1094,35 @@ let jsxMapper ~config =
| Pexp_ident caller -> (
match caller with
| {txt = Lident "createElement"; loc} ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: `createElement` should be preceeded by a module name."
(* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *)
| {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> (
- match config.React_jsx_common.version with
+ match config.Jsx_common.version with
| 3 ->
transformUppercaseCall3 modulePath mapper loc attrs callExpression
callArguments
- | _ ->
- React_jsx_common.raiseError ~loc "JSX: the JSX version must be 3")
+ | _ -> Jsx_common.raiseError ~loc "JSX: the JSX version must be 3")
(* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *)
(* turn that into
ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *)
| {loc; txt = Lident id} -> (
match config.version with
| 3 -> transformLowercaseCall3 mapper loc attrs callArguments id
- | _ -> React_jsx_common.raiseError ~loc "JSX: the JSX version must be 3"
- )
+ | _ -> Jsx_common.raiseError ~loc "JSX: the JSX version must be 3")
| {txt = Ldot (_, anythingNotCreateElementOrMake); loc} ->
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: the JSX attribute should be attached to a \
`YourModuleName.createElement` or `YourModuleName.make` call. We \
saw `%s` instead"
anythingNotCreateElementOrMake
| {txt = Lapply _; loc} ->
(* don't think there's ever a case where this is reached *)
- React_jsx_common.raiseError ~loc
+ Jsx_common.raiseError ~loc
"JSX: encountered a weird case while processing the code. Please \
report this!")
| _ ->
- React_jsx_common.raiseError ~loc:callExpression.pexp_loc
+ Jsx_common.raiseError ~loc:callExpression.pexp_loc
"JSX: `createElement` should be preceeded by a simple, direct module \
name."
in
diff --git a/analysis/vendor/res_syntax/res_cli.ml b/analysis/vendor/res_syntax/res_cli.ml
index 7af181f5b..8583f9639 100644
--- a/analysis/vendor/res_syntax/res_cli.ml
+++ b/analysis/vendor/res_syntax/res_cli.ml
@@ -90,7 +90,7 @@ module Color = struct
| Format.String_tag "dim" -> [Dim]
| Format.String_tag "filename" -> [FG Cyan]
| _ -> raise Not_found
- [@@raises Not_found]
+ [@@raises Not_found]
let color_enabled = ref true
@@ -177,7 +177,7 @@ end = struct
let interface = ref false
let jsxVersion = ref (-1)
let jsxModule = ref "react"
- let jsxMode = ref "classic"
+ let jsxMode = ref "automatic"
let file = ref ""
let typechecker = ref false
@@ -215,7 +215,7 @@ end = struct
"Specify the jsx module. Default: react" );
( "-jsx-mode",
Arg.String (fun txt -> jsxMode := txt),
- "Specify the jsx mode, classic or automatic. Default: classic" );
+ "Specify the jsx mode, classic or automatic. Default: automatic" );
( "-typechecker",
Arg.Unit (fun () -> typechecker := true),
"Parses the ast as it would be passed to the typechecker and not the \
@@ -284,7 +284,7 @@ module CliArgProcessor = struct
else exit 1)
else
let parsetree =
- Reactjs_jsx_ppx.rewrite_signature ~jsxVersion ~jsxModule ~jsxMode
+ Jsx_ppx.rewrite_signature ~jsxVersion ~jsxModule ~jsxMode
parseResult.parsetree
in
printEngine.printInterface ~width ~filename
@@ -300,12 +300,12 @@ module CliArgProcessor = struct
else exit 1)
else
let parsetree =
- Reactjs_jsx_ppx.rewrite_implementation ~jsxVersion ~jsxModule ~jsxMode
+ Jsx_ppx.rewrite_implementation ~jsxVersion ~jsxModule ~jsxMode
parseResult.parsetree
in
printEngine.printImplementation ~width ~filename
~comments:parseResult.comments parsetree
- [@@raises exit]
+ [@@raises exit]
end
(* let () =
diff --git a/analysis/vendor/res_syntax/res_comment.ml b/analysis/vendor/res_syntax/res_comment.ml
index 23898f8bc..579b5d327 100644
--- a/analysis/vendor/res_syntax/res_comment.ml
+++ b/analysis/vendor/res_syntax/res_comment.ml
@@ -43,7 +43,7 @@ let makeMultiLineComment ~loc ~docComment ~standalone txt =
loc;
style =
(if docComment then if standalone then ModuleComment else DocComment
- else MultiLine);
+ else MultiLine);
prevTokEndPos = Lexing.dummy_pos;
}
diff --git a/analysis/vendor/res_syntax/res_core.ml b/analysis/vendor/res_syntax/res_core.ml
index e15f1e66e..d4fb3c428 100644
--- a/analysis/vendor/res_syntax/res_core.ml
+++ b/analysis/vendor/res_syntax/res_core.ml
@@ -66,8 +66,8 @@ module ErrorMessages = struct
record, since a record needs an explicit declaration and that subset \
wouldn't have one.\n\
Solution: you need to pull out each field you want explicitly."
- (* let recordPatternUnderscore = "Record patterns only support one `_`, at the end." *)
- [@@live]
+ (* let recordPatternUnderscore = "Record patterns only support one `_`, at the end." *)
+ [@@live]
let arrayPatternSpread =
"Array's `...` spread is not supported in pattern matches.\n\
@@ -151,6 +151,10 @@ module ErrorMessages = struct
mean `#" ^ number ^ "`?"
end
+module InExternal = struct
+ let status = ref false
+end
+
let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr [])
let uncurriedAppAttr = (Location.mknoloc "res.uapp", Parsetree.PStr [])
let ternaryAttr = (Location.mknoloc "res.ternary", Parsetree.PStr [])
@@ -176,6 +180,9 @@ let suppressFragileMatchWarningAttr =
let makeBracesAttr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr [])
let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr [])
+let taggedTemplateLiteralAttr =
+ (Location.mknoloc "res.taggedTemplate", Parsetree.PStr [])
+
let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr [])
type argument = {
@@ -1290,9 +1297,9 @@ and parseRecordPattern ~attrs p =
match field with
| PatField field ->
(if hasSpread then
- let _, pattern = field in
- Parser.err ~startPos:pattern.Parsetree.ppat_loc.loc_start p
- (Diagnostics.message ErrorMessages.recordPatternSpread));
+ let _, pattern = field in
+ Parser.err ~startPos:pattern.Parsetree.ppat_loc.loc_start p
+ (Diagnostics.message ErrorMessages.recordPatternSpread));
(field :: fields, flag)
| PatUnderscore -> (fields, flag))
([], flag) rawFields
@@ -2251,6 +2258,66 @@ and parseBinaryExpr ?(context = OrdinaryExpr) ?a p prec =
(* ) *)
and parseTemplateExpr ?(prefix = "js") p =
+ let partPrefix =
+ (* we could stop treating js and j prefix as something special
+ for json, we would first need to remove @as(json`true`) feature *)
+ match prefix with
+ | "js" | "j" | "json" -> Some prefix
+ | _ -> None
+ in
+ let startPos = p.Parser.startPos in
+
+ let parseParts p =
+ let rec aux acc =
+ let startPos = p.Parser.startPos in
+ Parser.nextTemplateLiteralToken p;
+ match p.token with
+ | TemplateTail (txt, lastPos) ->
+ Parser.next p;
+ let loc = mkLoc startPos lastPos in
+ let str =
+ Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc
+ (Pconst_string (txt, partPrefix))
+ in
+ List.rev ((str, None) :: acc)
+ | TemplatePart (txt, lastPos) ->
+ Parser.next p;
+ let loc = mkLoc startPos lastPos in
+ let expr = parseExprBlock p 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 = Ext_list.filter_map parts snd in
+ let endPos = p.Parser.endPos 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:(mkLoc startPos endPos) ident
+ [(Nolabel, strings_array); (Nolabel, values_array)]
+ in
+
let hiddenOperator =
let op = Location.mknoloc (Longident.Lident "^") in
Ast_helper.Exp.ident op
@@ -2260,56 +2327,33 @@ and parseTemplateExpr ?(prefix = "js") p =
Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator
[(Nolabel, e1); (Nolabel, e2)]
in
- let rec parseParts (acc : Parsetree.expression) =
- let startPos = p.Parser.startPos in
- Parser.nextTemplateLiteralToken p;
- match p.token with
- | TemplateTail (txt, lastPos) ->
- Parser.next p;
- let loc = mkLoc startPos lastPos in
- let str =
- Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc
- (Pconst_string (txt, Some prefix))
- in
- concat acc str
- | TemplatePart (txt, lastPos) ->
- Parser.next p;
- let loc = mkLoc startPos lastPos in
- let expr = parseExprBlock p in
- let str =
- Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc
- (Pconst_string (txt, Some prefix))
- in
- let next =
- let a = concat acc str in
- concat a 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, lastPos) ->
- Parser.next p;
- Ast_helper.Exp.constant ~attrs:[templateLiteralAttr]
- ~loc:(mkLoc startPos lastPos)
- (Pconst_string (txt, Some prefix))
- | TemplatePart (txt, lastPos) ->
- Parser.next p;
- let constantLoc = mkLoc startPos lastPos in
- let expr = parseExprBlock p in
- let str =
- Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc:constantLoc
- (Pconst_string (txt, Some prefix))
+ let genInterpolatedString () =
+ let subparts =
+ List.flatten
+ (List.map
+ (fun part ->
+ match part with
+ | s, Some v -> [s; v]
+ | s, None -> [s])
+ parts)
in
- let next = concat str expr in
- parseParts next
- | token ->
- Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
- Ast_helper.Exp.constant (Pconst_string ("", None))
+ let exprOption =
+ List.fold_left
+ (fun acc subpart ->
+ Some
+ (match acc with
+ | Some expr -> concat expr subpart
+ | None -> subpart))
+ None subparts
+ in
+ match exprOption with
+ | Some expr -> expr
+ | None -> Ast_helper.Exp.constant (Pconst_string ("", None))
+ in
+
+ match prefix with
+ | "js" | "j" | "json" -> genInterpolatedString ()
+ | _ -> genTaggedTemplateCall ()
(* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int =>
* Also overparse constraints:
@@ -4276,6 +4320,22 @@ and parseEs6ArrowType ~attrs p =
p.uncurried_config |> Res_uncurried.fromDotted ~dotted
in
let loc = mkLoc startPos endPos in
+ let arity =
+ (* Workaround for ~lbl: @as(json`false`) _, which changes the arity *)
+ match argLbl with
+ | Labelled _s ->
+ let typ_is_any =
+ match typ.ptyp_desc with
+ | Ptyp_any -> true
+ | _ -> false
+ in
+ let has_as =
+ Ext_list.exists typ.ptyp_attributes (fun (x, _) -> x.txt = "as")
+ in
+ if !InExternal.status && typ_is_any && has_as then arity - 1
+ else arity
+ | _ -> arity
+ in
let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in
if uncurried && (paramNum = 1 || p.uncurried_config = Legacy) then
(paramNum - 1, Ast_uncurried.uncurriedType ~loc ~arity tArg, 1)
@@ -4544,7 +4604,6 @@ and parseConstrDeclArgs p =
(* TODO: this could use some cleanup/stratification *)
match p.Parser.token with
| Lbrace -> (
- let lbrace = p.startPos in
Parser.next p;
let startPos = p.Parser.startPos in
match p.Parser.token with
@@ -4676,20 +4735,15 @@ and parseConstrDeclArgs p =
let attrs =
if optional then optionalAttr :: attrs else attrs
in
- Parser.expect Comma p;
{field with Parsetree.pld_attributes = attrs}
in
- first
- :: parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations
- ~closing:Rbrace ~f:parseFieldDeclarationRegion p
- in
- let () =
- match fields with
- | [] ->
- Parser.err ~startPos:lbrace p
- (Diagnostics.message
- "An inline record declaration needs at least one field")
- | _ -> ()
+ if p.token = Rbrace then [first]
+ else (
+ Parser.expect Comma p;
+ first
+ :: parseCommaDelimitedRegion
+ ~grammar:Grammar.FieldDeclarations ~closing:Rbrace
+ ~f:parseFieldDeclarationRegion p)
in
Parser.expect Rbrace p;
Parser.optional p Comma |> ignore;
@@ -5447,6 +5501,8 @@ and parseTypeDefinitionOrExtension ~attrs p =
(* external value-name : typexp = external-declaration *)
and parseExternalDef ~attrs ~startPos p =
+ let inExternal = !InExternal.status in
+ InExternal.status := true;
Parser.leaveBreadcrumb p Grammar.External;
Parser.expect Token.External p;
let name, loc = parseLident p in
@@ -5471,6 +5527,7 @@ and parseExternalDef ~attrs ~startPos p =
let loc = mkLoc startPos p.prevEndPos in
let vb = Ast_helper.Val.mk ~loc ~attrs ~prim name typExpr in
Parser.eatBreadcrumb p;
+ InExternal.status := inExternal;
vb
(* constr-def ::=
@@ -5621,7 +5678,7 @@ and parseStructureItemRegion p =
Some
(Ast_helper.Str.eval ~loc:(mkLoc p.startPos p.prevEndPos) ~attrs expr)
| _ -> None)
- [@@progress Parser.next, Parser.expect, LoopProgress.listRest]
+[@@progress Parser.next, Parser.expect, LoopProgress.listRest]
(* include-statement ::= include module-expr *)
and parseIncludeStatement ~attrs p =
@@ -6253,7 +6310,7 @@ and parseSignatureItemRegion p =
(Diagnostics.message (ErrorMessages.attributeWithoutNode attr));
Some Recover.defaultSignatureItem
| _ -> None)
- [@@progress Parser.next, Parser.expect, LoopProgress.listRest]
+[@@progress Parser.next, Parser.expect, LoopProgress.listRest]
(* module rec module-name : module-type { and module-name: module-type } *)
and parseRecModuleSpec ~attrs ~startPos p =
diff --git a/analysis/vendor/res_syntax/res_diagnostics_printing_utils.ml b/analysis/vendor/res_syntax/res_diagnostics_printing_utils.ml
deleted file mode 100644
index 74d23e404..000000000
--- a/analysis/vendor/res_syntax/res_diagnostics_printing_utils.ml
+++ /dev/null
@@ -1,389 +0,0 @@
-(*
- This file is taken from ReScript's super_code_frame.ml and super_location.ml
- We're copying the look of ReScript's terminal error reporting.
- See https://github.com/rescript-lang/syntax/pull/77 for the rationale.
- A few lines have been commented out and swapped for their tweaked version.
-*)
-
-(* ===== super_code_frame.ml *)
-
-module Super_code_frame = struct
- let digits_count n =
- let rec loop n base count =
- if n >= base then loop n (base * 10) (count + 1) else count
- in
- loop (abs n) 1 0
-
- let seek_2_lines_before src pos =
- let open Lexing in
- let original_line = pos.pos_lnum in
- let rec loop current_line current_char =
- if current_line + 2 >= original_line then (current_char, current_line)
- else
- loop
- (if (src.[current_char] [@doesNotRaise]) = '\n' then current_line + 1
- else current_line)
- (current_char + 1)
- in
- loop 1 0
-
- let seek_2_lines_after src pos =
- let open Lexing in
- let original_line = pos.pos_lnum in
- let rec loop current_line current_char =
- if current_char = String.length src then (current_char, current_line)
- else
- match src.[current_char] [@doesNotRaise] with
- | '\n' when current_line = original_line + 2 ->
- (current_char, current_line)
- | '\n' -> loop (current_line + 1) (current_char + 1)
- | _ -> loop current_line (current_char + 1)
- in
- loop original_line pos.pos_cnum
-
- let leading_space_count str =
- let rec loop i count =
- if i = String.length str then count
- else if (str.[i] [@doesNotRaise]) != ' ' then count
- else loop (i + 1) (count + 1)
- in
- loop 0 0
-
- let break_long_line max_width line =
- let rec loop pos accum =
- if pos = String.length line then accum
- else
- let chunk_length = min max_width (String.length line - pos) in
- let chunk = (String.sub [@doesNotRaise]) line pos chunk_length in
- loop (pos + chunk_length) (chunk :: accum)
- in
- loop 0 [] |> List.rev
-
- let filter_mapi f l =
- let rec loop f l i accum =
- match l with
- | [] -> accum
- | head :: rest ->
- let accum =
- match f i head with
- | None -> accum
- | Some result -> result :: accum
- in
- loop f rest (i + 1) accum
- in
- loop f l 0 [] |> List.rev
-
- (* Spiritual equivalent of
- https://github.com/ocaml/ocaml/blob/414bdec9ae387129b8102cc6bf3c0b6ae173eeb9/utils/misc.ml#L601
- *)
- module Color = struct
- type color =
- | Dim
- (* | Filename *)
- | Err
- | Warn
- | NoColor
-
- let dim = "\x1b[2m"
-
- (* let filename = "\x1b[46m" *)
- let err = "\x1b[1;31m"
- let warn = "\x1b[1;33m"
- let reset = "\x1b[0m"
-
- external isatty : out_channel -> bool = "caml_sys_isatty"
-
- (* reasonable heuristic on whether colors should be enabled *)
- let should_enable_color () =
- let term = try Sys.getenv "TERM" with Not_found -> "" in
- term <> "dumb" && term <> "" && isatty stderr
-
- let color_enabled = ref true
-
- let setup =
- let first = ref true in
- (* initialize only once *)
- fun o ->
- if !first then (
- first := false;
- color_enabled :=
- match o with
- | Some Misc.Color.Always -> true
- | Some Auto -> should_enable_color ()
- | Some Never -> false
- | None -> should_enable_color ());
- ()
- end
-
- let setup = Color.setup
-
- type gutter = Number of int | Elided
- type highlighted_string = {s: string; start: int; end_: int}
- type line = {gutter: gutter; content: highlighted_string list}
-
- (*
- Features:
- - display a line gutter
- - break long line into multiple for terminal display
- - peek 2 lines before & after for context
- - center snippet when it's heavily indented
- - ellide intermediate lines when the reported range is huge
-*)
- let print ~is_warning ~src ~startPos ~endPos =
- let open Lexing in
- let indent = 2 in
- let highlight_line_start_line = startPos.pos_lnum in
- let highlight_line_end_line = endPos.pos_lnum in
- let start_line_line_offset, first_shown_line =
- seek_2_lines_before src startPos
- in
- let end_line_line_end_offset, last_shown_line =
- seek_2_lines_after src endPos
- in
-
- let more_than_5_highlighted_lines =
- highlight_line_end_line - highlight_line_start_line + 1 > 5
- in
- let max_line_digits_count = digits_count last_shown_line in
- (* TODO: change this back to a fixed 100? *)
- (* 3 for separator + the 2 spaces around it *)
- let line_width = 78 - max_line_digits_count - indent - 3 in
- let lines =
- (String.sub [@doesNotRaise]) src start_line_line_offset
- (end_line_line_end_offset - start_line_line_offset)
- |> String.split_on_char '\n'
- |> filter_mapi (fun i line ->
- let line_number = i + first_shown_line in
- if more_than_5_highlighted_lines then
- if line_number = highlight_line_start_line + 2 then
- Some (Elided, line)
- else if
- line_number > highlight_line_start_line + 2
- && line_number < highlight_line_end_line - 1
- then None
- else Some (Number line_number, line)
- else Some (Number line_number, line))
- in
- let leading_space_to_cut =
- lines
- |> List.fold_left
- (fun current_max (_, line) ->
- let leading_spaces = leading_space_count line in
- if String.length line = leading_spaces then
- (* the line's nothing but spaces. Doesn't count *)
- current_max
- else min leading_spaces current_max)
- 99999
- in
- let separator = if leading_space_to_cut = 0 then "│" else "┆" in
- let stripped_lines =
- lines
- |> List.map (fun (gutter, line) ->
- let new_content =
- if String.length line <= leading_space_to_cut then
- [{s = ""; start = 0; end_ = 0}]
- else
- (String.sub [@doesNotRaise]) line leading_space_to_cut
- (String.length line - leading_space_to_cut)
- |> break_long_line line_width
- |> List.mapi (fun i line ->
- match gutter with
- | Elided -> {s = line; start = 0; end_ = 0}
- | Number line_number ->
- let highlight_line_start_offset =
- startPos.pos_cnum - startPos.pos_bol
- in
- let highlight_line_end_offset =
- endPos.pos_cnum - endPos.pos_bol
- in
- let start =
- if i = 0 && line_number = highlight_line_start_line
- then
- highlight_line_start_offset - leading_space_to_cut
- else 0
- in
- let end_ =
- if line_number < highlight_line_start_line then 0
- else if
- line_number = highlight_line_start_line
- && line_number = highlight_line_end_line
- then
- highlight_line_end_offset - leading_space_to_cut
- else if line_number = highlight_line_start_line then
- String.length line
- else if
- line_number > highlight_line_start_line
- && line_number < highlight_line_end_line
- then String.length line
- else if line_number = highlight_line_end_line then
- highlight_line_end_offset - leading_space_to_cut
- else 0
- in
- {s = line; start; end_})
- in
- {gutter; content = new_content})
- in
- let buf = Buffer.create 100 in
- let open Color in
- let add_ch =
- let last_color = ref NoColor in
- fun color ch ->
- if (not !Color.color_enabled) || !last_color = color then
- Buffer.add_char buf ch
- else
- let ansi =
- match (!last_color, color) with
- | NoColor, Dim -> dim
- (* | NoColor, Filename -> filename *)
- | NoColor, Err -> err
- | NoColor, Warn -> warn
- | _, NoColor -> reset
- | _, Dim -> reset ^ dim
- (* | _, Filename -> reset ^ filename *)
- | _, Err -> reset ^ err
- | _, Warn -> reset ^ warn
- in
- Buffer.add_string buf ansi;
- Buffer.add_char buf ch;
- last_color := color
- in
- let draw_gutter color s =
- for _i = 1 to max_line_digits_count + indent - String.length s do
- add_ch NoColor ' '
- done;
- s |> String.iter (add_ch color);
- add_ch NoColor ' ';
- separator |> String.iter (add_ch Dim);
- add_ch NoColor ' '
- in
- stripped_lines
- |> List.iter (fun {gutter; content} ->
- match gutter with
- | Elided ->
- draw_gutter Dim ".";
- add_ch Dim '.';
- add_ch Dim '.';
- add_ch Dim '.';
- add_ch NoColor '\n'
- | Number line_number ->
- content
- |> List.iteri (fun i line ->
- let gutter_content =
- if i = 0 then string_of_int line_number else ""
- in
- let gutter_color =
- if
- i = 0
- && line_number >= highlight_line_start_line
- && line_number <= highlight_line_end_line
- then if is_warning then Warn else Err
- else NoColor
- in
- draw_gutter gutter_color gutter_content;
-
- line.s
- |> String.iteri (fun ii ch ->
- let c =
- if ii >= line.start && ii < line.end_ then
- if is_warning then Warn else Err
- else NoColor
- in
- add_ch c ch);
- add_ch NoColor '\n'));
- Buffer.contents buf
-end
-
-(* ===== super_location.ml *)
-module Super_location = struct
- let fprintf = Format.fprintf
-
- let setup_colors () =
- Misc.Color.setup !Clflags.color;
- Super_code_frame.setup !Clflags.color
-
- let print_filename = Location.print_filename
-
- let print_loc ~normalizedRange ppf (loc : Location.t) =
- setup_colors ();
- let dim_loc ppf = function
- | None -> ()
- | Some ((start_line, start_line_start_char), (end_line, end_line_end_char))
- ->
- if start_line = end_line then
- if start_line_start_char = end_line_end_char then
- fprintf ppf ":@{%i:%i@}" start_line start_line_start_char
- else
- fprintf ppf ":@{%i:%i-%i@}" start_line start_line_start_char
- end_line_end_char
- else
- fprintf ppf ":@{%i:%i-%i:%i@}" start_line start_line_start_char
- end_line end_line_end_char
- in
- fprintf ppf "@{%a@}%a" print_filename loc.loc_start.pos_fname
- dim_loc normalizedRange
-
- (* let print ~message_kind intro ppf (loc : Location.t) = *)
- let print ~message_kind intro src ppf (loc : Location.t) =
- (match message_kind with
- | `warning -> fprintf ppf "@[@{%s@}@]@," intro
- | `warning_as_error ->
- fprintf ppf "@[@{%s@} (configured as error) @]@," intro
- | `error -> fprintf ppf "@[@{%s@}@]@," intro);
- (* ocaml's reported line/col numbering is horrible and super error-prone
- when being handled programmatically (or humanly for that matter. If you're
- an ocaml contributor reading this: who the heck reads the character count
- starting from the first erroring character?) *)
- (* let (file, start_line, start_char) = Location.get_pos_info loc.loc_start in *)
- let _file, start_line, start_char = Location.get_pos_info loc.loc_start in
- let _, end_line, end_char = Location.get_pos_info loc.loc_end in
- (* line is 1-indexed, column is 0-indexed. We convert all of them to 1-indexed to avoid confusion *)
- (* start_char is inclusive, end_char is exclusive *)
- let normalizedRange =
- (* TODO: lots of the handlings here aren't needed anymore because the new
- rescript syntax has much stronger invariants regarding positions, e.g.
- no -1 *)
- if start_char == -1 || end_char == -1 then
- (* happens sometimes. Syntax error for example *)
- None
- else if start_line = end_line && start_char >= end_char then
- (* in some errors, starting char and ending char can be the same. But
- since ending char was supposed to be exclusive, here it might end up
- smaller than the starting char if we naively did start_char + 1 to
- just the starting char and forget ending char *)
- let same_char = start_char + 1 in
- Some ((start_line, same_char), (end_line, same_char))
- else
- (* again: end_char is exclusive, so +1-1=0 *)
- Some ((start_line, start_char + 1), (end_line, end_char))
- in
- fprintf ppf " @[%a@]@," (print_loc ~normalizedRange) loc;
- match normalizedRange with
- | None -> ()
- | Some _ -> (
- try
- (* let src = Ext_io.load_file file in *)
- (* we're putting the line break `@,` here rather than above, because this
- branch might not be reached (aka no inline file content display) so
- we don't wanna end up with two line breaks in the the consequent *)
- fprintf ppf "@,%s"
- (Super_code_frame.print ~is_warning:(message_kind = `warning) ~src
- ~startPos:loc.loc_start ~endPos:loc.loc_end)
- with
- (* this might happen if the file is e.g. "", "_none_" or any of the fake file name placeholders.
- we've already printed the location above, so nothing more to do here. *)
- | Sys_error _ ->
- ())
-
- (* taken from https://github.com/rescript-lang/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/parsing/location.ml#L380 *)
- (* This is the error report entry point. We'll replace the default reporter with this one. *)
- (* let rec super_error_reporter ppf ({loc; msg; sub} : Location.error) = *)
- let super_error_reporter ppf src ({loc; msg} : Location.error) =
- setup_colors ();
- (* open a vertical box. Everything in our message is indented 2 spaces *)
- (* Format.fprintf ppf "@[@, %a@, %s@,@]" (print ~message_kind:`error "We've found a bug for you!") src loc msg; *)
- Format.fprintf ppf "@[@, %a@, %s@,@]"
- (print ~message_kind:`error "Syntax error!" src)
- loc msg
- (* List.iter (Format.fprintf ppf "@,@[%a@]" super_error_reporter) sub *)
- (* no need to flush here; location's report_exception (which uses this ultimately) flushes *)
-end
diff --git a/analysis/vendor/res_syntax/res_doc.ml b/analysis/vendor/res_syntax/res_doc.ml
index 125ac7725..fe626e479 100644
--- a/analysis/vendor/res_syntax/res_doc.ml
+++ b/analysis/vendor/res_syntax/res_doc.ml
@@ -347,4 +347,4 @@ let debug t =
in
let doc = toDoc t in
toString ~width:10 doc |> print_endline
- [@@live]
+[@@live]
diff --git a/analysis/vendor/res_syntax/res_driver.ml b/analysis/vendor/res_syntax/res_driver.ml
index 21219b68c..a82c9a2a1 100644
--- a/analysis/vendor/res_syntax/res_driver.ml
+++ b/analysis/vendor/res_syntax/res_driver.ml
@@ -140,7 +140,7 @@ let parse_implementation ?(ignoreParseErrors = false) sourcefile =
Res_diagnostics.printReport parseResult.diagnostics parseResult.source;
if not ignoreParseErrors then exit 1);
parseResult.parsetree
- [@@raises exit]
+[@@raises exit]
let parse_interface ?(ignoreParseErrors = false) sourcefile =
Location.input_name := sourcefile;
@@ -151,11 +151,11 @@ let parse_interface ?(ignoreParseErrors = false) sourcefile =
Res_diagnostics.printReport parseResult.diagnostics parseResult.source;
if not ignoreParseErrors then exit 1);
parseResult.parsetree
- [@@raises exit]
+[@@raises exit]
(* suppress unused optional arg *)
let _ =
fun s ->
( parse_implementation ~ignoreParseErrors:false s,
parse_interface ~ignoreParseErrors:false s )
- [@@raises exit]
+[@@raises exit]
diff --git a/analysis/vendor/res_syntax/res_driver.mli b/analysis/vendor/res_syntax/res_driver.mli
index 8a208b2fd..ddc264739 100644
--- a/analysis/vendor/res_syntax/res_driver.mli
+++ b/analysis/vendor/res_syntax/res_driver.mli
@@ -24,14 +24,14 @@ val parseImplementationFromSource :
displayFilename:string ->
source:string ->
(Parsetree.structure, Res_diagnostics.t list) parseResult
- [@@live]
+[@@live]
val parseInterfaceFromSource :
forPrinter:bool ->
displayFilename:string ->
source:string ->
(Parsetree.signature, Res_diagnostics.t list) parseResult
- [@@live]
+[@@live]
type printEngine = {
printImplementation:
@@ -55,8 +55,8 @@ val printEngine : printEngine
(* ReScript implementation parsing compatible with ocaml pparse driver. Used by the compiler. *)
val parse_implementation :
?ignoreParseErrors:bool -> string -> Parsetree.structure
- [@@live] [@@raises Location.Error]
+[@@live] [@@raises Location.Error]
(* ReScript interface parsing compatible with ocaml pparse driver. Used by the compiler *)
val parse_interface : ?ignoreParseErrors:bool -> string -> Parsetree.signature
- [@@live] [@@raises Location.Error]
+[@@live] [@@raises Location.Error]
diff --git a/analysis/vendor/res_syntax/res_driver_ml_parser.mli b/analysis/vendor/res_syntax/res_driver_ml_parser.mli
index 63ea8f81f..55a99c4d5 100644
--- a/analysis/vendor/res_syntax/res_driver_ml_parser.mli
+++ b/analysis/vendor/res_syntax/res_driver_ml_parser.mli
@@ -3,7 +3,7 @@
(* extracts comments and the original string data from an ocaml file *)
val extractOcamlConcreteSyntax :
string -> (string * Location.t) list * Res_comment.t list
- [@@live]
+[@@live]
val parsingEngine : unit Res_driver.parsingEngine
diff --git a/analysis/vendor/res_syntax/res_io.ml b/analysis/vendor/res_syntax/res_io.ml
index ef29399ba..e5934b848 100644
--- a/analysis/vendor/res_syntax/res_io.ml
+++ b/analysis/vendor/res_syntax/res_io.ml
@@ -11,4 +11,4 @@ let writeFile ~filename ~contents:txt =
let chan = open_out_bin filename in
output_string chan txt;
close_out chan
- [@@raises Sys_error]
+[@@raises Sys_error]
diff --git a/analysis/vendor/res_syntax/res_multi_printer.ml b/analysis/vendor/res_syntax/res_multi_printer.ml
index 81d14d844..98cd1d423 100644
--- a/analysis/vendor/res_syntax/res_multi_printer.ml
+++ b/analysis/vendor/res_syntax/res_multi_printer.ml
@@ -85,7 +85,7 @@ let printRes ~ignoreParseErrors ~isInterface ~filename =
if not ignoreParseErrors then exit 1);
Res_printer.printImplementation ~width:defaultPrintWidth
~comments:parseResult.comments parseResult.parsetree
- [@@raises exit]
+[@@raises exit]
(* print ocaml files to res syntax *)
let printMl ~isInterface ~filename =
@@ -113,7 +113,7 @@ let print ?(ignoreParseErrors = false) language ~input =
match language with
| `res -> printRes ~ignoreParseErrors ~isInterface ~filename:input
| `ml -> printMl ~isInterface ~filename:input
- [@@raises exit]
+[@@raises exit]
(* suppress unused optional arg *)
let _ = fun s -> print ~ignoreParseErrors:false s [@@raises exit]
diff --git a/analysis/vendor/res_syntax/res_outcome_printer.ml b/analysis/vendor/res_syntax/res_outcome_printer.ml
index c9fda0c6d..7ea56d942 100644
--- a/analysis/vendor/res_syntax/res_outcome_printer.ml
+++ b/analysis/vendor/res_syntax/res_outcome_printer.ml
@@ -395,7 +395,7 @@ and printOutVariant variant =
Doc.concat
[
(if i > 0 then Doc.text "| "
- else Doc.ifBreaks (Doc.text "| ") Doc.nil);
+ else Doc.ifBreaks (Doc.text "| ") Doc.nil);
Doc.group
(Doc.concat
[
@@ -477,7 +477,7 @@ and printOutConstructorsDoc constructors =
Doc.concat
[
(if i > 0 then Doc.text "| "
- else Doc.ifBreaks (Doc.text "| ") Doc.nil);
+ else Doc.ifBreaks (Doc.text "| ") Doc.nil);
printOutConstructorDoc constructor;
])
constructors);
@@ -733,7 +733,7 @@ let rec printOutSigItemDoc ?(printNameAsIs = false)
attrs;
kw;
(if printNameAsIs then Doc.text outTypeDecl.otype_name
- else printIdentLike ~allowUident:false outTypeDecl.otype_name);
+ else printIdentLike ~allowUident:false outTypeDecl.otype_name);
typeParams;
kind;
]);
@@ -870,7 +870,7 @@ and printOutExtensionConstructorDoc
Doc.text " += ";
Doc.line;
(if outExt.oext_private = Asttypes.Private then Doc.text "private "
- else Doc.nil);
+ else Doc.nil);
printOutConstructorDoc
(outExt.oext_name, outExt.oext_args, outExt.oext_ret_type);
])
@@ -908,8 +908,8 @@ and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) =
typeParams;
Doc.text " += ";
(if typeExtension.otyext_private = Asttypes.Private then
- Doc.text "private "
- else Doc.nil);
+ Doc.text "private "
+ else Doc.nil);
printOutConstructorsDoc typeExtension.otyext_constructors;
])
diff --git a/analysis/vendor/res_syntax/res_outcome_printer.mli b/analysis/vendor/res_syntax/res_outcome_printer.mli
index d3ee60aa4..c51bb0931 100644
--- a/analysis/vendor/res_syntax/res_outcome_printer.mli
+++ b/analysis/vendor/res_syntax/res_outcome_printer.mli
@@ -15,4 +15,4 @@ val setup : unit lazy_t [@@live]
val printOutTypeDoc : Outcometree.out_type -> Res_doc.t [@@live]
val printOutSigItemDoc :
?printNameAsIs:bool -> Outcometree.out_sig_item -> Res_doc.t
- [@@live]
+[@@live]
diff --git a/analysis/vendor/res_syntax/res_parsetree_viewer.ml b/analysis/vendor/res_syntax/res_parsetree_viewer.ml
index 6f951f376..8142ae33b 100644
--- a/analysis/vendor/res_syntax/res_parsetree_viewer.ml
+++ b/analysis/vendor/res_syntax/res_parsetree_viewer.ml
@@ -135,7 +135,7 @@ let rewriteUnderscoreApply expr =
match arg with
| ( lbl,
({pexp_desc = Pexp_ident ({txt = Longident.Lident "__x"} as lid)}
- as argExpr) ) ->
+ as argExpr) ) ->
( lbl,
{
argExpr with
@@ -634,6 +634,14 @@ let hasTemplateLiteralAttr attrs =
| _ -> 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
@@ -645,6 +653,12 @@ 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
+
let hasSpreadAttr attrs =
List.exists
(fun attr ->
diff --git a/analysis/vendor/res_syntax/res_parsetree_viewer.mli b/analysis/vendor/res_syntax/res_parsetree_viewer.mli
index 15ca9e150..493b6e851 100644
--- a/analysis/vendor/res_syntax/res_parsetree_viewer.mli
+++ b/analysis/vendor/res_syntax/res_parsetree_viewer.mli
@@ -137,6 +137,7 @@ val collectPatternsFromListConstruct :
val isBlockExpr : Parsetree.expression -> bool
val isTemplateLiteral : Parsetree.expression -> bool
+val isTaggedTemplateLiteral : Parsetree.expression -> bool
val hasTemplateLiteralAttr : Parsetree.attributes -> bool
val isSpreadBeltListConcat : Parsetree.expression -> bool
diff --git a/analysis/vendor/res_syntax/res_printer.ml b/analysis/vendor/res_syntax/res_printer.ml
index f85094a7c..3b546e051 100644
--- a/analysis/vendor/res_syntax/res_printer.ml
+++ b/analysis/vendor/res_syntax/res_printer.ml
@@ -216,7 +216,7 @@ let printLeadingComment ?nextComment comment =
Doc.concat
[
(if singleLine then Doc.concat [Doc.hardLine; Doc.breakParent]
- else Doc.nil);
+ else Doc.nil);
(match nextComment with
| Some next ->
let nextLoc = Comment.loc next in
@@ -843,7 +843,7 @@ and printModType ~state modType cmtTbl =
Doc.concat
[
(if lbl.txt = "_" then Doc.nil
- else Doc.text ": ");
+ else Doc.text ": ");
printModType ~state modType cmtTbl;
]);
]
@@ -896,7 +896,7 @@ and printModType ~state modType cmtTbl =
Doc.concat
[
(if attrsAlreadyPrinted then Doc.nil
- else printAttributes ~state modType.pmty_attributes cmtTbl);
+ else printAttributes ~state modType.pmty_attributes cmtTbl);
modTypeDoc;
]
in
@@ -1106,23 +1106,23 @@ and printValueDescription ~state valueDescription cmtTbl =
Doc.text ": ";
printTypExpr ~state valueDescription.pval_type cmtTbl;
(if isExternal then
- Doc.group
- (Doc.concat
- [
- Doc.text " =";
- Doc.indent
- (Doc.concat
- [
- Doc.line;
- Doc.join ~sep:Doc.line
- (List.map
- (fun s ->
- Doc.concat
- [Doc.text "\""; Doc.text s; Doc.text "\""])
- valueDescription.pval_prim);
- ]);
- ])
- else Doc.nil);
+ Doc.group
+ (Doc.concat
+ [
+ Doc.text " =";
+ Doc.indent
+ (Doc.concat
+ [
+ Doc.line;
+ Doc.join ~sep:Doc.line
+ (List.map
+ (fun s ->
+ Doc.concat
+ [Doc.text "\""; Doc.text s; Doc.text "\""])
+ valueDescription.pval_prim);
+ ]);
+ ])
+ else Doc.nil);
])
and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl =
@@ -1604,16 +1604,16 @@ and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl =
Doc.group attrs;
Doc.group
(if hasAttrsBefore then
- Doc.concat
- [
- Doc.lparen;
- Doc.indent
- (Doc.concat
- [Doc.softLine; typDoc; Doc.text " => "; returnDoc]);
- Doc.softLine;
- Doc.rparen;
- ]
- else Doc.concat [typDoc; Doc.text " => "; returnDoc]);
+ Doc.concat
+ [
+ Doc.lparen;
+ Doc.indent
+ (Doc.concat
+ [Doc.softLine; typDoc; Doc.text " => "; returnDoc]);
+ Doc.softLine;
+ Doc.rparen;
+ ]
+ else Doc.concat [typDoc; Doc.text " => "; returnDoc]);
])
| args ->
let attrs = printAttributes ~state ~inline:true attrsBefore cmtTbl in
@@ -2080,6 +2080,8 @@ and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i =
ParsetreeViewer.isBinaryExpression ifExpr
|| ParsetreeViewer.hasAttributes ifExpr.pexp_attributes
| {pexp_desc = Pexp_newtype _} -> false
+ | {pexp_attributes = [({Location.txt = "res.taggedTemplate"}, _)]} ->
+ false
| e ->
ParsetreeViewer.hasAttributes e.pexp_attributes
|| ParsetreeViewer.isArrayAccess e)
@@ -2092,8 +2094,8 @@ and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i =
patternDoc;
Doc.text " =";
(if shouldIndent then
- Doc.indent (Doc.concat [Doc.line; printedExpr])
- else Doc.concat [Doc.space; printedExpr]);
+ Doc.indent (Doc.concat [Doc.line; printedExpr])
+ else Doc.concat [Doc.space; printedExpr]);
])
and printPackageType ~state ~printModuleKeywordAndParens
@@ -2253,13 +2255,13 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl =
[
Doc.text "list{";
(if shouldHug then children
- else
- Doc.concat
- [
- Doc.indent children;
- Doc.ifBreaks (Doc.text ",") Doc.nil;
- Doc.softLine;
- ]);
+ else
+ Doc.concat
+ [
+ Doc.indent children;
+ Doc.ifBreaks (Doc.text ",") Doc.nil;
+ Doc.softLine;
+ ]);
Doc.rbrace;
])
| Ppat_construct (constrName, constructorArgs) ->
@@ -2304,13 +2306,13 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl =
[
Doc.lparen;
(if shouldHug then argDoc
- else
- Doc.concat
- [
- Doc.indent (Doc.concat [Doc.softLine; argDoc]);
- Doc.trailingComma;
- Doc.softLine;
- ]);
+ else
+ Doc.concat
+ [
+ Doc.indent (Doc.concat [Doc.softLine; argDoc]);
+ Doc.trailingComma;
+ Doc.softLine;
+ ]);
Doc.rparen;
]
in
@@ -2355,13 +2357,13 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl =
[
Doc.lparen;
(if shouldHug then argDoc
- else
- Doc.concat
- [
- Doc.indent (Doc.concat [Doc.softLine; argDoc]);
- Doc.trailingComma;
- Doc.softLine;
- ]);
+ else
+ Doc.concat
+ [
+ Doc.indent (Doc.concat [Doc.softLine; argDoc]);
+ Doc.trailingComma;
+ Doc.softLine;
+ ]);
Doc.rparen;
]
in
@@ -2410,8 +2412,7 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl =
let patternDoc = printPattern ~state pat cmtTbl in
Doc.concat
[
- (if i == 0 then Doc.nil
- else Doc.concat [Doc.line; Doc.text "| "]);
+ (if i == 0 then Doc.nil else Doc.concat [Doc.line; Doc.text "| "]);
(match pat.ppat_desc with
(* (Blue | Red) | (Green | Black) | White *)
| Ppat_or _ -> addParens patternDoc
@@ -2526,8 +2527,8 @@ and printPatternRecordRow ~state row cmtTbl =
printLidentPath longident cmtTbl;
Doc.text ":";
(if ParsetreeViewer.isHuggablePattern pattern then
- Doc.concat [Doc.space; rhsDoc]
- else Doc.indent (Doc.concat [Doc.line; rhsDoc]));
+ Doc.concat [Doc.space; rhsDoc]
+ else Doc.indent (Doc.concat [Doc.line; rhsDoc]));
])
in
printComments doc cmtTbl locForComments
@@ -2663,7 +2664,7 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
else
Doc.group
(if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc])
- else Doc.concat [Doc.space; returnDoc])
+ else Doc.concat [Doc.space; returnDoc])
in
let typConstraintDoc =
match typConstraint with
@@ -2817,13 +2818,13 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
[
Doc.lparen;
(if shouldHug then argDoc
- else
- Doc.concat
- [
- Doc.indent (Doc.concat [Doc.softLine; argDoc]);
- Doc.trailingComma;
- Doc.softLine;
- ]);
+ else
+ Doc.concat
+ [
+ Doc.indent (Doc.concat [Doc.softLine; argDoc]);
+ Doc.trailingComma;
+ Doc.softLine;
+ ]);
Doc.rparen;
]
in
@@ -2942,13 +2943,13 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
[
Doc.lparen;
(if shouldHug then argDoc
- else
- Doc.concat
- [
- Doc.indent (Doc.concat [Doc.softLine; argDoc]);
- Doc.trailingComma;
- Doc.softLine;
- ]);
+ else
+ Doc.concat
+ [
+ Doc.indent (Doc.concat [Doc.softLine; argDoc]);
+ Doc.trailingComma;
+ Doc.softLine;
+ ]);
Doc.rparen;
]
in
@@ -3048,11 +3049,13 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
| Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})])
when ParsetreeViewer.isSpreadBeltListConcat e ->
printBeltListConcatApply ~state subLists cmtTbl
- | Pexp_apply _ ->
+ | Pexp_apply (callExpr, args) ->
if ParsetreeViewer.isUnaryExpression e then
printUnaryExpression ~state e cmtTbl
else if ParsetreeViewer.isTemplateLiteral e then
printTemplateLiteral ~state e cmtTbl
+ else if ParsetreeViewer.isTaggedTemplateLiteral e then
+ printTaggedTemplateLiteral ~state callExpr args cmtTbl
else if ParsetreeViewer.isBinaryExpression e then
printBinaryExpression ~state e cmtTbl
else printPexpApply ~state e cmtTbl
@@ -3136,7 +3139,7 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl =
[
Doc.text "while ";
(if ParsetreeViewer.isBlockExpr expr1 then condition
- else Doc.group (Doc.ifBreaks (addParens condition) condition));
+ else Doc.group (Doc.ifBreaks (addParens condition) condition));
Doc.space;
printExpressionBlock ~state ~braces:true expr2 cmtTbl;
])
@@ -3376,14 +3379,14 @@ and printPexpFun ~state ~inCallback e cmtTbl =
else
Doc.group
(if returnShouldIndent then
- Doc.concat
- [
- Doc.indent (Doc.concat [Doc.line; returnDoc]);
- (match inCallback with
- | FitsOnOneLine | ArgumentsFitOnOneLine -> Doc.softLine
- | _ -> Doc.nil);
- ]
- else Doc.concat [Doc.space; returnDoc])
+ Doc.concat
+ [
+ Doc.indent (Doc.concat [Doc.line; returnDoc]);
+ (match inCallback with
+ | FitsOnOneLine | ArgumentsFitOnOneLine -> Doc.softLine
+ | _ -> Doc.nil);
+ ]
+ else Doc.concat [Doc.space; returnDoc])
in
let typConstraintDoc =
match typConstraint with
@@ -3431,8 +3434,8 @@ and printSetFieldExpr ~state attrs lhs longidentLoc rhs loc cmtTbl =
printLidentPath longidentLoc cmtTbl;
Doc.text " =";
(if shouldIndent then
- Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc]))
- else Doc.concat [Doc.space; rhsDoc]);
+ Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc]))
+ else Doc.concat [Doc.space; rhsDoc]);
])
in
let doc =
@@ -3475,6 +3478,53 @@ and printTemplateLiteral ~state expr cmtTbl =
Doc.text "`";
]
+and printTaggedTemplateLiteral ~state 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 ~state x cmtTbl;
+ Doc.text "}";
+ ])
+ valuesList
+ in
+
+ 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 : Doc.t = process strings values in
+
+ let tag = printExpressionWithComments ~state callExpr cmtTbl in
+ Doc.concat [tag; Doc.text "`"; content; Doc.text "`"]
+
and printUnaryExpression ~state expr cmtTbl =
let printUnaryOperator op =
Doc.text
@@ -3661,8 +3711,8 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl =
lhsDoc;
Doc.text " =";
(if shouldIndent then
- Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc]))
- else Doc.concat [Doc.space; rhsDoc]);
+ Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc]))
+ else Doc.concat [Doc.space; rhsDoc]);
])
in
let doc =
@@ -3871,8 +3921,8 @@ and printPexpApply ~state expr cmtTbl =
printExpressionWithComments ~state lhs cmtTbl;
Doc.text " =";
(if shouldIndent then
- Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc]))
- else Doc.concat [Doc.space; rhsDoc]);
+ Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc]))
+ else Doc.concat [Doc.space; rhsDoc]);
])
in
match expr.pexp_attributes with
@@ -3981,8 +4031,8 @@ and printPexpApply ~state expr cmtTbl =
Doc.rbracket;
Doc.text " =";
(if shouldIndentTargetExpr then
- Doc.indent (Doc.concat [Doc.line; targetExpr])
- else Doc.concat [Doc.space; targetExpr]);
+ Doc.indent (Doc.concat [Doc.line; targetExpr])
+ else Doc.concat [Doc.space; targetExpr]);
])
(* TODO: cleanup, are those branches even remotely performant? *)
| Pexp_apply ({pexp_desc = Pexp_ident lident}, args)
@@ -4127,24 +4177,24 @@ and printJsxExpression ~state lident args cmtTbl =
else Doc.greaterThan);
]);
(if isSelfClosing then Doc.nil
- else
- Doc.concat
- [
- (if hasChildren then printChildren children
- else
- match children with
- | Some
- {
- Parsetree.pexp_desc =
- Pexp_construct ({txt = Longident.Lident "[]"}, None);
- pexp_loc = loc;
- } ->
- printCommentsInside cmtTbl loc
- | _ -> Doc.nil);
- Doc.text "";
- name;
- Doc.greaterThan;
- ]);
+ else
+ Doc.concat
+ [
+ (if hasChildren then printChildren children
+ else
+ match children with
+ | Some
+ {
+ Parsetree.pexp_desc =
+ Pexp_construct ({txt = Longident.Lident "[]"}, None);
+ pexp_loc = loc;
+ } ->
+ printCommentsInside cmtTbl loc
+ | _ -> Doc.nil);
+ Doc.text "";
+ name;
+ Doc.greaterThan;
+ ]);
])
and printJsxFragment ~state expr cmtTbl =
@@ -4354,19 +4404,19 @@ and printJsxProp ~state arg cmtTbl =
* Navabar.createElement -> Navbar
* Staff.Users.createElement -> Staff.Users *)
and printJsxName {txt = lident} =
+ let printIdent = printIdentLike ~allowUident:true in
let rec flatten acc lident =
match lident with
- | Longident.Lident txt -> txt :: acc
- | Ldot (lident, txt) ->
- let acc = if txt = "createElement" then acc else txt :: acc in
- flatten acc lident
+ | Longident.Lident txt -> printIdent txt :: acc
+ | Ldot (lident, "createElement") -> flatten acc lident
+ | Ldot (lident, txt) -> flatten (printIdent txt :: acc) lident
| _ -> acc
in
match lident with
- | Longident.Lident txt -> Doc.text txt
+ | Longident.Lident txt -> printIdent txt
| _ as lident ->
let segments = flatten [] lident in
- Doc.join ~sep:Doc.dot (List.map Doc.text segments)
+ Doc.join ~sep:Doc.dot segments
and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl =
(* Because the same subtree gets printed twice, we need to copy the cmtTbl.
@@ -4877,9 +4927,9 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint
[
maybeAsyncLparen;
(if shouldHug || inCallback then printedParamaters
- else
- Doc.concat
- [Doc.indent printedParamaters; Doc.trailingComma; Doc.softLine]);
+ else
+ Doc.concat
+ [Doc.indent printedParamaters; Doc.trailingComma; Doc.softLine]);
Doc.rparen;
])
@@ -5100,14 +5150,14 @@ and printExpressionBlock ~state ~braces expr cmtTbl =
in
Doc.breakableGroup ~forceBreak:true
(if braces then
- Doc.concat
- [
- Doc.lbrace;
- Doc.indent (Doc.concat [Doc.line; block]);
- Doc.line;
- Doc.rbrace;
- ]
- else block)
+ Doc.concat
+ [
+ Doc.lbrace;
+ Doc.indent (Doc.concat [Doc.line; block]);
+ Doc.line;
+ Doc.rbrace;
+ ]
+ else block)
(*
* // user types:
@@ -5422,12 +5472,12 @@ and printModExpr ~state modExpr cmtTbl =
[
Doc.text "unpack(";
(if shouldHug then unpackDoc
- else
- Doc.concat
- [
- Doc.indent (Doc.concat [Doc.softLine; unpackDoc]);
- Doc.softLine;
- ]);
+ else
+ Doc.concat
+ [
+ Doc.indent (Doc.concat [Doc.softLine; unpackDoc]);
+ Doc.softLine;
+ ]);
Doc.rparen;
])
| Pmod_extension extension ->
@@ -5449,32 +5499,32 @@ and printModExpr ~state modExpr cmtTbl =
[
printModExpr ~state callExpr cmtTbl;
(if isUnitSugar then
- printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl
- else
- Doc.concat
- [
- Doc.lparen;
- (if shouldHug then
- printModApplyArg ~state
- (List.hd args [@doesNotRaise])
- cmtTbl
- else
- Doc.indent
- (Doc.concat
- [
- Doc.softLine;
- Doc.join
- ~sep:(Doc.concat [Doc.comma; Doc.line])
- (List.map
- (fun modArg ->
- printModApplyArg ~state modArg cmtTbl)
- args);
- ]));
- (if not shouldHug then
- Doc.concat [Doc.trailingComma; Doc.softLine]
- else Doc.nil);
- Doc.rparen;
- ]);
+ printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl
+ else
+ Doc.concat
+ [
+ Doc.lparen;
+ (if shouldHug then
+ printModApplyArg ~state
+ (List.hd args [@doesNotRaise])
+ cmtTbl
+ else
+ Doc.indent
+ (Doc.concat
+ [
+ Doc.softLine;
+ Doc.join
+ ~sep:(Doc.concat [Doc.comma; Doc.line])
+ (List.map
+ (fun modArg ->
+ printModApplyArg ~state modArg cmtTbl)
+ args);
+ ]));
+ (if not shouldHug then
+ Doc.concat [Doc.trailingComma; Doc.softLine]
+ else Doc.nil);
+ Doc.rparen;
+ ]);
])
| Pmod_constraint (modExpr, modType) ->
Doc.concat
diff --git a/analysis/vendor/res_syntax/res_printer.mli b/analysis/vendor/res_syntax/res_printer.mli
index bca833da2..3647dc379 100644
--- a/analysis/vendor/res_syntax/res_printer.mli
+++ b/analysis/vendor/res_syntax/res_printer.mli
@@ -15,10 +15,10 @@ val addParens : Res_doc.t -> Res_doc.t
val printExpression : Parsetree.expression -> Res_comments_table.t -> Res_doc.t
val printPattern : Parsetree.pattern -> Res_comments_table.t -> Res_doc.t
- [@@live]
+[@@live]
val printStructure : Parsetree.structure -> Res_comments_table.t -> Res_doc.t
- [@@live]
+[@@live]
val printImplementation :
width:int -> Parsetree.structure -> comments:Res_comment.t list -> string
diff --git a/analysis/vendor/res_syntax/res_scanner.ml b/analysis/vendor/res_syntax/res_scanner.ml
index 371711796..afcd4b9f3 100644
--- a/analysis/vendor/res_syntax/res_scanner.ml
+++ b/analysis/vendor/res_syntax/res_scanner.ml
@@ -92,7 +92,7 @@ let _printDebug ~startPos ~endPos scanner token =
print_char '-';
print_int endPos.pos_cnum;
print_endline ""
- [@@live]
+[@@live]
let next scanner =
let nextOffset = scanner.offset + 1 in
diff --git a/analysis/vendor/res_syntax/res_token.ml b/analysis/vendor/res_syntax/res_token.ml
index f519af6f0..5d12e0f14 100644
--- a/analysis/vendor/res_syntax/res_token.ml
+++ b/analysis/vendor/res_syntax/res_token.ml
@@ -238,7 +238,7 @@ let keywordTable = function
| "when" -> When
| "while" -> While
| _ -> raise Not_found
- [@@raises Not_found]
+[@@raises Not_found]
let isKeyword = function
| Await | And | As | Assert | Constraint | Else | Exception | External | False