Something went wrong. Try again.
Odoc docs forked from jon.recoil.org/odd
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328(* Stats *)
(** Returns the [k] commands that took the most time for a given subcommand. *)
type stats = { mutable total_units : int Atomic.t; mutable total_impls : int Atomic.t; mutable total_mlds : int Atomic.t; mutable total_assets : int Atomic.t; mutable total_indexes : int Atomic.t; mutable non_hidden_units : int Atomic.t; mutable compiled_units : int Atomic.t; mutable compiled_impls : int Atomic.t; mutable compiled_mlds : int Atomic.t; mutable compiled_assets : int Atomic.t; mutable linked_units : int Atomic.t; mutable linked_impls : int Atomic.t; mutable linked_mlds : int Atomic.t; mutable generated_indexes : int Atomic.t; mutable generated_units : int Atomic.t; mutable processes : int Atomic.t; mutable process_activity : string Atomic.t Array.t; mutable finished : bool;}
let stats = { total_units = Atomic.make 0; total_impls = Atomic.make 0; total_mlds = Atomic.make 0; total_assets = Atomic.make 0; total_indexes = Atomic.make 0; non_hidden_units = Atomic.make 0; compiled_units = Atomic.make 0; compiled_impls = Atomic.make 0; compiled_mlds = Atomic.make 0; compiled_assets = Atomic.make 0; linked_units = Atomic.make 0; linked_impls = Atomic.make 0; linked_mlds = Atomic.make 0; generated_units = Atomic.make 0; generated_indexes = Atomic.make 0; processes = Atomic.make 0; process_activity = [||]; finished = false; }
let render_stats env ~generate_json nprocs = let if_app f = match Logs.level () with Some (App | Warning) | None -> f () | _ -> () in (* Avoids overkill indentation *) if_app @@ fun () -> let open Progress in let clock = Eio.Stdenv.clock env in let total = Atomic.get stats.total_units in let total_impls = Atomic.get stats.total_impls in let total_mlds = Atomic.get stats.total_mlds in let total_assets = Atomic.get stats.total_assets in let total_indexes = Atomic.get stats.total_indexes in let bar message total = let open Progress.Line in list [ lpad 16 (const message); bar total; rpad 10 (count_to total) ] in let procs total = let open Progress.Line in list [ lpad 16 (const "Processes"); bar total; rpad 10 (count_to total) ] in let description = let open Progress.Line in string in let descriptions = Multi.lines (List.init nprocs (fun _ -> description)) in
let non_hidden = Atomic.get stats.non_hidden_units in
let dline x y = Multi.line (bar x y) in let config = Progress.Config.v ~persistent:false () in let total_generate = let units = total_impls + non_hidden + total_mlds in if generate_json then 2 * units else units in with_reporters ~config Multi.( dline "Compiling" total ++ dline "Compiling impls" total_impls ++ dline "Compiling pages" total_mlds ++ dline "Compiling assets" total_assets ++ dline "Linking" non_hidden ++ dline "Linking impls" total_impls ++ dline "Linking mlds" total_mlds ++ dline "Indexes" total_indexes ++ dline "HTML" total_generate ++ line (procs nprocs) ++ descriptions) (fun comp compimpl compmld compassets link linkimpl linkmld indexes html procs descr -> let rec inner (a, b, c, j, d, e, f, i, g, h) = Eio.Time.sleep clock 0.1; let a' = Atomic.get stats.compiled_units in let b' = Atomic.get stats.compiled_impls in let c' = Atomic.get stats.compiled_mlds in let j' = Atomic.get stats.compiled_assets in let d' = Atomic.get stats.linked_units in let e' = Atomic.get stats.linked_impls in let f' = Atomic.get stats.linked_mlds in let i' = Atomic.get stats.generated_indexes in let g' = Atomic.get stats.generated_units in let h' = Atomic.get stats.processes in List.iteri (fun i descr -> descr (Atomic.get stats.process_activity.(i))) descr; comp (a' - a); compimpl (b' - b); compmld (c' - c); compassets (j' - j); link (d' - d); linkimpl (e' - e); linkmld (f' - f); indexes (i' - i); html (g' - g); procs (h' - h); if not stats.finished then inner (a', b', c', j', d', e', f', i', g', h') in inner (0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
let init_nprocs nprocs = stats.process_activity <- Array.init nprocs (fun _ -> Atomic.make "idle")
let pp_stats fmt stats = Fmt.pf fmt "Total units: %d\n\ Total impls: %d\n\ Total mlds: %d\n\ Non-hidden units: %d\n\ Compiled units: %d\n\ Compiled impls: %d\n\ Compiled mlds: %d\n\ Linked units: %d\n\ Linked impls: %d\n\ Linked mlds: %d\n\ Generated units: %d\n" (Atomic.get stats.total_units) (Atomic.get stats.total_impls) (Atomic.get stats.total_mlds) (Atomic.get stats.non_hidden_units) (Atomic.get stats.compiled_units) (Atomic.get stats.compiled_impls) (Atomic.get stats.compiled_mlds) (Atomic.get stats.linked_units) (Atomic.get stats.linked_impls) (Atomic.get stats.linked_mlds) (Atomic.get stats.generated_units)
let k_longest_commands cmd k = let open Run in filter_commands cmd |> List.sort (fun a b -> Float.compare b.time a.time) |> List.filteri (fun i _ -> i < k)
let dump () = let open Run in List.iter print_cmd (List.rev !commands); List.iter print_cmd (k_longest_commands "compile" 5); List.iter print_cmd (k_longest_commands "link" 5); List.iter print_cmd (k_longest_commands "html-generate" 5)
let rec compute_min_max_avg min_ max_ total count = function | [] -> (min_, max_, total /. float count, count) | hd :: tl -> compute_min_max_avg (min min_ hd) (max max_ hd) (total +. hd) (count + 1) tl
let compute_min_max_avg = function | [] -> None | hd :: tl -> Some (compute_min_max_avg hd hd hd 1 tl)
let compute_metric_int prefix suffix description values = match compute_min_max_avg values with | None -> [] | Some (min, max, avg, count) -> let min = int_of_float min in let max = int_of_float max in let avg = int_of_float avg in [ `Assoc [ ("name", `String (prefix ^ "-total-" ^ suffix)); ("value", `Int count); ("description", `String ("Number of " ^ description)); ]; `Assoc [ ("name", `String (prefix ^ "-size-" ^ suffix)); ( "value", `Assoc [ ("min", `Int min); ("max", `Int max); ("avg", `Int avg) ] ); ("units", `String "b"); ("description", `String ("Size of " ^ description)); ("trend", `String "lower-is-better"); ]; ]
let compute_metric_cmd cmd = let open Run in let cmds = filter_commands cmd in let times = List.map (fun c -> c.Run.time) cmds in match compute_min_max_avg times with | None -> [] | Some (min, max, avg, count) -> [ `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"); ]; ]
(** Analyze the size of files produced by a command. *)let compute_produced_cmd cmd = let output_file_size c = match c.Run.output_file with | Some f -> ( match Bos.OS.Path.stat f with | Ok st -> Some (float st.Unix.st_size) | Error _ -> None) | None -> None in let sizes = List.filter_map output_file_size (Run.filter_commands cmd) in compute_metric_int "produced" cmd ("files produced by 'odoc " ^ cmd ^ "'") sizes
(** Analyze the size of files outputed to the given directory. *)let compute_produced_tree cmd dir = let acc_file_sizes path acc = match Bos.OS.Path.stat path with | Ok st -> float st.Unix.st_size :: acc | Error _ -> acc in Bos.OS.Dir.fold_contents ~dotfiles:true ~elements:`Files acc_file_sizes [] dir |> Result.value ~default:[] |> compute_metric_int "produced" cmd ("files produced by 'odoc " ^ cmd ^ "'")
(** Analyze the running time of the slowest commands. *)let compute_longest_cmd cmd = let k = 5 in let cmds = k_longest_commands cmd k in let times = List.map (fun c -> c.Run.time) cmds in match compute_min_max_avg times with | None -> [] | Some (min, max, avg, _count) -> [ `Assoc [ ("name", `String ("longest-" ^ cmd)); ( "value", `Assoc [ ("min", `Float min); ("max", `Float max); ("avg", `Float avg); ] ); ("units", `String "s"); ( "description", `String (Printf.sprintf "Time taken by the %d longest calls to 'odoc %s'" k cmd) ); ("trend", `String "lower-is-better"); ]; ]
let all_metrics html_dir = compute_metric_cmd "compile" @ compute_metric_cmd "compile-deps" @ compute_metric_cmd "link" @ compute_metric_cmd "html-generate" @ compute_longest_cmd "compile" @ compute_longest_cmd "link" @ compute_produced_cmd "compile" @ compute_produced_cmd "link" @ compute_produced_tree "html-generate" html_dir
let bench_results html_dir = let result = `Assoc [ ("name", `String "odoc"); ( "results", `List [ `Assoc [ ("name", `String "driver.mld"); ("metrics", `List (all_metrics html_dir)); ]; ] ); ] in Yojson.to_file "driver-benchmarks.json" result
let total_time () = let open Run in let cmds = !commands in List.fold_left (fun acc c -> acc +. c.time) 0.0 cmds