Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
7.7 kB · 215 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216type check = | Waiting of { attempt : int; seconds : int } | Preparing of { attempt : int; seconds : int } | Running of { attempt : int; seconds : int } | Ended of { result : Check.result; seconds : int; attempt : int; stopped : string option; } | Reused of { result : Check.result }
type checks = { checks : (Check.name * check) list; past : int option }
let seconds_since ~now t = max 0 (int_of_float (Ptime.Span.to_float_s (Ptime.diff now t)))
(* Where a check stands at [now], from the instant it got there; an ended run's time is its own. *)let since make t ~now = make (seconds_since ~now t)let stays c ~now:_ = c
let checks ~now story = let step (acc, last) (time, (k : Event.kind)) = let set check st = match acc with | None -> None | Some l -> Some (List.map (fun (c, s) -> if Check.equal_name c check then (c, st) else (c, s)) l) in match k with | Event.Checking { checks; _ } -> let waiting = since (fun seconds -> Waiting { attempt = 1; seconds }) in (Some (List.map (fun c -> (c, waiting time)) checks), None) | Event.Check_started { check; attempt; phase = Preparing; _ } -> ( set check (since (fun seconds -> Preparing { attempt; seconds }) time), last ) | Event.Check_started { check; attempt; phase = Running; _ } -> ( set check (since (fun seconds -> Running { attempt; seconds }) time), last ) | Event.Check { check; attempt; rerun = true; _ } -> ( set check (since (fun seconds -> Waiting { attempt = attempt + 1; seconds }) time), last ) | Event.Check { check; result; seconds; attempt; stopped; _ } -> ( set check (stays (Ended { result; seconds; attempt; stopped })), Some time ) | Event.Reused { check; result; _ } -> (set check (stays (Reused { result })), Some time) | _ -> (acc, last) in match List.fold_left step (None, None) story with | None, _ -> None | Some l, last -> let checks = List.map (fun (c, at) -> (c, at ~now)) l in let ended = function Ended _ | Reused _ -> true | _ -> false in let past = match last with | Some t when List.for_all (fun (_, c) -> ended c) checks -> Some (seconds_since ~now t) | _ -> None in Some { checks; past }
let check_words = function | Waiting _ -> "waiting to start" | Preparing _ -> "preparing" | Running { attempt = 1; _ } -> "running" | Running _ -> "running its rerun" | Ended { result; _ } -> Check.string_of_result result | Reused _ -> "reused"
let check_seconds = function | Waiting { seconds; _ } | Preparing { seconds; _ } | Running { seconds; _ } | Ended { seconds; _ } -> Some seconds | Reused _ -> None
let pp_check ppf (name, c) = Fmt.pf ppf "%a %s" Check.pp_name name (check_words c); Option.iter (fun s -> Fmt.pf ppf " (%a)" Duration.pp (Duration.of_seconds s)) (check_seconds c)
let pp_checks ppf { checks; past } = Fmt.(list ~sep:(any ", ") pp_check) ppf checks; Option.iter (fun s -> Fmt.pf ppf "; past its checks for %a" Duration.pp (Duration.of_seconds s)) past
type t = | Landing of { branch : Branch.t; target : Branch.t; commits : int; dry_run : bool; source_of : Branch.t option; } | Checking of { branch : Branch.t; target : Branch.t; checks : Check.name list; } | Checked of { branch : Branch.t; check : Check.name; result : Check.result; seconds : int; attempt : int; log : Fpath.t option; stopped : string option; } | Rerunning of { branch : Branch.t; check : Check.name } | Running of { branch : Branch.t; checks : checks } | Moving of { branch : Branch.t; target : Branch.t } | Line of string
let of_event branch : Event.kind -> t list = function | Replaying { target; _ } -> [ Fmt.kstr (fun s -> Line s) "replaying %a onto %a" Branch.pp branch Branch.pp target; ] | Checking { target; checks } -> [ Checking { branch; target; checks } ] | Stage { name; _ } when String.equal name Event.preparing -> [] | Stage { name; seconds = None } -> [ Fmt.kstr (fun s -> Line s) "%a: %s started" Branch.pp branch name ] | Stage { name; seconds = Some seconds } -> [ Fmt.kstr (fun s -> Line s) "%a: %s ended (%a)" Branch.pp branch name Duration.pp (Duration.of_seconds seconds); ] | Check { check; result; seconds; attempt; rerun; log; stopped; _ } -> Checked { branch; check; result; seconds; attempt; log; stopped } :: (if rerun then [ Rerunning { branch; check } ] else []) | Probe_started p -> [ Fmt.kstr (fun s -> Line s) "probing %a: prefix %d of %d, to %a at %s" Branch.pp branch p.length p.suspects Branch.pp p.last (Commit.short p.commit); ] | Probed { prefix = p; verdict; seconds } -> [ Fmt.kstr (fun s -> Line s) "%a: prefix %d of %d %s (%a)" Branch.pp branch p.length p.suspects (match verdict with | Some Bisect.Passed -> "passed" | Some Bisect.Failed -> "failed" | None -> "could not settle") Duration.pp (Duration.of_seconds seconds); ] | _ -> []
let names cs = String.concat " " (List.map Check.string_of_name cs)let plural n word = Fmt.str "%d %s%s" n word (if n = 1 then "" else "s")
(* A run's line says which run it is: a rerun's says what the two runs make. *)let ran ~result ~seconds ~attempt = let took = Duration.of_seconds seconds in match (attempt, result) with | 1, _ -> Fmt.str "%s (%a)" (Check.string_of_result result) Duration.pp took | _, Check.Failed -> Fmt.str "failed again (%a): a red, not a flake" Duration.pp took | _, Check.Passed -> Fmt.str "passed on the rerun (%a): a flake, recorded" Duration.pp took | _, Check.Inherited -> Fmt.str "inherited again (%a): red only as the target's tip is" Duration.pp took | _, (Check.Stuck | Check.Error | Check.Stopped) -> Fmt.str "%s on the rerun (%a)" (Check.string_of_result result) Duration.pp took
let pp ppf = function | Landing { branch; target; commits; dry_run; source_of } -> let verb, prep = if dry_run then ("checking", "on") else ("landing", "into") in Fmt.pf ppf "%s %a %s %a%a: %s" verb Branch.pp branch prep Branch.pp target Fmt.(option (any ", " ++ Branch.pp ++ any "'s source")) source_of (if commits = 0 then "the lock commit" else plural commits "commit") | Checking { branch; checks; _ } -> Fmt.pf ppf "checking %a: %s" Branch.pp branch (names checks) | Checked { branch; check; result; seconds; attempt; stopped; _ } -> Fmt.pf ppf "%a: check %a %s%a" Branch.pp branch Check.pp_name check (ran ~result ~seconds ~attempt) Fmt.(option (any " because " ++ string)) stopped | Rerunning { branch; check } -> Fmt.pf ppf "rerunning %a: %a once, to tell a flake from a red" Branch.pp branch Check.pp_name check | Running { branch; checks = { checks = []; _ } } -> Fmt.pf ppf "checking %a" Branch.pp branch | Running { branch; checks } -> Fmt.pf ppf "checking %a: %a" Branch.pp branch pp_checks checks | Moving { branch; target } -> Fmt.pf ppf "fast-forwarding %a to %a" Branch.pp target Branch.pp branch | Line s -> Fmt.string ppf s