ocaml-precommit / bin / main.ml

(** 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/<branch>-before-fix-<timestamp>). 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)