diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index a433d12908..ac1d5ae595 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -51,3 +51,17 @@ let fullsFromModule ~package ~moduleName = let loadFullCmtFromPath ~path = let uri = Uri.fromPath path in fullFromUri ~uri + +let loadCmtInfosFromPath ~path = + let uri = Uri.fromPath path in + match Packages.getPackage ~uri with + | None -> None + | Some package -> ( + let moduleName = + BuildSystem.namespacedName package.namespace (FindFiles.getName path) + in + match Hashtbl.find_opt package.pathsForModule moduleName with + | Some paths -> + let cmt = getCmtPath ~uri paths in + Shared.tryReadCmt cmt + | None -> None) diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml index e91361d1ac..52493a0047 100644 --- a/compiler/bsc/rescript_compiler_main.ml +++ b/compiler/bsc/rescript_compiler_main.ml @@ -462,4 +462,6 @@ let _ : unit = exit 2 | x -> Location.report_exception ppf x; + (* Re-save cmt so we can get the possible actions *) + Cmt_format.resave_cmt_with_possible_actions (); exit 2 diff --git a/compiler/ext/warnings.ml b/compiler/ext/warnings.ml index f799100a36..e140738930 100644 --- a/compiler/ext/warnings.ml +++ b/compiler/ext/warnings.ml @@ -428,7 +428,9 @@ let message = function | Ambiguous_name (_slist, tl, true) -> "these field labels belong to several types: " ^ String.concat " " tl ^ "\nThe first one was selected. Please disambiguate if this is wrong." - | Nonoptional_label s -> "the label " ^ s ^ " is not optional." + | Nonoptional_label s -> + (* TODO(actions) When does this happen? *) + "the label " ^ s ^ " is not optional." | Open_shadow_identifier (kind, s) -> Printf.sprintf "this open statement shadows the %s identifier %s (which is later used)" @@ -682,3 +684,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 59971b94be..a23e4a0be5 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/ast_iterator.ml b/compiler/ml/ast_iterator.ml index 4380ca1af2..a0aeb53bb7 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 @@ -289,7 +292,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; @@ -310,11 +313,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; @@ -400,12 +399,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; @@ -489,6 +483,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; @@ -528,4 +523,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 e2f4d6cad0..bc6e0fcf1c 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) @@ -287,7 +291,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 @@ -306,10 +310,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) @@ -392,12 +393,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) -> @@ -475,6 +471,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) @@ -509,6 +506,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/cmt_format.ml b/compiler/ml/cmt_format.ml index 907f2e7122..2d24a1cbb1 100644 --- a/compiler/ml/cmt_format.ml +++ b/compiler/ml/cmt_format.ml @@ -63,6 +63,7 @@ type cmt_infos = { cmt_imports : (string * Digest.t option) list; cmt_interface_digest : Digest.t option; cmt_use_summaries : bool; + cmt_possible_actions : Cmt_utils.cmt_action list; } type error = @@ -154,15 +155,22 @@ let read_cmi filename = let saved_types = ref [] let value_deps = ref [] +let possible_actions = ref [] let clear () = saved_types := []; - value_deps := [] + value_deps := []; + possible_actions := [] let add_saved_type b = saved_types := b :: !saved_types let get_saved_types () = !saved_types let set_saved_types l = saved_types := l +let add_possible_action action = + possible_actions := action :: !possible_actions + +let _ = Cmt_utils._add_possible_action := add_possible_action + let record_value_dependency vd1 vd2 = if vd1.Types.val_loc <> vd2.Types.val_loc then value_deps := (vd1, vd2) :: !value_deps @@ -172,8 +180,30 @@ let save_cmt _filename _modname _binary_annots _sourcefile _initial_env _cmi = ( #else open Cmi_format +let current_cmt_filename = ref None + +(* TODO: Terrible hack. Figure out way to do this without saving the cmt file twice. + Probably change how/where we save the cmt, and delay it to after writing errors, if possible. +*) +let resave_cmt_with_possible_actions () = + if List.length !possible_actions > 0 then begin + match !current_cmt_filename with + | None -> () + | Some filename -> + let current_cmt = read_cmt filename in + Misc.output_to_bin_file_directly filename + (fun _temp_file_name oc -> + let cmt = { + current_cmt with + cmt_possible_actions = current_cmt.cmt_possible_actions @ !possible_actions; + } in + output_cmt oc cmt) + end; + clear () + let save_cmt filename modname binary_annots sourcefile initial_env cmi = if !Clflags.binary_annotations then begin + current_cmt_filename := Some filename; Misc.output_to_bin_file_directly filename (fun temp_file_name oc -> let this_crc = @@ -197,6 +227,7 @@ let save_cmt filename modname binary_annots sourcefile initial_env cmi = cmt_imports = List.sort compare (Env.imports ()); cmt_interface_digest = this_crc; cmt_use_summaries = need_to_clear_env; + cmt_possible_actions = !possible_actions; } in output_cmt oc cmt) end; diff --git a/compiler/ml/cmt_format.mli b/compiler/ml/cmt_format.mli index 1a84aa68d0..64dc7ce3ac 100644 --- a/compiler/ml/cmt_format.mli +++ b/compiler/ml/cmt_format.mli @@ -63,6 +63,7 @@ type cmt_infos = { cmt_imports: (string * Digest.t option) list; cmt_interface_digest: Digest.t option; cmt_use_summaries: bool; + cmt_possible_actions: Cmt_utils.cmt_action list; } type error = Not_a_typedtree of string @@ -111,6 +112,8 @@ val set_saved_types : binary_part list -> unit val record_value_dependency : Types.value_description -> Types.value_description -> unit +val resave_cmt_with_possible_actions : unit -> unit + (* val is_magic_number : string -> bool diff --git a/compiler/ml/cmt_utils.ml b/compiler/ml/cmt_utils.ml new file mode 100644 index 0000000000..671e2c5751 --- /dev/null +++ b/compiler/ml/cmt_utils.ml @@ -0,0 +1,151 @@ +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 cmt_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 : (cmt_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/error_message_utils.ml b/compiler/ml/error_message_utils.ml index 1534837789..14092c6b45 100644 --- a/compiler/ml/error_message_utils.ml +++ b/compiler/ml/error_message_utils.ml @@ -320,6 +320,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, _ -> + Cmt_utils.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\ @@ -341,6 +343,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, _ -> + Cmt_utils.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\ @@ -400,6 +404,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf Some record | _ -> None) in + Cmt_utils.add_possible_action + { + loc; + action = RewriteObjectToRecord; + description = "Rewrite object to record"; + }; fprintf ppf "@,\ @,\ @@ -413,6 +423,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? *) + Cmt_utils.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 -> @@ -420,6 +433,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 -> + Cmt_utils.add_possible_action + { + loc; + action = RewriteArrayToTuple; + description = "Rewrite to tuple"; + }; Some {exp with Parsetree.pexp_desc = Pexp_tuple items} | _ -> None) in @@ -445,6 +464,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf in let print_jsx_msg ?(extra = "") name target_fn = + Cmt_utils.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 "@,\ @,\ @@ -461,6 +486,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 "@,\ @,\ @@ -489,6 +515,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 -> + Cmt_utils.add_possible_action + { + loc; + action = ChangeRecordFieldOptional {optional = true}; + description = "Pass field as optional"; + }; fprintf ppf "@,\ @,\ @@ -507,6 +539,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 "@,\ @,\ @@ -525,6 +558,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 -> + Cmt_utils.add_possible_action + { + loc; + action = RewriteArgType {to_type = `Optional}; + description = "Make argument optional"; + }; fprintf ppf "@,\ @,\ @@ -554,6 +593,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 -> + Cmt_utils.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\ @@ -612,6 +660,15 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf in match reprinted with | Some reprinted -> + Cmt_utils.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\ @@ -669,6 +726,14 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf in if can_show_coercion_message && not is_constant then ( + Cmt_utils.add_possible_action + { + loc; + action = + ApplyCoercion + {coerce_to_name = target_type_string |> Longident.parse}; + description = "Coerce to " ^ target_type_string; + }; fprintf ppf "@,\ @,\ @@ -746,6 +811,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\ @@ -756,6 +822,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 19de2b7125..fbba381a7d 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 0dae8985bf..77accfc3e4 100644 --- a/compiler/ml/parmatch.ml +++ b/compiler/ml/parmatch.ml @@ -2028,6 +2028,7 @@ let do_check_partial ?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 ?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 @@ -2145,6 +2147,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/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 ff3671b681..047e34f1ff 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 + Cmt_utils.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) | _ -> ()) | _ -> () @@ -801,7 +808,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 @@ -2902,7 +2909,9 @@ and type_expect_ ~context ?in_function ?(recarg = Rejected) env sexp ty_expected 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 @@ -4315,6 +4324,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.@]" @@ -4322,6 +4332,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.@]" @@ -4427,6 +4438,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 @@ -4644,13 +4656,32 @@ let report_error env loc ppf error = if not is_fallback then fprintf ppf "@,"; - if List.length missing_required_args > 0 then + if List.length missing_required_args > 0 then ( + Cmt_utils.add_possible_action + { + loc; + action = + InsertMissingArguments + { + missing_args = + missing_required_args + |> List.map (fun arg -> Noloc.Labelled arg); + }; + description = "Insert missing arguments"; + }; + Cmt_utils.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) - |> String.concat ", "); + |> String.concat ", ")); 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 ", "); @@ -4697,25 +4728,34 @@ let report_error env loc ppf error = match suggestion with | None -> () | Some suggestion_str -> + Cmt_utils.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 53758e26c1..089fdb567b 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 @@ -128,13 +132,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 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 loc decl.val_attributes (Path.name path); r @@ -166,8 +174,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. *) @@ -720,20 +729,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 = @@ -741,7 +750,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) @@ -773,8 +782,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`@]" @@ -782,6 +792,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 \ @@ -843,7 +854,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) -> @@ -852,29 +863,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 -> + Cmt_utils.add_possible_action + { + loc; + action = Cmt_utils.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 -> + Cmt_utils.add_possible_action + { + loc; + action = Cmt_utils.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 @@ -911,10 +943,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 -> + Cmt_utils.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 \ @@ -926,14 +965,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 \ @@ -942,7 +982,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 \ @@ -953,8 +993,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 19f7fa46b9..ac10f6d4a2 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 30adeea5ee..4c27f6c9de 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -113,6 +113,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/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..51d7e47e6f --- /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 cmtPath = fullFilePath.replace(".res", ".cmt"); + 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, cmtPath, "--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 88f7ffa575..46df309ac7 100644 --- a/tools/bin/main.ml +++ b/tools/bin/main.ml @@ -109,6 +109,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 cmtPath = + match opts with + | path :: _ when String.ends_with ~suffix:".cmt" 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 ?cmtPath file + else Tools.Actions.extractActionsFromFile ?cmtPath file | "extract-embedded" :: extPointNames :: filename :: _ -> logAndExit (Ok diff --git a/tools/src/tools.ml b/tools/src/tools.ml index 1722fdda07..f90923374e 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -1292,3 +1292,627 @@ module ExtractCodeblocks = struct ]) |> Protocol.array) end + +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 : Cmt_utils.cmt_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 : Cmt_utils.cmt_action) -> + match action.action with + | RemoveRecFlag -> Some action.loc + | _ -> None) + actions + in + let force_open_action_locs = + List.filter_map + (fun (action : Cmt_utils.cmt_action) -> + match action.action with + | ForceOpen -> Some action.loc + | _ -> None) + actions + in + let assign_to_underscore_action_locs = + List.filter_map + (fun (action : Cmt_utils.cmt_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 : Cmt_utils.cmt_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 : Cmt_utils.cmt_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 : Cmt_utils.cmt_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 : Cmt_utils.cmt_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 : Cmt_utils.cmt_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 : Cmt_utils.cmt_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 : Cmt_utils.cmt_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) ?cmtPath + entryPointFile = + let path = + match Filename.is_relative entryPointFile with + | true -> Unix.realpath entryPointFile + | false -> entryPointFile + in + let loadedCmt = + match cmtPath with + | None -> Cmt.loadCmtInfosFromPath ~path + | Some path -> Shared.tryReadCmt path + in + match loadedCmt 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 : Cmt_utils.cmt_action) -> + match action.action with + | Cmt_utils.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 : Cmt_utils.cmt_action) -> + Printf.printf "- %s - %s\n" + (Cmt_utils.action_to_string action.action) + action.description); + print_endline "*/" + | Error e -> + print_endline e; + exit 1) + + let extractActionsFromFile ?cmtPath entryPointFile = + let path = + match Filename.is_relative entryPointFile with + | true -> Unix.realpath entryPointFile + | false -> entryPointFile + in + let loadedCmt = + match cmtPath with + | None -> Cmt.loadCmtInfosFromPath ~path + | Some path -> Shared.tryReadCmt path + in + match loadedCmt 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