Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
10 kB · 264 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265(* Pace: the queue's pace over a window, from the samples records give (lib/pace.mli, lib/sample.mli; doc/commands.md, mq status's pace line and mq stats's pace; doc/refs.md, j_samples). Each figure is derived by hand from the trace below. *)
open Merge_queue
let b = Branch.v
let time d h m s = Option.get (Ptime.of_date_time ((2026, 10, d), ((h, m, s), 0)))
let now = time 2 12 0 0let since = time 1 12 0 0let first = time 1 18 0 0let staging = b "staging"let main = b "main"let alice = Caller.v ~user:"alice" (Host.v "laptop")let event ?branch t kind = Event.v alice ~time:t ?branch kindlet commit c = Option.get (Commit.of_hex (String.make 40 c))let tree = Option.get (Tree.of_hex (String.make 40 'd'))let submission = Submission.v ~description:Description.empty []
(* A landing into [target] at [at], with the four phases of its time, in seconds, when given. *)let landed ?phases name target at = let time = Option.map (fun (q, r, c, m) -> let after s = Option.get (Ptime.add_span at (Ptime.Span.of_int_s s)) in let total = q + r + c + m in Lead.v ~queued:(after (-total)) ~taken:(after (-(r + c + m))) ~checking:(after (-(c + m))) ~checked:(after (-m)) ~landed:at ~runs:c) phases in let outcome = Outcome.v ~branch:(b name) ~target:(Outcome.Into target) ?time Outcome.Landed "detail" in let landing = Landing.v ~submission ~tree ~checks:[] ~name:(b name) ~queued:(commit 'a') ~target ~was:(commit 'b') ~landed:(commit 'c') ~commits:1 () in event ~branch:(b name) at (Event.Landed (outcome, landing))
let stage ?seconds name branch at = event ~branch:(b branch) at (Event.Stage { name; seconds })
let idled target at span = event ~branch:target at (Event.Idled span)
let stuck check branch at = event ~branch:(b branch) at (Event.check ~key:(Key.of_tree tree) ~result:Check.Stuck ~seconds:600 ~attempt:1 ~rerun:false (Result.get_ok (Check.name_of_string check)))
let trace = [ (* Before the window: not counted. *) landed "old" staging (time 1 10 0 0) ~phases:(1, 1, 1, 1); landed "a" staging (time 2 9 0 0) ~phases:(600, 10, 300, 50); stage "moving target" "a" (time 2 9 0 0) ~seconds:40; stage "moving target" "b" (time 2 11 28 0); idled staging (time 2 10 0 0) { Idle.ms = 60_000; idle = 6; waiting = 1; holds = [ ("stacked", 1) ] }; stuck "suite" "a" (time 2 11 0 0); landed "b" staging (time 2 11 30 0) ~phases:(1200, 20, 600, 100); stage "moving target" "b" (time 2 11 30 0) ~seconds:120; stage "tidy: reading" "b" (time 2 11 31 0) ~seconds:30; landed "d" main (time 2 11 40 0) ~phases:(60, 0, 0, 30); idled staging (time 2 11 45 0) { Idle.ms = 600_000; idle = 3; waiting = 4; holds = [ ("behind", 3); ("cone", 1) ]; }; landed "c" staging (time 2 11 50 0); ]
let samples = List.concat_map (fun (e : Event.t) -> List.map (fun s -> (e.time, s)) (Sample.of_event e)) trace
let pace = Pace.v ~now ~since ~first:(Some first) ~slots:6 samples
let target name = List.find (fun (x : Pace.target) -> Branch.equal x.target (b name)) pace.targets
(* sample.mli, of_event: one sample per quantity a record measures; a stage that starts measures nothing, nor does a record of no measure. A landing's is named by its key: the branch, the target and the commits it moved the target between. *)let range = String.make 40 'b' ^ ".." ^ String.make 40 'c'
let test_samples () = let words e = List.map (Fmt.str "%a" Sample.pp) (Sample.of_event e) in Alcotest.(check (list string)) "a timed landing" [ "landed a staging " ^ range ^ " on staging: 960000ms"; "lead queued on staging: 600000ms"; "lead replaying on staging: 10000ms"; "lead checking on staging: 300000ms"; "lead moving on staging: 50000ms"; ] (words (List.nth trace 1)); Alcotest.(check (list string)) "an untimed one" [ "landed c staging " ^ range ^ " on staging: no time" ] (words (List.nth trace 11)); Alcotest.(check (list string)) "a stage that ends" [ "step moving target on a: 40000ms" ] (words (List.nth trace 2)); Alcotest.(check (list string)) "one that starts" [] (words (List.nth trace 3)); Alcotest.(check (list string)) "an idled span, by kind" [ "idle behind on staging: 1350000ms"; "idle cone on staging: 450000ms" ] (words (List.nth trace 10)); Alcotest.(check (list string)) "a check at its wall" [ "wall suite on a: 600000ms" ] (words (List.nth trace 5))
(* pace.mli, v: by target, most landings first; the lead's median of two is their mean (type 7), its p95 960 + 0.95 * 960 seconds. *)let test_targets () = Alcotest.(check (list string)) "most landings first" [ "staging"; "main" ] (List.map (fun (x : Pace.target) -> Branch.to_string x.target) pace.targets); let s = target "staging" in Alcotest.(check (pair int int)) "landed, in the last hour" (3, 2) (s.landed, s.hour); Alcotest.(check (list (option int))) "lead: count, median, p95, longest" [ Some 2; Some 1_440_000; Some 1_872_000; Some 1_920_000 ] [ Some s.lead.count; s.lead.median_ms; s.lead.p95_ms; s.lead.longest_ms ]; Alcotest.(check (list (pair string (option int)))) "each phase's median" [ ("queued", Some 900_000); ("replaying", Some 15_000); ("checking", Some 450_000); ("moving", Some 75_000); ] (List.map (fun (p, (f : Pace.figure)) -> (p, f.median_ms)) s.phases); Alcotest.(check int) "idle in the window" 2_160_000 s.idle_ms; Alcotest.(check (list (pair string int))) "by kind, most first" [ ("behind", 1_350_000); ("cone", 450_000); ("stacked", 360_000) ] s.holds; Alcotest.(check int) "idle in the last hour" 1_800_000 s.hour_idle_ms; Alcotest.(check int) "the journal covers 18h" (18 * 3600) pace.covers
let test_steps_and_walls () = Alcotest.(check (list (pair string (list (option int))))) "each step, longest in all first" [ ("moving target", [ Some 2; Some 80_000; Some 120_000 ]); ("tidy: reading", [ Some 1; Some 30_000; Some 30_000 ]); ] (List.map (fun (s, (f : Pace.figure)) -> (s, [ Some f.count; f.median_ms; f.longest_ms ])) pace.steps); Alcotest.(check (list (pair string int))) "walls" [ ("suite", 1) ] pace.walls
(* pace.mli, v: a landing the journal holds twice, as the first run that reads a landing not journaled yet journals it again (doc/invariants.md 16), is one landing, as mq stats' landed line counts it: its first record, timed, gives its lead. *)let test_landing_twice () = let trace = [ landed "a" staging (time 2 11 0 0) ~phases:(600, 10, 300, 50); landed "a" staging (time 2 11 0 5); ] in let samples = List.concat_map (fun (e : Event.t) -> List.map (fun s -> (e.time, s)) (Sample.of_event e)) trace in let pace = Pace.v ~now ~since ~first:(Some first) ~slots:6 samples in match pace.targets with | [ s ] -> Alcotest.(check (pair int int)) "one landing, in the last hour" (1, 1) (s.landed, s.hour); Alcotest.(check (option int)) "its lead" (Some 960_000) s.lead.median_ms | l -> Alcotest.failf "%d targets" (List.length l)
(* doc/commands.md, mq status: the pace line, one target a line. Slots idle 1800 s of 6 slots' 3600 s is 8%; behind holds 1350 of it, 75%. *)let test_line () = Alcotest.(check (list string)) "the pace lines" [ "staging: 2 landed in the last hour, 3 in the day (18h of history) · \ queued to landed 24m median · slots idle 8% of the last hour while \ entries waited, most behind (75%)"; "main: 1 landed in the last hour, 1 in the day (18h of history) · queued \ to landed 1m30s median"; ] (String.split_on_char '\n' (Fmt.str "@[<v>%a@]" Pace.pp_line pace))
(* doc/commands.md, mq status: a share that rounds to none reads under 1%, never 0% beside the share of it a hold took. Five slots idle 5 s, four 2 s and six 2 s, of 6 slots' 3600 s, is 45 slot-seconds, 0.2%: so blacksun's line read at 03:57 on 2026-10-22, "slots idle 0% ... most cone (69%)". Cone holds 33 of the 45, 73%. *)let test_line_small () = let span ms idle hold = { Idle.ms; idle; waiting = 1; holds = [ (hold, 1) ] } in let trace = [ idled staging (time 2 11 50 0) (span 5_000 5 "cone"); idled staging (time 2 11 55 0) (span 2_000 4 "cone"); idled staging (time 2 11 56 0) (span 2_000 6 "closing"); ] in let samples = List.concat_map (fun (e : Event.t) -> List.map (fun s -> (e.time, s)) (Sample.of_event e)) trace in let pace = Pace.v ~now ~since ~first:(Some first) ~slots:6 samples in Alcotest.(check string) "under 1%" "staging: 0 landed in the last hour, 0 in the day (18h of history) · slots \ idle under 1% of the last hour while entries waited, most cone (73%)" (Fmt.str "@[<v>%a@]" Pace.pp_line pace)
(* pace.mli, codec: what mq stats --json prints reads back as the pace. *)let test_codec () = let s = Json.Value.to_string (Json.Codec.encode Pace.codec pace) in match Json.Value.of_string s with | Error e -> Alcotest.fail (Json.Error.to_string e) | Ok v -> ( match Json.Codec.decode Pace.codec v with | Error e -> Alcotest.fail (Json.Error.to_string e) | Ok p -> Alcotest.(check string) "the same lines" (Fmt.str "%a" Pace.pp pace) (Fmt.str "%a" Pace.pp p))
let suite = ( "pace", [ Alcotest.test_case "samples" `Quick test_samples; Alcotest.test_case "targets" `Quick test_targets; Alcotest.test_case "steps and walls" `Quick test_steps_and_walls; Alcotest.test_case "a landing journaled twice" `Quick test_landing_twice; Alcotest.test_case "the status line" `Quick test_line; Alcotest.test_case "a share under 1%" `Quick test_line_small; Alcotest.test_case "codec" `Quick test_codec; ] )