Refactor deprecated command-line arguments

Makefile

@@ -68,9 +68,9 @@ self-coverage-workspace :
 	mkdir -p $(SELF_COVERAGE)/bisect_ppx/test
 	cp -r test/unit $(SELF_COVERAGE)/bisect_ppx/test/
 	cd $(SELF_COVERAGE)/meta_bisect_ppx && \
-	  patch -p2 < ../../test/self/meta_bisect_ppx.diff
+	  patch --no-backup-if-mismatch -p2 < ../../test/self/meta_bisect_ppx.diff
 	cd $(SELF_COVERAGE)/bisect_ppx && \
-	  patch -p2 < ../../test/self/bisect_ppx.diff
+	  patch --no-backup-if-mismatch -p2 < ../../test/self/bisect_ppx.diff
 
 .PHONY : self-coverage-rename
 self-coverage-rename :

src/common/bisect_common.ml

@@ -213,3 +213,34 @@ let register_file file ~point_count ~point_definitions =
         current_count + 1
       else
         current_count)
+
+
+
+type options = (Arg.key * Arg.spec * Arg.doc) list
+
+let deprecated basename options =
+  let make make_spec fn =
+    (basename,
+    make_spec (fun v ->
+      Printf.eprintf
+        "bisect-ppx-report argument '%s' is deprecated.\n" basename;
+      Printf.eprintf "Use '-%s' instead.\n" basename;
+      Printf.eprintf "This requires Bisect_ppx >= 2.0.0.\n";
+      fn v),
+    " Deprecated")
+  in
+
+  let (_, spec, _) =
+    options |> List.find (fun (option, _, _) -> option = "-" ^ basename) in
+
+  let deprecated_option =
+    match spec with
+    | Arg.Unit f -> make (fun f -> Arg.Unit f) f
+    | Arg.Set r -> make (fun f -> Arg.Unit f) (fun () -> r := true)
+    | Arg.String f -> make (fun f -> Arg.String f) f
+    | Arg.Set_string r -> make (fun f -> Arg.String f) ((:=) r)
+    | Arg.Int f -> make (fun f -> Arg.Int f) f
+    | _ -> prerr_endline basename; assert false
+  in
+
+  options @ [deprecated_option]

src/common/bisect_common.mli

@@ -87,3 +87,10 @@ val register_file :
     [point_definitions] is a serialized [Common.point_definition list] giving
     the locations of all points in the file. The returned callback is used to
     increment visitation counts. *)
+
+
+
+type options = (Arg.key * Arg.spec * Arg.doc) list
+
+val deprecated : string -> options -> options
+(** Appends a specification for a deprecated command-line argument. *)

src/ppx/register.ml

@@ -4,6 +4,8 @@
 
 
 
+module Common = Bisect_common
+
 let conditional = ref false
 
 let enabled () =
@@ -24,11 +26,6 @@ let conditional_exclude_file filename =
   | `Enabled -> Exclusions.add_file filename
   | `Disabled -> ()
 
-let deprecated argument =
-  Printf.eprintf "bisect_ppx argument '-%s' is deprecated.\n" argument;
-  Printf.eprintf "Use '--%s' instead.\n" argument;
-  Printf.eprintf "This requires Bisect_ppx >= 2.0.0.\n"
-
 let switches = [
   ("--exclude",
    Arg.String Exclusions.add,
@@ -46,36 +43,22 @@ let switches = [
   Arg.Set Comments.no_comment_parsing,
   " Do not parse source files for BISECT-* comments");
 
-  ("-exclude",
-  Arg.String (fun s ->
-    deprecated "exclude";
-    Exclusions.add s),
-  " Deprecated") ;
-
-  ("-exclude-file",
-  Arg.String (fun s ->
-    deprecated "exclude-file";
-    conditional_exclude_file s),
-  " Deprecated") ;
-
   ("-mode",
   (Arg.Symbol (["safe"; "fast"; "faster"], fun _ ->
     prerr_endline "bisect_ppx argument '-mode' is deprecated.")),
   " Deprecated") ;
-
-  ("-conditional",
-   Arg.Unit (fun () ->
-    deprecated "conditional";
-    conditional := true),
-   " Deprecated");
-
-  ("-no-comment-parsing",
-   Arg.Unit (fun () ->
-    deprecated "no-comment-parsing";
-    Comments.no_comment_parsing := true),
-  " Deprecated");
 ]
 
+let deprecated = Common.deprecated
+
+let switches =
+  switches
+  |> deprecated "-exclude"
+  |> deprecated "-exclude-file"
+  |> deprecated "-conditional"
+  |> deprecated "-no-comment-parsing"
+  |> Arg.align
+
 
 
 let () =

src/report/report.ml

@@ -49,12 +49,7 @@ struct
 
   let repo_token = ref ""
 
-  let deprecated argument =
-    Printf.eprintf "bisect-ppx-report argument '-%s' is deprecated.\n" argument;
-    Printf.eprintf "Use '--%s' instead.\n" argument;
-    Printf.eprintf "This requires Bisect_ppx >= 2.0.0.\n"
-
-  let options = Arg.align [
+  let options = [
     ("--html",
     Arg.String (fun s -> add_output (`Html, s)),
     "<dir>  Output HTML report to <dir> (HTML only)");
@@ -101,7 +96,7 @@ struct
     "<file>  Output bare dump to <file>");
 
     ("--verbose",
-    Arg.Unit (fun () -> deprecated "verbose"; verbose := true),
+    Arg.Set verbose,
     " Set verbose mode");
 
     ("--version",
@@ -123,80 +118,29 @@ struct
     ("--repo-token",
     Arg.Set_string repo_token,
     "<string>  Repo token for Coveralls json (Coveralls only)");
-
-    ("-html",
-    Arg.String (fun s -> deprecated "html"; add_output (`Html, s)),
-    " Deprecated");
-
-    ("-ignore-missing-files",
-    Arg.Unit (fun () ->
-      deprecated "ignore-missing-files";
-      ignore_missing_files := true),
-    " Deprecated");
-
-    ("-title",
-    Arg.String (fun s -> deprecated "title"; report_title := s),
-    " Deprecated");
-
-    ("-tab-size",
-    Arg.Int
-      (fun x ->
-        deprecated "tab-size";
-        if x < 0 then
-          (prerr_endline " *** error: tab size should be positive"; exit 1)
-        else
-          tab_size := x),
-    " Deprecated");
-
-    ("-text",
-    Arg.String (fun s -> deprecated "text"; add_output (`Text, s)),
-    " Deprecated");
-
-    ("-summary-only",
-    Arg.Unit (fun () -> deprecated "summary-only"; summary_only := true),
-    " Deprecated");
-
-    ("-csv",
-    Arg.String (fun s -> deprecated "csv"; add_output (`Csv, s)),
-    " Deprecated");
-
-    ("-separator",
-    Arg.String (fun s -> deprecated "separator"; csv_separator := s),
-    " Deprecated");
-
-    ("-dump",
-    Arg.String (fun s -> deprecated "dump"; add_output (`Dump, s)),
-    " Deprecated");
-
-    ("-verbose",
-    Arg.Set verbose,
-    " Deprecated");
-
-    ("-version",
-    Arg.Unit (fun () ->
-      deprecated "version";
-      print_endline Report_utils.version; exit 0),
-    " Deprecated");
-
-    ("-coveralls",
-    Arg.String (fun s ->
-      deprecated "coveralls";
-      add_output (`Coveralls, s)),
-    " Deprecated");
-
-    ("-service-name",
-    Arg.String (fun s -> deprecated "service-name"; service_name := s),
-    " Deprecated");
-
-    ("-service-job-id",
-    Arg.String (fun s -> deprecated "service-job-id"; service_job_id := s),
-    " Deprecated");
-
-    ("-repo-token",
-    Arg.String (fun s -> deprecated "repo-token"; repo_token := s),
-    " Deprecated");
 ]
 
+  let deprecated = Common.deprecated
+
+  let options =
+    options
+    |> deprecated "-html"
+    |> deprecated "-ignore-missing-files"
+    |> deprecated "-title"
+    |> deprecated "-tab-size"
+    |> deprecated "-text"
+    |> deprecated "-summary-only"
+    |> deprecated "-csv"
+    |> deprecated "-separator"
+    |> deprecated "-dump"
+    |> deprecated "-verbose"
+    |> deprecated "-version"
+    |> deprecated "-coveralls"
+    |> deprecated "-service-name"
+    |> deprecated "-service-job-id"
+    |> deprecated "-repo-token"
+    |> Arg.align
+
   let usage =
 {|Usage:
 

test/self/meta_bisect_ppx.diff

@@ -59,6 +59,18 @@ diff -ru src/ppx/instrument.ml _self/meta_bisect_ppx/src/ppx/instrument.ml
                  [%e file] ~point_count:[%e point_count] ~point_definitions
              in
              cb
+diff -ru src/ppx/register.ml _self/meta_bisect_ppx/src/ppx/register.ml
+--- src/ppx/register.ml
++++ _self/meta_bisect_ppx/src/ppx/register.ml
+@@ -4,7 +4,7 @@
+
+
+
+-module Common = Bisect_common
++module Common = Meta_bisect_common
+
+ let conditional = ref false
+
 diff -ru src/report/dune _self/meta_bisect_ppx/src/report/dune
 --- src/report/dune
 +++ _self/meta_bisect_ppx/src/report/dune
@@ -120,8 +132,8 @@ diff -ru src/report/report.ml _self/meta_bisect_ppx/src/report/report.ml
 -module Common = Bisect_common
 +module Common = Meta_bisect_common
 
- type output_kind =
-   | Html_output of string
+ module Arguments =
+ struct
 diff -ru src/report/report_utils.ml _self/meta_bisect_ppx/src/report/report_utils.ml
 --- src/report/report_utils.ml
 +++ _self/meta_bisect_ppx/src/report/report_utils.ml