Add -brief output mode

polytypic · polytypic · commit 968dd54ab2d5 · 2024-03-10T13:05:05.000+02:00
This is useful as the output mode when running a benchmark executable as a test
and the JSON output is just too much.
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,5 +1,6 @@
 ## Next release
 
+- Add `-brief` to show results in a concise human readable format (@polytypic)
 - Add support for `wrap`ping the work without timing `wrap` itself (@polytypic)
 - Add `-diff base.json` switch to diff against base results from file
   (@polytypic)
diff --git a/bench/dune b/bench/dune
@@ -10,6 +10,8 @@ let () =
 
 (test
  (name main)
+ (action
+  (run %{test} -brief))
  (libraries
   multicore-bench
   backoff
diff --git a/lib/cmd.ml b/lib/cmd.ml
@@ -1,3 +1,17 @@
+type output = [ `JSON | `Brief | `Diff of string ]
+
+let print_brief json =
+  let open Data in
+  json |> Results.parse
+  |> Option.iter @@ fun (results : Results.t) ->
+     results
+     |> List.iter @@ fun (bench : Benchmark.t) ->
+        Printf.printf "%s:\n" bench.name;
+        bench.metrics
+        |> List.iter @@ fun (metric : Metric.t) ->
+           Printf.printf "  %s:\n" metric.name;
+           Printf.printf "    %.2f %s\n" metric.value metric.units
+
 let print_diff base next =
   let open Data in
   Option.pair (Results.parse base) (Results.parse next)
@@ -49,12 +63,12 @@ let build_filter = function
            | exception Not_found -> false
     end
 
-let run ~benchmarks ?(budgetf = 0.025) ?(filters = []) ?(debug = false) ?diff
-    ?(argv = Sys.argv) ?(flush = true) () =
+let run ~benchmarks ?(budgetf = 0.025) ?(filters = []) ?(debug = false)
+    ?(output = `JSON) ?(argv = Sys.argv) ?(flush = true) () =
   let budgetf = ref budgetf in
   let filters = ref filters in
   let debug = ref debug in
-  let diff = ref diff in
+  let output = ref output in
 
   let rec specs =
     [
@@ -63,8 +77,11 @@ let run ~benchmarks ?(budgetf = 0.025) ?(filters = []) ?(debug = false) ?diff
         Arg.Set debug,
         "\t  Print progress information to help debugging" );
       ( "-diff",
-        Arg.String (fun path -> diff := Some path),
+        Arg.String (fun path -> output := `Diff path),
         "path.json\t  Show diff against specified base results" );
+      ( "-brief",
+        Arg.Unit (fun () -> output := `Brief),
+        "\t  Show brief human readable results." );
       ("-help", Unit help, "\t  Show this help message");
       ("--help", Unit help, "\t  Show this help message");
     ]
@@ -100,9 +117,10 @@ let run ~benchmarks ?(budgetf = 0.025) ?(filters = []) ?(debug = false) ?diff
   in
 
   begin
-    match !diff with
-    | None -> Yojson.Safe.pretty_print ~std:true Format.std_formatter results
-    | Some fname -> print_diff (Yojson.Safe.from_file fname) results
+    match !output with
+    | `JSON -> Yojson.Safe.pretty_print ~std:true Format.std_formatter results
+    | `Brief -> print_brief results
+    | `Diff fname -> print_diff (Yojson.Safe.from_file fname) results
   end;
 
   if flush then Format.print_flush ()
diff --git a/lib/multicore_bench.mli b/lib/multicore_bench.mli
@@ -143,12 +143,23 @@ end
 module Cmd : sig
   (** Command line interface for a benchmark executable. *)
 
+  type output =
+    [ `JSON
+      (** [`JSON] gives the JSON output for
+          {{:https://github.com/ocurrent/current-bench}current-bench}. *)
+    | `Brief  (** [`Brief] gives concise human readable output. *)
+    | `Diff of string
+      (** [`Diff "path.json"] gives concise human readable diff against results
+          stored in specified [path.json] file. *)
+    ]
+  (** Specifies the output format. *)
+
   val run :
     benchmarks:(string * Suite.t) list ->
     ?budgetf:float ->
     ?filters:string list ->
     ?debug:bool ->
-    ?diff:string ->
+    ?output:output ->
     ?argv:string array ->
     ?flush:bool ->
     unit ->
@@ -169,8 +180,7 @@ module Cmd : sig
       - [~debug]: Print progress information to help debugging.  Defaults to
         [false].
 
-      - [~diff]: Name of JSON file of results to show diff against.  Defaults to
-        [None].
+      - [~output]: Output mode.  Defaults to [`JSON].
 
       - [~argv]: Array of command line arguments.  Defaults to [Sys.argv].
 
