You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
617 lines
22 KiB
617 lines
22 KiB
(*
|
|
* Copyright (c) Facebook, Inc. and its affiliates.
|
|
*
|
|
* This source code is licensed under the MIT license found in the
|
|
* LICENSE file in the root directory of this source tree.
|
|
*)
|
|
|
|
module Command = Core.Command
|
|
module Tbl = String.Tbl
|
|
|
|
let read filename =
|
|
let tbl = Tbl.create () in
|
|
List.iter (Sexp.load_sexps filename) ~f:(fun sexp ->
|
|
let {Report.name; entry} = Report.t_of_sexp sexp in
|
|
match (Tbl.find_opt tbl name, entry) with
|
|
| None, ProcessTimes ptimes -> Tbl.replace tbl name ([ptimes], [], [])
|
|
| None, GcStats gc -> Tbl.replace tbl name ([], [gc], [])
|
|
| None, Status status -> Tbl.replace tbl name ([], [], [status])
|
|
| Some (times, gcs, statuses), ProcessTimes ptimes ->
|
|
Tbl.replace tbl name (ptimes :: times, gcs, statuses)
|
|
| Some (times, gcs, statuses), GcStats gc ->
|
|
Tbl.replace tbl name (times, gc :: gcs, statuses)
|
|
| Some (times, gc, statuses), Status status ->
|
|
Tbl.replace tbl name (times, gc, status :: statuses) ) ;
|
|
tbl
|
|
|
|
type times = {etime: float; utime: float; stime: float}
|
|
|
|
type ('t, 'g) row =
|
|
{ name: string
|
|
; times: 't
|
|
; times_deltas: 't
|
|
; gcs: 'g
|
|
; gcs_deltas: 'g
|
|
; status: Report.status list
|
|
; status_deltas: Report.status list option }
|
|
|
|
let times_of_raw {Report.etime; utime; stime; cutime; cstime} =
|
|
let utime = utime +. cutime in
|
|
let stime = stime +. cstime in
|
|
let etime = etime in
|
|
{etime; utime; stime}
|
|
|
|
let add_time base_times ptimes row =
|
|
let tustimes = times_of_raw ptimes in
|
|
let times = tustimes :: row.times in
|
|
let times_deltas =
|
|
Option.fold base_times row.times_deltas
|
|
~f:(fun {etime= btt; utime= but; stime= bst} times_deltas ->
|
|
let {etime= tt; utime= ut; stime= st} = tustimes in
|
|
{etime= tt -. btt; utime= ut -. but; stime= st -. bst}
|
|
:: times_deltas )
|
|
in
|
|
{row with times; times_deltas}
|
|
|
|
let add_times base_times times row =
|
|
if List.is_empty times then
|
|
{row with times_deltas= Option.to_list base_times}
|
|
else List.fold ~f:(add_time base_times) times row
|
|
|
|
let add_gc base_gcs gc row =
|
|
let gcs = gc :: row.gcs in
|
|
let gcs_deltas =
|
|
Option.fold base_gcs row.gcs_deltas ~f:(fun bgc gcs_deltas ->
|
|
Report.
|
|
{ allocated= gc.allocated -. bgc.allocated
|
|
; promoted= gc.promoted -. bgc.promoted
|
|
; peak_size= gc.peak_size -. bgc.peak_size }
|
|
:: gcs_deltas )
|
|
in
|
|
{row with gcs; gcs_deltas}
|
|
|
|
let add_gcs base_gcs gcs row =
|
|
if List.is_empty gcs then {row with gcs_deltas= Option.to_list base_gcs}
|
|
else List.fold ~f:(add_gc base_gcs) gcs row
|
|
|
|
let add_status base_status status row =
|
|
if List.mem ~eq:Report.equal_status status row.status then row
|
|
else
|
|
match base_status with
|
|
| Some base_status
|
|
when not (List.mem ~eq:Report.equal_status status base_status) ->
|
|
{ row with
|
|
status= status :: row.status
|
|
; status_deltas=
|
|
Some (base_status @ Option.value row.status_deltas ~default:[])
|
|
}
|
|
| _ -> {row with status= status :: row.status}
|
|
|
|
let add_statuses base_status statuses row =
|
|
List.fold ~f:(add_status base_status) statuses row
|
|
|
|
let ave_floats flts =
|
|
assert (not (Iter.is_empty flts)) ;
|
|
let min, max, sum, num =
|
|
Iter.fold flts (Float.infinity, Float.neg_infinity, 0., 0)
|
|
~f:(fun flt (min, max, sum, num) ->
|
|
(Float.min min flt, Float.max max flt, sum +. flt, num + 1) )
|
|
in
|
|
if num >= 5 then (sum -. min -. max) /. Float.of_int (num - 2)
|
|
else sum /. Float.of_int num
|
|
|
|
let combine name b_result c_result =
|
|
let base_times, base_gcs, base_status =
|
|
match b_result with
|
|
| Some (times, gcs, statuses) ->
|
|
let times =
|
|
if List.is_empty times then None
|
|
else
|
|
let etimes, utimes, stimes, cutimes, cstimes =
|
|
let init =
|
|
(Iter.empty, Iter.empty, Iter.empty, Iter.empty, Iter.empty)
|
|
in
|
|
List.fold times init
|
|
~f:(fun {Report.etime; utime; stime; cutime; cstime}
|
|
(etimes, utimes, stimes, cutimes, cstimes)
|
|
->
|
|
( Iter.cons etime etimes
|
|
, Iter.cons utime utimes
|
|
, Iter.cons stime stimes
|
|
, Iter.cons cutime cutimes
|
|
, Iter.cons cstime cstimes ) )
|
|
in
|
|
Some
|
|
(times_of_raw
|
|
{ etime= ave_floats etimes
|
|
; utime= ave_floats utimes
|
|
; stime= ave_floats stimes
|
|
; cutime= ave_floats cutimes
|
|
; cstime= ave_floats cstimes })
|
|
in
|
|
let gcs =
|
|
if List.is_empty gcs then None
|
|
else
|
|
let allocs, promos, peaks =
|
|
List.fold gcs (Iter.empty, Iter.empty, Iter.empty)
|
|
~f:(fun {Report.allocated; promoted; peak_size}
|
|
(allocs, promos, peaks)
|
|
->
|
|
( Iter.cons allocated allocs
|
|
, Iter.cons promoted promos
|
|
, Iter.cons peak_size peaks ) )
|
|
in
|
|
Some
|
|
Report.
|
|
{ allocated= ave_floats allocs
|
|
; promoted= ave_floats promos
|
|
; peak_size= ave_floats peaks }
|
|
in
|
|
let status =
|
|
Some (List.sort_uniq ~cmp:Report.compare_status statuses)
|
|
in
|
|
(times, gcs, status)
|
|
| None -> (None, None, None)
|
|
in
|
|
let row =
|
|
{ name
|
|
; times= []
|
|
; times_deltas= []
|
|
; gcs= []
|
|
; gcs_deltas= []
|
|
; status= []
|
|
; status_deltas= None }
|
|
in
|
|
match c_result with
|
|
| None ->
|
|
let times_deltas = Option.to_list base_times in
|
|
let gcs_deltas = Option.to_list base_gcs in
|
|
let status_deltas = base_status in
|
|
{row with times_deltas; gcs_deltas; status_deltas}
|
|
| Some (c_times, c_gcs, c_statuses) ->
|
|
row
|
|
|> add_times base_times c_times
|
|
|> add_gcs base_gcs c_gcs
|
|
|> add_statuses base_status c_statuses
|
|
|
|
type ranges =
|
|
{ max_time: float
|
|
; pct_time: float
|
|
; max_alloc: float
|
|
; pct_alloc: float
|
|
; max_promo: float
|
|
; pct_promo: float
|
|
; max_peak: float
|
|
; pct_peak: float }
|
|
|
|
let ranges rows =
|
|
let init =
|
|
{ max_time= 0.
|
|
; pct_time= 0.
|
|
; max_alloc= 0.
|
|
; pct_alloc= 0.
|
|
; max_promo= 0.
|
|
; pct_promo= 0.
|
|
; max_peak= 0.
|
|
; pct_peak= 0. }
|
|
in
|
|
Iter.fold rows init ~f:(fun {times; times_deltas; gcs; gcs_deltas} acc ->
|
|
Option.fold times_deltas acc ~f:(fun deltas acc ->
|
|
let max_time = Float.max acc.max_time (Float.abs deltas.etime) in
|
|
let pct_time =
|
|
Option.fold times acc.pct_time ~f:(fun times pct_time ->
|
|
let pct = 100. *. deltas.etime /. times.etime in
|
|
Float.max pct_time (Float.abs pct) )
|
|
in
|
|
{acc with max_time; pct_time} )
|
|
|> fun acc ->
|
|
Option.fold gcs_deltas acc ~f:(fun deltas acc ->
|
|
let max_alloc = Float.max acc.max_alloc deltas.Report.allocated in
|
|
let pct_alloc =
|
|
Option.fold gcs acc.pct_alloc ~f:(fun gcs pct_alloc ->
|
|
let pct =
|
|
100. *. deltas.Report.allocated /. gcs.Report.allocated
|
|
in
|
|
Float.max pct_alloc (Float.abs pct) )
|
|
in
|
|
let max_promo = Float.max acc.max_promo deltas.Report.promoted in
|
|
let pct_promo =
|
|
Option.fold gcs acc.pct_promo ~f:(fun gcs pct_promo ->
|
|
let pct =
|
|
100. *. deltas.Report.promoted /. gcs.Report.promoted
|
|
in
|
|
Float.max pct_promo (Float.abs pct) )
|
|
in
|
|
let max_peak = Float.max acc.max_peak deltas.Report.peak_size in
|
|
let pct_peak =
|
|
Option.fold gcs acc.pct_peak ~f:(fun gcs pct_peak ->
|
|
let pct =
|
|
100. *. deltas.Report.peak_size /. gcs.Report.peak_size
|
|
in
|
|
Float.max pct_peak (Float.abs pct) )
|
|
in
|
|
{ acc with
|
|
max_alloc
|
|
; pct_alloc
|
|
; max_promo
|
|
; pct_promo
|
|
; max_peak
|
|
; pct_peak } ) )
|
|
|
|
let color max dat =
|
|
(* linear interpolation mapping -1 to green, 0 to lace, and 1 to red *)
|
|
let green = (133., 153., 0.) in
|
|
let lace = (253., 246., 227.) in
|
|
let red = (220., 50., 47.) in
|
|
let gradient x =
|
|
let scale x (r0, g0, b0) (r1, g1, b1) =
|
|
let scale1 x c0 c1 = (x *. (c1 -. c0)) +. c0 in
|
|
(scale1 x r0 r1, scale1 x g0 g1, scale1 x b0 b1)
|
|
in
|
|
let x = Float.max (-1.) (Float.min x 1.) in
|
|
if Float.(x < 0.) then scale (-.x) lace green else scale x lace red
|
|
in
|
|
let rgb_to_hex (r, g, b) =
|
|
let to_int x = Int.min 255 (Int.max 0 (Float.to_int x)) in
|
|
Printf.sprintf "#%2x%2x%2x" (to_int r) (to_int g) (to_int b)
|
|
in
|
|
let rat = dat /. max in
|
|
if Float.is_nan rat then rgb_to_hex lace else rgb_to_hex (gradient rat)
|
|
|
|
let write_html ranges rows chan =
|
|
let pf fmt = Printf.fprintf chan fmt in
|
|
pf "<html><head><title>Test results</title><style>\n" ;
|
|
pf ".base2 { background-color: #eee8d5; }\n" ;
|
|
pf ".regress { background-color: #dc322f; }\n" ;
|
|
pf ".neutral { background-color: #b58900; }\n" ;
|
|
pf ".improve { background-color: #859900; }\n" ;
|
|
pf "th { background-color: #eee8d5; position: sticky; top: 0; }" ;
|
|
pf "th, td { padding: 5px; }\n" ;
|
|
pf "</style></head>\n" ;
|
|
pf "<body style=\"background-color:#fdf6e3\">" ;
|
|
pf
|
|
{|<table style="border-collapse: collapse"><tr>
|
|
<th>Test</th>
|
|
<th>elapsed<br>(sec)</th>
|
|
<th>Δ<br></th>
|
|
<th>Δ%%<br></th>
|
|
<th>user<br>(sec)</th>
|
|
<th>Δ<br></th>
|
|
<th>Δ%%<br></th>
|
|
<th>system<br>(sec)</th>
|
|
<th>Δ<br></th>
|
|
<th>Δ%%<br></th>
|
|
<th>alloc<br>(MB)</th>
|
|
<th>Δ<br></th>
|
|
<th>Δ%%<br></th>
|
|
<th>promo<br>(MB)</th>
|
|
<th>Δ<br></th>
|
|
<th>Δ%%<br></th>
|
|
<th>peak<br>(MB)</th>
|
|
<th>Δ<br></th>
|
|
<th>Δ%%<br></th>
|
|
<th>Status</th>
|
|
<th>Δ<br></th>
|
|
</tr>
|
|
|} ;
|
|
Iter.iter rows ~f:(fun row ->
|
|
let {name; times; times_deltas; gcs; gcs_deltas; status; status_deltas}
|
|
=
|
|
row
|
|
in
|
|
let max_name_length = 50 in
|
|
let name =
|
|
if String.length name <= max_name_length then name
|
|
else
|
|
let len = max_name_length / 2 in
|
|
String.take len name ^ "…" ^ String.rtake len name
|
|
in
|
|
let time ppf t =
|
|
Printf.fprintf ppf
|
|
"<td style=\"border-left: 2px solid #eee8d5\"; \
|
|
align=\"right\">%12.3f</td>\n"
|
|
t
|
|
in
|
|
let nondelta ppf t =
|
|
Printf.fprintf ppf "<td align=\"right\">%12.3f</td>\n" t
|
|
in
|
|
let delta max pct t ppf d =
|
|
let r = 100. *. d /. t in
|
|
Printf.fprintf ppf
|
|
"<td align=\"right\" bgcolor=\"%s\">%12.3f</td>\n\
|
|
<td align=\"right\" bgcolor=\"%s\">%12.2f%%</td>\n"
|
|
(color max d) d (color pct r) r
|
|
in
|
|
let timed = delta ranges.max_time ranges.pct_time in
|
|
let allocd = delta ranges.max_alloc ranges.pct_alloc in
|
|
let promod = delta ranges.max_promo ranges.pct_promo in
|
|
let peakd = delta ranges.max_peak ranges.pct_peak in
|
|
let pf_status ppf s =
|
|
let status_to_string = Format.asprintf "%a" Report.pp_status in
|
|
Printf.fprintf ppf "%s" (String.take 50 (status_to_string s))
|
|
in
|
|
let stat ppf = function
|
|
| [] ->
|
|
Printf.fprintf ppf
|
|
"<td style=\"border-left: 2px solid #eee8d5\";></td>\n"
|
|
| ss ->
|
|
List.iter ss ~f:(fun s ->
|
|
match (s : Report.status) with
|
|
| Safe _ | Unsafe _ | Ok ->
|
|
Printf.fprintf ppf
|
|
"<td style=\"border-left: 2px solid #eee8d5\";>%a</td>\n"
|
|
pf_status s
|
|
| _ ->
|
|
Printf.fprintf ppf
|
|
"<td style=\"border-left: 2px solid #eee8d5\"; \
|
|
class=\"regress\">%a</td>\n"
|
|
pf_status s )
|
|
in
|
|
let statd ppf = function
|
|
| None | Some [] -> Printf.fprintf ppf "<td></td>\n"
|
|
| Some ss ->
|
|
Printf.fprintf ppf "<td class=\"neutral\">" ;
|
|
List.iter ss ~f:(fun s -> Printf.fprintf ppf "%a" pf_status s) ;
|
|
Printf.fprintf ppf "</td>\n"
|
|
in
|
|
pf "<tr>" ;
|
|
pf "<td>%s</td>" name ;
|
|
( match (times, times_deltas) with
|
|
| ( Some {etime; utime; stime}
|
|
, Some {etime= etime_delta; utime= utime_delta; stime= stime_delta}
|
|
) ->
|
|
pf "%a%a%a%a%a%a" time etime (timed etime) etime_delta time utime
|
|
(timed utime) utime_delta time stime (timed stime) stime_delta
|
|
| Some {etime; utime; stime}, None ->
|
|
pf
|
|
"%a<td></td><td></td>\n\
|
|
%a<td></td><td></td>\n\
|
|
%a<td></td><td></td>\n"
|
|
time etime time utime time stime
|
|
| None, Some {etime; utime; stime} ->
|
|
pf
|
|
"<td style=\"border-left: 2px solid #eee8d5\";></td>%a<td></td>\n\
|
|
<td style=\"border-left: 2px solid #eee8d5\";></td>%a<td></td>\n\
|
|
<td style=\"border-left: 2px solid #eee8d5\";></td>%a<td></td>\n"
|
|
nondelta etime nondelta utime nondelta stime
|
|
| None, None ->
|
|
pf
|
|
"<td style=\"border-left: 2px solid \
|
|
#eee8d5\";></td><td></td><td></td>\n\
|
|
<td style=\"border-left: 2px solid \
|
|
#eee8d5\";></td><td></td><td></td>\n\
|
|
<td style=\"border-left: 2px solid \
|
|
#eee8d5\";></td><td></td><td></td>\n" ) ;
|
|
( match (gcs, gcs_deltas) with
|
|
| ( Some {Report.allocated; promoted; peak_size}
|
|
, Some
|
|
{ allocated= allocated_delta
|
|
; promoted= promoted_delta
|
|
; peak_size= peak_size_delta } ) ->
|
|
pf "%a%a%a%a%a%a" time allocated (allocd allocated)
|
|
allocated_delta time promoted (promod promoted) promoted_delta
|
|
time peak_size (peakd peak_size) peak_size_delta
|
|
| Some {allocated; promoted; peak_size}, None ->
|
|
pf
|
|
"%a<td></td><td></td>\n\
|
|
%a<td></td><td></td>\n\
|
|
%a<td></td><td></td>\n"
|
|
time allocated time promoted time peak_size
|
|
| None, Some {allocated; promoted; peak_size} ->
|
|
pf
|
|
"<td style=\"border-left: 2px solid #eee8d5\";></td>%a<td></td>\n\
|
|
<td style=\"border-left: 2px solid #eee8d5\";></td>%a<td></td>\n\
|
|
<td style=\"border-left: 2px solid #eee8d5\";></td>%a<td></td>\n"
|
|
nondelta allocated nondelta promoted nondelta peak_size
|
|
| None, None ->
|
|
pf
|
|
"<td style=\"border-left: 2px solid \
|
|
#eee8d5\";></td><td></td><td></td>\n\
|
|
<td style=\"border-left: 2px solid \
|
|
#eee8d5\";></td><td></td><td></td>\n\
|
|
<td style=\"border-left: 2px solid \
|
|
#eee8d5\";></td><td></td><td></td>\n" ) ;
|
|
pf "%a%a" stat status statd status_deltas ;
|
|
pf "</tr>\n" ) ;
|
|
pf "<table>\n" ;
|
|
pf "</body></html>\n"
|
|
|
|
let average row =
|
|
let ave_times times =
|
|
if List.is_empty times then None
|
|
else
|
|
let etimes, utimes, stimes =
|
|
List.fold times (Iter.empty, Iter.empty, Iter.empty)
|
|
~f:(fun {etime; utime; stime} (etimes, utimes, stimes) ->
|
|
( Iter.cons etime etimes
|
|
, Iter.cons utime utimes
|
|
, Iter.cons stime stimes ) )
|
|
in
|
|
Some
|
|
{ etime= ave_floats etimes
|
|
; utime= ave_floats utimes
|
|
; stime= ave_floats stimes }
|
|
in
|
|
let times = ave_times row.times in
|
|
let times_deltas = ave_times row.times_deltas in
|
|
let ave_gcs gcs =
|
|
if List.is_empty gcs then None
|
|
else
|
|
let alloc, promo, peak =
|
|
List.fold gcs (Iter.empty, Iter.empty, Iter.empty)
|
|
~f:(fun {Report.allocated; promoted; peak_size}
|
|
(alloc, promo, peak)
|
|
->
|
|
( Iter.cons allocated alloc
|
|
, Iter.cons promoted promo
|
|
, Iter.cons peak_size peak ) )
|
|
in
|
|
Some
|
|
Report.
|
|
{ allocated= ave_floats alloc
|
|
; promoted= ave_floats promo
|
|
; peak_size= ave_floats peak }
|
|
in
|
|
let gcs = ave_gcs row.gcs in
|
|
let gcs_deltas = ave_gcs row.gcs_deltas in
|
|
{row with times; times_deltas; gcs; gcs_deltas}
|
|
|
|
let add_total rows =
|
|
let init =
|
|
{ name= "TOTAL"
|
|
; times= Some {etime= 0.; utime= 0.; stime= 0.}
|
|
; times_deltas= Some {etime= 0.; utime= 0.; stime= 0.}
|
|
; gcs= Some {Report.allocated= 0.; promoted= 0.; peak_size= 0.}
|
|
; gcs_deltas= Some {Report.allocated= 0.; promoted= 0.; peak_size= 0.}
|
|
; status= []
|
|
; status_deltas= None }
|
|
in
|
|
let total =
|
|
Iter.fold rows init ~f:(fun total row ->
|
|
let times =
|
|
match (total.times, row.times) with
|
|
| Some total_times, Some row_times ->
|
|
Some
|
|
{ etime= total_times.etime +. row_times.etime
|
|
; utime= total_times.utime +. row_times.utime
|
|
; stime= total_times.stime +. row_times.stime }
|
|
| _ -> total.times
|
|
in
|
|
let times_deltas =
|
|
match (total.times_deltas, row.times_deltas) with
|
|
| Some total_deltas, Some row_deltas ->
|
|
Some
|
|
{ etime= total_deltas.etime +. row_deltas.etime
|
|
; utime= total_deltas.utime +. row_deltas.utime
|
|
; stime= total_deltas.stime +. row_deltas.stime }
|
|
| _ -> total.times_deltas
|
|
in
|
|
let gcs =
|
|
match (total.gcs, row.gcs) with
|
|
| Some total_gcs, Some row_gcs ->
|
|
Some
|
|
Report.
|
|
{ allocated= total_gcs.allocated +. row_gcs.allocated
|
|
; promoted= total_gcs.promoted +. row_gcs.promoted
|
|
; peak_size= total_gcs.peak_size +. row_gcs.peak_size }
|
|
| _ -> total.gcs
|
|
in
|
|
let gcs_deltas =
|
|
match (total.gcs_deltas, row.gcs_deltas) with
|
|
| Some total_deltas, Some row_deltas ->
|
|
Some
|
|
Report.
|
|
{ allocated= total_deltas.allocated +. row_deltas.allocated
|
|
; promoted= total_deltas.promoted +. row_deltas.promoted
|
|
; peak_size=
|
|
total_deltas.peak_size +. row_deltas.peak_size }
|
|
| _ -> total.gcs_deltas
|
|
in
|
|
let status_deltas =
|
|
if
|
|
Option.is_some total.status_deltas
|
|
|| Option.is_some row.status_deltas
|
|
then Some []
|
|
else None
|
|
in
|
|
{total with times; times_deltas; gcs; gcs_deltas; status_deltas} )
|
|
in
|
|
Iter.cons total rows
|
|
|
|
let cmp x y =
|
|
match (x.status_deltas, y.status_deltas) with
|
|
| Some xs, Some ys ->
|
|
List.compare Report.compare_status xs ys
|
|
|> fun o -> if o <> 0 then o else String.compare x.name y.name
|
|
| Some _, None -> -1
|
|
| None, Some _ -> 1
|
|
| None, None -> (
|
|
match (x.times_deltas, y.times_deltas) with
|
|
| Some xtd, Some ytd -> Float.(compare (abs ytd.utime) (abs xtd.utime))
|
|
| Some _, None -> 1
|
|
| None, Some _ -> -1
|
|
| None, None -> String.compare x.name y.name )
|
|
|
|
let filter rows =
|
|
Iter.filter rows ~f:(fun {status} ->
|
|
List.exists status ~f:(function Unimplemented _ -> false | _ -> true) )
|
|
|
|
let input_rows ?baseline current =
|
|
let b_tbl = Option.map ~f:read baseline in
|
|
let c_tbl = read current in
|
|
let names =
|
|
let keys = Tbl.keys c_tbl in
|
|
let keys =
|
|
Option.fold ~f:(fun t -> Iter.append (Tbl.keys t)) b_tbl keys
|
|
in
|
|
Iter.sort_uniq ~cmp:String.compare keys
|
|
in
|
|
Iter.map names ~f:(fun name ->
|
|
let opt_find_opt t n = Option.bind ~f:(fun t -> Tbl.find_opt t n) t in
|
|
let b_result = opt_find_opt b_tbl name in
|
|
let c_result = Tbl.find_opt c_tbl name in
|
|
combine name b_result c_result )
|
|
|
|
let generate_html ?baseline current output =
|
|
let rows = input_rows ?baseline current in
|
|
let rows = Iter.map ~f:average rows in
|
|
let ranges = ranges rows in
|
|
let rows = filter rows in
|
|
let rows = add_total rows in
|
|
let rows = Iter.sort ~cmp rows in
|
|
Out_channel.with_file output ~f:(write_html ranges rows)
|
|
|
|
let html_cmd =
|
|
let open Command.Let_syntax in
|
|
let%map_open baseline =
|
|
flag "baseline" (optional string)
|
|
~doc:"<file> read baseline results from report <file>"
|
|
and current = anon ("<file>" %: string)
|
|
and output =
|
|
flag "output" (required string)
|
|
~doc:"<file> write html report to <file>"
|
|
in
|
|
fun () -> generate_html ?baseline current output
|
|
|
|
let write_status rows chan =
|
|
let rows =
|
|
Iter.filter rows ~f:(fun row -> Option.is_some row.status_deltas)
|
|
in
|
|
let rows =
|
|
Iter.sort ~cmp:(fun x y -> String.compare x.name y.name) rows
|
|
in
|
|
let ppf = Format.formatter_of_out_channel chan in
|
|
Iter.iter rows ~f:(fun {name; status; status_deltas} ->
|
|
Format.fprintf ppf "%s:\t%a%a@\n" name
|
|
(List.pp ", " Report.pp_status)
|
|
status
|
|
(Option.pp "\t%a" (List.pp ", " Report.pp_status))
|
|
status_deltas )
|
|
|
|
let generate_status ?baseline current output =
|
|
let rows = input_rows ?baseline current in
|
|
match output with
|
|
| None -> write_status rows Out_channel.stdout
|
|
| Some output -> Out_channel.with_file output ~f:(write_status rows)
|
|
|
|
let status_cmd =
|
|
let open Command.Let_syntax in
|
|
let%map_open baseline =
|
|
flag "baseline" (optional string)
|
|
~doc:"<file> read baseline results from report <file>"
|
|
and current = anon ("<file>" %: string)
|
|
and output =
|
|
flag "output" (optional string)
|
|
~doc:
|
|
"<file> write status report to <file>, or to standard output if \
|
|
omitted"
|
|
in
|
|
fun () -> generate_status ?baseline current output
|
|
|
|
;;
|
|
Command.run
|
|
(Command.group ~summary:"SLEdge report manipulation"
|
|
[ ("html", Command.basic ~summary:"generate html report" html_cmd)
|
|
; ("status", Command.basic ~summary:"generate status report" status_cmd)
|
|
])
|