diff --git a/.gitignore b/.gitignore index 76f2f75b90..ce9b7ae9b4 100644 --- a/.gitignore +++ b/.gitignore @@ -11,6 +11,7 @@ _build *.cmx *.cmt *.cmti +*.resextra *.cma *.a *.cmxa diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index ac1d5ae595..c89b9e6965 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -38,7 +38,8 @@ let fullFromUri ~uri = let cmt = getCmtPath ~uri paths in fullForCmt ~moduleName ~package ~uri cmt | None -> - prerr_endline ("can't find module " ^ moduleName); + if not (Uri.isInterface uri) then + prerr_endline ("can't find module " ^ moduleName); None)) let fullsFromModule ~package ~moduleName = diff --git a/analysis/src/Resextra.ml b/analysis/src/Resextra.ml new file mode 100644 index 0000000000..fd9205313c --- /dev/null +++ b/analysis/src/Resextra.ml @@ -0,0 +1,30 @@ +let extrasPathFromCmtPath cmtPath = + if Filename.check_suffix cmtPath ".cmti" then + Filename.chop_extension cmtPath ^ ".resiextra" + else if Filename.check_suffix cmtPath ".cmt" then + Filename.chop_extension cmtPath ^ ".resextra" + else cmtPath ^ ".resextra" + +let loadActionsFromPackage ~path ~package = + let uri = Uri.fromPath path in + let moduleName = + BuildSystem.namespacedName package.SharedTypes.namespace + (FindFiles.getName path) + in + match Hashtbl.find_opt package.SharedTypes.pathsForModule moduleName with + | None -> None + | Some paths -> + let cmtPath = SharedTypes.getCmtPath ~uri paths in + let extrasPath = extrasPathFromCmtPath cmtPath in + + let tryLoad path = + if Sys.file_exists path then + try + let ic = open_in_bin path in + let v = (input_value ic : Actions.action list) in + close_in ic; + Some v + with _ -> None + else None + in + tryLoad extrasPath diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index ddf783c559..87be894057 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -897,6 +897,28 @@ let parseInterface ~filename = let extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug = let pos = startPos in let codeActions = ref [] in + let add_actions_from_extras ~path ~pos ~package ~codeActions = + let map_extra_action (a : Actions.action) = + match a.action with + | Actions.RemoveOpen -> + let range = Loc.rangeOfLoc a.loc in + let newText = "" in + Some + (CodeActions.make ~title:a.description ~kind:RefactorRewrite ~uri:path + ~newText ~range) + | _ -> None + in + match Resextra.loadActionsFromPackage ~path ~package with + | None -> () + | Some actions -> + let relevant = + actions + |> List.filter (fun (a : Actions.action) -> Loc.hasPos ~pos a.loc) + in + relevant + |> List.filter_map map_extra_action + |> List.iter (fun ca -> codeActions := ca :: !codeActions) + in match Files.classifySourceFile currentFile with | Res -> let structure, printExpr, printStructureItem, printStandaloneStructure = @@ -920,7 +942,8 @@ let extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug = ~pos: (if startPos = endPos then Single startPos else Range (startPos, endPos)) - ~full ~structure ~codeActions ~debug ~currentFile + ~full ~structure ~codeActions ~debug ~currentFile; + add_actions_from_extras ~path ~pos ~package:full.package ~codeActions | None -> () in @@ -929,5 +952,8 @@ let extractCodeActions ~path ~startPos ~endPos ~currentFile ~debug = let signature, printSignatureItem = parseInterface ~filename:currentFile in AddDocTemplate.Interface.xform ~pos ~codeActions ~path ~signature ~printSignatureItem; + (match Packages.getPackage ~uri:(Uri.fromPath path) with + | Some package -> add_actions_from_extras ~path ~pos ~package ~codeActions + | None -> ()); !codeActions | Other -> [] diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index ec40263bb6..ad05600952 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -437,6 +437,9 @@ let _ : unit = Bs_conditional_initial.setup_env (); Clflags.color := Some Always; + (* Save extras (e.g., actions) once before exit, after all reporting. *) + at_exit (fun () -> Res_extra.save ()); + let flags = "flags" in Ast_config.add_structure flags file_level_flags_handler; Ast_config.add_signature flags file_level_flags_handler; diff --git a/compiler/core/js_implementation.ml b/compiler/core/js_implementation.ml index 5f4e4e6c76..f0205ca46d 100644 --- a/compiler/core/js_implementation.ml +++ b/compiler/core/js_implementation.ml @@ -49,6 +49,8 @@ let after_parsing_sig ppf outputprefix ast = if !Js_config.syntax_only then Warnings.check_fatal () else let modulename = module_of_filename outputprefix in + Res_extra.set_is_interface true; + Res_extra.set_current_outputprefix (Some outputprefix); Lam_compile_env.reset (); let initial_env = Res_compmisc.initial_env ~modulename () in Env.set_unit_name modulename; @@ -65,7 +67,9 @@ let after_parsing_sig ppf outputprefix ast = in Typemod.save_signature modulename tsg outputprefix !Location.input_name initial_env sg; - process_with_gentype (outputprefix ^ ".cmti")) + process_with_gentype (outputprefix ^ ".cmti"); + (* Persist any collected code actions to .resextra sidecar *) + Res_extra.save ()) let interface ~parser ppf ?outputprefix fname = let outputprefix = @@ -130,6 +134,8 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = if !Js_config.syntax_only then Warnings.check_fatal () else let modulename = Ext_filename.module_name outputprefix in + Res_extra.set_is_interface false; + Res_extra.set_current_outputprefix (Some outputprefix); Lam_compile_env.reset (); let env = Res_compmisc.initial_env ~modulename () in Env.set_unit_name modulename; @@ -152,7 +158,9 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = in if not !Js_config.cmj_only then Lam_compile_main.lambda_as_module js_program outputprefix); - process_with_gentype (outputprefix ^ ".cmt")) + process_with_gentype (outputprefix ^ ".cmt"); + (* Persist any collected code actions to .resextra sidecar *) + Res_extra.save ()) let implementation ~parser ppf ?outputprefix fname = let outputprefix = diff --git a/compiler/ext/warnings.ml b/compiler/ext/warnings.ml index f25b91b4f8..b1125c5ad5 100644 --- a/compiler/ext/warnings.ml +++ b/compiler/ext/warnings.ml @@ -690,3 +690,6 @@ let loc_to_string (loc : loc) : string = (loc.loc_start.pos_cnum - loc.loc_start.pos_bol) loc.loc_end.pos_lnum (loc.loc_end.pos_cnum - loc.loc_end.pos_bol) + +let emit_possible_actions_from_warning : (loc -> t -> unit) ref = + ref (fun _ _ -> ()) diff --git a/compiler/ext/warnings.mli b/compiler/ext/warnings.mli index ba1a03ceec..dd79748f5c 100644 --- a/compiler/ext/warnings.mli +++ b/compiler/ext/warnings.mli @@ -131,3 +131,5 @@ val loc_to_string : loc -> string (** Turn the location into a string with (line,column--line,column) format. *) + +val emit_possible_actions_from_warning : (loc -> t -> unit) ref diff --git a/compiler/ml/actions.ml b/compiler/ml/actions.ml new file mode 100644 index 0000000000..4ce1afb815 --- /dev/null +++ b/compiler/ml/actions.ml @@ -0,0 +1,182 @@ +type deprecated_used_context = FunctionCall | Reference + +type deprecated_used = { + source_loc: Location.t; + deprecated_text: string; + migration_template: Parsetree.expression option; + migration_in_pipe_chain_template: Parsetree.expression option; + context: deprecated_used_context option; +} + +type cmt_extra_info = {deprecated_used: deprecated_used list} + +let record_deprecated_used : + (?deprecated_context:deprecated_used_context -> + ?migration_template:Parsetree.expression -> + ?migration_in_pipe_chain_template:Parsetree.expression -> + Location.t -> + string -> + unit) + ref = + ref + (fun + ?deprecated_context + ?migration_template + ?migration_in_pipe_chain_template + _ + _ + -> + ignore deprecated_context; + ignore migration_template; + ignore migration_in_pipe_chain_template) +type action_type = + | ApplyFunction of {function_name: Longident.t} + | ApplyCoercion of {coerce_to_name: Longident.t} + | RemoveSwitchCase + | RemoveOpen + | RemoveAwait + | AddAwait + | ReplaceWithVariantConstructor of {constructor_name: Longident.t} + | ReplaceWithPolymorphicVariantConstructor of {constructor_name: string} + | RewriteObjectToRecord + | RewriteArrayToTuple + | RewriteIdentToModule of {module_name: string} + | RewriteIdent of {new_ident: Longident.t} + | RewriteArgType of {to_type: [`Labelled | `Optional | `Unlabelled]} + | PrefixVariableWithUnderscore + | RemoveUnusedVariable + | RemoveUnusedType + | RemoveUnusedModule + | RemoveRecFlag + | RemoveRecordSpread + | ForceOpen + | AssignToUnderscore + | PipeToIgnore + | PartiallyApplyFunction + | InsertMissingArguments of {missing_args: Asttypes.Noloc.arg_label list} + | ChangeRecordFieldOptional of {optional: bool} + | UnwrapOptionMapRecordField of {field_name: Longident.t} + +(* TODO: +- Unused var in patterns (and aliases )*) + +type action = {loc: Location.t; action: action_type; description: string} + +let action_to_string = function + | ApplyFunction {function_name} -> + Printf.sprintf "ApplyFunction(%s)" + (Longident.flatten function_name |> String.concat ".") + | ApplyCoercion {coerce_to_name} -> + Printf.sprintf "ApplyCoercion(%s)" + (Longident.flatten coerce_to_name |> String.concat ".") + | RemoveSwitchCase -> "RemoveSwitchCase" + | RemoveOpen -> "RemoveOpen" + | RemoveAwait -> "RemoveAwait" + | AddAwait -> "AddAwait" + | RewriteObjectToRecord -> "RewriteObjectToRecord" + | RewriteArrayToTuple -> "RewriteArrayToTuple" + | RewriteIdentToModule {module_name} -> + Printf.sprintf "RewriteIdentToModule(%s)" module_name + | PrefixVariableWithUnderscore -> "PrefixVariableWithUnderscore" + | RemoveUnusedVariable -> "RemoveUnusedVariable" + | RemoveUnusedType -> "RemoveUnusedType" + | RemoveUnusedModule -> "RemoveUnusedModule" + | ReplaceWithVariantConstructor {constructor_name} -> + Printf.sprintf "ReplaceWithVariantConstructor(%s)" + (constructor_name |> Longident.flatten |> String.concat ".") + | ReplaceWithPolymorphicVariantConstructor {constructor_name} -> + Printf.sprintf "ReplaceWithPolymorphicVariantConstructor(%s)" + constructor_name + | RewriteIdent {new_ident} -> + Printf.sprintf "RewriteIdent(%s)" + (Longident.flatten new_ident |> String.concat ".") + | RemoveRecFlag -> "RemoveRecFlag" + | ForceOpen -> "ForceOpen" + | RemoveRecordSpread -> "RemoveRecordSpread" + | AssignToUnderscore -> "AssignToUnderscore" + | PipeToIgnore -> "PipeToIgnore" + | RewriteArgType {to_type} -> ( + match to_type with + | `Labelled -> "RewriteArgType(Labelled)" + | `Optional -> "RewriteArgType(Optional)" + | `Unlabelled -> "RewriteArgType(Unlabelled)") + | PartiallyApplyFunction -> "PartiallyApplyFunction" + | InsertMissingArguments {missing_args} -> + Printf.sprintf "InsertMissingArguments(%s)" + (missing_args + |> List.map (fun arg -> + match arg with + | Asttypes.Noloc.Labelled txt -> "~" ^ txt + | Asttypes.Noloc.Optional txt -> "?" ^ txt + | Asttypes.Noloc.Nolabel -> "") + |> String.concat ", ") + | ChangeRecordFieldOptional {optional} -> + Printf.sprintf "ChangeRecordFieldOptional(%s)" + (if optional then "true" else "false") + | UnwrapOptionMapRecordField {field_name} -> + Printf.sprintf "UnwrapOptionMapRecordField(%s)" + (Longident.flatten field_name |> String.concat ".") + +let _add_possible_action : (action -> unit) ref = ref (fun _ -> ()) +let add_possible_action action = !_add_possible_action action + +let emit_possible_actions_from_warning loc w = + match w with + | Warnings.Unused_open _ -> + add_possible_action {loc; action = RemoveOpen; description = "Remove open"} + | Unused_match | Unreachable_case -> + add_possible_action + {loc; action = RemoveSwitchCase; description = "Remove switch case"} + | Unused_var _ | Unused_var_strict _ | Unused_value_declaration _ -> + add_possible_action + { + loc; + action = PrefixVariableWithUnderscore; + description = "Prefix with `_`"; + }; + add_possible_action + { + loc; + action = RemoveUnusedVariable; + description = "Remove unused variable"; + } + | Unused_type_declaration _ -> + add_possible_action + {loc; action = RemoveUnusedType; description = "Remove unused type"} + | Unused_module _ -> + add_possible_action + {loc; action = RemoveUnusedModule; description = "Remove unused module"} + | Unused_rec_flag -> + add_possible_action + {loc; action = RemoveRecFlag; description = "Remove rec flag"} + | Open_shadow_identifier _ | Open_shadow_label_constructor _ -> + add_possible_action {loc; action = ForceOpen; description = "Force open"} + | Useless_record_with -> + add_possible_action + {loc; action = RemoveRecordSpread; description = "Remove `...` spread"} + | Bs_toplevel_expression_unit _ -> + add_possible_action + {loc; action = PipeToIgnore; description = "Pipe to ignore()"}; + add_possible_action + {loc; action = AssignToUnderscore; description = "Assign to let _ ="} + | Nonoptional_label _ -> + add_possible_action + { + loc; + action = RewriteArgType {to_type = `Labelled}; + description = "Make argument optional"; + } + (* + + === TODO === + + *) + | Unused_pat -> (* Remove pattern *) () + | Unused_argument -> (* Remove unused argument or prefix with underscore *) () + | Unused_constructor _ -> (* Remove unused constructor *) () + | Bs_unused_attribute _ -> (* Remove unused attribute *) () + | _ -> () + +let _ = + Warnings.emit_possible_actions_from_warning := + emit_possible_actions_from_warning diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index a430bb0b7b..d553b5d062 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -44,6 +44,8 @@ type iterator = { open_description: iterator -> open_description -> unit; pat: iterator -> pattern -> unit; payload: iterator -> payload -> unit; + record_field: iterator -> expression record_element -> unit; + record_field_pat: iterator -> pattern record_element -> unit; signature: iterator -> signature -> unit; signature_item: iterator -> signature_item -> unit; structure: iterator -> structure -> unit; @@ -53,6 +55,7 @@ type iterator = { type_extension: iterator -> type_extension -> unit; type_kind: iterator -> type_kind -> unit; value_binding: iterator -> value_binding -> unit; + value_bindings: iterator -> value_binding list -> unit; value_description: iterator -> value_description -> unit; with_constraint: iterator -> with_constraint -> unit; } @@ -250,7 +253,7 @@ module M = struct | Pstr_eval (x, attrs) -> sub.expr sub x; sub.attributes sub attrs - | Pstr_value (_r, vbs) -> List.iter (sub.value_binding sub) vbs + | Pstr_value (_r, vbs) -> sub.value_bindings sub vbs | Pstr_primitive vd -> sub.value_description sub vd | Pstr_type (_rf, l) -> List.iter (sub.type_declaration sub) l | Pstr_typext te -> sub.type_extension sub te @@ -287,7 +290,7 @@ module E = struct | Pexp_ident x -> iter_loc sub x | Pexp_constant _ -> () | Pexp_let (_r, vbs, e) -> - List.iter (sub.value_binding sub) vbs; + sub.value_bindings sub vbs; sub.expr sub e | Pexp_fun {default = def; lhs = p; rhs = e} -> iter_opt (sub.expr sub) def; @@ -308,11 +311,7 @@ module E = struct iter_opt (sub.expr sub) arg | Pexp_variant (_lab, eo) -> iter_opt (sub.expr sub) eo | Pexp_record (l, eo) -> - List.iter - (fun {lid; x = exp} -> - iter_loc sub lid; - sub.expr sub exp) - l; + List.iter (sub.record_field sub) l; iter_opt (sub.expr sub) eo | Pexp_field (e, lid) -> sub.expr sub e; @@ -398,12 +397,7 @@ module P = struct iter_loc sub l; iter_opt (sub.pat sub) p | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p - | Ppat_record (lpl, _cf) -> - List.iter - (fun {lid; x = pat} -> - iter_loc sub lid; - sub.pat sub pat) - lpl + | Ppat_record (lpl, _cf) -> List.iter (sub.record_field_pat sub) lpl | Ppat_array pl -> List.iter (sub.pat sub) pl | Ppat_or (p1, p2) -> sub.pat sub p1; @@ -487,6 +481,7 @@ let default_iterator = this.expr this pvb_expr; this.location this pvb_loc; this.attributes this pvb_attributes); + value_bindings = (fun this l -> List.iter (this.value_binding this) l); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> iter_loc this pcd_name; @@ -526,4 +521,12 @@ let default_iterator = | PPat (x, g) -> this.pat this x; iter_opt (this.expr this) g); + record_field = + (fun this {lid; x; opt = _} -> + iter_loc this lid; + this.expr this x); + record_field_pat = + (fun this {lid; x; opt = _} -> + iter_loc this lid; + this.pat this x); } diff --git a/compiler/ml/ast_iterator.mli b/compiler/ml/ast_iterator.mli index 8c7b7a5e9f..1302b5ea1a 100644 --- a/compiler/ml/ast_iterator.mli +++ b/compiler/ml/ast_iterator.mli @@ -42,6 +42,8 @@ type iterator = { open_description: iterator -> open_description -> unit; pat: iterator -> pattern -> unit; payload: iterator -> payload -> unit; + record_field: iterator -> expression record_element -> unit; + record_field_pat: iterator -> pattern record_element -> unit; signature: iterator -> signature -> unit; signature_item: iterator -> signature_item -> unit; structure: iterator -> structure -> unit; @@ -51,6 +53,7 @@ type iterator = { type_extension: iterator -> type_extension -> unit; type_kind: iterator -> type_kind -> unit; value_binding: iterator -> value_binding -> unit; + value_bindings: iterator -> value_binding list -> unit; value_description: iterator -> value_description -> unit; with_constraint: iterator -> with_constraint -> unit; } diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 673465477b..d048c9cd08 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -48,6 +48,9 @@ type mapper = { open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; + record_field: + mapper -> expression record_element -> expression record_element; + record_field_pat: mapper -> pattern record_element -> pattern record_element; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; @@ -57,6 +60,7 @@ type mapper = { type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; + value_bindings: mapper -> value_binding list -> value_binding list; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } @@ -247,7 +251,7 @@ module M = struct match desc with | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) - | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_value (r, vbs) -> value ~loc r (sub.value_bindings sub vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) @@ -285,7 +289,7 @@ module E = struct | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> - let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) + let_ ~loc ~attrs r (sub.value_bindings sub vbs) (sub.expr sub e) | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async} -> fun_ ~loc ~attrs ~arity ~async lab @@ -304,10 +308,7 @@ module E = struct variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs - (List.map - (fun {lid; x = exp; opt} -> - {lid = map_loc sub lid; x = sub.expr sub exp; opt}) - l) + (List.map (sub.record_field sub) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) @@ -390,12 +391,7 @@ module P = struct construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> - record ~loc ~attrs - (List.map - (fun {lid; x = pat; opt} -> - {lid = map_loc sub lid; x = sub.pat sub pat; opt}) - lpl) - cf + record ~loc ~attrs (List.map (sub.record_field_pat sub) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> @@ -473,6 +469,7 @@ let default_mapper = Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes)); + value_bindings = (fun this l -> List.map (this.value_binding this) l); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) @@ -507,6 +504,12 @@ let default_mapper = | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g)); + record_field = + (fun this {lid; x; opt} -> + {lid = map_loc this lid; x = this.expr this x; opt}); + record_field_pat = + (fun this {lid; x; opt} -> + {lid = map_loc this lid; x = this.pat this x; opt}); } let rec extension_of_error {loc; msg; if_highlight; sub} = diff --git a/compiler/ml/ast_mapper.mli b/compiler/ml/ast_mapper.mli index 745fdb8d20..299d59d5de 100644 --- a/compiler/ml/ast_mapper.mli +++ b/compiler/ml/ast_mapper.mli @@ -76,6 +76,9 @@ type mapper = { open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; + record_field: + mapper -> expression record_element -> expression record_element; + record_field_pat: mapper -> pattern record_element -> pattern record_element; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; @@ -85,6 +88,7 @@ type mapper = { type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; + value_bindings: mapper -> value_binding list -> value_binding list; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } diff --git a/compiler/ml/error_message_utils.ml b/compiler/ml/error_message_utils.ml index 1805844fd9..b9fe407675 100644 --- a/compiler/ml/error_message_utils.ml +++ b/compiler/ml/error_message_utils.ml @@ -389,6 +389,8 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf \ To fix this, change the highlighted code so it evaluates to a \ @{bool@}." | Some Await, _ -> + Actions.add_possible_action + {loc; action = RemoveAwait; description = "Remove await"}; fprintf ppf "\n\n\ \ You're trying to await something that is not a promise.\n\n\ @@ -415,6 +417,8 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf | Some ComparisonOperator, _ -> fprintf ppf "\n\n You can only compare things of the same type." | Some ArrayValue, _ -> + Actions.add_possible_action + {loc; action = RewriteArrayToTuple; description = "Rewrite to tuple"}; fprintf ppf "\n\n\ \ Arrays can only contain items of the same type.\n\n\ @@ -474,6 +478,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf Some record | _ -> None) in + Actions.add_possible_action + { + loc; + action = RewriteObjectToRecord; + description = "Rewrite object to record"; + }; fprintf ppf "@,\ @,\ @@ -487,6 +497,9 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf | None -> "") | _, Some ({Types.desc = Tconstr (p1, _, _)}, _) when Path.same p1 Predef.path_promise -> + (* TODO: This should be aware of if we're in an async context or not? *) + Actions.add_possible_action + {loc; action = AddAwait; description = "Await promise"}; fprintf ppf "\n\n - Did you mean to await this promise before using it?\n" | _, Some ({Types.desc = Tconstr (p1, _, _)}, {Types.desc = Ttuple _}) when Path.same p1 Predef.path_array -> @@ -494,6 +507,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf Parser.reprint_expr_at_loc loc ~mapper:(fun exp -> match exp.Parsetree.pexp_desc with | Pexp_array items -> + Actions.add_possible_action + { + loc; + action = RewriteArrayToTuple; + description = "Rewrite to tuple"; + }; Some {exp with Parsetree.pexp_desc = Pexp_tuple items} | _ -> None) in @@ -519,6 +538,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf in let print_jsx_msg ?(extra = "") name target_fn = + Actions.add_possible_action + { + loc; + action = ApplyFunction {function_name = Longident.parse target_fn}; + description = Printf.sprintf "Convert to %s with %s" name target_fn; + }; fprintf ppf "@,\ @,\ @@ -535,6 +560,7 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf | _ when Path.same p Predef.path_float -> print_jsx_msg "float" (with_configured_jsx_module "float") | [_] when Path.same p Predef.path_option -> + (* TODO(actions) Unwrap action? *) fprintf ppf "@,\ @,\ @@ -563,6 +589,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf | ( Some (RecordField {optional = true; field_name; jsx = None}), Some ({desc = Tconstr (p, _, _)}, _) ) when Path.same Predef.path_option p -> + Actions.add_possible_action + { + loc; + action = ChangeRecordFieldOptional {optional = true}; + description = "Pass field as optional"; + }; fprintf ppf "@,\ @,\ @@ -581,6 +613,7 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf | ( Some (RecordField {optional = true; field_name; jsx = Some _}), Some ({desc = Tconstr (p, _, _)}, _) ) when Path.same Predef.path_option p -> + (* TODO(actions) JSX: Prepend with `?` *) fprintf ppf "@,\ @,\ @@ -599,6 +632,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf | ( Some (FunctionArgument {optional = true}), Some ({desc = Tconstr (p, _, _)}, _) ) when Path.same Predef.path_option p -> + Actions.add_possible_action + { + loc; + action = RewriteArgType {to_type = `Optional}; + description = "Make argument optional"; + }; fprintf ppf "@,\ @,\ @@ -657,6 +696,15 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf in match (reprinted, List.mem string_value variant_constructors) with | Some reprinted, true -> + Actions.add_possible_action + { + loc; + action = + ReplaceWithPolymorphicVariantConstructor + {constructor_name = string_value}; + description = + "Replace with polymorphic variant constructor " ^ string_value; + }; fprintf ppf "\n\n\ \ Possible solutions:\n\ @@ -715,6 +763,15 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf in match reprinted with | Some reprinted -> + Actions.add_possible_action + { + loc; + action = + ReplaceWithVariantConstructor + {constructor_name = Longident.parse constructor_name}; + description = + "Replace with variant constructor " ^ constructor_name; + }; fprintf ppf "\n\n\ \ Possible solutions:\n\ @@ -772,6 +829,14 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf in if can_show_coercion_message && not is_constant then ( + Actions.add_possible_action + { + loc; + action = + ApplyCoercion + {coerce_to_name = target_type_string |> Longident.parse}; + description = "Coerce to " ^ target_type_string; + }; fprintf ppf "@,\ @,\ @@ -849,6 +914,7 @@ let print_contextual_unification_error ppf t1 t2 = | Tconstr (p1, _, _), Tconstr (p2, _, _) when Path.same p1 Predef.path_option && Path.same p2 Predef.path_option <> true -> + (* TODO(actions) Remove `Some`/`None` *) fprintf ppf "@,\ @\n\ @@ -859,6 +925,7 @@ let print_contextual_unification_error ppf t1 t2 = | Tconstr (p1, _, _), Tconstr (p2, _, _) when Path.same p2 Predef.path_option && Path.same p1 Predef.path_option <> true -> + (* TODO(actions) Add `Some` *) fprintf ppf "@,\ @\n\ diff --git a/compiler/ml/location.ml b/compiler/ml/location.ml index fa2e806db0..9f490f33ef 100644 --- a/compiler/ml/location.ml +++ b/compiler/ml/location.ml @@ -153,6 +153,7 @@ let default_warning_printer loc ppf w = | `Inactive -> () | `Active {Warnings.number = _; message = _; is_error; sub_locs = _} -> setup_colors (); + !Warnings.emit_possible_actions_from_warning loc w; let message_kind = if is_error then `warning_as_error else `warning in Format.fprintf ppf "@[@, %a@, %s@,@]@." (print ~message_kind diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml index 8d1fe66c70..6e2b7f2b2b 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -2028,6 +2028,7 @@ let do_check_partial ?partial_match_warning_hint ?pred exhaust loc casel pss = | [] -> () | _ -> if Warnings.is_active Warnings.All_clauses_guarded then + (* TODO(actions) Add catch-all clause with %todo *) Location.prerr_warning loc Warnings.All_clauses_guarded); Partial | ps :: _ -> ( @@ -2051,6 +2052,7 @@ let do_check_partial ?partial_match_warning_hint ?pred exhaust loc casel pss = | None -> Total | Some v -> (if Warnings.is_active (Warnings.Partial_match "") then + (* TODO(actions) Add missing cases *) let errmsg = try let buf = Buffer.create 16 in @@ -2150,6 +2152,7 @@ let do_check_fragile_param exhaust loc casel pss = (fun ext -> match exhaust (Some ext) pss (List.length ps) with | Rnone -> + (* TODO(actions) Add explicit pattern for all variant constructors *) Location.prerr_warning loc (Warnings.Fragile_match (Path.name ext)) | Rsome _ -> ()) exts) diff --git a/compiler/ml/res_extra.ml b/compiler/ml/res_extra.ml new file mode 100644 index 0000000000..89eb4e0ff1 --- /dev/null +++ b/compiler/ml/res_extra.ml @@ -0,0 +1,25 @@ +let current_outputprefix : string option ref = ref None + +let possible_actions : Actions.action list ref = ref [] + +let set_current_outputprefix v = current_outputprefix := v + +let is_interface : bool ref = ref false + +let set_is_interface v = is_interface := v + +let add_possible_action action = possible_actions := action :: !possible_actions + +let () = Actions._add_possible_action := add_possible_action + +let save () = + match !current_outputprefix with + | None -> () + | Some outputprefix -> + let extras_filename = + outputprefix ^ if !is_interface then ".resiextra" else ".resextra" + in + if List.length !possible_actions > 0 then + Misc.output_to_bin_file_directly extras_filename (fun _ oc -> + output_value oc (!possible_actions : Actions.action list)); + possible_actions := [] diff --git a/compiler/ml/res_extra.mli b/compiler/ml/res_extra.mli new file mode 100644 index 0000000000..ff77fbeea2 --- /dev/null +++ b/compiler/ml/res_extra.mli @@ -0,0 +1,7 @@ +val set_current_outputprefix : string option -> unit + +val set_is_interface : bool -> unit + +val add_possible_action : Actions.action -> unit + +val save : unit -> unit diff --git a/compiler/ml/translattribute.ml b/compiler/ml/translattribute.ml index ed63ecbdf1..2784f6bc46 100644 --- a/compiler/ml/translattribute.ml +++ b/compiler/ml/translattribute.ml @@ -32,6 +32,7 @@ let find_attribute p (attributes : t list) = | [] -> None | [attr] -> Some attr | _ :: ({txt; loc}, _) :: _ -> + (* TODO(actions) Remove duplicate attribute *) Location.prerr_warning loc (Warnings.Duplicated_attribute txt); None in diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index f0f7b09009..258d4d74ca 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -698,9 +698,16 @@ let simple_conversions = (("string", "int"), "Int.fromString"); ] -let print_simple_conversion ppf (actual, expected) = +let print_simple_conversion ~loc ppf (actual, expected) = try let converter = List.assoc (actual, expected) simple_conversions in + Actions.add_possible_action + { + loc; + action = ApplyFunction {function_name = Longident.parse converter}; + description = Printf.sprintf "Convert to %s with %s" expected converter; + }; + fprintf ppf "@,\ @,\ @@ -719,14 +726,14 @@ let print_simple_message ppf = function @{20.@})." | _ -> () -let show_extra_help ppf _env trace = +let show_extra_help ~loc ppf _env trace = match bottom_aliases trace with | Some ( {Types.desc = Tconstr (actual_path, actual_args, _)}, {desc = Tconstr (expected_path, expexted_args, _)} ) -> ( match (actual_path, actual_args, expected_path, expexted_args) with | Pident {name = actual_name}, [], Pident {name = expected_name}, [] -> - print_simple_conversion ppf (actual_name, expected_name); + print_simple_conversion ~loc ppf (actual_name, expected_name); print_simple_message ppf (actual_name, expected_name) | _ -> ()) | _ -> () @@ -800,7 +807,7 @@ let print_expr_type_clash ~context env loc trace ppf = (function ppf -> error_expected_type_text ppf context); print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf bottom_aliases_result trace context; - show_extra_help ppf env trace + show_extra_help ~loc ppf env trace let report_arity_mismatch ~arity_a ~arity_b ppf = fprintf ppf @@ -2941,7 +2948,9 @@ and type_expect_ ?deprecated_context ~context ?in_function ?(recarg = Rejected) Types.val_loc = loc; } env - ~check:(fun s -> Warnings.Unused_for_index s) + ~check:(fun s -> + (* TODO(actions) Remove unused for-loop index or prefix with underscore *) + Warnings.Unused_for_index s) | _ -> raise (Error (param.ppat_loc, env, Invalid_for_loop_index)) in let body = type_statement ~context:None new_env sbody in @@ -3709,6 +3718,7 @@ and type_application ~context total_app env funct (sargs : sargs) : else (sargs, (l, ty, lv) :: omitted, None) | Some (l', sarg0, sargs) -> if (not optional) && is_optional l' then + (* TODO(actions) Add ? to make argument optional *) Location.prerr_warning sarg0.pexp_loc (Warnings.Nonoptional_label (Printtyp.string_of_label l)); ( sargs, @@ -4369,6 +4379,7 @@ let report_error env loc ppf error = (* modified *) let is_inline_record = Option.is_some constuctor.cstr_inlined in if is_inline_record && expected = 1 then + (* TODO(actions) Add empty inline record argument, or change to inline record *) fprintf ppf "@[This variant constructor @{%a@} expects an inline record as \ payload%s.@]" @@ -4376,6 +4387,7 @@ let report_error env loc ppf error = (if provided = 0 then ", but it's not being passed any arguments" else "") else + (* TODO(actions) Add missing arguments *) fprintf ppf "@[This variant constructor @{%a@} expects %i %s, but it's%s \ being passed %i.@]" @@ -4465,6 +4477,7 @@ let report_error env loc ppf error = | Apply_wrong_label (l, ty) -> let print_message ppf = function | Nolabel -> + (* ?TODO(actions) Make labelled *) fprintf ppf "The argument at this position should be labelled." | l -> fprintf ppf "This function does not take the argument @{%s@}." @@ -4481,6 +4494,7 @@ let report_error env loc ppf error = | Label_multiply_defined {label} -> fprintf ppf "The record field label %s is defined several times" label | Labels_missing {labels; jsx_component_info = Some jsx_component_info} -> + (* TODO(actions) Add missing JSX props *) print_component_labels_missing_error ppf labels jsx_component_info | Labels_missing {labels} -> let print_labels ppf = List.iter (fun lbl -> fprintf ppf "@ %s" lbl) in @@ -4703,6 +4717,24 @@ let report_error env loc ppf error = if not is_fallback then fprintf ppf "@,"; if List.length missing_required_args > 0 then ( + Actions.add_possible_action + { + loc; + action = + InsertMissingArguments + { + missing_args = + missing_required_args + |> List.map (fun arg -> Noloc.Labelled arg); + }; + description = "Insert missing arguments"; + }; + Actions.add_possible_action + { + loc; + action = PartiallyApplyFunction; + description = "Partially apply function"; + }; fprintf ppf "@,- Missing arguments that must be provided: %s" (missing_required_args |> List.map (fun v -> "~" ^ v) @@ -4715,6 +4747,7 @@ let report_error env loc ppf error = Example: @{yourFn(~arg1=someVar, ...)@}"); if List.length superfluous_args > 0 then + (* TODO(actions) Remove arguments *) fprintf ppf "@,- Called with arguments it does not take: %s" (superfluous_args |> String.concat ", "); @@ -4761,25 +4794,34 @@ let report_error env loc ppf error = match suggestion with | None -> () | Some suggestion_str -> + Actions.add_possible_action + { + loc; + action = RewriteIdent {new_ident = Longident.parse suggestion_str}; + description = Printf.sprintf "Rewrite to use %s" suggestion_str; + }; fprintf ppf "@,@,Hint: Try @{%s@} instead (takes @{%d@} argument%s)." suggestion_str args (if args = 1 then "" else "s")) | None -> ()); - fprintf ppf "@]" | Field_not_optional (name, typ) -> + (* TODO(actions) Remove `?` *) fprintf ppf "Field @{%s@} is not optional in type %a. Use without ?" name type_expr typ | Type_params_not_supported lid -> + (* TODO(actions) Remove type parameters *) fprintf ppf "The type %a@ has type parameters, but type parameters is not supported \ here." longident lid | Field_access_on_dict_type -> + (* TODO(actions) Rewrite to Dict.get *) fprintf ppf "Direct field access on a dict is not supported. Use Dict.get instead." | Jsx_not_enabled -> + (* ?TODO(actions) Add JSX config to rescript.json...? *) fprintf ppf "Cannot compile JSX expression because JSX support is not enabled. Add \ \"jsx\" settings to rescript.json to enable JSX support." diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml index 9867baac11..f74c9a3a79 100644 --- a/compiler/ml/typetexp.ml +++ b/compiler/ml/typetexp.ml @@ -41,9 +41,13 @@ type error = | Cannot_quantify of string * type_expr | Multiple_constraints_on_type of Longident.t | Method_mismatch of string * type_expr * type_expr - | Unbound_value of Longident.t + | Unbound_value of Longident.t * Location.t | Unbound_constructor of Longident.t - | Unbound_label of Longident.t * type_expr option + | Unbound_label of { + loc: Location.t; + field_name: Longident.t; + from_type: type_expr option; + } | Unbound_module of Longident.t | Unbound_modtype of Longident.t | Ill_typed_functor_application of Longident.t @@ -129,13 +133,17 @@ let find_constructor = let find_all_constructors = find_component Env.lookup_all_constructors (fun lid -> Unbound_constructor lid) -let find_all_labels = - find_component Env.lookup_all_labels (fun lid -> Unbound_label (lid, None)) +let find_all_labels env loc = + find_component Env.lookup_all_labels + (fun lid -> Unbound_label {loc; field_name = lid; from_type = None}) + env loc let find_value ?deprecated_context env loc lid = Env.check_value_name (Longident.last lid) loc; let ((path, decl) as r) = - find_component Env.lookup_value (fun lid -> Unbound_value lid) env loc lid + find_component Env.lookup_value + (fun lid -> Unbound_value (lid, loc)) + env loc lid in Builtin_attributes.check_deprecated ?deprecated_context loc decl.val_attributes (Path.name path); @@ -168,8 +176,9 @@ let unbound_constructor_error ?from_type env lid = Unbound_constructor lid) let unbound_label_error ?from_type env lid = + let lid_with_loc = lid in narrow_unbound_lid_error env lid.loc lid.txt (fun lid -> - Unbound_label (lid, from_type)) + Unbound_label {loc = lid_with_loc.loc; field_name = lid; from_type}) (* Support for first-class modules. *) @@ -722,20 +731,20 @@ let transl_type_scheme env styp = open Format open Printtyp -let did_you_mean ppf choices : bool = +let did_you_mean ppf choices : bool * string list = (* flush now to get the error report early, in the (unheard of) case where the linear search would take a bit of time; in the worst case, the user has seen the error, she can interrupt the process before the spell-checking terminates. *) Format.fprintf ppf "@?"; match choices () with - | [] -> false - | last :: rev_rest -> + | [] -> (false, []) + | last :: rev_rest as choices -> Format.fprintf ppf "@[@,@,@{Hint: Did you mean %s%s%s?@}@]" (String.concat ", " (List.rev rev_rest)) (if rev_rest = [] then "" else " or ") last; - true + (true, choices) let super_spellcheck ppf fold env lid = let choices path name : string list = @@ -743,7 +752,7 @@ let super_spellcheck ppf fold env lid = Misc.spellcheck env name in match lid with - | Longident.Lapply _ -> false + | Longident.Lapply _ -> (false, []) | Longident.Lident s -> did_you_mean ppf (fun _ -> choices None s) | Longident.Ldot (r, s) -> did_you_mean ppf (fun _ -> choices (Some r) s) @@ -775,8 +784,9 @@ let report_error env ppf = function (* modified *) Format.fprintf ppf "@[This type constructor, `%a`, can't be found.@ " Printtyp.longident lid; - let has_candidate = super_spellcheck ppf Env.fold_types env lid in + let has_candidate, _ = super_spellcheck ppf Env.fold_types env lid in if not has_candidate then + (* TODO(actions) Add rec flag by first checking the let bindings for matching name *) Format.fprintf ppf "If you wanted to write a recursive type, don't forget the `rec` in \ `type rec`@]" @@ -784,6 +794,7 @@ let report_error env ppf = function fprintf ppf "The type constructor@ %a@ is not yet completely defined" path p | Type_arity_mismatch (lid, expected, provided) -> if expected == 0 then + (* TODO(actions) Remove type parameters *) fprintf ppf "@[The type %a is not generic so expects no arguments,@ but is here \ applied to %i argument(s).@ Have you tried removing the angular \ @@ -845,7 +856,7 @@ let report_error env ppf = function Printtyp.reset_and_mark_loops_list [ty; ty']; fprintf ppf "@[Method '%s' has type %a,@ which should be %a@]" l Printtyp.type_expr ty Printtyp.type_expr ty') - | Unbound_value lid -> ( + | Unbound_value (lid, loc) -> ( (* modified *) (match lid with | Ldot (outer, inner) -> @@ -854,29 +865,50 @@ let report_error env ppf = function | other_ident -> Format.fprintf ppf "The value %a can't be found" Printtyp.longident other_ident); - let did_spellcheck = super_spellcheck ppf Env.fold_values env lid in + let did_spellcheck, choices = + super_spellcheck ppf Env.fold_values env lid + in + if did_spellcheck then + choices + |> List.iter (fun choice -> + Actions.add_possible_action + { + loc; + action = Actions.RewriteIdent {new_ident = Lident choice}; + description = "Change to `" ^ choice ^ "`"; + }); (* For cases such as when the user refers to something that's a value with a lowercase identifier in JS but a module in ReScript. 'Console' is a typical example, where JS is `console.log` and ReScript is `Console.log`. *) - (* TODO(codemods) Add codemod for refering to the module instead. *) - let as_module = + let as_module_name = match lid with - | Lident name -> ( + | Lident name -> Some (String.capitalize_ascii name) + | _ -> None + in + let as_module = + match as_module_name with + | Some name -> ( try Some (env |> Env.lookup_module ~load:false (Lident (String.capitalize_ascii name))) with _ -> None) - | _ -> None + | None -> None in - match as_module with - | None -> () - | Some module_path -> + match (as_module, as_module_name) with + | Some module_path, Some as_module_name -> + Actions.add_possible_action + { + loc; + action = Actions.RewriteIdentToModule {module_name = as_module_name}; + description = "Change to `" ^ as_module_name ^ "`"; + }; Format.fprintf ppf "@,@[@,@[%s to use the module @{%a@}?@]@]" (if did_spellcheck then "Or did you mean" else "Maybe you meant") - Printtyp.path module_path) + Printtyp.path module_path + | _ -> ()) | Unbound_module lid -> (* modified *) (match lid with @@ -913,10 +945,17 @@ let report_error env ppf = function = Bar@}.@]@]" Printtyp.longident lid Printtyp.longident lid Printtyp.longident lid; spellcheck ppf fold_constructors env lid - | Unbound_label (lid, from_type) -> + | Unbound_label {loc; field_name; from_type} -> (* modified *) (match from_type with | Some {desc = Tconstr (p, _, _)} when Path.same p Predef.path_option -> + Actions.add_possible_action + { + loc; + action = UnwrapOptionMapRecordField {field_name}; + description = + "Unwrap the option first before accessing the record field"; + }; (* TODO: Extend for nullable/null? *) Format.fprintf ppf "@[You're trying to access the record field @{%a@}, but the \ @@ -928,14 +967,15 @@ let report_error env ppf = function @{xx->Option.map(field => field.%a)@}@]@,\ @[- Or use @{Option.getOr@} with a default: \ @{xx->Option.getOr(defaultRecord).%a@}@]@]" - Printtyp.longident lid Printtyp.longident lid Printtyp.longident lid + Printtyp.longident field_name Printtyp.longident field_name + Printtyp.longident field_name | Some {desc = Tconstr (p, _, _)} when Path.same p Predef.path_array -> Format.fprintf ppf "@[You're trying to access the record field @{%a@}, but the \ value you're trying to access it on is an @{array@}.@ You need \ to access an individual element of the array if you want to access an \ individual record field.@]" - Printtyp.longident lid + Printtyp.longident field_name | Some ({desc = Tconstr (_p, _, _)} as t1) -> Format.fprintf ppf "@[You're trying to access the record field @{%a@}, but the \ @@ -944,7 +984,7 @@ let report_error env ppf = function %a@,\n\ @,\ Only records have fields that can be accessed with dot notation.@]" - Printtyp.longident lid Error_message_utils.type_expr t1 + Printtyp.longident field_name Error_message_utils.type_expr t1 | None | Some _ -> Format.fprintf ppf "@[@{%a@} refers to a record field, but no corresponding \ @@ -955,8 +995,9 @@ let report_error env ppf = function @{TheModule.%a@}@]@,\ @[- Or specifying the record type explicitly:@ @{let theValue: \ TheModule.theType = {%a: VALUE}@}@]@]" - Printtyp.longident lid Printtyp.longident lid Printtyp.longident lid); - spellcheck ppf fold_labels env lid + Printtyp.longident field_name Printtyp.longident field_name + Printtyp.longident field_name); + spellcheck ppf fold_labels env field_name | Unbound_modtype lid -> fprintf ppf "Unbound module type %a" longident lid; spellcheck ppf fold_modtypes env lid diff --git a/compiler/ml/typetexp.mli b/compiler/ml/typetexp.mli index 8f40096392..b9cd68c0d6 100644 --- a/compiler/ml/typetexp.mli +++ b/compiler/ml/typetexp.mli @@ -50,9 +50,13 @@ type error = | Cannot_quantify of string * type_expr | Multiple_constraints_on_type of Longident.t | Method_mismatch of string * type_expr * type_expr - | Unbound_value of Longident.t + | Unbound_value of Longident.t * Location.t | Unbound_constructor of Longident.t - | Unbound_label of Longident.t * type_expr option + | Unbound_label of { + loc: Location.t; + field_name: Longident.t; + from_type: type_expr option; + } | Unbound_module of Longident.t | Unbound_modtype of Longident.t | Ill_typed_functor_application of Longident.t diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index ee74eae6b4..5b3b2db9e5 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -151,6 +151,7 @@ module ErrorMessages = struct `'A`" let attribute_without_node (attr : Parsetree.attribute) = + (* TODO: Be explicit about doc comments *) let {Asttypes.txt = attr_name}, _ = attr in "Did you forget to attach `" ^ attr_name ^ "` to an item?\n Standalone attributes start with `@@` like: `@@" diff --git a/lib_dev/process.js b/lib_dev/process.js index 0dbddd4881..af2d4caf24 100644 --- a/lib_dev/process.js +++ b/lib_dev/process.js @@ -176,6 +176,19 @@ export function setup(cwd = process.cwd()) { return exec(bsc_exe, args, options); }, + /** + * `rescript-tools` CLI + * + * @return {Promise} + */ + rescriptTools(command, args = [], options = {}) { + const cliPath = path.join( + import.meta.dirname, + "../cli/rescript-tools.js", + ); + return exec("node", [cliPath, command, ...args].filter(Boolean), options); + }, + /** * Execute ReScript `build` command directly * diff --git a/rewatch/src/build/clean.rs b/rewatch/src/build/clean.rs index 7a360f7f64..074b71487d 100644 --- a/rewatch/src/build/clean.rs +++ b/rewatch/src/build/clean.rs @@ -57,7 +57,7 @@ fn remove_compile_asset(package: &packages::Package, source_file: &Path, extensi pub fn remove_compile_assets(package: &packages::Package, source_file: &Path) { // optimization // only issue cmti if there is an interfacce file - for extension in &["cmj", "cmi", "cmt", "cmti"] { + for extension in &["cmj", "cmi", "cmt", "cmti", "resextra", "resiextra"] { remove_compile_asset(package, source_file, extension); } } diff --git a/rewatch/src/build/compile.rs b/rewatch/src/build/compile.rs index c48457a5e1..c8ce45c8f7 100644 --- a/rewatch/src/build/compile.rs +++ b/rewatch/src/build/compile.rs @@ -717,6 +717,13 @@ fn compile_file( .join(format!("{basename}.cmt")), ocaml_build_path_abs.join(format!("{basename}.cmt")), ); + let _ = std::fs::copy( + package + .get_build_path() + .join(dir) + .join(format!("{basename}.resextra")), + ocaml_build_path_abs.join(format!("{basename}.resextra")), + ); } else { let _ = std::fs::copy( package @@ -729,6 +736,13 @@ fn compile_file( package.get_build_path().join(dir).join(format!("{basename}.cmi")), ocaml_build_path_abs.join(format!("{basename}.cmi")), ); + let _ = std::fs::copy( + package + .get_build_path() + .join(dir) + .join(format!("{basename}.resiextra")), + ocaml_build_path_abs.join(format!("{basename}.resiextra")), + ); } if let SourceType::SourceFile(SourceFile { diff --git a/tests/analysis_tests/tests/src/CodeActionExtras.res b/tests/analysis_tests/tests/src/CodeActionExtras.res new file mode 100644 index 0000000000..0f7d3bdeaa --- /dev/null +++ b/tests/analysis_tests/tests/src/CodeActionExtras.res @@ -0,0 +1,5 @@ +@@warning("+33") + +open Belt +// ^xfm + diff --git a/tests/analysis_tests/tests/src/expected/CodeActionExtras.res.txt b/tests/analysis_tests/tests/src/expected/CodeActionExtras.res.txt new file mode 100644 index 0000000000..11d4047421 --- /dev/null +++ b/tests/analysis_tests/tests/src/expected/CodeActionExtras.res.txt @@ -0,0 +1,9 @@ +Xform src/CodeActionExtras.res 2:3 +Hit: Remove open + +TextDocumentEdit: CodeActionExtras.res +{"start": {"line": 2, "character": 0}, "end": {"line": 2, "character": 9}} +newText: +<--here + + diff --git a/tests/build_tests/actions/ACTIONS_TESTS.md b/tests/build_tests/actions/ACTIONS_TESTS.md new file mode 100644 index 0000000000..c9d11ea0d9 --- /dev/null +++ b/tests/build_tests/actions/ACTIONS_TESTS.md @@ -0,0 +1,8 @@ +# Actions tests + +Tests for emitted possible actions. + +- Add ReScript files that should be producing actions to `tests/build_tests/actions/fixtures`. Make sure you prefix all filenames with `Actions_`, e.g `Actions_UnusedOpen.res` +- Test file output are emitted as actual ReScript files suffixed with `_applied`, into `tests/build_tests/actions/expected`. So `Actions_UnusedOpen_applied.res` +- Run `node tests/build_tests/actions/input.js` to run the tests +- Run `node tests/build_tests/actions/input.js update` to persist any updates to the test output, or write initial output for new tests diff --git a/tests/build_tests/actions/expected/Actions_AccessRecordFieldOnOption_applied.res b/tests/build_tests/actions/expected/Actions_AccessRecordFieldOnOption_applied.res new file mode 100644 index 0000000000..11bfbf38f2 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_AccessRecordFieldOnOption_applied.res @@ -0,0 +1,16 @@ +module X = { + type y = {d: int} + type x = { + a: int, + b: int, + c: option, + } + + let x = {a: 1, b: 2, c: Some({d: 3})} +} + +let f = X.x.c->Option.map(v => v.d) + +/* === AVAILABLE ACTIONS: +- UnwrapOptionMapRecordField(d) - Unwrap the option first before accessing the record field +*/ diff --git a/tests/build_tests/actions/expected/Actions_AddAwait_applied.res b/tests/build_tests/actions/expected/Actions_AddAwait_applied.res new file mode 100644 index 0000000000..a651c5e659 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_AddAwait_applied.res @@ -0,0 +1,9 @@ +let fn = async () => 12 + +let other = async (): int => { + await fn() +} + +/* === AVAILABLE ACTIONS: +- AddAwait - Await promise +*/ diff --git a/tests/build_tests/actions/expected/Actions_ApplyCoercion_applied.res b/tests/build_tests/actions/expected/Actions_ApplyCoercion_applied.res new file mode 100644 index 0000000000..2294ba4390 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_ApplyCoercion_applied.res @@ -0,0 +1,9 @@ +type x1 = One +type x2 = | ...x1 | Two + +let x1: x1 = One +let x2: x2 = (x1 :> x2) + +/* === AVAILABLE ACTIONS: +- ApplyCoercion(x2) - Coerce to x2 +*/ diff --git a/tests/build_tests/actions/expected/Actions_ApplyConversionFunction_applied.res b/tests/build_tests/actions/expected/Actions_ApplyConversionFunction_applied.res new file mode 100644 index 0000000000..b72e89cc8d --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_ApplyConversionFunction_applied.res @@ -0,0 +1,5 @@ +let x: int = Float.toInt(12.) + +/* === AVAILABLE ACTIONS: +- ApplyFunction(Float.toInt) - Convert to int with Float.toInt +*/ diff --git a/tests/build_tests/actions/expected/Actions_AssignToUnderscore_applied.res b/tests/build_tests/actions/expected/Actions_AssignToUnderscore_applied.res new file mode 100644 index 0000000000..964847798a --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_AssignToUnderscore_applied.res @@ -0,0 +1,9 @@ +let _ = // actionFilter=AssignToUnderscore +switch 1 { +| _ => "one" +} + +/* === AVAILABLE ACTIONS: +- AssignToUnderscore - Assign to let _ = +- PipeToIgnore - Pipe to ignore() +*/ diff --git a/tests/build_tests/actions/expected/Actions_ForceOpen_applied.res b/tests/build_tests/actions/expected/Actions_ForceOpen_applied.res new file mode 100644 index 0000000000..b2746b7515 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_ForceOpen_applied.res @@ -0,0 +1,32 @@ +type person = { + name: string, + age: int, +} + +module X = { + let ff = 15 +} + +let ff = 16 + +open! X + +let f2 = ff + +module RecordExample = { + type t = { + name: string, + age: int, + } + let person = {name: "John", age: 30} +} + +open! RecordExample + +let p = {name: "Jane", age: 25} + +/* === AVAILABLE ACTIONS: +- ForceOpen - Force open +- ForceOpen - Force open +- ForceOpen - Force open +*/ diff --git a/tests/build_tests/actions/expected/Actions_IdentButDidYouMeanModule_applied.res b/tests/build_tests/actions/expected/Actions_IdentButDidYouMeanModule_applied.res new file mode 100644 index 0000000000..a0180da07f --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_IdentButDidYouMeanModule_applied.res @@ -0,0 +1,5 @@ +Console.log(123) + +/* === AVAILABLE ACTIONS: +- RewriteIdentToModule(Console) - Change to `Console` +*/ diff --git a/tests/build_tests/actions/expected/Actions_InsertMissingArguments_applied.res b/tests/build_tests/actions/expected/Actions_InsertMissingArguments_applied.res new file mode 100644 index 0000000000..99123d0b8a --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_InsertMissingArguments_applied.res @@ -0,0 +1,8 @@ +// actionFilter=InsertMissingArguments +let x = (~a, ~b) => a + b +let y = x(~a=2, ~b=%todo) + 2 + +/* === AVAILABLE ACTIONS: +- PartiallyApplyFunction - Partially apply function +- InsertMissingArguments(~b) - Insert missing arguments +*/ diff --git a/tests/build_tests/actions/expected/Actions_JSXCustomComponentChildren_applied.res b/tests/build_tests/actions/expected/Actions_JSXCustomComponentChildren_applied.res new file mode 100644 index 0000000000..d9261ca3f3 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_JSXCustomComponentChildren_applied.res @@ -0,0 +1,28 @@ +@@config({ + flags: ["-bs-jsx", "4"], +}) + +module React = { + type element = Jsx.element + type componentLike<'props, 'return> = 'props => 'return + type component<'props> = Jsx.component<'props> + + @module("react/jsx-runtime") + external jsx: (component<'props>, 'props) => element = "jsx" + + type fragmentProps = {children?: element} + @module("react/jsx-runtime") external jsxFragment: component = "Fragment" +} + +module CustomComponent = { + @react.component + let make = (~children) => { + <> {children} + } +} + +let x = {React.float(1.)} + +/* === AVAILABLE ACTIONS: +- ApplyFunction(React.float) - Convert to float with React.float +*/ diff --git a/tests/build_tests/actions/expected/Actions_MakeArgNonOptional_applied.res b/tests/build_tests/actions/expected/Actions_MakeArgNonOptional_applied.res new file mode 100644 index 0000000000..cf9ab078a6 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_MakeArgNonOptional_applied.res @@ -0,0 +1,9 @@ +let myFunction = (~name: string) => { + ignore(name) +} +let name = "John" +myFunction(~name) + +/* === AVAILABLE ACTIONS: +- RewriteArgType(Labelled) - Make argument optional +*/ diff --git a/tests/build_tests/actions/expected/Actions_MakeArgOptional_applied.res b/tests/build_tests/actions/expected/Actions_MakeArgOptional_applied.res new file mode 100644 index 0000000000..21458bc809 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_MakeArgOptional_applied.res @@ -0,0 +1,9 @@ +let myFunction = (~name: option=?) => { + ignore(name) +} +let name = Some("John") +myFunction(~name?) + +/* === AVAILABLE ACTIONS: +- RewriteArgType(Optional) - Make argument optional +*/ diff --git a/tests/build_tests/actions/expected/Actions_PartiallyApplyFunction_applied.res b/tests/build_tests/actions/expected/Actions_PartiallyApplyFunction_applied.res new file mode 100644 index 0000000000..7d79033803 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_PartiallyApplyFunction_applied.res @@ -0,0 +1,8 @@ +// actionFilter=PartiallyApplyFunction +let x = (~a, ~b) => a + b +let y = x(~a=2, ...) + 2 + +/* === AVAILABLE ACTIONS: +- PartiallyApplyFunction - Partially apply function +- InsertMissingArguments(~b) - Insert missing arguments +*/ diff --git a/tests/build_tests/actions/expected/Actions_PassRecordFieldAsOptional_applied.res b/tests/build_tests/actions/expected/Actions_PassRecordFieldAsOptional_applied.res new file mode 100644 index 0000000000..6c91a4a32d --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_PassRecordFieldAsOptional_applied.res @@ -0,0 +1,8 @@ +type record = {a: int, test?: bool} +let test = Some(true) + +let x = {a: 10, ?test} + +/* === AVAILABLE ACTIONS: +- ChangeRecordFieldOptional(true) - Pass field as optional +*/ diff --git a/tests/build_tests/actions/expected/Actions_PipeToIgnore_applied.res b/tests/build_tests/actions/expected/Actions_PipeToIgnore_applied.res new file mode 100644 index 0000000000..a31b78fdf2 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_PipeToIgnore_applied.res @@ -0,0 +1,9 @@ +// actionFilter=PipeToIgnore +switch 1 { +| _ => "one" +}->ignore + +/* === AVAILABLE ACTIONS: +- AssignToUnderscore - Assign to let _ = +- PipeToIgnore - Pipe to ignore() +*/ diff --git a/tests/build_tests/actions/expected/Actions_PrefixUnusedVarUnderscore_applied.res b/tests/build_tests/actions/expected/Actions_PrefixUnusedVarUnderscore_applied.res new file mode 100644 index 0000000000..08ab3a728d --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_PrefixUnusedVarUnderscore_applied.res @@ -0,0 +1,10 @@ +// actionFilter=PrefixVariableWithUnderscore +let f = () => { + let _x = 1 + 12 +} + +/* === AVAILABLE ACTIONS: +- RemoveUnusedVariable - Remove unused variable +- PrefixVariableWithUnderscore - Prefix with `_` +*/ diff --git a/tests/build_tests/actions/expected/Actions_RemoveAwait_applied.res b/tests/build_tests/actions/expected/Actions_RemoveAwait_applied.res new file mode 100644 index 0000000000..6071c2d522 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RemoveAwait_applied.res @@ -0,0 +1,6 @@ +let f = 12 +let x = f + +/* === AVAILABLE ACTIONS: +- RemoveAwait - Remove await +*/ diff --git a/tests/build_tests/actions/expected/Actions_RemoveRecFlag_applied.res b/tests/build_tests/actions/expected/Actions_RemoveRecFlag_applied.res new file mode 100644 index 0000000000..2397491dae --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RemoveRecFlag_applied.res @@ -0,0 +1,12 @@ +// actionFilter=RemoveRecFlag +let f = 12 +let fn = () => { + let x = 12 +} + +/* === AVAILABLE ACTIONS: +- RemoveUnusedVariable - Remove unused variable +- PrefixVariableWithUnderscore - Prefix with `_` +- RemoveRecFlag - Remove rec flag +- RemoveRecFlag - Remove rec flag +*/ diff --git a/tests/build_tests/actions/expected/Actions_RemoveRecordSpread_applied.res b/tests/build_tests/actions/expected/Actions_RemoveRecordSpread_applied.res new file mode 100644 index 0000000000..23603dde2f --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RemoveRecordSpread_applied.res @@ -0,0 +1,9 @@ +type x = {a: int} + +let x = {a: 1} + +let f = {a: 1} + +/* === AVAILABLE ACTIONS: +- RemoveRecordSpread - Remove `...` spread +*/ diff --git a/tests/build_tests/actions/expected/Actions_RemoveUnusedModule_applied.res b/tests/build_tests/actions/expected/Actions_RemoveUnusedModule_applied.res new file mode 100644 index 0000000000..3605fa5032 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RemoveUnusedModule_applied.res @@ -0,0 +1,8 @@ +// actionFilter=RemoveUnusedModule +module M: {} = {} + +/* === AVAILABLE ACTIONS: +- RemoveUnusedModule - Remove unused module +- RemoveUnusedVariable - Remove unused variable +- PrefixVariableWithUnderscore - Prefix with `_` +*/ diff --git a/tests/build_tests/actions/expected/Actions_RemoveUnusedType_applied.res b/tests/build_tests/actions/expected/Actions_RemoveUnusedType_applied.res new file mode 100644 index 0000000000..fea4ca49d7 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RemoveUnusedType_applied.res @@ -0,0 +1,6 @@ +// actionFilter=RemoveUnusedType +module M: {} = {} + +/* === AVAILABLE ACTIONS: +- RemoveUnusedType - Remove unused type +*/ diff --git a/tests/build_tests/actions/expected/Actions_RemoveUnusedValue_applied.res b/tests/build_tests/actions/expected/Actions_RemoveUnusedValue_applied.res new file mode 100644 index 0000000000..38591b776d --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RemoveUnusedValue_applied.res @@ -0,0 +1,7 @@ +// actionFilter=RemoveUnusedVariable +module M: {} = {} + +/* === AVAILABLE ACTIONS: +- RemoveUnusedVariable - Remove unused variable +- PrefixVariableWithUnderscore - Prefix with `_` +*/ diff --git a/tests/build_tests/actions/expected/Actions_RemoveUnusedVar_applied.res b/tests/build_tests/actions/expected/Actions_RemoveUnusedVar_applied.res new file mode 100644 index 0000000000..6bd0933076 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RemoveUnusedVar_applied.res @@ -0,0 +1,9 @@ +// actionFilter=RemoveUnusedVariable +let f = () => { + 12 +} + +/* === AVAILABLE ACTIONS: +- RemoveUnusedVariable - Remove unused variable +- PrefixVariableWithUnderscore - Prefix with `_` +*/ diff --git a/tests/build_tests/actions/expected/Actions_RewriteArrayToTuple2_applied.res b/tests/build_tests/actions/expected/Actions_RewriteArrayToTuple2_applied.res new file mode 100644 index 0000000000..eb04e4e08e --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RewriteArrayToTuple2_applied.res @@ -0,0 +1,9 @@ +let doStuff = ((one, two)) => { + one ++ two +} + +let x = doStuff(("hello", "world")) + +/* === AVAILABLE ACTIONS: +- RewriteArrayToTuple - Rewrite to tuple +*/ diff --git a/tests/build_tests/actions/expected/Actions_RewriteArrayToTuple_applied.res b/tests/build_tests/actions/expected/Actions_RewriteArrayToTuple_applied.res new file mode 100644 index 0000000000..4af04fc8f7 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RewriteArrayToTuple_applied.res @@ -0,0 +1,6 @@ +let x = (1, 2, "hello") + +/* === AVAILABLE ACTIONS: +- ApplyFunction(Int.fromString) - Convert to int with Int.fromString +- RewriteArrayToTuple - Rewrite to tuple +*/ diff --git a/tests/build_tests/actions/expected/Actions_RewriteIdent_applied.res b/tests/build_tests/actions/expected/Actions_RewriteIdent_applied.res new file mode 100644 index 0000000000..f44fc78b2a --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RewriteIdent_applied.res @@ -0,0 +1,5 @@ +Console.log("hello") + +/* === AVAILABLE ACTIONS: +- RewriteIdent(Console.log) - Rewrite to use Console.log +*/ diff --git a/tests/build_tests/actions/expected/Actions_RewriteObjectToRecord_applied.res b/tests/build_tests/actions/expected/Actions_RewriteObjectToRecord_applied.res new file mode 100644 index 0000000000..f448225c03 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_RewriteObjectToRecord_applied.res @@ -0,0 +1,8 @@ +type x = {one: bool} +type xx = array + +let x: xx = [{one: true}] + +/* === AVAILABLE ACTIONS: +- RewriteObjectToRecord - Rewrite object to record +*/ diff --git a/tests/build_tests/actions/expected/Actions_SpellcheckIdent_applied.res b/tests/build_tests/actions/expected/Actions_SpellcheckIdent_applied.res new file mode 100644 index 0000000000..6a0af8a6fa --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_SpellcheckIdent_applied.res @@ -0,0 +1,6 @@ +let aaaaa = 10 +let b = aaaaa + +/* === AVAILABLE ACTIONS: +- RewriteIdent(aaaaa) - Change to `aaaaa` +*/ diff --git a/tests/build_tests/actions/expected/Actions_StringConstantToPolyvariantConstructor_applied.res b/tests/build_tests/actions/expected/Actions_StringConstantToPolyvariantConstructor_applied.res new file mode 100644 index 0000000000..8032bbd562 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_StringConstantToPolyvariantConstructor_applied.res @@ -0,0 +1,12 @@ +let doStuff = (a: int, b: [#ONE | #TWO]) => { + switch b { + | #ONE => a + 1 + | #TWO => a + 2 + } +} + +let x = doStuff(1, #ONE) + +/* === AVAILABLE ACTIONS: +- ReplaceWithPolymorphicVariantConstructor(ONE) - Replace with polymorphic variant constructor ONE +*/ diff --git a/tests/build_tests/actions/expected/Actions_StringConstantToVariantConstructor_applied.res b/tests/build_tests/actions/expected/Actions_StringConstantToVariantConstructor_applied.res new file mode 100644 index 0000000000..00e0fba7b1 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_StringConstantToVariantConstructor_applied.res @@ -0,0 +1,15 @@ +type status = Active | Inactive | Pending + +let processStatus = (s: status) => { + switch s { + | Active => "active" + | Inactive => "inactive" + | Pending => "pending" + } +} + +let result = processStatus(Active) + +/* === AVAILABLE ACTIONS: +- ReplaceWithVariantConstructor(Active) - Replace with variant constructor Active +*/ diff --git a/tests/build_tests/actions/expected/Actions_UnusedOpen_applied.res b/tests/build_tests/actions/expected/Actions_UnusedOpen_applied.res new file mode 100644 index 0000000000..57c8bd6a08 --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_UnusedOpen_applied.res @@ -0,0 +1,7 @@ +module X = { + let doStuff = s => Console.log(s) +} + +/* === AVAILABLE ACTIONS: +- RemoveOpen - Remove open +*/ diff --git a/tests/build_tests/actions/expected/Actions_UnusedSwitchCase_applied.res b/tests/build_tests/actions/expected/Actions_UnusedSwitchCase_applied.res new file mode 100644 index 0000000000..d51669487b --- /dev/null +++ b/tests/build_tests/actions/expected/Actions_UnusedSwitchCase_applied.res @@ -0,0 +1,9 @@ +let x1 = switch Some(true) { +| Some(true) => 1 +| Some(false) => 2 +| None => 3 +} + +/* === AVAILABLE ACTIONS: +- RemoveSwitchCase - Remove switch case +*/ diff --git a/tests/build_tests/actions/fixtures/Actions_AccessRecordFieldOnOption.res b/tests/build_tests/actions/fixtures/Actions_AccessRecordFieldOnOption.res new file mode 100644 index 0000000000..9d71abf6d5 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_AccessRecordFieldOnOption.res @@ -0,0 +1,12 @@ +module X = { + type y = {d: int} + type x = { + a: int, + b: int, + c: option, + } + + let x = {a: 1, b: 2, c: Some({d: 3})} +} + +let f = X.x.c.d diff --git a/tests/build_tests/actions/fixtures/Actions_AddAwait.res b/tests/build_tests/actions/fixtures/Actions_AddAwait.res new file mode 100644 index 0000000000..51247f6c6c --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_AddAwait.res @@ -0,0 +1,5 @@ +let fn = async () => 12 + +let other = async (): int => { + fn() +} diff --git a/tests/build_tests/actions/fixtures/Actions_ApplyCoercion.res b/tests/build_tests/actions/fixtures/Actions_ApplyCoercion.res new file mode 100644 index 0000000000..d841d248e0 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_ApplyCoercion.res @@ -0,0 +1,5 @@ +type x1 = One +type x2 = | ...x1 | Two + +let x1: x1 = One +let x2: x2 = x1 diff --git a/tests/build_tests/actions/fixtures/Actions_ApplyConversionFunction.res b/tests/build_tests/actions/fixtures/Actions_ApplyConversionFunction.res new file mode 100644 index 0000000000..674fb45769 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_ApplyConversionFunction.res @@ -0,0 +1 @@ +let x: int = 12. diff --git a/tests/build_tests/actions/fixtures/Actions_AssignToUnderscore.res b/tests/build_tests/actions/fixtures/Actions_AssignToUnderscore.res new file mode 100644 index 0000000000..31495f7ba2 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_AssignToUnderscore.res @@ -0,0 +1,4 @@ +// actionFilter=AssignToUnderscore +switch 1 { +| _ => "one" +} diff --git a/tests/build_tests/actions/fixtures/Actions_ForceOpen.res b/tests/build_tests/actions/fixtures/Actions_ForceOpen.res new file mode 100644 index 0000000000..965c62eb8c --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_ForceOpen.res @@ -0,0 +1,26 @@ +type person = { + name: string, + age: int, +} + +module X = { + let ff = 15 +} + +let ff = 16 + +open X + +let f2 = ff + +module RecordExample = { + type t = { + name: string, + age: int, + } + let person = {name: "John", age: 30} +} + +open RecordExample + +let p = {name: "Jane", age: 25} diff --git a/tests/build_tests/actions/fixtures/Actions_IdentButDidYouMeanModule.res b/tests/build_tests/actions/fixtures/Actions_IdentButDidYouMeanModule.res new file mode 100644 index 0000000000..cbf92a5557 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_IdentButDidYouMeanModule.res @@ -0,0 +1 @@ +console.log(123) diff --git a/tests/build_tests/actions/fixtures/Actions_InsertMissingArguments.res b/tests/build_tests/actions/fixtures/Actions_InsertMissingArguments.res new file mode 100644 index 0000000000..79b617bdb4 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_InsertMissingArguments.res @@ -0,0 +1,3 @@ +// actionFilter=InsertMissingArguments +let x = (~a, ~b) => a + b +let y = x(~a=2) + 2 diff --git a/tests/build_tests/actions/fixtures/Actions_JSXCustomComponentChildren.res b/tests/build_tests/actions/fixtures/Actions_JSXCustomComponentChildren.res new file mode 100644 index 0000000000..b4059e242b --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_JSXCustomComponentChildren.res @@ -0,0 +1,24 @@ +@@config({ + flags: ["-bs-jsx", "4"], +}) + +module React = { + type element = Jsx.element + type componentLike<'props, 'return> = 'props => 'return + type component<'props> = Jsx.component<'props> + + @module("react/jsx-runtime") + external jsx: (component<'props>, 'props) => element = "jsx" + + type fragmentProps = {children?: element} + @module("react/jsx-runtime") external jsxFragment: component = "Fragment" +} + +module CustomComponent = { + @react.component + let make = (~children) => { + <> {children} + } +} + +let x = {1.} diff --git a/tests/build_tests/actions/fixtures/Actions_MakeArgNonOptional.res b/tests/build_tests/actions/fixtures/Actions_MakeArgNonOptional.res new file mode 100644 index 0000000000..daa6d2c435 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_MakeArgNonOptional.res @@ -0,0 +1,5 @@ +let myFunction = (~name: string) => { + ignore(name) +} +let name = "John" +myFunction(~name?) diff --git a/tests/build_tests/actions/fixtures/Actions_MakeArgOptional.res b/tests/build_tests/actions/fixtures/Actions_MakeArgOptional.res new file mode 100644 index 0000000000..9c8a4e4e65 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_MakeArgOptional.res @@ -0,0 +1,5 @@ +let myFunction = (~name: option=?) => { + ignore(name) +} +let name = Some("John") +myFunction(~name) diff --git a/tests/build_tests/actions/fixtures/Actions_PartiallyApplyFunction.res b/tests/build_tests/actions/fixtures/Actions_PartiallyApplyFunction.res new file mode 100644 index 0000000000..f608aa3bea --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_PartiallyApplyFunction.res @@ -0,0 +1,3 @@ +// actionFilter=PartiallyApplyFunction +let x = (~a, ~b) => a + b +let y = x(~a=2) + 2 diff --git a/tests/build_tests/actions/fixtures/Actions_PassRecordFieldAsOptional.res b/tests/build_tests/actions/fixtures/Actions_PassRecordFieldAsOptional.res new file mode 100644 index 0000000000..c4d8af901b --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_PassRecordFieldAsOptional.res @@ -0,0 +1,4 @@ +type record = {a: int, test?: bool} +let test = Some(true) + +let x = {a: 10, test} diff --git a/tests/build_tests/actions/fixtures/Actions_PipeToIgnore.res b/tests/build_tests/actions/fixtures/Actions_PipeToIgnore.res new file mode 100644 index 0000000000..d5a735c59c --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_PipeToIgnore.res @@ -0,0 +1,4 @@ +// actionFilter=PipeToIgnore +switch 1 { +| _ => "one" +} diff --git a/tests/build_tests/actions/fixtures/Actions_PrefixUnusedVarUnderscore.res b/tests/build_tests/actions/fixtures/Actions_PrefixUnusedVarUnderscore.res new file mode 100644 index 0000000000..ce8db0b896 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_PrefixUnusedVarUnderscore.res @@ -0,0 +1,5 @@ +// actionFilter=PrefixVariableWithUnderscore +let f = () => { + let x = 1 + 12 +} diff --git a/tests/build_tests/actions/fixtures/Actions_RemoveAwait.res b/tests/build_tests/actions/fixtures/Actions_RemoveAwait.res new file mode 100644 index 0000000000..fda89aa400 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RemoveAwait.res @@ -0,0 +1,2 @@ +let f = 12 +let x = await f diff --git a/tests/build_tests/actions/fixtures/Actions_RemoveRecFlag.res b/tests/build_tests/actions/fixtures/Actions_RemoveRecFlag.res new file mode 100644 index 0000000000..15dbc12e5c --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RemoveRecFlag.res @@ -0,0 +1,5 @@ +// actionFilter=RemoveRecFlag +let rec f = 12 +let fn = () => { + let rec x = 12 +} diff --git a/tests/build_tests/actions/fixtures/Actions_RemoveRecordSpread.res b/tests/build_tests/actions/fixtures/Actions_RemoveRecordSpread.res new file mode 100644 index 0000000000..434279bbfc --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RemoveRecordSpread.res @@ -0,0 +1,5 @@ +type x = {a: int} + +let x = {a: 1} + +let f = {...x, a: 1} diff --git a/tests/build_tests/actions/fixtures/Actions_RemoveUnusedModule.res b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedModule.res new file mode 100644 index 0000000000..3400742ca3 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedModule.res @@ -0,0 +1,6 @@ +// actionFilter=RemoveUnusedModule +module M: {} = { + module N = { + let x = 12 + } +} diff --git a/tests/build_tests/actions/fixtures/Actions_RemoveUnusedType.res b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedType.res new file mode 100644 index 0000000000..813bd607e0 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedType.res @@ -0,0 +1,4 @@ +// actionFilter=RemoveUnusedType +module M: {} = { + type t = int +} diff --git a/tests/build_tests/actions/fixtures/Actions_RemoveUnusedValue.res b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedValue.res new file mode 100644 index 0000000000..6c1d0f536f --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedValue.res @@ -0,0 +1,4 @@ +// actionFilter=RemoveUnusedVariable +module M: {} = { + let x = 12 +} diff --git a/tests/build_tests/actions/fixtures/Actions_RemoveUnusedVar.res b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedVar.res new file mode 100644 index 0000000000..080861e1f6 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RemoveUnusedVar.res @@ -0,0 +1,5 @@ +// actionFilter=RemoveUnusedVariable +let f = () => { + let x = 1 + 12 +} diff --git a/tests/build_tests/actions/fixtures/Actions_RewriteArrayToTuple.res b/tests/build_tests/actions/fixtures/Actions_RewriteArrayToTuple.res new file mode 100644 index 0000000000..541be0e3ce --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RewriteArrayToTuple.res @@ -0,0 +1 @@ +let x = [1, 2, "hello"] diff --git a/tests/build_tests/actions/fixtures/Actions_RewriteArrayToTuple2.res b/tests/build_tests/actions/fixtures/Actions_RewriteArrayToTuple2.res new file mode 100644 index 0000000000..4b203b92ce --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RewriteArrayToTuple2.res @@ -0,0 +1,5 @@ +let doStuff = ((one, two)) => { + one ++ two +} + +let x = doStuff(["hello", "world"]) diff --git a/tests/build_tests/actions/fixtures/Actions_RewriteIdent.res b/tests/build_tests/actions/fixtures/Actions_RewriteIdent.res new file mode 100644 index 0000000000..bcb56f917c --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RewriteIdent.res @@ -0,0 +1 @@ +Console.log2("hello") diff --git a/tests/build_tests/actions/fixtures/Actions_RewriteObjectToRecord.res b/tests/build_tests/actions/fixtures/Actions_RewriteObjectToRecord.res new file mode 100644 index 0000000000..1451c3f3d8 --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_RewriteObjectToRecord.res @@ -0,0 +1,4 @@ +type x = {one: bool} +type xx = array + +let x: xx = [{"one": true}] diff --git a/tests/build_tests/actions/fixtures/Actions_SpellcheckIdent.res b/tests/build_tests/actions/fixtures/Actions_SpellcheckIdent.res new file mode 100644 index 0000000000..dc6051081d --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_SpellcheckIdent.res @@ -0,0 +1,2 @@ +let aaaaa = 10 +let b = aaaab diff --git a/tests/build_tests/actions/fixtures/Actions_StringConstantToPolyvariantConstructor.res b/tests/build_tests/actions/fixtures/Actions_StringConstantToPolyvariantConstructor.res new file mode 100644 index 0000000000..d52a39ecaf --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_StringConstantToPolyvariantConstructor.res @@ -0,0 +1,8 @@ +let doStuff = (a: int, b: [#ONE | #TWO]) => { + switch b { + | #ONE => a + 1 + | #TWO => a + 2 + } +} + +let x = doStuff(1, "ONE") diff --git a/tests/build_tests/actions/fixtures/Actions_StringConstantToVariantConstructor.res b/tests/build_tests/actions/fixtures/Actions_StringConstantToVariantConstructor.res new file mode 100644 index 0000000000..d3e7f5a6ec --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_StringConstantToVariantConstructor.res @@ -0,0 +1,11 @@ +type status = Active | Inactive | Pending + +let processStatus = (s: status) => { + switch s { + | Active => "active" + | Inactive => "inactive" + | Pending => "pending" + } +} + +let result = processStatus("Active") diff --git a/tests/build_tests/actions/fixtures/Actions_UnusedOpen.res b/tests/build_tests/actions/fixtures/Actions_UnusedOpen.res new file mode 100644 index 0000000000..89670b250e --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_UnusedOpen.res @@ -0,0 +1,5 @@ +module X = { + let doStuff = s => Console.log(s) +} + +open X diff --git a/tests/build_tests/actions/fixtures/Actions_UnusedSwitchCase.res b/tests/build_tests/actions/fixtures/Actions_UnusedSwitchCase.res new file mode 100644 index 0000000000..bfc62e529c --- /dev/null +++ b/tests/build_tests/actions/fixtures/Actions_UnusedSwitchCase.res @@ -0,0 +1,6 @@ +let x1 = switch Some(true) { +| Some(true) => 1 +| Some(false) => 2 +| None => 3 +| _ => 4 +} diff --git a/tests/build_tests/actions/input.js b/tests/build_tests/actions/input.js new file mode 100644 index 0000000000..e2b16fe732 --- /dev/null +++ b/tests/build_tests/actions/input.js @@ -0,0 +1,78 @@ +// @ts-check + +import { readdirSync } from "node:fs"; +import * as fs from "node:fs/promises"; +import * as path from "node:path"; +import { setup } from "#dev/process"; +import { normalizeNewlines } from "#dev/utils"; + +const { bsc, rescriptTools } = setup(import.meta.dirname); + +const expectedDir = path.join(import.meta.dirname, "expected"); + +const fixtures = readdirSync(path.join(import.meta.dirname, "fixtures")).filter( + fileName => path.extname(fileName) === ".res", +); + +const prefix = ["-w", "+A", "-bs-jsx", "4"]; + +const updateTests = process.argv[2] === "update"; + +/** + * @param {string} output + * @return {string} + */ +function postProcessErrorOutput(output) { + let result = output; + result = result.trimEnd() + "\n"; + return normalizeNewlines(result); +} + +let doneTasksCount = 0; +let atLeastOneTaskFailed = false; + +for (const fileName of fixtures) { + const fullFilePath = path.join(import.meta.dirname, "fixtures", fileName); + const extrasPath = fullFilePath.replace(".res", ".resextra"); + await bsc([...prefix, "-color", "always", fullFilePath]); + const firstLine = + (await fs.readFile(fullFilePath, "utf-8")).split("\n")[0] ?? ""; + const actionFilter = firstLine.split("actionFilter=")[1]; + const callArgs = [fullFilePath, extrasPath, "--runAll"]; + if (actionFilter != null) { + callArgs.push("--actionFilter", actionFilter); + } + const { stdout, stderr } = await rescriptTools("actions", callArgs); + if (stderr.length > 0) { + console.error(stderr.toString()); + } + doneTasksCount++; + const expectedFilePath = path.join( + expectedDir, + `${fileName.replace(".res", "")}_applied.res`, + ); + const actualActions = postProcessErrorOutput(stdout.toString()); + if (updateTests) { + await fs.writeFile(expectedFilePath, actualActions); + } else { + const expectedActions = postProcessErrorOutput( + await fs.readFile(expectedFilePath, "utf-8"), + ); + if (expectedActions !== actualActions) { + console.error( + `The old and new actions for the test ${fullFilePath} aren't the same`, + ); + console.error("\n=== Old:"); + console.error(expectedActions); + console.error("\n=== New:"); + console.error(actualActions); + atLeastOneTaskFailed = true; + } + + if (doneTasksCount === fixtures.length && atLeastOneTaskFailed) { + process.exit(1); + } + } +} + +// TODO: Check that the emitted files compile. diff --git a/tools/bin/main.ml b/tools/bin/main.ml index cd810b5309..f2523b16b9 100644 --- a/tools/bin/main.ml +++ b/tools/bin/main.ml @@ -177,6 +177,28 @@ let main () = done; Sys.argv.(len - 1) <- ""; Reanalyze.cli () + | "actions" :: file :: opts -> + let run_all_on_file = List.mem "--runAll" opts in + let rec extract_arg_with_value target_arg opts = + match opts with + | arg :: value :: _ when arg = target_arg -> Some value + | _ :: rest -> extract_arg_with_value target_arg rest + | [] -> None + in + let extrasPath = + match opts with + | path :: _ when String.ends_with ~suffix:".resextra" path -> Some path + | _ -> None + in + let actionFilter = + match extract_arg_with_value "--actionFilter" opts with + | Some filter -> + Some (String.split_on_char ',' filter |> List.map String.trim) + | None -> None + in + if run_all_on_file then + Tools.Actions.runActionsOnFile ?actionFilter ?extrasPath file + else Tools.Actions.extractActionsFromFile ?extrasPath file | "extract-embedded" :: extPointNames :: filename :: _ -> logAndExit (Ok diff --git a/tools/src/tools.ml b/tools/src/tools.ml index eb591aa912..645ca15831 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -1294,3 +1294,644 @@ module ExtractCodeblocks = struct end module Migrate = Migrate +module TemplateUtils = struct + let get_expr source = + let {Res_driver.parsetree; invalid} = + Res_driver.parse_implementation_from_source ~for_printer:true + ~display_filename:"" ~source + in + if invalid then Error "Could not parse expression" + else + match parsetree with + | [{pstr_desc = Pstr_eval (e, _)}] -> Ok e + | _ -> Error "Expected a record expression" + + let get_expr_exn source = + match get_expr source with + | Ok e -> e + | Error e -> failwith e +end + +module Actions = struct + let change_record_field_optional (record_el : _ Parsetree.record_element) + target_loc actions = + let change_record_field_optional_action = + actions + |> List.find_map (fun (action : Actions.action) -> + match action.action with + | ChangeRecordFieldOptional {optional} when target_loc = action.loc + -> + Some optional + | _ -> None) + in + match change_record_field_optional_action with + | Some opt -> {record_el with opt} + | None -> record_el + + let applyActionsToFile path actions = + let mapper = + { + Ast_mapper.default_mapper with + record_field = + (fun mapper record_el -> + let record_el = + change_record_field_optional record_el record_el.x.pexp_loc + actions + in + Ast_mapper.default_mapper.record_field mapper record_el); + record_field_pat = + (fun mapper record_el -> + let record_el = + change_record_field_optional record_el record_el.x.ppat_loc + actions + in + Ast_mapper.default_mapper.record_field_pat mapper record_el); + structure_item = + (fun mapper str_item -> + let remove_rec_flag_action_locs = + List.filter_map + (fun (action : Actions.action) -> + match action.action with + | RemoveRecFlag -> Some action.loc + | _ -> None) + actions + in + let force_open_action_locs = + List.filter_map + (fun (action : Actions.action) -> + match action.action with + | ForceOpen -> Some action.loc + | _ -> None) + actions + in + let assign_to_underscore_action_locs = + List.filter_map + (fun (action : Actions.action) -> + match action.action with + | AssignToUnderscore -> Some action.loc + | _ -> None) + actions + in + match str_item.pstr_desc with + | Pstr_eval (({pexp_loc} as e), attrs) + when List.mem pexp_loc assign_to_underscore_action_locs -> + let str_item = + Ast_mapper.default_mapper.structure_item mapper str_item + in + let loc = str_item.pstr_loc in + { + str_item with + pstr_desc = + Pstr_value + ( Nonrecursive, + [ + Ast_helper.Vb.mk ~loc ~attrs + (Ast_helper.Pat.var ~loc (Location.mkloc "_" loc)) + e; + ] ); + } + | Pstr_open ({popen_override = Fresh} as open_desc) + when List.mem str_item.pstr_loc force_open_action_locs -> + let str_item = + Ast_mapper.default_mapper.structure_item mapper str_item + in + { + str_item with + pstr_desc = Pstr_open {open_desc with popen_override = Override}; + } + | Pstr_value (Recursive, ({pvb_pat = {ppat_loc}} :: _ as bindings)) + when List.mem ppat_loc remove_rec_flag_action_locs -> + let str_item = + Ast_mapper.default_mapper.structure_item mapper str_item + in + {str_item with pstr_desc = Pstr_value (Nonrecursive, bindings)} + | _ -> Ast_mapper.default_mapper.structure_item mapper str_item); + structure = + (fun mapper items -> + let items = + items + |> List.filter_map (fun (str_item : Parsetree.structure_item) -> + match str_item.pstr_desc with + | Pstr_open _ -> ( + let remove_open_action = + actions + |> List.find_opt (fun (action : Actions.action) -> + match action.action with + | RemoveOpen -> action.loc = str_item.pstr_loc + | _ -> false) + in + match remove_open_action with + | Some _ -> None + | None -> Some str_item) + | Pstr_type (_, _type_declarations) -> ( + let remove_unused_type_action = + actions + |> List.find_opt (fun (action : Actions.action) -> + match action.action with + | RemoveUnusedType -> + action.loc = str_item.pstr_loc + | _ -> false) + in + match remove_unused_type_action with + | Some _ -> None + | None -> Some str_item) + | Pstr_module {pmb_loc} -> + let remove_unused_module_action_locs = + List.filter_map + (fun (action : Actions.action) -> + match action.action with + | RemoveUnusedModule -> Some action.loc + | _ -> None) + actions + in + if List.mem pmb_loc remove_unused_module_action_locs then + None + else Some str_item + | _ -> Some str_item) + in + let items = Ast_mapper.default_mapper.structure mapper items in + + (* Cleanup if needed *) + items + |> List.filter_map (fun (str_item : Parsetree.structure_item) -> + match str_item.pstr_desc with + | Pstr_value (_, []) -> None + | _ -> Some str_item)); + value_bindings = + (fun mapper bindings -> + let remove_unused_variables_action_locs = + List.filter_map + (fun (action : Actions.action) -> + match action.action with + | RemoveUnusedVariable -> Some action.loc + | _ -> None) + actions + in + let bindings = + bindings + |> List.filter_map (fun (binding : Parsetree.value_binding) -> + if + List.mem binding.pvb_pat.ppat_loc + remove_unused_variables_action_locs + then None + else Some binding) + in + Ast_mapper.default_mapper.value_bindings mapper bindings); + pat = + (fun mapper pattern -> + let pattern = + match pattern.ppat_desc with + | Ppat_var var -> ( + let prefix_underscore_action = + actions + |> List.find_opt (fun (action : Actions.action) -> + match action.action with + | PrefixVariableWithUnderscore -> + action.loc = pattern.ppat_loc + | _ -> false) + in + match prefix_underscore_action with + | Some _ -> + { + pattern with + ppat_desc = Ppat_var {var with txt = "_" ^ var.txt}; + } + | None -> pattern) + | _ -> pattern + in + Ast_mapper.default_mapper.pat mapper pattern); + cases = + (fun mapper cases -> + let cases = + cases + |> List.filter_map (fun (case : Parsetree.case) -> + let remove_case_action = + actions + |> List.find_opt (fun (action : Actions.action) -> + match action.action with + | RemoveSwitchCase -> + action.loc = case.pc_lhs.ppat_loc + | _ -> false) + in + match remove_case_action with + | Some _ -> None + | None -> Some case) + in + Ast_mapper.default_mapper.cases mapper cases); + expr = + (fun mapper expr -> + (* TODO: Must account for pipe chains *) + let mapped_expr = + actions + |> List.find_map (fun (action : Actions.action) -> + (* When the loc is the expr itself *) + if action.loc = expr.pexp_loc then + let expr = Ast_mapper.default_mapper.expr mapper expr in + match action.action with + | PipeToIgnore -> + Some + { + expr with + pexp_desc = + Pexp_apply + { + funct = + Ast_helper.Exp.ident + (Location.mknoloc (Longident.Lident "->")); + partial = false; + transformed_jsx = false; + args = + [ + (Nolabel, expr); + ( Nolabel, + Ast_helper.Exp.ident + (Location.mknoloc + (Longident.Lident "ignore")) ); + ]; + }; + } + | RemoveRecordSpread -> ( + match expr with + | {pexp_desc = Pexp_record (fields, Some _)} -> + Some + {expr with pexp_desc = Pexp_record (fields, None)} + | _ -> None) + | RewriteIdent {new_ident} -> ( + match expr with + | {pexp_desc = Pexp_ident ident} -> + Some + { + expr with + pexp_desc = + Pexp_ident {ident with txt = new_ident}; + } + | _ -> None) + | RewriteArrayToTuple -> ( + match expr with + | {pexp_desc = Pexp_array items} -> + Some {expr with pexp_desc = Pexp_tuple items} + | _ -> None) + | RewriteObjectToRecord -> ( + match expr with + | { + pexp_desc = + Pexp_extension + ( {txt = "obj"}, + PStr + [ + { + pstr_desc = + Pstr_eval + ( ({pexp_desc = Pexp_record _} as + record), + _ ); + }; + ] ); + } -> + Some record + | _ -> None) + | AddAwait -> + Some {expr with pexp_desc = Pexp_await expr} + | ReplaceWithVariantConstructor {constructor_name} -> + Some + { + expr with + pexp_desc = + Pexp_construct + (Location.mknoloc constructor_name, None); + } + | ReplaceWithPolymorphicVariantConstructor + {constructor_name} -> + Some + { + expr with + pexp_desc = Pexp_variant (constructor_name, None); + } + | ApplyFunction {function_name} -> + Some + { + expr with + pexp_desc = + Pexp_apply + { + funct = + Ast_helper.Exp.ident + (Location.mknoloc function_name); + args = + [ + (* Remove any existing braces. Makes the output prettier. *) + ( Nolabel, + { + expr with + pexp_attributes = + expr.pexp_attributes + |> List.filter + (fun + (({txt}, _) : + Parsetree.attribute) + -> txt <> "res.braces"); + } ); + ]; + partial = false; + transformed_jsx = false; + }; + } + | ApplyCoercion {coerce_to_name} -> + Some + { + expr with + pexp_desc = + Pexp_coerce + ( expr, + (), + Ast_helper.Typ.constr + (Location.mknoloc coerce_to_name) + [] ); + } + | _ -> None + else + (* Other cases when the loc is on something else in the expr *) + match (expr.pexp_desc, action.action) with + | ( Pexp_field (e, {loc}), + UnwrapOptionMapRecordField {field_name} ) + when action.loc = loc -> + Some + { + expr with + pexp_desc = + Pexp_apply + { + funct = + Ast_helper.Exp.ident + (Location.mknoloc (Longident.Lident "->")); + partial = false; + transformed_jsx = false; + args = + [ + (Nolabel, e); + ( Nolabel, + TemplateUtils.get_expr_exn + (Printf.sprintf + "Option.map(v => v.%s)" + (Longident.flatten field_name + |> String.concat ".")) ); + ]; + }; + } + | ( Pexp_apply ({funct; args} as apply), + InsertMissingArguments {missing_args} ) + when funct.pexp_loc = action.loc -> + let args_to_insert = + missing_args + |> List.map (fun (lbl : Asttypes.Noloc.arg_label) -> + ( Asttypes.to_arg_label lbl, + Ast_helper.Exp.extension + (Location.mknoloc "todo", PStr []) )) + in + Some + { + expr with + pexp_desc = + Pexp_apply + {apply with args = args @ args_to_insert}; + } + | ( Pexp_apply ({funct} as apply_args), + PartiallyApplyFunction ) + when funct.pexp_loc = action.loc -> + Some + { + expr with + pexp_desc = + Pexp_apply {apply_args with partial = true}; + } + | Pexp_apply ({args} as apply), RewriteArgType {to_type} + -> + let arg_locs = + args + |> List.filter_map (fun (lbl, _e) -> + match lbl with + | Asttypes.Labelled {loc} | Optional {loc} -> + Some loc + | Nolabel -> None) + in + if List.mem action.loc arg_locs then + Some + { + expr with + pexp_desc = + Pexp_apply + { + apply with + args = + args + |> List.map (fun (lbl, e) -> + ( (match (lbl, to_type) with + | ( Asttypes.Optional {txt; loc}, + `Labelled ) -> + Asttypes.Labelled {txt; loc} + | ( Asttypes.Labelled {txt; loc}, + `Optional ) -> + Asttypes.Optional {txt; loc} + | _ -> lbl), + Ast_mapper.default_mapper.expr + mapper e )); + }; + } + else None + | ( Pexp_let + ( Recursive, + ({pvb_pat = {ppat_loc}} :: _ as bindings), + cont ), + RemoveRecFlag ) + when action.loc = ppat_loc -> + Some + { + expr with + pexp_desc = Pexp_let (Nonrecursive, bindings, cont); + } + | ( Pexp_field + ( {pexp_desc = Pexp_ident e}, + {txt = Lident inner; loc} ), + RewriteIdentToModule {module_name} ) + when e.loc = action.loc -> + Some + { + expr with + pexp_desc = + Pexp_ident + { + loc; + txt = + Longident.Ldot (Lident module_name, inner); + }; + } + | Pexp_await inner, RemoveAwait + when inner.pexp_loc = action.loc -> + Some (Ast_mapper.default_mapper.expr mapper inner) + | Pexp_array items, RewriteArrayToTuple + when items + |> List.find_opt + (fun (item : Parsetree.expression) -> + item.pexp_loc = action.loc) + |> Option.is_some -> + (* When the loc is on an item in the array *) + Some + { + expr with + pexp_desc = + Pexp_tuple + (items + |> List.map (fun item -> + Ast_mapper.default_mapper.expr mapper + item)); + } + | _ -> None) + in + let mapped_expr = + match mapped_expr with + | None -> Ast_mapper.default_mapper.expr mapper expr + | Some expr -> expr + in + (* We sometimes need to do some post-transformation cleanup. + E.g if all let bindings was removed from `Pexp_let`, we need to remove the entire Pexp_let.*) + match mapped_expr with + | {pexp_desc = Pexp_let (_, [], cont); pexp_attributes} -> + { + cont with + pexp_attributes = cont.pexp_attributes @ pexp_attributes; + } + | _ -> mapped_expr); + } + in + if Filename.check_suffix path ".res" then + let parser = + Res_driver.parsing_engine.parse_implementation ~for_printer:true + in + let {Res_driver.parsetree; comments} = parser ~filename:path in + let ast_mapped = mapper.structure mapper parsetree in + Ok (Res_printer.print_implementation ast_mapped ~comments) + else + (* TODO: Handle .resi? *) + Error + (Printf.sprintf + "error: failed to apply actions to %s because it is not a .res file" + path) + + let runActionsOnFile ?(actionFilter : string list option) ?extrasPath + entryPointFile = + let path = + match Filename.is_relative entryPointFile with + | true -> Unix.realpath entryPointFile + | false -> entryPointFile + in + let try_read_resextra path = + if Sys.file_exists path then + try + let ic = open_in_bin path in + let v = (input_value ic : Actions.action list) in + close_in ic; + Some v + with _ -> None + else None + in + let loaded_actions = + match extrasPath with + | Some path -> try_read_resextra path + | None -> None + in + match loaded_actions with + | None -> + Printf.printf + "error: failed to run actions on %s because build artifacts could not \ + be found. try to build the project" + path + | Some cmt_possible_actions -> ( + let possible_actions = + match actionFilter with + | None -> cmt_possible_actions + | Some filter -> + cmt_possible_actions + |> List.filter (fun (action : Actions.action) -> + match action.action with + | Actions.ApplyFunction _ -> List.mem "ApplyFunction" filter + | ApplyCoercion _ -> List.mem "ApplyCoercion" filter + | RemoveSwitchCase -> List.mem "RemoveSwitchCase" filter + | RemoveOpen -> List.mem "RemoveOpen" filter + | RemoveAwait -> List.mem "RemoveAwait" filter + | AddAwait -> List.mem "AddAwait" filter + | ReplaceWithVariantConstructor _ -> + List.mem "ReplaceWithVariantConstructor" filter + | ReplaceWithPolymorphicVariantConstructor _ -> + List.mem "ReplaceWithPolymorphicVariantConstructor" filter + | RewriteObjectToRecord -> + List.mem "RewriteObjectToRecord" filter + | RewriteArrayToTuple -> List.mem "RewriteArrayToTuple" filter + | RewriteIdent _ -> List.mem "RewriteIdent" filter + | RewriteIdentToModule _ -> + List.mem "RewriteIdentToModule" filter + | PrefixVariableWithUnderscore -> + List.mem "PrefixVariableWithUnderscore" filter + | RemoveUnusedVariable -> + List.mem "RemoveUnusedVariable" filter + | RemoveUnusedType -> List.mem "RemoveUnusedType" filter + | RemoveUnusedModule -> List.mem "RemoveUnusedModule" filter + | RemoveRecFlag -> List.mem "RemoveRecFlag" filter + | ForceOpen -> List.mem "ForceOpen" filter + | RemoveRecordSpread -> List.mem "RemoveRecordSpread" filter + | AssignToUnderscore -> List.mem "AssignToUnderscore" filter + | PipeToIgnore -> List.mem "PipeToIgnore" filter + | PartiallyApplyFunction -> + List.mem "PartiallyApplyFunction" filter + | RewriteArgType _ -> List.mem "RewriteArgType" filter + | InsertMissingArguments _ -> + List.mem "InsertMissingArguments" filter + | ChangeRecordFieldOptional _ -> + List.mem "ChangeRecordFieldOptional" filter + | UnwrapOptionMapRecordField _ -> + List.mem "UnwrapOptionMapRecordField" filter) + in + match applyActionsToFile path possible_actions with + | Ok applied -> + print_endline applied; + print_endline "/* === AVAILABLE ACTIONS:"; + cmt_possible_actions + |> List.iter (fun (action : Actions.action) -> + Printf.printf "- %s - %s\n" + (Actions.action_to_string action.action) + action.description); + print_endline "*/" + | Error e -> + print_endline e; + exit 1) + + let extractActionsFromFile ?extrasPath entryPointFile = + let path = + match Filename.is_relative entryPointFile with + | true -> Unix.realpath entryPointFile + | false -> entryPointFile + in + let try_read_resextra path = + if Sys.file_exists path then + try + let ic = open_in_bin path in + let v = (input_value ic : Actions.action list) in + close_in ic; + Some v + with _ -> None + else None + in + let loaded_actions = + match extrasPath with + | Some path -> try_read_resextra path + | None -> None + in + match loaded_actions with + | None -> + Printf.printf + "error: failed to extract actions for %s because build artifacts could \ + not be found. try to build the project" + path + | Some _ -> + (* TODO *) + () +end