Improve render and dump CLI

`eio-trace render` and `eio-trace dump` now take a list of trace files
rather than the name of the output. This works better with
tab-completion and is consistent with how the `show` sub-command works.

Author: talex5

README.md

@@ -81,9 +81,11 @@ dune exec -- eio-trace show trace.fxt
 To convert a trace to SVG format:
 
 ```
-dune exec -- eio-trace render -f trace.fxt trace.svg
+dune exec -- eio-trace render trace.fxt
 ```
 
+You can also use `--format=png` for PNG output.
+
 ## Reading traces
 
 Eio fibers are shown as horizontal bars.

gtk/main.ml

@@ -2,6 +2,11 @@ open Eio_trace
 
 let (_ : string) = GMain.init ()
 
+let format_of_string = function
+  | ".svg" -> `Svg
+  | ".png" -> `Png
+  | x -> Fmt.failwith "Unknown format %S (should be .svg or .png)" x
+
 let load tracefile =
   let ch = open_in_bin tracefile in
   let len = in_channel_length ch in
@@ -22,7 +27,13 @@ let show ?args tracefile =
   in
   Gtk_ui.create ~title (load tracefile)
 
-let render ~output ~start_time ?duration ~format tracefile =
+let render ?output ~start_time ?duration ~format tracefile =
+  let output =
+    match output with
+    | Some x -> x
+    | None -> Filename.remove_extension tracefile ^ format
+  in
+  let format = format_of_string format in
   let l = load (tracefile) in
   let v =
     View.of_layout l
@@ -48,28 +59,32 @@ let render ~output ~start_time ?duration ~format tracefile =
     | `Svg -> ()
     | `Png -> Cairo.PNG.write surface output
   end;
-  Cairo.Surface.finish surface
-
-let format_of_string = function
-  | ".svg" -> `Svg
-  | ".png" -> `Png
-  | x -> Fmt.failwith "Unknown format %S (should be .svg or .png)" x
+  Cairo.Surface.finish surface;
+  Printf.printf "Wrote %S\n" output
 
 let () =
   match Array.to_list Sys.argv with
   | _ :: "show" :: tracefiles -> List.iter show tracefiles; GMain.main ()
   | _ :: "run" :: tracefile :: args -> show ~args tracefile; GMain.main ()
-  | [ _; "render-svg"; tracefile; format; output; start_time; duration ] ->
+  | _ :: "render-svg" :: format :: output :: start_time :: duration :: tracefiles ->
     let duration =
       match duration with
       | "" -> None
       | x -> Some (float_of_string x *. 1e9)
     in
-    render tracefile
-      ~output
-      ~start_time:(float_of_string start_time *. 1e9)
-      ?duration
-      ~format:(format_of_string format)
+    let output =
+      match output with
+      | "" -> None
+      | x -> Some x
+    in
+    let render =
+      render
+        ?output
+        ~start_time:(float_of_string start_time *. 1e9)
+        ?duration
+        ~format
+    in
+    List.iter render tracefiles
   | args ->
     Fmt.failwith "Invalid arguments (eio-trace-gtk should be run via eio-trace)@.(got %a)"
       Fmt.(Dump.list string) args

src/dump.ml

@@ -1,7 +1,9 @@
 module Read = Fxt.Read
 
-let main out tracefile =
-  Eio.Path.with_open_in tracefile @@
-  Eio.Buf_read.parse_exn ~max_size:max_int @@ fun r ->
-  Fmt.pf out "@[<v>%a@]@." (Fmt.seq Read.pp_record) (Read.records r);
+let main out tracefiles =
+  tracefiles |> List.iter (fun tracefile ->
+      Eio.Path.with_open_in tracefile @@
+      Eio.Buf_read.parse_exn ~max_size:max_int @@ fun r ->
+      Fmt.pf out "@[<v>%a@]@." (Fmt.seq Read.pp_record) (Read.records r);
+    );
   Ok ()

src/main.ml

@@ -24,12 +24,21 @@ let tracefile =
   Arg.(value @@ opt string "trace.fxt" @@ info ["f"; "tracefile"] ~docv:"PATH" ~doc)
 
 let tracefiles =
-  let doc = "The path of the trace file(s)." in
+  let doc = "The path of the trace file(s). The default is trace.fxt." in
   Arg.(value @@ pos_all string ["trace.fxt"] @@ info [] ~docv:"PATH" ~doc)
 
 let imagefile =
-  let doc = "The path of the output image." in
-  Arg.(required @@ pos 0 (some string) None @@ info [] ~docv:"OUTPUT" ~doc)
+  let doc = "The path of the output image. The default is the input path with the new type extension." in
+  Arg.(value @@ opt (some string) None @@ info ["o"; "output"] ~docv:"OUTPUT" ~doc)
+
+let fmt =
+  let doc = "Output image file-type." in
+  let formats = Arg.enum [
+      "png", ".png";
+      "svg", ".svg";
+    ]
+  in
+  Arg.(value @@ opt (some formats) None @@ info ["T"; "format"] ~docv:"TYPE" ~doc)
 
 let freq =
   let doc = "How many times per second to check for events." in
@@ -80,29 +89,39 @@ let run ~fs ~proc_mgr freq args =
 
 let record ~fs ~proc_mgr freq tracefile args =
   Record.run ~fs ~proc_mgr ~freq ~tracefile args
-
-let render tracefile output start_time duration =
-  match Filename.extension output with
-  | "" -> Fmt.error "No extension on %S; can't determine format" output
-  | ".svg"
-  | ".png" as format ->
-    let start_time = Option.value start_time ~default:0.0 |> string_of_float in
-    let duration = Option.map string_of_float duration |> Option.value ~default:"" in
-    exec_gtk ["render-svg"; tracefile; format; output; start_time; duration]
-  | _ ->
-    Fmt.error "Unknown file extension in %S (should end in e.g. '.svg')" output
+    
+let ( let* ) = Result.bind
+
+let render tracefiles output fmt start_time duration =
+  let* fmt =
+    match fmt, output with
+    | None, None -> Ok ".svg"
+    | _, Some _ when List.length tracefiles > 1 -> Error "Can't use --output with multiple input files"
+    | Some x, _ -> Ok x
+    | None, Some output ->
+      match Filename.extension output with
+      | "" -> Fmt.error "No extension on %S; can't determine format" output
+      | ".svg"
+      | ".png" as f -> Ok f
+      | _ ->
+        Fmt.error "Unknown file extension in %S (should end in e.g. '.svg')" output
+  in
+  let start_time = Option.value start_time ~default:0.0 |> string_of_float in
+  let duration = Option.map string_of_float duration |> Option.value ~default:"" in
+  let output = Option.value output ~default:"" in
+  exec_gtk @@ "render-svg" :: fmt :: output :: start_time :: duration :: tracefiles
 
 let cmd env =
   let fs = Eio.Stdenv.fs env in
   let proc_mgr = Eio.Stdenv.process_mgr env in
-  let path x = Eio.Path.( / ) fs $$ x in
+  let path = Eio.Path.( / ) fs in
   Cmd.group (Cmd.info "eio-trace")
   @@ List.map (fun (name, term) -> Cmd.v (Cmd.info name) term) [
-    "record", record ~fs ~proc_mgr           $$ freq $ path tracefile $ child_args;
-    "dump",   Dump.main Format.std_formatter $$ path tracefile;
+    "record", record ~fs ~proc_mgr           $$ freq $ (path $$ tracefile) $ child_args;
+    "dump",   Dump.main Format.std_formatter $$ (List.map path $$ tracefiles);
     "run",    run ~fs ~proc_mgr              $$ freq $ child_args;
     "show",   show                           $$ tracefiles;
-    "render", render                         $$ tracefile $ imagefile $ start_time $ duration;
+    "render", render                         $$ tracefiles $ imagefile $ fmt $ start_time $ duration;
   ]
 
 let () =