Move trace events to dune_trace

bin/common.ml

@@ -1423,14 +1423,9 @@ let init_with_root ~(root : Workspace_root.t) (builder : Builder.t) =
   Dune_console.separate_messages c.builder.separate_error_messages;
   Option.iter c.stats ~f:(fun stats ->
     if Dune_trace.extended_build_job_info stats
-    then
-      (* Communicate config settings as an instant event here. *)
-      let open Chrome_trace in
-      let args = [ "build_dir", `String (Path.Build.to_string Path.Build.root) ] in
-      let ts = Event.Timestamp.of_float_seconds (Unix.gettimeofday ()) in
-      let common = Event.common_fields ~cat:[ "config" ] ~name:"config" ~ts () in
-      let event = Event.instant ~args common in
-      Dune_trace.emit stats event);
+    then (
+      let event = Dune_trace.Event.config () in
+      Dune_trace.emit stats event));
   (* Setup hook for printing GC stats to a file *)
   at_exit (fun () ->
     match c.builder.dump_gc_stats with

doc/changes/changed/12867.md

@@ -0,0 +1,3 @@
+- Persistent DB and process events have been slightly modified. Persistent
+  DB events have more concise names and job events always include full
+  information. (#12867, @rgrinberg)

flake.nix

@@ -100,6 +100,7 @@
             file
             mercurial
             unzip
+            perl
           ]
           ++ lib.optionals stdenv.isLinux [ strace ];
         testNativeBuildInputs =

otherlibs/chrome-trace/test/chrome_trace_tests.ml

@@ -1,17 +1,6 @@
 open Stdune
-open Dune_tests_common
 
-let () = init ()
-let buf = Buffer.create 0
-
-let c =
-  let write s = Buffer.add_string buf s in
-  let close () = () in
-  let flush () = () in
-  Dune_trace.create (Custom { write; close; flush }) ~extended_build_job_info:false
-;;
-
-let () =
+let%expect_test _ =
   let module Event = Chrome_trace.Event in
   let module Id = Chrome_trace.Id in
   let module Timestamp = Event.Timestamp in
@@ -30,22 +19,12 @@ let () =
         ~args:[ "foo", `Int 100 ]
     ]
   in
-  List.iter events ~f:(Dune_trace.emit c);
-  Dune_trace.close c
-;;
-
-let buffer_lines () = String.split_lines (Buffer.contents buf)
-
-let%expect_test _ =
-  Format.printf
-    "%a@."
-    Pp.to_fmt
-    (Pp.vbox (Pp.concat_map (buffer_lines ()) ~sep:Pp.cut ~f:Pp.verbatim));
+  List.iter events ~f:(fun event ->
+    Chrome_trace.Event.to_json event |> Dune_trace.Json.to_string |> print_endline);
   [%expect
     {|
-[{"args":{"foo":"bar"},"ph":"X","dur":1000000,"name":"foo","cat":"","ts":500000,"pid":0,"tid":0}
-,{"ph":"C","args":{"bar":250},"name":"cnt","cat":"","ts":500000,"pid":0,"tid":0}
-,{"args":{"foo":100},"ph":"b","id":"foo","name":"async","cat":"","ts":500000,"pid":0,"tid":0}
-]
-|}]
+    {"args":{"foo":"bar"},"ph":"X","dur":1000000,"name":"foo","cat":"","ts":500000,"pid":0,"tid":0}
+    {"ph":"C","args":{"bar":250},"name":"cnt","cat":"","ts":500000,"pid":0,"tid":0}
+    {"args":{"foo":100},"ph":"b","id":"foo","name":"async","cat":"","ts":500000,"pid":0,"tid":0}
+    |}]
 ;;

src/dune_engine/build_system.ml

@@ -307,17 +307,13 @@ end = struct
 
   let report_evaluated_rule_exn (t : Build_config.t) =
     Option.iter t.stats ~f:(fun stats ->
-      let module Event = Chrome_trace.Event in
       let event =
         let rule_total =
           match Fiber.Svar.read State.t with
           | Building progress -> progress.number_of_rules_discovered
           | _ -> assert false
         in
-        let args = [ "value", `Int rule_total ] in
-        let ts = Event.Timestamp.of_float_seconds (Unix.gettimeofday ()) in
-        let common = Event.common_fields ~name:"evaluated_rules" ~ts () in
-        Event.counter common args
+        Dune_trace.Event.evalauted_rules ~rule_total
       in
       Dune_trace.emit stats event)
   ;;

src/dune_engine/process.ml

@@ -280,14 +280,6 @@ let command_line ~prog ~args ~dir ~stdout_to ~stderr_to ~stdin_from =
   prefix ^ String.quote_list_for_shell (prog :: args) ^ suffix
 ;;
 
-module Exit_status = struct
-  type error =
-    | Failed of int
-    | Signaled of Signal.t
-
-  type t = (int, error) result
-end
-
 module Fancy = struct
   let split_prog s =
     let len = String.length s in
@@ -372,6 +364,8 @@ module Fancy = struct
   ;;
 end
 
+module Exit_status = Dune_trace.Event.Exit_status
+
 (* Implemt the rendering for [--display short] *)
 module Short_display : sig
   val pp_ok : prog:string -> purpose:purpose -> User_message.Style.t Pp.t
@@ -822,58 +816,29 @@ let report_process_finished
       ~stderr
       (times : Proc.Times.t)
   =
-  let common =
-    let name =
-      match metadata.name with
-      | Some n -> n
-      | None -> Filename.basename prog
-    in
-    let ts = Timestamp.of_float_seconds started_at in
-    Event.common_fields ~cat:("process" :: metadata.categories) ~name ~ts ()
+  let targets =
+    match metadata.purpose with
+    | Internal_job -> []
+    | Build_job None -> []
+    | Build_job (Some targets) -> Targets.Validated.to_trace_args targets
   in
-  let always =
-    [ "process_args", `List (List.map args ~f:(fun arg -> `String arg))
-    ; "pid", `Int (Pid.to_int pid)
-    ]
-  in
-  let extended =
-    if not (Dune_trace.extended_build_job_info stats)
-    then []
-    else (
-      let targets =
-        match metadata.purpose with
-        | Internal_job -> []
-        | Build_job None -> []
-        | Build_job (Some targets) -> Targets.Validated.to_trace_args targets
-      in
-      let exit =
-        match exit_status with
-        | Ok n -> [ "exit", `Int n ]
-        | Error (Exit_status.Failed n) ->
-          [ "exit", `Int n; "error", `String (sprintf "exited with code %d" n) ]
-        | Error (Signaled s) ->
-          [ "exit", `Int (Signal.to_int s)
-          ; "error", `String (sprintf "got signal %s" (Signal.name s))
-          ]
-      in
-      let output name s =
-        match Result.Out.get s with
-        | "" -> []
-        | s -> [ name, `String s ]
-      in
-      List.concat
-        [ [ "prog", `String prog
-          ; "dir", `String (Option.map ~f:Path.to_string dir |> Option.value ~default:".")
-          ]
-        ; targets
-        ; exit
-        ; output "stdout" stdout
-        ; output "stderr" stderr
-        ])
+  let stdout = Result.Out.get stdout in
+  let stderr = Result.Out.get stderr in
+  let event =
+    Dune_trace.Event.process
+      ~name:metadata.name
+      ~started_at
+      ~targets
+      ~categories:metadata.categories
+      ~pid
+      ~exit:exit_status
+      ~prog
+      ~process_args:args
+      ~dir
+      ~stdout
+      ~stderr
+      ~times:(times : Proc.Times.t)
   in
-  let args = always @ extended in
-  let dur = Event.Timestamp.of_float_seconds times.elapsed_time in
-  let event = Event.complete ~args ~dur common in
   Dune_trace.emit stats event
 ;;
 

src/dune_engine/sandbox.ml

@@ -185,7 +185,7 @@ let create ~mode ~dune_stats ~rule_loc ~dirs ~deps ~rule_dir ~rule_digest =
     Dune_trace.start dune_stats (fun () ->
       let cat = Some [ "create-sandbox" ] in
       let name = Loc.to_file_colon_line rule_loc in
-      Dune_trace.Event.data ~cat ~name ~args:None)
+      Dune_trace.Event.Async.data ~cat ~name ~args:None)
   in
   init ();
   let sandbox_dir =

src/dune_engine/scheduler.ml

@@ -1182,15 +1182,7 @@ module Run = struct
        But we don't care because the user enabled this manually with
        [--trace-file] *)
     Option.iter stats ~f:(fun stats ->
-      let event =
-        let fields =
-          let ts = Chrome_trace.Event.Timestamp.of_float_seconds (Unix.gettimeofday ()) in
-          Chrome_trace.Event.common_fields ~name:"watch mode iteration" ~ts ()
-        in
-        (* the instant event allows us to separate build commands from
-           different iterations of the watch mode in the event viewer *)
-        Chrome_trace.Event.instant ~scope:Global fields
-      in
+      let event = Dune_trace.Event.scheduler_idle () in
       Dune_trace.emit stats event;
       Dune_trace.flush stats)
   ;;

src/dune_pkg/fetch.ml

@@ -253,7 +253,7 @@ let fetch ~unpack ~checksum ~target ~url:(url_loc, url) =
   let event =
     Dune_trace.(
       start (global ()) (fun () ->
-        Dune_trace.Event.data
+        Dune_trace.Event.Async.data
           ~cat:None
           ~name:label
           ~args:

src/dune_rpc_server/dune_rpc_server.ml

@@ -270,52 +270,30 @@ type message_kind =
   | Request of Dune_rpc_private.Id.t
   | Notification
 
-type stage =
-  | Start
-  | Stop
-
 module Event = struct
   module Event = Chrome_trace.Event
 
-  let async_kind_of_stage = function
-    | Start -> Event.Start
-    | Stop -> Event.End
-  ;;
-
   type t =
-    | Session of stage
+    | Session of Dune_trace.Event.Rpc.stage
     | Message of
         { kind : message_kind
         ; meth_ : string
-        ; stage : stage
+        ; stage : Dune_trace.Event.Rpc.stage
         }
 
   let emit t stats id =
     Option.iter stats ~f:(fun stats ->
       let event =
-        let kind, name, args =
-          match t with
-          | Session stage -> async_kind_of_stage stage, "rpc_session", None
-          | Message { kind; meth_; stage } ->
-            let args =
-              match kind with
-              | Notification -> None
-              | Request id ->
-                let id = Dune_rpc_private.Id.to_sexp id in
-                let rec to_json : Sexp.t -> Chrome_trace.Json.t = function
-                  | Atom s -> `String s
-                  | List s -> `List (List.map s ~f:to_json)
-                in
-                Some [ "request_id", to_json id ]
-            in
-            async_kind_of_stage stage, meth_, args
-        in
-        let common =
-          let ts = Event.Timestamp.of_float_seconds (Unix.gettimeofday ()) in
-          Event.common_fields ~ts ~name ()
-        in
-        let id = Chrome_trace.Id.create (`Int (Session.Id.to_int id)) in
-        Event.async ?args id kind common
+        let id = Session_id.to_int id in
+        match t with
+        | Session stage -> Dune_trace.Event.Rpc.session ~id stage
+        | Message { kind; meth_; stage } ->
+          let kind =
+            match kind with
+            | Request id -> `Request (Dune_rpc_private.Id.to_sexp id)
+            | Notification -> `Notification
+          in
+          Dune_trace.Event.Rpc.message kind ~meth_ ~id stage
       in
       Dune_trace.emit stats event)
   ;;
@@ -351,7 +329,10 @@ module H = struct
 
   let dispatch_notification (type a) (t : a t) stats (session : a Session.t) meth_ n =
     let kind = Notification in
-    Event.emit (Message { kind; meth_; stage = Start }) stats (Session.id session);
+    Event.emit
+      (Message { kind; meth_; stage = Dune_trace.Event.Rpc.Start })
+      stats
+      (Session.id session);
     let+ result = V.Handler.handle_notification t.handler session n in
     let () =
       match result with