(- NF fix) Remove all .bs.m?js-suffixed build-products, not just .bs.js

Author: ELLIOTTCABLE

jscomp/bsb/bsb_config_parse.ml

@@ -179,17 +179,6 @@ let check_stdlib (map : json_map) cwd (*built_in_package*) =
       | _ -> assert false
 
     end
-let extract_bs_suffix_exn (map : json_map) =
-  match Map_string.find_opt map Bsb_build_schemas.suffix with
-  | None -> false
-  | Some (Str {str} as config ) ->
-    if str = Literals.suffix_js then false
-    else if str = Literals.suffix_bs_js then true
-    else Bsb_exception.config_error config
-        "expect .bs.js or .js string here"
-  | Some config ->
-    Bsb_exception.config_error config
-      "expect .bs.js or .js string here"
 
 let extract_gentype_config (map : json_map) cwd
   : Bsb_config_types.gentype_config option =
@@ -402,7 +391,6 @@ let interpret_json
       extract_package_name_and_namespace  map in
     let refmt = extract_refmt map per_proj_dir in
     let gentype_config  = extract_gentype_config map per_proj_dir in
-    let bs_suffix = extract_bs_suffix_exn map in
     (* The default situation is empty *)
     let built_in_package = check_stdlib map per_proj_dir in
     let package_specs =
@@ -411,6 +399,7 @@ let interpret_json
         Bsb_package_specs.from_json x
       | None ->  Bsb_package_specs.default_package_specs
     in
+    let bs_suffixes = Bsb_package_specs.extract_in_source_bs_suffixes package_specs in
     let pp_flags : string option =
       extract_string map Bsb_build_schemas.pp_flags (fun p ->
         if p = "" then
@@ -434,12 +423,11 @@ let interpret_json
             ~toplevel
             ~root: per_proj_dir
             ~cut_generators
-            ~bs_suffix
+            ~bs_suffixes
             ~namespace
             sources in
         {
           gentype_config;
-          bs_suffix ;
           package_name ;
           namespace ;
           warning = extract_warning map;

jscomp/bsb/bsb_package_specs.ml

@@ -92,6 +92,21 @@ let default_suffix format in_source =
   | _, false -> Literals.suffix_mjs
   | _, true -> Literals.suffix_bs_mjs
 
+module SS = Set.Make(String)
+
+let supported_bs_suffixes = Literals.[suffix_bs_js; suffix_bs_mjs]
+
+(** Produces a [list] of supported, bs-prefixed file-suffixes used in
+    [in-source] package-specs.
+*)
+let extract_in_source_bs_suffixes (package_specs : Spec_set.t) =
+  let f spec suffixes =
+    if spec.in_source && List.mem spec.suffix supported_bs_suffixes then
+      SS.add spec.suffix suffixes
+    else suffixes
+  in
+  let suffixes = Spec_set.fold f package_specs SS.empty in
+  SS.elements suffixes
 
 let rec from_array (arr : Ext_json_types.t array) : Spec_set.t =
   let spec = ref Spec_set.empty in

jscomp/bsb/bsb_package_specs.mli

@@ -33,6 +33,9 @@ val from_json:
 val get_list_of_output_js :
   t -> bool -> string -> string list
 
+val extract_in_source_bs_suffixes :
+  t -> string list
+
 (**
   Sample output: {[ -bs-package-output commonjs:lib/js/jscomp/test]}
 *)

jscomp/bsb/bsb_parse_sources.ml

@@ -51,7 +51,7 @@ type cxt = {
   cut_generators : bool;
   traverse : bool;
   namespace : string option;
-  bs_suffix : bool;
+  bs_suffixes : string list;
   ignored_dirs : Set_string.t;
 }
 
@@ -206,6 +206,13 @@ let classify_suffix (x : string) : suffix_kind =
         else Not_any
 
 
+(** Attempt to delete any [.bs.m?js] files for a given artifact. *)
+let unlink_bs_suffixes context artifact =
+  List.iter
+    (fun suffix -> try_unlink (Filename.concat context.cwd (artifact ^ suffix)))
+    context.bs_suffixes
+
+
 (** This is the only place where we do some removal during scanning,
     configurably. *)
 let prune_staled_bs_js_files (context : cxt) (cur_sources : _ Map_string.t) :
@@ -236,12 +243,7 @@ let prune_staled_bs_js_files (context : cxt) (cur_sources : _ Map_string.t) :
                     if cmd <> "" then
                       Ext_pervasives.try_it (fun _ ->
                           Sys.command (cmd ^ " -cmt-rm " ^ filepath))
-                | Cmj _ ->
-                    (* remove .bs.js *)
-                    if context.bs_suffix then
-                      try_unlink
-                        (Filename.concat context.cwd
-                           (String.sub x 0 j ^ Literals.suffix_bs_js))
+                | Cmj _ -> unlink_bs_suffixes context (String.sub x 0 j)
                 | _ -> () );
                 try_unlink filepath )
               else () (* assert false *))
@@ -380,8 +382,8 @@ and  parse_sources ( cxt : cxt) (sources : Ext_json_types.t )  =
   | _ -> parsing_single_source cxt sources
 
 
-let scan ~toplevel ~root ~cut_generators ~namespace ~bs_suffix ~ignored_dirs x :
-    t * int =
+let scan ~toplevel ~root ~cut_generators ~namespace ~bs_suffixes ~ignored_dirs x
+    : t * int =
   Bsb_dir_index.reset ();
   let output =
     parse_sources
@@ -393,7 +395,7 @@ let scan ~toplevel ~root ~cut_generators ~namespace ~bs_suffix ~ignored_dirs x :
         root;
         cut_generators;
         namespace;
-        bs_suffix;
+        bs_suffixes;
         traverse = false;
       }
       x

jscomp/bsb/bsb_parse_sources.mli

@@ -34,7 +34,7 @@ val scan :
   root: string ->
   cut_generators: bool ->
   namespace : string option ->
-  bs_suffix:bool ->
+  bs_suffixes : string list ->
   ignored_dirs:Set_string.t ->
   Ext_json_types.t ->
   Bsb_file_groups.t * int