Something went wrong. Try again.
My own corner of monopam
Something went wrong. Try again.
5.1 kB · 129 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130open Cmdliner
let hooks_path = let doc = "Directory the repository tracks its hooks in, resolved against the \ work-tree root. A relative $(docv) resolves against each worktree's own \ root, so one wiring covers every worktree of a clone." in Arg.(value & opt string ".githooks" & info [ "hooks-path" ] ~docv:"DIR" ~doc)
(* Reporting, previewing and wiring are three things to do, not three flags to combine: asking for two of them at once has no meaning, and vflag refuses it rather than picking one. *)let action = let check = let doc = "Report whether this clone is wired and write nothing. Exit code is 1 \ when it is not." in (`Check, Arg.info [ "check" ] ~doc) in let dry_run = let doc = "Show what wiring would do, without doing it." in (`Dry_run, Arg.info [ "n"; "dry-run" ] ~doc) in Arg.(value & vflag `Wire [ check; dry_run ])
let force = let doc = "Wire even when git runs a hook the tracked directory does not carry, \ retiring it." in Arg.(value & flag & info [ "f"; "force" ] ~doc)
let report_hook (name, exec) = if exec then Common.success "%s is executable" name else Common.error "%s is not executable, so git skips it" name
let report (s : Precommit.link_status) = if s.by_mq then Common.success "core.hooksPath is %s, mq's copy of %s" s.hooks_dir s.tracked_dir else if s.wired then Common.success "core.hooksPath is %s" s.tracked_dir else Option.iter (Common.error "%s") (Precommit.unwired s); (match s.tracked_hooks with | [] -> Common.error "%s carries no hook" s.tracked_dir | hooks -> List.iter report_hook hooks); match s.shadowed with | [] -> () | names -> Common.info "git also runs, from outside %s: %s" s.tracked_dir (String.concat ", " names)
(* Wired means every part of it: git reads the tracked directory, and the hooks there are executable. A hook git reads but cannot execute is skipped without a word, which is the same silence as no hook at all. *)let is_wired (s : Precommit.link_status) = match s.tracked_hooks with | [] -> false | hooks -> s.wired && List.for_all snd hooks
let check_impl ctx ~proc ~tracked_dir = match Precommit.link_status ctx ~proc ~tracked_dir "." with | Error msg -> Common.error "%s" msg; exit 1 | Ok s -> report s; if not (is_wired s) then exit 1
let wire_impl ctx ~proc ~force ~tracked_dir = Common.or_die (Precommit.link ctx ~proc ~dry_run:false ~force ~tracked_dir "."); check_impl ctx ~proc ~tracked_dir
let run chdir tracked_dir action force () = Common.with_env chdir (fun ctx env -> let proc = Eio.Stdenv.process_mgr env in match action with | `Check -> check_impl ctx ~proc ~tracked_dir | `Dry_run -> Common.or_die (Precommit.link ctx ~proc ~dry_run:true ~force ~tracked_dir ".") | `Wire -> wire_impl ctx ~proc ~force ~tracked_dir)
let cmd = let doc = "Point this clone at the hooks directory the repository tracks." in let man = [ `S Manpage.s_description; `P "Git runs the hooks of $(b,core.hooksPath) when that is set, and of \ $(b,.git/hooks) otherwise. Only the first can be a directory git \ tracks. $(tname) sets it, so that the hooks a repository carries are \ the hooks it runs, and makes executable any hook there that is not."; `P "The value is relative, so each worktree runs the hooks its own \ checkout carries. Git runs a push's hooks from the git directory, \ where that value names nothing, so $(tname) also links the tracked \ directory's path under $(b,.git) to the main worktree's, and refuses \ anything else standing there. $(b,--check) fails on an absolute value \ and on a missing link."; `P "Setting $(b,core.hooksPath) retires every hook outside it, so \ $(tname) refuses when git runs one the tracked directory does not \ carry, and names it. $(b,--force) wires anyway."; `P "A primary mq serves runs mq's copy of the tracked directory, as the \ tip of its queue's ref holds it: $(b,mq.hooks) names the tracked \ directory and $(b,core.hooksPath) a directory under the git \ directory. $(tname) leaves that setting alone and $(b,--check) \ accepts it."; `P "This is once per clone: git cannot run a hook a clone does not have \ yet, so nothing a repository carries can gate the first commit of an \ unwired one. $(b,--check) is what makes that state visible, in a \ bootstrap script or by hand."; `S Manpage.s_examples; `P "Wire this clone:"; `Pre " precommit link"; `P "Ask whether it is wired, changing nothing:"; `Pre " precommit link --check"; `P "Wire a repository that tracks its hooks elsewhere:"; `Pre " precommit link --hooks-path tools/hooks"; ] in let info = Cmd.info "link" ~doc ~man in Cmd.v info Term.(const run $ Common.chdir $ hooks_path $ action $ force $ Common.setup)