Something went wrong. Try again.
A local Git merge queue with content-bound gate verdicts
Something went wrong. Try again.
23 kB · 468 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469(** The rules: one file, [mq.toml], on a branch of its own.
The rules define the checks, say which checks each branch takes and how the branches feed each other (the DAG), and give the bounds, the resolver and the hook (doc/configuration.md). They live on the branch [mq/config], or the branch [mq.rules] names, and change by a land into it. A run reads them when a pass starts and lands under them.
{v [check.build] command = "dune build @check"
[branch.staging] checks = ["pre-commit", "build"]
[branch.main] takes = "staging" checks = ["pre-commit", "build"] v}
A file is read in full or refused: an unknown key, a value of the wrong type, a check a branch lists that is neither a section nor a Git hook, a section or a branch's list that names the [rules] check (mq's own), a [takes] that names no branch of the rules, a cycle, an edge on a pattern, an [after] that names a check its branch does not list or vets, or that no branch takes but branches that report, or a DAG with no entry branch, is an error that names it. Nothing is read with a default except the bounds the specification gives one. *)
(** {1:rules Rules} *)
type branch_rule = private { pattern : Branch.Pattern.t; (** The section's name: a branch or a pattern. *) checks : Check.name list; (** The checks a land into it must pass. *) vet : Check.name list; (** The checks among [checks] an entry into it passes on its replay onto the branch's tip before it may ride a batch ({!vet}); none by default. *) after : Check.name list; (** The checks among [checks] its lands leave to the edges out of it, whose serves run them ({!checks}); none by default. *) drain : Check.name list option; (** The checks among [checks] a drain's lane into it runs ({!drain}); [None] by default, where it runs the checks a land runs. *) takes : Branch.t option; (** The branch it takes its commits from. *) report : bool; (** It only reports: no consumer locks at it ({!last} stops before it). *)}(** The type for the rules of one branch, or of every branch a pattern names. [takes] makes an edge of the DAG; a pattern has none. *)
type bounds = private { check_wall : int; (** [bounds.check_wall]: a check's time bound unless its section gives its own [wall] (default 3600). *) check_grace : int; (** [bounds.check_grace]: the seconds between the TERM and the KILL of a check stopped at its bound (default 30). *) wait_wall : int; (** [bounds.wait_wall]: the bound of every wait (default 7200). *) run_start : int; (** [bounds.run_start]: how long a land waits for the scheduler to start a run (default 300). *) stall : int; (** [bounds.stall]: how long a run holds the lock with entries queued and no check started before it is stalled (default 120). *) resolve_wall : int option; (** [bounds.resolve_wall]: the resolver's bound; with none, [--resolve] is refused. *) hook_wall : int; (** [bounds.hook_wall]: the bound of one call of the hook (default 30). *) remote_bytes : int; (** [bounds.remote_bytes]: the bytes one session with a remote may read, its listing, the pack a pull fetches and the status a push reads back (default 17179869184, 16 GiB). *) remote_stall : int; (** [bounds.remote_stall]: the seconds a session with a remote waits on one that makes no progress, where the user's ssh_config(5) or Git's configuration states no bound: ConnectTimeout, and the ServerAliveInterval a quarter of it with OpenSSH's count of 3; the low-speed time of 1 byte a second (default 60, at least 1). *) store_log : int; (** [bounds.store_log]: the bytes the write-ahead log of the journal's index may hold; past it, mq doctor reports a copy-back that did not run (default 67108864, 64 MiB: two of the largest commits mq makes, a fold of 6.9k pages). *) max_batch : int; (** [bounds.max_batch]: the most lands one batch into a branch that takes no other checks as one tree (default 128, at least 1; 1 checks each land alone). *) trace_wall : int; (** [bounds.trace_wall]: the wall under which a command prints no span tree unasked, whatever its history (default 2). *) slot_overdraft : int; (** [bounds.slot_overdraft]: the build slots past [mq.slots] an expedited land or a land into the rules branch takes when every slot is held by work it ranks above ({!Order.grant}; default 1, at least 0). *) check_memory : int; (** [bounds.check_memory]: the resident size, in bytes, past which a process of a check's group is ended while the check runs (default 4294967296, 4 GiB). *)}(** The type for the bounds, in seconds but for [remote_bytes], [store_log] and [check_memory], in bytes, and the counts [max_batch] and [slot_overdraft].*)
type resolve = private { command : string option; (** [resolve.command], the resolver. *) default : [ `Auto | `Stop ]; (** [resolve.default], for a land no terminal typed (default [`Stop], and [`Stop] when there is no command). *) layout : [ `Conflicts | `Tree ]; (** [resolve.layout], what the resolver's worktree holds of the tree: [`Conflicts] (["conflicts"], the default), the paths in conflict alone, every other one in its index with the skip-worktree bit, as Git's mergetool reads only the conflict; [`Tree] (["tree"]), the whole tree, for a command that reads more of it. *) models : string list; (** [resolve.models], the models the resolver asks at once, in order; given to the command as [MQ_RESOLVE_MODELS], separated by spaces; [[]] when the rules name none. *) max_tokens : int option; (** [resolve.max_tokens], the most tokens the model may write; given to the command as [MQ_RESOLVE_MAX_TOKENS]. *) grants : Check.grants; (** [resolve.read], [resolve.write] and [resolve.network]: what the resolver needs beyond its worktree, as a check's grants say it, which only a machine that confines it enforces. *)}(** The type for the resolver's rules (doc/conflicts.md). *)
type repair = private { command : string; (** [repair.command], what answers a repair request. *) models : string list; (** [repair.models], the models it asks, as {!type-resolve.field-models} says them; given to the command as [MQ_REPAIR_MODELS]. *) max_tokens : int option; (** [repair.max_tokens], the most tokens the model may write; given to the command as [MQ_REPAIR_MAX_TOKENS]. *) grants : Check.grants; (** [repair.read], [repair.write] and [repair.network], as {!type-resolve.field-grants} says them. *)}(** The type for the repairer's rules: the [[resolve]] section's keys, for a red bump's repair request ({!Repair}) and an entry's own red no check's repair answers ({!Fix}). *)
type lock = private { command : string; (** [lock.command], run at the root of a worktree of a lock commit whose dependencies read the commits it selects. *) paths : string list; (** [lock.paths], the paths relative to the root that the command derives from them, which the lock commit takes from that worktree. *)}(** The type for the lock command (doc/commands.md, "The lock"). *)
type generated = private { files : string list; (** [generated.files], the files the command writes, as path patterns relative to the root ({!Git.Pathspec}, the syntax of [.gitattributes]). *) command : string; (** [generated.command], run at the root of a worktree of a replayed commit to write {!field-files} from the tree's sources. *)}(** The type for the generated files (doc/configuration.md, "Generated files").*)
type install = private { branch : Branch.t; (** [install.branch], the branch mq is installed from: a branch the rules name by its own name, whose every commit passed its checks. *) check : Check.name; (** [install.check], the check that marks a build of the branch's tip installable: it builds the executable and starts it. No branch lists it, so the check worktree it runs in is its own. *) executable : string; (** [install.executable], the file that check leaves in the tree it ran in: a path relative to the root, inside it. *) trial : Duration.t; (** [install.trial], how long after an install a run that could not run or ended as a defect rolls it back; 30 minutes when the rules do not set it. *)}(** The type for the install of mq from the repository that builds it (doc/install.md). *)
type judged = [ `Queued | `Handed_out ](** The type for the event kinds the hook can give a verdict on: a land's [queued] event and mq new's [handed-out] event. *)
type delivered = [ `Every (** Every event, [deliver = true] or no key. *) | `Nothing (** None: [deliver = false], the verdict only. *) | `Types of string list (** The events of these types, each a CloudEvents type after [merge-queue.], in name order: an event of another type is passed over, as a webhook is sent only the events it subscribes to. The rules check refuses a name no event is written as. *) ](** The type for the events delivered to the hook. *)
type t = private { name : Branch.t option; (** The declared prefix for this consumer's branches in dependencies. *) checks : Check.t list; (** The [[check.NAME]] sections, in file order. *) branches : branch_rule list; (** The [[branch.NAME]] sections, in file order. *) entry : Branch.t option; (** The top-level [entry] key. *) bounds : bounds; resolve : resolve; repair : repair option; (** The [[repair]] section; with [None] the [[resolve]] command answers a repair request, and with neither the request stays a request. *) hook : string option; (** [hook.command]. *) hook_deliver : delivered; (** [hook.deliver]: the journal's events delivered to the hook, every one by default; [false] asks it only for its verdict. *) hook_judges : judged list; (** [hook.judges]: the event kinds the hook gives a verdict on, each once, in the order of {!type-judged}; both when the rules do not set it. *) cone : string option; (** [cone.command], the build adapter's answer to what a land's change can affect ({!Cone}). *) lock : lock option; (** The [[lock]] section. *) generated : generated option; (** The [[generated]] section. *) install : install option; (** The [[install]] section: the scheduled run keeps the mq at the registered path built from that branch's tip (doc/install.md). *) platforms : Platform_name.t list option; (** [[platforms] supported]: the platforms the repository supports, in the order the rules name them; [None] when the rules have no [[platforms]] section, and every platform is supported. A check's [platforms] are each one of them (doc/configuration.md). *) stock : int; (** [pool.stock]: how many worktrees a run keeps parked at the tip of each branch it lands into, so that a hand-out writes only what its branch changes; [2] when the rules have no [[pool]] section, [0] for none. *) stock_max : int; (** [pool.stock_max]: the most a run raises the stock of a branch to, from the hand-outs on it of the last ten minutes ({!Pool.stock_target}); [8], or [pool.stock] when that is higher, when the rules do not set it. Never under {!field-stock}. *) cache_size : int; (** [pool.cache_size]: the bytes the build cache on the pool's volume is trimmed to once it holds more ({!Trim}); 60 GB (60{^ 9} bytes, dune's [GB]) when the rules do not set it. *) check_build_size : int; (** [pool.check_build_size]: the bytes the build directories of the check worktrees no check runs in are cleared down to ({!Trim}); half of {!field-cache_size} when the rules do not set it, as each is a view over the cache that a check restores from it. *) sync : bool; (** [[sync]], a section with no key: a scheduled run starts [mq sync], which pulls the agreed copy and pushes this machine's landings, whenever a branch of the DAG or its copy moved since the last one started ({!Sync}); [false] when the rules have no [[sync]] section, and nothing touches the network untyped. *)}(** The type for rules. *)
val delivered_types : t -> string list option(** [delivered_types t] is the types [t]'s [hook.deliver] names, and [None] when it names none ({!type-delivered}). *)
val verdict_hook : t -> judged -> string option(** [verdict_hook t kind] is the hook's command when the rules name a hook that gives a verdict on events of [kind] ({!field-hook_judges}), and [None] when no verdict is asked of an event of [kind]. *)
val of_string : ?file:string -> string -> (t, [ `Msg of string ]) result(** [of_string ~file s] is the rules [s] holds, or the first reason they are refused; when the TOML itself is malformed, the reason names [file] (defaults to [mq.toml]) and the line, as Git names a configuration file and its line. *)
val repairing : t(** [repairing] is the rules a land into the rules branch and its hand-out run under when the rules there do not load (doc/configuration.md): no check of their own, no branch, no hook, no resolver, and the default bounds. *)
val to_string : t -> string(** [to_string t] is [t] as [mq.toml]: checks, branches, then the other sections, each key the rules set and no default. {!val-of_string} reads it back to an equal value. *)
val initial : ?sync:bool -> Branch.t -> Check.t option -> t(** [initial ?sync branch check] is the rules the first [mq init] writes: the DAG of [branch] alone, taking [check] when there is one, and the [[sync]] section when [sync] holds ([false] by default). A check named after a Git hook gets no section. *)
val default_bounds : bounds(** [default_bounds] is the bounds of a file with no [[bounds]] section. *)
(** The type for the bounds that have a default. *)type bound = Check_wall | Check_grace | Wait_wall | Run_start | Hook_wall
val pp_bound : (bound * int) Fmt.t(** [pp_bound] formats a bound an outcome ends at, with its value in seconds and whether that value is the default ({!default_bounds}), as rule 5 asks: [bounds.wait_wall, 7200s by default] or [bounds.wait_wall, 2s]. *)
(** {1:dag The DAG} *)
val rule : t -> Branch.t -> branch_rule option(** [rule t b] is the section that governs [b]: the one named [b], else the first pattern that matches [b]. *)
val names : t -> Branch.t -> bool(** [names t b] is [true] iff [b] is a branch of the DAG: the rules name it, by its own name or by a pattern (doc/rules.md, rule 1). *)
val takes : t -> Branch.t -> Branch.t option(** [takes t b] is the branch [b] takes its commits from, if [b] is fed along an edge. *)
val route : t -> from:Branch.t -> Branch.t -> Branch.t list option(** [route t ~from b] is the branches from [from] to [b] along the edges, [from] first and [b] last, each taking its commits from the one before; [[from]] when [b] is [from]. It is [None] when [b] is not fed, through the branches it takes from, by [from]. *)
val reports : t -> Branch.t -> bool(** [reports t b] is [true] iff the rules of [b] say [report = true]. *)
val paired_wait : t -> Branch.t -> bool(** [paired_wait t b] is [true] iff a land into [b] waits for each dependency's branch paired with [b] to hold what the land locks (doc/commands.md, "The edges"): every branch but one that only reports, which reads what its source locks, held already by the dependency's branch paired with its source. *)
val literals : t -> Branch.t list(** [literals t] is the branches the rules name by their own name, in the order of their sections. *)
val takers : t -> Branch.t -> Branch.t list(** [takers t b] is the branches that take their commits from [b]. *)
val last : t -> Branch.t -> Branch.t(** [last t b] is the last branch along the edges from [b]: [last t n] when exactly one branch [n] takes from [b] and [n] does not report, else [b]. Its tip holds what every check on the way passed. *)
val entry : t -> (Branch.t, [ `Msg of string ]) result(** [entry t] is the entry branch: the [entry] key when present, else the one branch the rules name by its own name that takes no other. *)
val paired : t -> Branch.t -> Branch.t option(** [paired t b] is the branch of the repository [t] rules that is paired with a reader's branch [b], as a lock pairs it (doc/commands.md, "The selected commit"): [b] when [t] names it, [NAME] for a dependency half [CONSUMER/NAME] when [t]'s name is [CONSUMER], else {!entry}, which rules with no entry lack. *)
val input_branches : t -> Branch.t -> Branch.t list(** [input_branches t b] is where a land into [b] reads its inputs, first first ({!Check.branches}): for the serve of an edge, the branch paired with its source, then the branch paired with [b]; [b] alone when no edge feeds it. *)
val check : t -> Check.name -> Check.t option(** [check t n] is the check [n]: its section, or the Git hook it names. *)
val checks : t -> Branch.t -> Check.t list(** [checks t b] is the checks a land into [b] must pass: those its section lists less those its {!field-after} leaves to the edges out of it, in the order it lists them, then, when an edge feeds [b], each check its source's {!field-after} names that [b]'s section does not list; [[]] when no section governs [b] (doc/configuration.md, "[branch.NAME]"). *)
val drain : t -> Branch.t -> Check.t list(** [drain t b] is the checks a drain's lane into [b] passes before it moves [b] (doc/runs.md, "A drain"): the section's [drain] key, each one of its [checks], in the order the key lists them; {!checks} when it has none; [[]] when no section governs [b] (doc/configuration.md). *)
val land_checks : t -> rules_branch:Branch.t -> Branch.t -> Check.t list(** [land_checks t ~rules_branch target] is the checks a land into [target] must pass: the [rules] check for the rules branch [rules_branch], and {!checks}[ t target] otherwise. *)
val vet : t -> Branch.t -> Check.t list(** [vet t b] is the checks an entry into [b] passes on its own commits replayed onto [b]'s tip, as a reading found it, before it may ride a batch into [b] or be predicted on (doc/runs.md, "A vet"): the section's [vet] key, each one of its [checks], in the order the key lists them; [[]] when it names none or no section governs [b] (doc/configuration.md). *)
(** {1:check The rules check}
A land into the rules branch runs one check, {!Check.rules}, which mq provides: it passes when the file loads, every branch it names exists, every check it names resolves at the tip of each branch it is required on, and every lock a bump moves has a repairer (doc/configuration.md). The file loads by {!of_string}. The rest reads the branches of this repository and the files their tips hold, which the shell reads as {!val-lookups} asks and {!val-judge} decides on. *)
val generates : generated -> string list -> bool(** [generates g conflict] is [true] iff [conflict] names a path and every path of it is one of [g]'s files. *)
val regenerates : t -> string list -> bool(** [regenerates t conflict] is [true] iff [conflict] names a path and every path of it is one of [t]'s generated files: the replay takes the target's copy of each, replays the change's sources and runs the generator, rather than holding on a conflict (doc/conflicts.md, "Generated files"). *)
val candidate : string option -> (t, string list) result(** [candidate file] is the rules a land into the rules branch proposes, from the [mq.toml] its replayed tip holds, or why the rules check fails on them: there is no such file, or it does not load in full. *)
type tips = (Branch.t * Commit.t) list(** The type for the local branches of a repository and their tips. *)
type lookups = { in_tree : (Commit.t * Fpath.t) list; (** Files the tree of a tip holds, executable, by their path from its root. *) on_machine : Fpath.t list; (** Files this machine holds, executable. *) locks : Commit.t list; (** The tips whose tree holds a lock ([.mqmodule]): asked, the tips of the branches a bump serves, each the rules name by its own name that takes from no other; found, those whose tree holds one. *)}(** The type for the files the rules check reads. *)
val unrepaired : t -> string option(** [unrepaired t] is why a red bump's repair request under [t] has no repairer, if it has none: no [[repair]] section and no [[resolve]] command, or a [[resolve]] command with no {!type-bounds.field-resolve_wall}. Such a request is a hold nobody discharges, which the rules check refuses ({!judge}). *)
val lookups : t -> rules_branch:Branch.t -> hooks:Check.place -> tips -> lookups(** [lookups t ~rules_branch ~hooks tips] is what the rules check of [t] reads: the program ({!Check.program}, with Git's hooks at [hooks]) of each check at the tip of each branch of [tips] the rules require it on, in the order of [tips] then of the branch's list. The rules branch [rules_branch], which a land into runs the rules check alone, requires nothing. *)
val judge : t -> rules_branch:Branch.t -> hooks:Check.place -> tips -> found:lookups -> (unit, string list) result(** [judge t ~rules_branch ~hooks tips ~found] is the verdict of the rules check of [t], once the files of {!val-lookups} the shell found are [found]: [Ok] when every branch [t] names by its own name is one of [tips], every file looked up was found, and no tip of {!field-locks} found holding a lock is left with no repairer ({!unrepaired}); otherwise each reason it fails, the branches first, then the files in the order of {!val-lookups}, then the unrepaired locks. *)
val summary : t -> string(** [summary t] is the clause [mq init] prints after the rules branch: the DAG as its branches joined by [->], each pattern after them, and, for a DAG of one branch, that branch's checks ([DAG main, check pre-commit], [DAG main, no checks], [DAG staging -> main, release/*]). *)
val equal : t -> t -> bool(** [equal a b] is [true] iff [to_string a] and [to_string b] are equal. *)
val pp : t Fmt.t(** [pp] formats rules as {!to_string} writes them. *)