feature: sandbox extraction event (#13544)

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

Author: rgrinberg

doc/changes/added/13544.md

@@ -0,0 +1 @@
+- Add sandbox extraction trace event (#13544, @rgrinberg)

src/dune_engine/sandbox.ml

@@ -274,7 +274,7 @@ let move_targets_to_build_dir t ~should_be_skipped ~(targets : Targets.Validated
   : unit Fiber.t
   =
   let open Fiber.O in
-  let+ _start, _finish, _queued =
+  let+ start, stop, queued =
     maybe_async (fun () ->
       Option.iter t.snapshot ~f:(fun old_snapshot ->
         register_snapshot_promotion t targets ~old_snapshot);
@@ -308,7 +308,8 @@ let move_targets_to_build_dir t ~should_be_skipped ~(targets : Targets.Validated
           if Path.Untracked.exists (Path.build src_dir)
           then Unix.rename (Path.Build.to_string src_dir) (Path.Build.to_string target)))
   in
-  ()
+  Dune_trace.emit ~buffered:true Sandbox (fun () ->
+    Dune_trace.Event.sandbox `Extract ~start ~stop ~queued t.loc ~dir:t.dir)
 ;;
 
 let failed_to_delete_sandbox dir reason =

src/dune_trace/dune_trace.mli

@@ -38,7 +38,7 @@ module Event : sig
   type t
 
   val sandbox
-    :  [ `Create | `Snapshot | `Destroy ]
+    :  [ `Create | `Snapshot | `Destroy | `Extract ]
     -> start:Time.t
     -> stop:Time.t
     -> queued:Time.Span.t option

src/dune_trace/event.ml

@@ -761,6 +761,7 @@ let sandbox name ~start ~stop ~queued loc ~dir =
     | `Destroy -> "destroy"
     | `Snapshot -> "snapshot"
     | `Create -> "create"
+    | `Extract -> "extract"
   in
   Event.complete ~args ~name ~start ~dur Sandbox
 ;;

test/blackbox-tests/test-cases/sandbox/sandbox-events.t

@@ -25,6 +25,14 @@ Demonstrate sandbox events:
       "dir": "_build/.sandbox/$DIGEST"
     }
   }
+  {
+    "cat": "sandbox",
+    "name": "extract",
+    "args": {
+      "loc": "dune:1",
+      "dir": "_build/.sandbox/$DIGEST"
+    }
+  }
   {
     "cat": "sandbox",
     "name": "destroy",