Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
28 kB · 766 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767(* The JSON document printed by mq status. Every object has one strict reader and writer. *)module C = Json.Codecmodule O = C.Object
type progress = { check : string; state : string; attempt : int option; seconds : int option; stopped : string option;}
type stage = { name : string; since : string }
type branch = { branch : string; target : string option; state : string option; position : int option; of_ : int option; behind : string option; check : string option; since : string option; ended : string option; reason : string option; log : string option; next : string option; worktree : string option; waits : Hold.t option; checks : progress list option; why : string list option; stage : stage option;}
type check = { check : string; verdict : string }
type tip = { commit : string; tree : string; checked : bool; verdict : string; checks : check list; unread : int;}
type failure = { name : string; offset : int }type failures = { count : int; first : failure list }
type check_run = { check : string; result : string; attempt : int; seconds : int; log : string option; reused : string option; stopped : string option; failures : failures;}
type probe = { length : int; suspects : int; without : string list; last : string; commit : string; tree : string; started : string; result : string option; seconds : int option;}
type serve = { source : string; commit : string option; tree : string option; queued : string; outcome : string option; ended : string option; reason : string option; log : string option; next : string option; checks : check_run list; probes : probe list;}
type culprit = { branch : string; commit : string; subject : string; check : string; log : string option; took : string option; at : string;}
type overdue = { since : string option; reason : string }
type push = { remote : string; ref_ : string; ahead : int option; behind : int option; updated : string option; overdue : overdue option;}
type waits = { path : string; branch : string; commit : string }
type target = { branch : string; queued : string list; takes : string option; every : string option; behind : int option; ahead : int option; standing : string option; waits : waits option; overdue : string option; culprit : culprit option; adopted : string option; next : string option; tip : tip option; held : bool; due : string option; serve : serve option; push : push option;}
type running = { run : string; since : string option; last_check : string option; stalled : bool;}
type last = { ended : string; status : int; reason : string option; log : string option;}
type holder = { slot : int; owner : string; build : string; since : string option; ends : string option;}
type slots = { total : int; busy : int; waiting : int; holders : holder list }
type livelock = { at : string; count : int; check : string option; entries : string list; trees : string list; alone : string option;}
type reap = { trees : int; oldest : string; reaped : int option }type registration = { at : string; detail : string; refused : bool }
type runs = { registration : registration option; started_by : string; running : running option; last : last option; killed : string list; livelock : livelock option; slots : slots option; reap : reap option;}
type oldest = { sequence : int; event : string; calls : int; reason : string; not_before : string;}
type hooks = { pending : int; failing : int; oldest : oldest option; parked : int;}
type rules = { branch : string; commit : string; entry : string; push : push option; sync : string option;}
type landed = { branch : string; target : string; landed : string; was : string; queued : string; commits : int; at : string;}
type dropped = { branch : string; tip : string; at : string option }type record = { ref_ : string; why : string; holds : string option }type moved = { branch : string; target : string; landed : string; at : string }type span = { name : string; detail : string option; ms : int }
type stalled = { since : string; check : string; worktree : string option; cause : string;}
type movement = { queue : string; landed : string option; queued : int; checking : int; landing : int; oldest : string option; stalled : stalled option;}
type t = { mqschema : string; branches : branch list; targets : target list; runs : runs option; hooks : hooks option; journal : string list; records : record list; rules : rules; landed : landed option; dropped : dropped option; moved : moved option; spans : span list option; movement : movement list; unsettled : bool;}
(* Each codec is built when {!codec} is first called, never as the module loads: every mq process links this module, and most never read or write a status document. *)let progress_codec () = O.map ~kind:"status progress" (fun check state attempt seconds stopped -> { check; state; attempt; seconds; stopped }) |> O.member "check" C.string ~enc:(fun (x : progress) -> x.check) |> O.member "state" C.string ~enc:(fun (x : progress) -> x.state) |> O.member "attempt" (C.option C.int) ~enc:(fun (x : progress) -> x.attempt) |> O.member "seconds" (C.option C.int) ~enc:(fun (x : progress) -> x.seconds) |> O.member "stopped" (C.option C.string) ~enc:(fun (x : progress) -> x.stopped) |> O.error_unknown |> O.error_duplicates |> O.seal
let branch branch target state position of_ behind check since ended reason log next worktree waits checks why stage : branch = { branch; target; state; position; of_; behind; check; since; ended; reason; log; next; worktree; waits; checks; why; stage; }
let stage_codec () = O.map ~kind:"status stage" (fun name since -> { name; since }) |> O.member "name" C.string ~enc:(fun (x : stage) -> x.name) |> O.member "since" C.string ~enc:(fun (x : stage) -> x.since) |> O.error_unknown |> O.error_duplicates |> O.seal
let branch_codec () = O.map ~kind:"status branch" branch |> O.member "branch" C.string ~enc:(fun (x : branch) -> x.branch) |> O.member "target" (C.option C.string) ~enc:(fun (x : branch) -> x.target) |> O.member "state" (C.option C.string) ~enc:(fun (x : branch) -> x.state) |> O.member "position" (C.option C.int) ~enc:(fun (x : branch) -> x.position) |> O.member "of" (C.option C.int) ~enc:(fun (x : branch) -> x.of_) |> O.member "behind" (C.option C.string) ~enc:(fun (x : branch) -> x.behind) |> O.member "check" (C.option C.string) ~enc:(fun (x : branch) -> x.check) |> O.member "since" (C.option C.string) ~enc:(fun (x : branch) -> x.since) |> O.member "ended" (C.option C.string) ~enc:(fun (x : branch) -> x.ended) |> O.member "reason" (C.option C.string) ~enc:(fun (x : branch) -> x.reason) |> O.member "log" (C.option C.string) ~enc:(fun (x : branch) -> x.log) |> O.member "next" (C.option C.string) ~enc:(fun (x : branch) -> x.next) |> O.member "worktree" (C.option C.string) ~enc:(fun (x : branch) -> x.worktree) |> O.member "waits" (C.option Hold.codec) ~enc:(fun (x : branch) -> x.waits) |> O.opt_member "checks" (C.list (progress_codec ())) ~enc:(fun (x : branch) -> x.checks) |> O.opt_member "why" (C.list C.string) ~enc:(fun (x : branch) -> x.why) |> O.opt_member "stage" (stage_codec ()) ~enc:(fun (x : branch) -> x.stage) |> O.error_unknown |> O.error_duplicates |> O.seal
let check_codec () = O.map ~kind:"status check" (fun check verdict -> { check; verdict }) |> O.member "check" C.string ~enc:(fun (x : check) -> x.check) |> O.member "verdict" C.string ~enc:(fun (x : check) -> x.verdict) |> O.error_unknown |> O.error_duplicates |> O.seal
let tip_codec () = O.map ~kind:"status tip" (fun commit tree checked verdict checks unread -> { commit; tree; checked; verdict; checks; unread }) |> O.member "commit" C.string ~enc:(fun (x : tip) -> x.commit) |> O.member "tree" C.string ~enc:(fun (x : tip) -> x.tree) |> O.member "checked" C.bool ~enc:(fun (x : tip) -> x.checked) |> O.member "verdict" C.string ~enc:(fun (x : tip) -> x.verdict) |> O.member "checks" (C.list (check_codec ())) ~enc:(fun (x : tip) -> x.checks) |> O.member "unread" C.int ~enc:(fun (x : tip) -> x.unread) |> O.error_unknown |> O.error_duplicates |> O.seal
let failure_codec () = O.map ~kind:"status failure" (fun name offset -> { name; offset }) |> O.member "name" C.string ~enc:(fun (x : failure) -> x.name) |> O.member "offset" C.int ~enc:(fun (x : failure) -> x.offset) |> O.error_unknown |> O.error_duplicates |> O.seal
let failures_codec () = O.map ~kind:"status failures" (fun count first -> { count; first }) |> O.member "count" C.int ~enc:(fun (x : failures) -> x.count) |> O.member "first" (C.list (failure_codec ())) ~enc:(fun (x : failures) -> x.first) |> O.error_unknown |> O.error_duplicates |> O.seal
let check_run_codec () = O.map ~kind:"status check_run" (fun check result attempt seconds log reused stopped failures -> { check; result; attempt; seconds; log; reused; stopped; failures }) |> O.member "check" C.string ~enc:(fun (x : check_run) -> x.check) |> O.member "result" C.string ~enc:(fun (x : check_run) -> x.result) |> O.member "attempt" C.int ~enc:(fun (x : check_run) -> x.attempt) |> O.member "seconds" C.int ~enc:(fun (x : check_run) -> x.seconds) |> O.member "log" (C.option C.string) ~enc:(fun (x : check_run) -> x.log) |> O.member "reused" (C.option C.string) ~enc:(fun (x : check_run) -> x.reused) |> O.member "stopped" (C.option C.string) ~enc:(fun (x : check_run) -> x.stopped) |> O.member "failures" (failures_codec ()) ~enc:(fun (x : check_run) -> x.failures) |> O.error_unknown |> O.error_duplicates |> O.seal
let probe_codec () = O.map ~kind:"status probe" (fun length suspects without last commit tree started result seconds -> { length; suspects; without; last; commit; tree; started; result; seconds; }) |> O.member "length" C.int ~enc:(fun (x : probe) -> x.length) |> O.member "suspects" C.int ~enc:(fun (x : probe) -> x.suspects) |> O.member "without" (C.list C.string) ~dec_absent:[] ~enc:(fun (x : probe) -> x.without) ~enc_omit:(fun l -> l = []) |> O.member "last" C.string ~enc:(fun (x : probe) -> x.last) |> O.member "commit" C.string ~enc:(fun (x : probe) -> x.commit) |> O.member "tree" C.string ~enc:(fun (x : probe) -> x.tree) |> O.member "started" C.string ~enc:(fun (x : probe) -> x.started) |> O.member "result" (C.option C.string) ~enc:(fun (x : probe) -> x.result) |> O.member "seconds" (C.option C.int) ~enc:(fun (x : probe) -> x.seconds) |> O.error_unknown |> O.error_duplicates |> O.seal
let serve_codec () = O.map ~kind:"status serve" (fun source commit tree queued outcome ended reason log next checks probes -> { source; commit; tree; queued; outcome; ended; reason; log; next; checks; probes; }) |> O.member "source" C.string ~enc:(fun (x : serve) -> x.source) |> O.member "commit" (C.option C.string) ~enc:(fun (x : serve) -> x.commit) |> O.member "tree" (C.option C.string) ~enc:(fun (x : serve) -> x.tree) |> O.member "queued" C.string ~enc:(fun (x : serve) -> x.queued) |> O.member "outcome" (C.option C.string) ~enc:(fun (x : serve) -> x.outcome) |> O.member "ended" (C.option C.string) ~enc:(fun (x : serve) -> x.ended) |> O.member "reason" (C.option C.string) ~enc:(fun (x : serve) -> x.reason) |> O.member "log" (C.option C.string) ~enc:(fun (x : serve) -> x.log) |> O.member "next" (C.option C.string) ~enc:(fun (x : serve) -> x.next) |> O.member "checks" (C.list (check_run_codec ())) ~enc:(fun (x : serve) -> x.checks) |> O.member "probes" (C.list (probe_codec ())) ~enc:(fun (x : serve) -> x.probes) |> O.error_unknown |> O.error_duplicates |> O.seal
let culprit_codec () = O.map ~kind:"status culprit" (fun branch commit subject check log took at -> { branch; commit; subject; check; log; took; at }) |> O.member "branch" C.string ~enc:(fun (x : culprit) -> x.branch) |> O.member "commit" C.string ~enc:(fun (x : culprit) -> x.commit) |> O.member "subject" C.string ~enc:(fun (x : culprit) -> x.subject) |> O.member "check" C.string ~enc:(fun (x : culprit) -> x.check) |> O.member "log" (C.option C.string) ~enc:(fun (x : culprit) -> x.log) |> O.member "took" (C.option C.string) ~enc:(fun (x : culprit) -> x.took) |> O.member "at" C.string ~enc:(fun (x : culprit) -> x.at) |> O.error_unknown |> O.error_duplicates |> O.seal
let overdue_codec () = O.map ~kind:"status push overdue" (fun since reason -> { since; reason }) |> O.member "since" (C.option C.string) ~enc:(fun (x : overdue) -> x.since) |> O.member "reason" C.string ~enc:(fun (x : overdue) -> x.reason) |> O.error_unknown |> O.error_duplicates |> O.seal
let push_codec () = O.map ~kind:"status push" (fun remote ref_ ahead behind updated overdue -> { remote; ref_; ahead; behind; updated; overdue }) |> O.member "remote" C.string ~enc:(fun (x : push) -> x.remote) |> O.member "ref" C.string ~enc:(fun (x : push) -> x.ref_) |> O.member "ahead" (C.option C.int) ~enc:(fun (x : push) -> x.ahead) |> O.member "behind" (C.option C.int) ~enc:(fun (x : push) -> x.behind) |> O.member "updated" (C.option C.string) ~enc:(fun (x : push) -> x.updated) |> O.member "overdue" (C.option (overdue_codec ())) ~enc:(fun (x : push) -> x.overdue) |> O.error_unknown |> O.error_duplicates |> O.seal
let waits_codec () = O.map ~kind:"status waits" (fun path branch commit -> { path; branch; commit }) |> O.member "path" C.string ~enc:(fun (x : waits) -> x.path) |> O.member "branch" C.string ~enc:(fun (x : waits) -> x.branch) |> O.member "commit" C.string ~enc:(fun (x : waits) -> x.commit) |> O.error_unknown |> O.error_duplicates |> O.seal
let target branch queued takes every behind ahead standing waits overdue culprit adopted next tip held due serve push : target = { branch; queued; takes; every; behind; ahead; standing; waits; overdue; culprit; adopted; next; tip; held; due; serve; push; }
let target_codec () = O.map ~kind:"status target" target |> O.member "branch" C.string ~enc:(fun (x : target) -> x.branch) |> O.member "queued" (C.list C.string) ~enc:(fun (x : target) -> x.queued) |> O.member "takes" (C.option C.string) ~enc:(fun (x : target) -> x.takes) |> O.member "every" (C.option C.string) ~enc:(fun (x : target) -> x.every) |> O.member "behind" (C.option C.int) ~enc:(fun (x : target) -> x.behind) |> O.member "ahead" (C.option C.int) ~enc:(fun (x : target) -> x.ahead) |> O.member "standing" (C.option C.string) ~enc:(fun (x : target) -> x.standing) |> O.member "waits" (C.option (waits_codec ())) ~enc:(fun (x : target) -> x.waits) |> O.member "overdue" (C.option C.string) ~enc:(fun (x : target) -> x.overdue) |> O.member "culprit" (C.option (culprit_codec ())) ~enc:(fun (x : target) -> x.culprit) |> O.member "adopted" (C.option C.string) ~enc:(fun (x : target) -> x.adopted) |> O.member "next" (C.option C.string) ~enc:(fun (x : target) -> x.next) |> O.member "tip" (C.option (tip_codec ())) ~enc:(fun (x : target) -> x.tip) |> O.member "held" C.bool ~enc:(fun (x : target) -> x.held) |> O.member "due" (C.option C.string) ~enc:(fun (x : target) -> x.due) |> O.member "serve" (C.option (serve_codec ())) ~enc:(fun (x : target) -> x.serve) |> O.member "push" (C.option (push_codec ())) ~enc:(fun (x : target) -> x.push) |> O.error_unknown |> O.error_duplicates |> O.seal
let running_codec () = O.map ~kind:"status running" (fun run since last_check stalled -> { run; since; last_check; stalled }) |> O.member "run" C.string ~enc:(fun (x : running) -> x.run) |> O.member "since" (C.option C.string) ~enc:(fun (x : running) -> x.since) |> O.member "last_check" (C.option C.string) ~enc:(fun (x : running) -> x.last_check) |> O.member "stalled" C.bool ~enc:(fun (x : running) -> x.stalled) |> O.error_unknown |> O.error_duplicates |> O.seal
let last_codec () = O.map ~kind:"status last" (fun ended status reason log -> { ended; status; reason; log }) |> O.member "ended" C.string ~enc:(fun (x : last) -> x.ended) |> O.member "status" C.int ~enc:(fun (x : last) -> x.status) |> O.member "reason" (C.option C.string) ~enc:(fun (x : last) -> x.reason) |> O.member "log" (C.option C.string) ~enc:(fun (x : last) -> x.log) |> O.error_unknown |> O.error_duplicates |> O.seal
let holder_codec () = O.map ~kind:"status slot holder" (fun slot owner build since ends -> { slot; owner; build; since; ends }) |> O.member "slot" C.int ~enc:(fun (x : holder) -> x.slot) |> O.member "owner" C.string ~enc:(fun (x : holder) -> x.owner) |> O.member "build" C.string ~enc:(fun (x : holder) -> x.build) |> O.opt_member "since" C.string ~enc:(fun (x : holder) -> x.since) |> O.opt_member "ends" C.string ~enc:(fun (x : holder) -> x.ends) |> O.error_unknown |> O.error_duplicates |> O.seal
let slots_codec () = O.map ~kind:"status slots" (fun total busy waiting holders -> { total; busy; waiting; holders }) |> O.member "total" C.int ~enc:(fun (x : slots) -> x.total) |> O.member "busy" C.int ~enc:(fun (x : slots) -> x.busy) |> O.member "waiting" C.int ~enc:(fun (x : slots) -> x.waiting) |> O.member "holders" (C.list (holder_codec ())) ~enc:(fun (x : slots) -> x.holders) |> O.error_unknown |> O.error_duplicates |> O.seal
let livelock_codec () = O.map ~kind:"status livelock" (fun at count check entries trees alone -> { at; count; check; entries; trees; alone }) |> O.member "at" C.string ~enc:(fun (x : livelock) -> x.at) |> O.member "count" C.int ~enc:(fun (x : livelock) -> x.count) |> O.member "check" (C.option C.string) ~enc:(fun (x : livelock) -> x.check) |> O.member "entries" (C.list C.string) ~enc:(fun (x : livelock) -> x.entries) |> O.member "trees" (C.list C.string) ~enc:(fun (x : livelock) -> x.trees) |> O.member "alone" (C.option C.string) ~enc:(fun (x : livelock) -> x.alone) |> O.error_unknown |> O.error_duplicates |> O.seal
let registration_codec () = O.map ~kind:"status registration" (fun at detail refused -> { at; detail; refused }) |> O.member "at" C.string ~enc:(fun (x : registration) -> x.at) |> O.member "detail" C.string ~enc:(fun (x : registration) -> x.detail) |> O.member "refused" C.bool ~enc:(fun (x : registration) -> x.refused) |> O.error_unknown |> O.error_duplicates |> O.seal
let reap_codec () = O.map ~kind:"status reap" (fun trees oldest reaped -> { trees; oldest; reaped }) |> O.member "trees" C.int ~enc:(fun (x : reap) -> x.trees) |> O.member "oldest" C.string ~enc:(fun (x : reap) -> x.oldest) |> O.member "reaped" (C.option C.int) ~enc:(fun (x : reap) -> x.reaped) |> O.error_unknown |> O.error_duplicates |> O.seal
let runs_codec () = O.map ~kind:"status runs" (fun registration started_by running last killed livelock slots reap -> { registration; started_by; running; last; killed; livelock; slots; reap }) |> O.member "registration" (C.option (registration_codec ())) ~enc:(fun (x : runs) -> x.registration) |> O.member "started_by" C.string ~enc:(fun (x : runs) -> x.started_by) |> O.member "running" (C.option (running_codec ())) ~enc:(fun (x : runs) -> x.running) |> O.member "last" (C.option (last_codec ())) ~enc:(fun (x : runs) -> x.last) |> O.member "killed" (C.list C.string) ~enc:(fun (x : runs) -> x.killed) |> O.member "livelock" (C.option (livelock_codec ())) ~enc:(fun (x : runs) -> x.livelock) |> O.member "slots" (C.option (slots_codec ())) ~enc:(fun (x : runs) -> x.slots) |> O.opt_member "reap" (reap_codec ()) ~enc:(fun (x : runs) -> x.reap) |> O.error_unknown |> O.error_duplicates |> O.seal
let oldest_codec () = O.map ~kind:"status oldest" (fun sequence event calls reason not_before -> { sequence; event; calls; reason; not_before }) |> O.member "sequence" C.int ~enc:(fun (x : oldest) -> x.sequence) |> O.member "event" C.string ~enc:(fun (x : oldest) -> x.event) |> O.member "calls" C.int ~enc:(fun (x : oldest) -> x.calls) |> O.member "reason" C.string ~enc:(fun (x : oldest) -> x.reason) |> O.member "not_before" C.string ~enc:(fun (x : oldest) -> x.not_before) |> O.error_unknown |> O.error_duplicates |> O.seal
let hooks_codec () = O.map ~kind:"status hooks" (fun pending failing oldest parked -> { pending; failing; oldest; parked }) |> O.member "pending" C.int ~enc:(fun (x : hooks) -> x.pending) |> O.member "failing" C.int ~enc:(fun (x : hooks) -> x.failing) |> O.member "oldest" (C.option (oldest_codec ())) ~enc:(fun (x : hooks) -> x.oldest) |> O.member "parked" C.int ~enc:(fun (x : hooks) -> x.parked) |> O.error_unknown |> O.error_duplicates |> O.seal
let rules_codec () = O.map ~kind:"status rules" (fun branch commit entry push sync -> { branch; commit; entry; push; sync }) |> O.member "branch" C.string ~enc:(fun (x : rules) -> x.branch) |> O.member "commit" C.string ~enc:(fun (x : rules) -> x.commit) |> O.member "entry" C.string ~enc:(fun (x : rules) -> x.entry) |> O.member "push" (C.option (push_codec ())) ~enc:(fun (x : rules) -> x.push) |> O.member "sync" (C.option C.string) ~enc:(fun (x : rules) -> x.sync) |> O.error_unknown |> O.error_duplicates |> O.seal
let landed_codec () = O.map ~kind:"status landed" (fun branch target landed was queued commits at -> { branch; target; landed; was; queued; commits; at }) |> O.member "branch" C.string ~enc:(fun (x : landed) -> x.branch) |> O.member "target" C.string ~enc:(fun (x : landed) -> x.target) |> O.member "landed" C.string ~enc:(fun (x : landed) -> x.landed) |> O.member "was" C.string ~enc:(fun (x : landed) -> x.was) |> O.member "queued" C.string ~enc:(fun (x : landed) -> x.queued) |> O.member "commits" C.int ~enc:(fun (x : landed) -> x.commits) |> O.member "at" C.string ~enc:(fun (x : landed) -> x.at) |> O.error_unknown |> O.error_duplicates |> O.seal
let dropped_codec () = O.map ~kind:"status dropped" (fun branch tip at -> { branch; tip; at }) |> O.member "branch" C.string ~enc:(fun (x : dropped) -> x.branch) |> O.member "tip" C.string ~enc:(fun (x : dropped) -> x.tip) |> O.member "at" (C.option C.string) ~enc:(fun (x : dropped) -> x.at) |> O.error_unknown |> O.error_duplicates |> O.seal
let record_codec () = O.map ~kind:"status record" (fun ref_ why holds -> { ref_; why; holds }) |> O.member "ref" C.string ~enc:(fun (x : record) -> x.ref_) |> O.member "why" C.string ~enc:(fun (x : record) -> x.why) |> O.member "holds" (C.option C.string) ~enc:(fun (x : record) -> x.holds) |> O.error_unknown |> O.error_duplicates |> O.seal
let moved_codec () = O.map ~kind:"status moved" (fun branch target landed at -> { branch; target; landed; at }) |> O.member "branch" C.string ~enc:(fun (x : moved) -> x.branch) |> O.member "target" C.string ~enc:(fun (x : moved) -> x.target) |> O.member "landed" C.string ~enc:(fun (x : moved) -> x.landed) |> O.member "at" C.string ~enc:(fun (x : moved) -> x.at) |> O.error_unknown |> O.error_duplicates |> O.seal
let span_codec () = O.map ~kind:"status span" (fun name detail ms -> { name; detail; ms }) |> O.member "name" C.string ~enc:(fun (x : span) -> x.name) |> O.member "detail" (C.option C.string) ~enc:(fun (x : span) -> x.detail) |> O.member "ms" C.int ~enc:(fun (x : span) -> x.ms) |> O.error_unknown |> O.error_duplicates |> O.seal
let stalled_codec () = O.map ~kind:"status stalled" (fun since check worktree cause -> { since; check; worktree; cause }) |> O.member "since" C.string ~enc:(fun (x : stalled) -> x.since) |> O.member "check" C.string ~enc:(fun (x : stalled) -> x.check) |> O.member "worktree" (C.option C.string) ~enc:(fun (x : stalled) -> x.worktree) |> O.member "cause" C.string ~enc:(fun (x : stalled) -> x.cause) |> O.error_unknown |> O.error_duplicates |> O.seal
let movement_codec () = O.map ~kind:"status movement" (fun queue landed queued checking landing oldest stalled : movement -> { queue; landed; queued; checking; landing; oldest; stalled }) |> O.member "queue" C.string ~enc:(fun (x : movement) -> x.queue) |> O.member "landed" (C.option C.string) ~enc:(fun (x : movement) -> x.landed) |> O.member "queued" C.int ~enc:(fun (x : movement) -> x.queued) |> O.member "checking" C.int ~enc:(fun (x : movement) -> x.checking) |> O.member "landing" C.int ~enc:(fun (x : movement) -> x.landing) |> O.member "oldest" (C.option C.string) ~enc:(fun (x : movement) -> x.oldest) |> O.member "stalled" (C.option (stalled_codec ())) ~dec_absent:None ~enc:(fun (x : movement) -> x.stalled) |> O.error_unknown |> O.error_duplicates |> O.seal
let document mqschema branches targets runs hooks journal records rules landed dropped moved spans movement unsettled : t = { mqschema; branches; targets; runs; hooks; journal; records; rules; landed; dropped; moved; spans; movement; unsettled; }
let t_codec () = O.map ~kind:"status" document |> O.member "mqschema" (C.enum ~kind:"mqschema" [ ("1", "1") ]) ~enc:(fun (x : t) -> x.mqschema) |> O.member "branches" (C.list (branch_codec ())) ~enc:(fun (x : t) -> x.branches) |> O.member "targets" (C.list (target_codec ())) ~enc:(fun (x : t) -> x.targets) |> O.member "runs" (C.option (runs_codec ())) ~enc:(fun (x : t) -> x.runs) |> O.member "hooks" (C.option (hooks_codec ())) ~enc:(fun (x : t) -> x.hooks) |> O.member "journal" (C.list C.string) ~enc:(fun (x : t) -> x.journal) |> O.member "records" (C.list (record_codec ())) ~enc:(fun (x : t) -> x.records) |> O.member "rules" (rules_codec ()) ~enc:(fun (x : t) -> x.rules) |> O.member "landed" (C.option (landed_codec ())) ~enc:(fun (x : t) -> x.landed) |> O.member "dropped" (C.option (dropped_codec ())) ~enc:(fun (x : t) -> x.dropped) |> O.member "moved" (C.option (moved_codec ())) ~enc:(fun (x : t) -> x.moved) |> O.opt_member "spans" (C.list (span_codec ())) ~enc:(fun (x : t) -> x.spans) |> O.member "movement" (C.list (movement_codec ())) ~dec_absent:[] ~enc_omit:(fun m -> m = []) ~enc:(fun (x : t) -> x.movement) |> O.member "unsettled" C.bool ~dec_absent:false ~enc_omit:not ~enc:(fun (x : t) -> x.unsettled) |> O.error_unknown |> O.error_duplicates |> O.seal
let current = Once.v t_codeclet codec () = Once.get currentlet to_json t = Json.Value.to_string (C.encode (codec ()) t)
let of_json s = Result.bind (Json.Value.of_string s) (C.decode (codec ())) |> Result.map_error (fun e -> `Msg (Json.Error.to_string e))
let pp ppf t = Fmt.string ppf (to_json t)