chore: Bump opam deps for new dune

dev/dune-tools/dune-commands/README.md

@@ -0,0 +1,13 @@
+Dune Commands
+=============
+
+This package provides a program called `dune-commands`, which can extract the
+run command from a JSONL dune trace.
+
+It can be used as follows.
+```sh
+dune trace cat > trace.jsonl
+dune exec -- dune-commands --json --trace-file trace.jsonl > commands.json
+```
+
+Run `dune-commands --help` for more information.

dev/dune-tools/dune-report/dune-report.opam → dev/dune-tools/dune-commands/dune-commands.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-synopsis: "Library for interpreting failures from the dune log"
+synopsis: "Library for extracting run commands from a dune trace"
 maintainer: ["Rodolphe Lepigre <rodolphe.lepigre@skylabs-ai.com>"]
 authors: ["Rodolphe Lepigre <rodolphe.lepigre@skylabs-ai.com>"]
 license: "LGPL-2.0-or-later"

dev/dune-tools/dune-report/dune-project → dev/dune-tools/dune-commands/dune-project

@@ -1,5 +1,5 @@
 (lang dune 3.21)
-(name dune-report)
+(name dune-commands)
 (generate_opam_files true)
 
 (source (github SkylabsAI/workspace))
@@ -8,8 +8,8 @@
 (license LGPL-2.0-or-later)
 
 (package
- (name dune-report)
- (synopsis "Library for interpreting failures from the dune log")
+ (name dune-commands)
+ (synopsis "Library for extracting run commands from a dune trace")
  (depends
   cmdliner
   ppx_deriving_yojson))

dev/dune-tools/dune-commands/src/dune

@@ -0,0 +1,6 @@
+(executable
+ (name main)
+ (public_name dune-commands)
+ (package dune-commands)
+ (preprocess (pps ppx_deriving_yojson))
+ (libraries cmdliner ppx_deriving_yojson.runtime))

dev/dune-tools/dune-commands/src/dune_log.ml

@@ -0,0 +1,99 @@
+type command = {
+  command : string;
+  output : string list;
+  status : int;
+}
+[@@deriving yojson]
+
+let command_to_json = command_to_yojson
+
+exception Error of string
+
+let error : string -> 'a = fun s ->
+  raise (Error(s))
+
+let read : In_channel.t -> fname:string -> command list = fun ic ~fname ->
+  let lines = In_channel.input_lines ic in
+  let parse i line =
+    let lnum = i + 1 in
+    let error s =
+      error (Printf.sprintf "File %s, line %i: %s" fname lnum s)
+    in
+    let json =
+      try Yojson.Safe.from_string ~fname ~lnum line with
+      | Yojson.Json_error(s) -> error ("JSON parse failure.\n" ^ s)
+    in
+    let assoc =
+      match json with
+      | `Assoc(fields) -> fields
+      | _              -> error "unexpected JSON value (not an object)"
+    in
+    let get field =
+      try List.assoc field assoc with Not_found ->
+        error ("no field \"" ^ field ^ "\"")
+    in
+    if get "cat" <> `String("process") then None else
+    if get "name" <> `String("finish") then None else
+    let args =
+      match get "args" with
+      | `Assoc(fields) -> fields
+      | _              -> error "ill-typed \"args\" field"
+    in
+    let get field =
+      try List.assoc field args with Not_found ->
+        error ("no field \"" ^ field ^ "\"")
+    in
+    let status =
+      match get "exit" with
+      | `Int(i) -> i
+      | _       -> error "ill-typed \"exit\" field"
+    in
+    let output =
+      let lines s =
+        let parts = String.split_on_char '\n' s in
+        match List.rev parts with
+        | "" :: parts -> List.rev parts
+        | _           -> parts
+      in
+      let get s =
+        match List.assoc_opt s args with
+        | None             -> []
+        | Some(`String(s)) -> lines s
+        | _                -> error ("ill-typed \"" ^ s ^ "\" field")
+      in
+      get "stdout" @ get "stderr"
+    in
+    let command =
+      let prog =
+        match get "prog" with
+        | `String(p) -> Filename.basename p
+        | _          -> error ("ill-typed \"prog\" field")
+      in
+      let dir =
+        match List.assoc_opt "dir" args with
+        | None             -> None
+        | Some(`String(s)) -> Some(s)
+        | _                -> error ("ill-typed \"dir\" field")
+      in
+      let args =
+        match List.assoc_opt "process_args" args with
+        | None              -> []
+        | Some(`List(args)) -> args
+        | _                 -> error ("ill-typed \"process_args\" field")
+      in
+      let args =
+        let get_string json =
+          match json with
+          | `String(s) -> s
+          | _          -> error "expected a string"
+        in
+        List.map get_string args
+      in
+      let command = String.concat " " (prog :: args) in
+      match dir with
+      | None    -> command
+      | Some(d) -> Printf.sprintf "(cd %s && %s)" d command
+    in
+    Some({command; output; status})
+  in
+  List.filter_map Fun.id (List.mapi parse lines)

dev/dune-tools/dune-commands/src/dune_log.mli

@@ -0,0 +1,21 @@
+(** Command logged during a dune build. *)
+type command = {
+  command : string;
+  (** Command that was run. *)
+  output : string list;
+  (** Lines of output from the command (including error message). *)
+  status : int;
+  (** Return code from the command (non-0 on failure). *)
+}
+
+(** [command_to_json command] turns [command] into its JSON representation. *)
+val command_to_json : command -> Yojson.Safe.t
+
+(** Exception raised by [read]. *)
+exception Error of string
+
+(** [read ic ~fname] extracts a list of run commands from the dune JSONL trace
+    expected on channel [ic], corresponding to file name [fname]. In case of a
+    file system error, the [Sys_error] exception is raised. If the channel has
+    unexpected contents, an [Error] exception is raised. *)
+val read : In_channel.t -> fname:string -> command list

dev/dune-tools/dune-report/bin/main.ml → dev/dune-tools/dune-commands/src/main.ml

@@ -7,20 +7,13 @@ let pp_command : Format.formatter -> Dune_log.command -> unit = fun ff cmd ->
   List.iter (Format.fprintf ff "%s\n%!") cmd.Dune_log.output;
   Format.fprintf ff "[%i]\n%!" cmd.Dune_log.status
 
-let run : bool -> bool -> string option -> unit = fun json all log_file ->
-  let log_file =
-    match log_file with
-    | Some(log_file) -> log_file
-    | None           ->
-    match Dune_log.locate () with
-    | Some(log_file) -> log_file
-    | None           ->
-        Printf.eprintf "Could not locate the dune log. ";
-        Printf.eprintf "Did you run \"dune build\"?\n%!";
-        exit 3
-  in
+let run : bool -> bool -> string option -> unit = fun json all trace_file ->
   let commands =
-    try Dune_log.read ~log_file with
+    try
+      match trace_file with
+      | Some(fname) -> In_channel.with_open_text fname (Dune_log.read ~fname)
+      | None        -> Dune_log.read ~fname:"-" stdin
+    with
     | Sys_error(s)      ->
         Printf.eprintf "File system error: %s.\n%!" s;
         exit 2
@@ -53,17 +46,20 @@ let all =
   in
   Arg.(value & flag & info ["all"] ~doc)
 
-let log_file =
+let trace_file =
   let doc =
-    "Specify a path to the dune log to process. When not specified, the log \
-     from the current dune workspace is located."
+    "Specify a path to a file containing a JSONL file holding a dune log. \
+     When not specified, the log is read on the standard input."
   in
-  let i = Arg.(info ["log-file"] ~docv:"LOGFILE" ~doc) in
+  let i = Arg.(info ["trace-file"] ~docv:"TRACEFILE" ~doc) in
   Arg.(value & opt (some non_dir_file) None & i)
 
 let cmd =
-  let doc = "Builds a report form the dune build log." in
-  let term = Term.(const run $ json $ all $ log_file) in
+  let doc =
+    "Builds a report from a JSONL dune build trace. Such a trace can be \
+     obtained using $(b,dune trace cat)."
+  in
+  let term = Term.(const run $ json $ all $ trace_file) in
   let exits =
     let open Cmd.Exit in
     info ~doc:"On success." ok ::

dev/dune-tools/dune-named-logfile/dune-named-logfile

@@ -2,10 +2,10 @@
 set -o errexit
 set -o pipefail
 
-# "dune-named-logfile ARGS ..." invokes "dune ARGS ...", and then copies the
-# resulting dune "_build/log" to the path specified by SL_DUNE_LOG_FILE. If
-# SL_LOG_APPEND is set and non-empty, the log contents is added to the end of
-# the file instead of overwriting it.
+# "dune-named-logfile ARGS ..." invokes "dune ARGS ...", and then extracts the
+# data from "_build/trace.csexp" to the path specified by environment variable
+# SL_DUNE_LOG_FILE using "dune trace cat ...". If SL_DUNE_LOG_APPEND is set
+# and non-empty, the data is added to the end of the file.
 #
 # This script is meant to be put in the PATH under name "dune". This is useful
 # when "dune" invocations cannot easily be replaced by "dune-named-logfile".
@@ -14,8 +14,9 @@ set -o pipefail
 #
 # Options (all passed via environment variables):
 # - SL_DUNE_ORIGINAL: absolute path to the original "dune" binary.
-# - SL_DUNE_LOG_FILE: target log file.
-# - SL_DUNE_LOG_APPEND: if non-empty, the log is appended and not overwritten.
+# - SL_DUNE_LOG_FILE: target data file (in jsonl format).
+# - SL_DUNE_LOG_APPEND: if non-empty, append data at the end of the file that
+#   is specified by SL_DUNE_LOG_FILE instead of overwriting it.
 
 SELF=$(realpath $0)
 DUNE=$(realpath "${SL_DUNE_ORIGINAL:=$(which dune)}")
@@ -56,16 +57,16 @@ else
   fi
 
   BUILD_PATH=$(realpath "${DUNE_PATH}/..")
-  DUNE_LOG="${BUILD_PATH}/log"
-  rm "${DUNE_LOG}"
+  DUNE_TRACE="${BUILD_PATH}/trace.csexp"
+  rm -f "${DUNE_TRACE}"
 
   ${DUNE} "$@" && EXIT=$? || EXIT=$?
 
-  if [ -f "${DUNE_LOG}" ]; then
+  if [ -f "${DUNE_TRACE}" ]; then
     if [ -z "${SL_DUNE_LOG_APPEND}" ]; then
-      cp "${DUNE_LOG}" "${LOG}"
+      ${DUNE} trace cat --trace-file "${DUNE_TRACE}" > "${LOG}"
     else
-      cat "${DUNE_LOG}" >> "${LOG}"
+      ${DUNE} trace cat --trace-file "${DUNE_TRACE}" >> "${LOG}"
     fi
   else
     if [ -z "${SL_DUNE_LOG_APPEND}" ]; then