From 868abc9cd73411deb2b602075c4a7482d623231d Mon Sep 17 00:00:00 2001
From: Jules Aguillon <jules@j3s.fr>
Date: Fri, 23 Jun 2023 17:41:31 +0200
Subject: [PATCH] driver: Record execution time of every commands

The result is written into a current-bench's JSON format and promoted by

    dune build @bench
---
 doc/driver.mld | 81 +++++++++++++++++++++++++++++++++++++++++++++++---
 doc/dune       | 26 ++++++++++------
 dune           |  5 ++++
 3 files changed, 99 insertions(+), 13 deletions(-)

diff --git a/doc/driver.mld b/doc/driver.mld
index 790d2d1cdc..a397c9950c 100644
--- a/doc/driver.mld
+++ b/doc/driver.mld
@@ -155,12 +155,15 @@ let link_output = ref [ "" ]
 
 let generate_output = ref [ "" ]
 
+(* Record the commands executed and their running time. *)
 let commands = ref [ ]
 
 let run cmd =
-  let cmd_str = Cmd.to_string cmd in
-  commands := cmd_str :: !commands;
-  OS.Cmd.(run_out ~err:OS.Cmd.err_run_out cmd |> to_lines) |> get_ok
+  let t_start = Sys.time () in
+  let r = OS.Cmd.(run_out ~err:OS.Cmd.err_run_out cmd |> to_lines) |> get_ok in
+  let t_end = Sys.time () in
+  commands := (cmd, t_end -. t_start) :: !commands;
+  r
 
 let add_prefixed_output cmd list prefix lines =
   if List.length lines > 0 then
@@ -875,7 +878,7 @@ html/odoc/odoc_html/Odoc_html/Types/index.html
 Finally, let's have a list of all of the commands executed during the execution of this process:
 
 {[
-# List.iter (Printf.printf "$ %s\n") (List.rev !commands);;
+# List.iter (fun (cmd, _) -> Printf.printf "$ %s\n" (Cmd.to_string cmd)) (List.rev !commands);;
 $ 'ocamlfind' 'query' 'yojson'
 $ 'ocamlfind' 'query' 'stdlib'
 $ 'ocamlfind' 'query' 'fmt'
@@ -2916,3 +2919,73 @@ $ '../src/odoc/bin/main.exe' 'html-generate' 'page-ocamldoc_differences.odocl' '
 $ '../src/odoc/bin/main.exe' 'support-files' '-o' 'html/odoc'
 - : unit = ()
 ]}
+
+This last block analyze the running times so that they can be submitted to
+{{:https://github.com/ocurrent/current-bench}current-bench}.
+
+{[
+(* *)
+#require "yojson" ;;
+
+let compute_metric_cmd cmd =
+  let rec compute min_ max_ total count = function
+    | [] -> (min_, max_, total /. float count, count)
+    | (_, t) :: tl ->
+        compute (min min_ t) (max max_ t) (total +. t) (count + 1) tl
+  in
+  let filtered_commands =
+    List.filter
+      (fun (cmd', _) ->
+        match Bos.Cmd.to_list cmd' with
+        | _ :: cmd' :: _ -> cmd = cmd'
+        | _ -> false)
+      !commands
+  in
+  match filtered_commands with
+  | [] -> []
+  | (_, time) :: tl ->
+      let min, max, avg, count = compute time time time 1 tl in
+      [
+        `Assoc
+          [
+            ("name", `String ("total-" ^ cmd));
+            ("value", `Int count);
+            ( "description",
+              `String ("Number of time 'odoc " ^ cmd ^ "' has run.") );
+          ];
+        `Assoc
+          [
+            ("name", `String ("time-" ^ cmd));
+            ( "value",
+              `Assoc
+                [
+                  ("min", `Float min); ("max", `Float max); ("avg", `Float avg);
+                ] );
+            ("units", `String "s");
+            ("description", `String ("Time taken by 'odoc " ^ cmd ^ "'"));
+            ("trend", `String "lower-is-better");
+          ];
+      ]
+
+let metrics =
+  compute_metric_cmd "compile"
+  @ compute_metric_cmd "compile-deps"
+  @ compute_metric_cmd "link"
+  @ compute_metric_cmd "html-generate"
+
+let bench_results =
+  `Assoc
+    [
+      ("name", `String "odoc");
+      ( "results",
+        `List
+          [
+            `Assoc
+              [ ("name", `String "driver.mld"); ("metrics", `List metrics) ];
+          ] );
+    ]
+
+(* Save the result in a file. This file won't be promoted into the
+   documentation. *)
+let () = Yojson.to_file "driver-benchmarks.json" bench_results
+]}
diff --git a/doc/dune b/doc/dune
index ad4a2d9654..8e3771c8bf 100644
--- a/doc/dune
+++ b/doc/dune
@@ -22,17 +22,25 @@
 ;   odoc_for_authors.mld
 ;   parent_child_spec.mld))
 
+; The driver is also used to collect benchmarks. The benchmark result is always
+; generated but is promoted only by the @bench alias.
 (rule
- (alias docgen)
- (deps
-  (:x driver.mld)
-  (glob_files *.ml*)
-  (glob_files *.png)
-  (glob_files library_mlds/*.mld)
-  (package odoc))
+ (targets driver.mld.corrected driver-benchmarks.json)
  (enabled_if
   (> %{ocaml_version} 4.11))
+ (deps
+  (glob_files *.mld)
+  (glob_files library_mlds/*)
+  (glob_files examples/*.ml*))
+ (action
+  (progn
+   ; Make sure the benchmark result is created as Dune would not show the diff
+   ; if the script failed before creating it.
+   (write-file driver-benchmarks.json "")
+   (run ocaml-mdx-test --force-output %{dep:driver.mld}))))
+
+(rule
+ (alias docgen)
  (action
   (progn
-   (run ocaml-mdx-test %{x})
-   (diff? %{x} %{x}.corrected))))
+   (diff driver.mld driver.mld.corrected))))
diff --git a/dune b/dune
index 7fc2364be1..d30ceee584 100644
--- a/dune
+++ b/dune
@@ -8,3 +8,8 @@
  (release
   (flags
    (:standard -g -w -18-53))))
+
+(rule
+ (alias bench)
+ (action
+  (diff driver-benchmarks.json doc/driver-benchmarks.json)))