(** CLI for pre-commit hook initialisation. *) open Cmdliner let setup = Term.( const (fun () () -> ()) $ Vlog.setup ~json_reporter:None "precommit" $ Memtrace.term) (* {1 Styled output} *) let success fmt = Fmt.pf Fmt.stdout ("%a " ^^ fmt ^^ "@.") Fmt.(styled (`Fg `Green) string) "✓" let error fmt = Fmt.pf Fmt.stderr ("%a " ^^ fmt ^^ "@.") Fmt.(styled (`Fg `Red) string) "✗" let info fmt = Fmt.pf Fmt.stdout ("%a " ^^ fmt ^^ "@.") Fmt.(styled (`Fg `Cyan) string) "ℹ" (* {1 Common arguments} *) let chdir = let doc = "Change to $(docv) before running. Equivalent to cd $(docv)." in Arg.(value & opt (some dir) None & info [ "C" ] ~docv:"DIR" ~doc) let dirs = let doc = "Root directories to scan for git projects. Defaults to the current \ directory. Each directory is scanned recursively for repositories \ containing a $(b,.git) entry." in Arg.(value & pos_all dir [ "." ] & info [] ~docv:"DIR" ~doc) let dry_run = let doc = "Show what would be done without making changes." in Arg.(value & flag & info [ "n"; "dry-run" ] ~doc) let force = let doc = "Install hooks even if no dune-project is found." in Arg.(value & flag & info [ "f"; "force" ] ~doc) let hooks_conv = let parse s = let parts = String.split_on_char ',' s in let fmt = List.mem "fmt" parts in let ai = List.mem "ai" parts in if fmt || ai then Ok Precommit.{ fmt; ai } else Error (`Msg "expected comma-separated list of: fmt, ai") in let print ppf h = let parts = (if h.Precommit.fmt then [ "fmt" ] else []) @ if h.Precommit.ai then [ "ai" ] else [] in Fmt.string ppf (String.concat "," parts) in Arg.conv (parse, print) let hooks = let doc = "Which hooks to install. Comma-separated list of: $(b,fmt) (pre-commit \ hook running dune fmt), $(b,ai) (commit-msg hook removing Claude \ attribution). Default: all." in Arg.( value & opt hooks_conv Precommit.all_hooks & info [ "hooks" ] ~doc ~docv:"HOOKS") (* {1 Helpers} *) let or_die = function | Ok () -> () | Error msg -> error "%s" msg; exit 1 let collect_dirs ctx dirs = let result = List.concat_map (fun d -> Precommit.git_projects ctx d) dirs in if result = [] then begin error "No git repositories found"; exit 1 end; result let with_ctx chdir f = Eio_main.run @@ fun env -> let fs = Eio.Stdenv.fs env in let cwd = match chdir with None -> Eio.Stdenv.cwd env | Some d -> Eio.Path.(fs / d) in f (Precommit.ctx ~cwd ~fs) (* {1 Init command} *) let init_impl ctx ~dry_run ~force hooks dirs = let dirs = collect_dirs ctx dirs in let count = ref 0 in let skipped_not_ocaml = ref 0 in let already_configured = ref 0 in List.iter (fun d -> let s = Precommit.status_in_dir ctx d in if not s.is_git_repo then () else if not (force || s.is_ocaml_project) then incr skipped_not_ocaml else let needs_fmt = hooks.Precommit.fmt && not s.has_pre_commit in let needs_ai = hooks.Precommit.ai && not s.has_commit_msg in if needs_fmt || needs_ai then begin or_die (Precommit.init_in_dir ctx ~dry_run ~force ~hooks d); incr count; if dry_run then info "Would initialise %a" Fmt.(styled `Bold string) d else success "Initialised %a" Fmt.(styled `Bold string) d end else incr already_configured) dirs; if !count > 0 then success "Processed %d director%s" !count (if !count = 1 then "y" else "ies") else if !already_configured > 0 then info "All directories already have hooks installed" else if !skipped_not_ocaml > 0 then begin info "No OCaml projects found (use --force to install anyway)"; exit 1 end let init_cmd = let doc = "Initialise pre-commit hooks for OCaml projects." in let man = [ `S Manpage.s_description; `P "Install git hooks that run $(b,dune fmt) before commit and remove \ Claude attribution from commit messages. Also creates \ $(b,.ocamlformat) if missing (unless $(b,--force) is used)."; `S Manpage.s_examples; `P "Initialise hooks in the current directory:"; `Pre " precommit init"; `P "Initialise hooks in all projects under src/:"; `Pre " precommit init src/"; `P "Preview what would be done:"; `Pre " precommit init -n"; `P "Install only the AI attribution hook in a non-OCaml project:"; `Pre " precommit init -f --hooks ai"; `P "Install only the dune fmt hook:"; `Pre " precommit init --hooks fmt"; ] in let info = Cmd.info "init" ~doc ~man in Cmd.v info Term.( const (fun chdir dry_run force hooks dirs () -> with_ctx chdir (fun ctx -> init_impl ctx ~dry_run ~force hooks dirs)) $ chdir $ dry_run $ force $ hooks $ dirs $ setup) (* {1 Status command} *) let check_span b = if b then Tty.Span.styled Tty.Style.(fg Tty.Color.green) "+" else Tty.Span.styled Tty.Style.(fg Tty.Color.red) "-" let status_impl ctx dirs = let dirs = collect_dirs ctx dirs in let missing = ref 0 in let ok = ref 0 in let rows = List.map (fun d -> let s = Precommit.status_in_dir ctx d in if s.is_ocaml_project && s.is_git_repo then begin if not (s.has_pre_commit && s.has_commit_msg && s.has_ocamlformat) then incr missing else if s.formatting_disabled then incr missing else incr ok end; [ Tty.Span.text d; check_span s.has_pre_commit; check_span s.has_commit_msg; check_span s.has_ocamlformat; check_span (not s.formatting_disabled); ]) dirs in let table = Tty.Table.( of_rows ~border:Tty.Border.rounded [ column "directory"; column ~align:`Center "pre-commit"; column ~align:`Center "commit-msg"; column ~align:`Center "ocamlformat"; column ~align:`Center "formatting"; ] rows) in Tty.Table.pp Format.std_formatter table; Format.pp_print_newline Format.std_formatter (); (* Summary *) if !missing > 0 then begin Fmt.pf Fmt.stdout "%a %d project%s with missing hooks@." Fmt.(styled (`Fg `Red) string) "✗" !missing (if !missing = 1 then "" else "s"); exit 1 end else if !ok > 0 then success "%d project%s properly configured" !ok (if !ok = 1 then "" else "s") let status chdir dirs () = with_ctx chdir (fun ctx -> status_impl ctx dirs) let status_cmd = let doc = "Check pre-commit hook status." in let man = [ `S Manpage.s_description; `P "Show which directories have hooks installed."; `P "Columns show: pre-commit hook, commit-msg hook, .ocamlformat file, \ formatting enabled. Exit code is 1 if any OCaml project is missing \ hooks, .ocamlformat, or has formatting disabled."; `S Manpage.s_examples; `P "Check status of all projects under src/:"; `Pre " precommit status src/"; ] in let info = Cmd.info "status" ~doc ~man in Cmd.v info Term.(const status $ chdir $ dirs $ setup) (* {1 Check command} *) let terminal_width () = try let ic = Unix.open_process_in "tput cols 2>/dev/null" in let width = int_of_string (String.trim (input_line ic)) in ignore (Unix.close_process_in ic); width with Failure _ | End_of_file | Unix.Unix_error _ -> 80 let truncate_subject max_len s = if String.length s <= max_len then s else String.sub s 0 (max_len - 1) ^ "…" (* Shared: find AI commits across dirs and display a unified table. Returns [(affected_dirs, total_commits, repos_with_issues)]. *) let commit_row subject_max d first (c : Precommit.ai_commit) = let project_cell = if !first then begin first := false; Tty.Span.styled Tty.Style.bold d end else Tty.Span.text "" in [ project_cell; Tty.Span.styled Tty.Style.(fg Tty.Color.yellow) c.hash; Tty.Span.text (truncate_subject subject_max c.subject); ] let display_ai_commits ctx dirs = let term_width = terminal_width () in let subject_max = max 20 (term_width - 35) in let total_commits = ref 0 in let repos_with_issues = ref 0 in let all_rows = ref [] in let affected_dirs = ref [] in List.iter (fun d -> let commits = Precommit.check_ai_attribution ctx d in if commits <> [] then begin incr repos_with_issues; total_commits := !total_commits + List.length commits; affected_dirs := d :: !affected_dirs; let first = ref true in let rows = List.map (commit_row subject_max d first) commits in all_rows := !all_rows @ rows end) dirs; if !all_rows <> [] then begin let table = Tty.Table.( of_rows ~border:Tty.Border.rounded [ column ~align:`Left "project"; column ~align:`Left "hash"; column ~align:`Left "subject"; ] !all_rows) in Tty.Table.pp Format.std_formatter table; Format.pp_print_newline Format.std_formatter () end; (List.rev !affected_dirs, !total_commits, !repos_with_issues) let check_impl ctx dirs = let dirs = collect_dirs ctx dirs in let _affected, total_commits, repos_with_issues = display_ai_commits ctx dirs in if total_commits > 0 then begin error "%d commit%s with AI attribution in %d repo%s" total_commits (if total_commits = 1 then "" else "s") repos_with_issues (if repos_with_issues = 1 then "" else "s"); exit 1 end else success "No AI attribution found in commit history" let check chdir dirs () = with_ctx chdir (fun ctx -> check_impl ctx dirs) let check_cmd = let doc = "Check git history for commits with AI attribution." in let man = [ `S Manpage.s_description; `P "Scan git history for commits by the configured user that contain \ 'claude' in the commit message. Exit code is 1 if any are found."; `S Manpage.s_examples; `P "Check all projects under src/:"; `Pre " precommit check src/"; `P "Check a specific directory:"; `Pre " precommit check -C ../src/ocaml-requests"; ] in let info = Cmd.info "check" ~doc ~man in Cmd.v info Term.(const check $ chdir $ dirs $ setup) (* {1 Fix command} *) let confirm_prompt n_repos = let warning = Tty.Panel.lines ~border: (Tty.Border.with_style Tty.Style.(fg Tty.Color.yellow) Tty.Border.rounded) ~title:(Tty.Span.styled Tty.Style.(fg Tty.Color.yellow) "Warning") [ Tty.Span.text (Fmt.str "This will rewrite git history in %d repositor%s." n_repos (if n_repos = 1 then "y" else "ies")); Tty.Span.text "Branches will be backed up before rewriting."; ] in Tty.Panel.pp Format.std_formatter warning; Format.pp_print_newline Format.std_formatter (); Fmt.pf Fmt.stdout "Continue? [y/N] %!"; let line = try input_line stdin with End_of_file -> "" in let answer = String.trim line in answer = "y" || answer = "Y" let plural n = if n = 1 then "" else "s" let run_fixes ctx affected = let fixed = Atomic.make 0 in let errors = Atomic.make 0 in Eio.Fiber.all (List.map (fun d () -> let backup = Precommit.backup_branch ctx d in success "%s: backed up to %s" d backup; match Precommit.rewrite_ai_attribution ctx d with | Ok _ -> Atomic.incr fixed; success "%s: attribution removed" d | Error msg -> Atomic.incr errors; error "%s" msg) affected); (Atomic.get fixed, Atomic.get errors) let fix_impl ctx ~dry_run ~yes dirs = let dirs = collect_dirs ctx dirs in let affected, total_commits, repos_with_issues = display_ai_commits ctx dirs in if total_commits = 0 then success "No AI attribution found in commit history" else if dry_run then begin info "Would rewrite %d commit%s in %d repo%s" total_commits (plural total_commits) repos_with_issues (plural repos_with_issues); List.iter (fun d -> let branch = Precommit.current_branch ctx d in let name = Option.value ~default:"HEAD" branch in info "Would backup %s:%s before rewriting" d name) affected end else begin if not yes then if not (confirm_prompt repos_with_issues) then begin info "Aborted"; exit 0 end; Format.pp_print_newline Format.std_formatter (); let n_fixed, n_errors = run_fixes ctx affected in if n_errors > 0 then begin error "%d repo%s fixed, %d error%s" n_fixed (plural n_fixed) n_errors (plural n_errors); exit 1 end else success "%d repo%s fixed" n_fixed (plural n_fixed) end let yes = let doc = "Skip interactive confirmation prompt." in Arg.(value & flag & info [ "y"; "yes" ] ~doc) let fix_cmd = let doc = "Remove AI attribution from commit history." in let man = [ `S Manpage.s_description; `P "Scan git history for commits with AI attribution (Co-Authored-By: \ Claude) and rewrite them to remove the attribution lines. This \ rewrites git history using $(b,git filter-branch)."; `P "Before rewriting, the current branch is backed up to \ $(b,backup/-before-fix-). Use $(b,--yes) to skip \ the interactive confirmation prompt."; `S Manpage.s_examples; `P "Fix all projects under the current directory:"; `Pre " precommit fix"; `P "Preview what would be done:"; `Pre " precommit fix -n"; `P "Fix without confirmation prompt:"; `Pre " precommit fix -y"; ] in let info = Cmd.info "fix" ~doc ~man in Cmd.v info Term.( const (fun chdir dry_run yes dirs () -> with_ctx chdir (fun ctx -> fix_impl ctx ~dry_run ~yes dirs)) $ chdir $ dry_run $ yes $ dirs $ setup) (* {1 Main} *) let cmd = let doc = "Manage pre-commit hooks for OCaml projects." in let man = [ `S Manpage.s_description; `P "$(tname) installs git hooks that enforce code formatting and commit \ message hygiene for OCaml projects."; `S "ENVIRONMENT"; `P "$(b,PRECOMMIT_LOG) can be set to configure logging levels (e.g., \ $(b,debug) or $(b,info))."; `S Manpage.s_bugs; `P "Report issues at https://github.com/gazagnaire.org/ocaml-precommit"; `S "EXIT STATUS"; `P "$(b,0) on success."; `P "$(b,1) if hooks are missing (status) or initialisation failed."; ] in let info = Cmd.info "precommit" ~version:Monopam_info.version ~doc ~man in let default = setup in Cmd.group info ~default [ init_cmd; status_cmd; check_cmd; fix_cmd ] let () = exit (Cmd.eval cmd)