Installs pre-commit hooks for OCaml projects that run dune fmt automatically
precommit: support running check/fix from git subdirectories
When running `precommit check` or `precommit fix` from a subdirectory
of a git repository (e.g., projects/fprime-ocaml when .git is at the
parent), the commands now correctly walk up the filesystem to find the
git root.
Changes:
- Add is_inside_git_repo to detect when cwd is inside a git repo
- Update find_git_projects to include directories inside git repos
- Update find_git_root to use absolute paths and full filesystem
- Update current_branch, backup_branch, rewrite_ai_attribution to
use find_git_root for locating the git repository
- Handle filesystem permission errors gracefully when walking up
+341
-174
+27
-22
bin/main.ml
+27
-22
bin/main.ml
···
2
2
3
3
open Cmdliner
4
4
5
-
let log_src = Logs.Src.create "precommit"
6
-
7
-
module Log = (val Logs.src_log log_src : Logs.LOG)
8
-
9
5
(* {1 Styled output} *)
10
6
11
7
let success fmt =
···
75
71
error "%s" msg;
76
72
exit 1
77
73
78
-
let collect_dirs ~fs dirs =
79
-
List.concat_map (fun d -> Precommit.find_git_projects ~fs d) dirs
74
+
let collect_dirs ~cwd ~fs dirs =
75
+
List.concat_map (fun d -> Precommit.find_git_projects ~cwd ~fs d) dirs
80
76
81
77
(* {1 Init command} *)
82
78
83
79
let init_impl ~fs dry_run force hooks dirs =
84
-
let dirs = collect_dirs ~fs dirs in
80
+
let dirs = collect_dirs ~cwd:fs ~fs dirs in
85
81
let count = ref 0 in
86
82
List.iter
87
83
(fun d ->
···
98
94
dirs;
99
95
if !count = 0 then info "All directories already have hooks installed"
100
96
else
101
-
Log.info (fun m ->
102
-
m "Processed %d director%s" !count (if !count = 1 then "y" else "ies"))
97
+
success "Processed %d director%s" !count (if !count = 1 then "y" else "ies")
103
98
104
-
let init chdir dry_run force hooks dirs =
99
+
let init chdir dry_run force hooks dirs () =
105
100
Eio_main.run @@ fun env ->
106
101
let fs =
107
102
match chdir with
···
133
128
]
134
129
in
135
130
let info = Cmd.info "init" ~doc ~man in
136
-
Cmd.v info Term.(const init $ chdir $ dry_run $ force $ hooks $ dirs)
131
+
Cmd.v info
132
+
Term.(
133
+
const init $ chdir $ dry_run $ force $ hooks $ dirs
134
+
$ Vlog.setup ~json_reporter:None "precommit")
137
135
138
136
(* {1 Status command} *)
139
137
···
142
140
else Tty.Span.styled Tty.Style.(fg Tty.Color.red) "-"
143
141
144
142
let status_impl ~fs dirs =
145
-
let dirs = collect_dirs ~fs dirs in
143
+
let dirs = collect_dirs ~cwd:fs ~fs dirs in
146
144
let missing = ref 0 in
147
145
let ok = ref 0 in
148
146
let rows =
···
189
187
else if !ok > 0 then
190
188
success "%d project%s properly configured" !ok (if !ok = 1 then "" else "s")
191
189
192
-
let status chdir dirs =
190
+
let status chdir dirs () =
193
191
Eio_main.run @@ fun env ->
194
192
let fs =
195
193
match chdir with
···
214
212
]
215
213
in
216
214
let info = Cmd.info "status" ~doc ~man in
217
-
Cmd.v info Term.(const status $ chdir $ dirs)
215
+
Cmd.v info
216
+
Term.(
217
+
const status $ chdir $ dirs $ Vlog.setup ~json_reporter:None "precommit")
218
218
219
219
(* {1 Check command} *)
220
220
···
284
284
(List.rev !affected_dirs, !total_commits, !repos_with_issues)
285
285
286
286
let check_impl ~cwd ~fs dirs =
287
-
let dirs = collect_dirs ~fs:cwd dirs in
287
+
let dirs = collect_dirs ~cwd ~fs dirs in
288
288
let _affected, total_commits, repos_with_issues =
289
289
find_and_display_ai_commits ~cwd ~fs dirs
290
290
in
···
297
297
end
298
298
else success "No AI attribution found in commit history"
299
299
300
-
let check chdir dirs =
300
+
let check chdir dirs () =
301
301
Eio_main.run @@ fun env ->
302
302
let fs = Eio.Stdenv.fs env in
303
303
let cwd =
···
321
321
]
322
322
in
323
323
let info = Cmd.info "check" ~doc ~man in
324
-
Cmd.v info Term.(const check $ chdir $ dirs)
324
+
Cmd.v info
325
+
Term.(
326
+
const check $ chdir $ dirs $ Vlog.setup ~json_reporter:None "precommit")
325
327
326
328
(* {1 Fix command} *)
327
329
···
349
351
answer = "y" || answer = "Y"
350
352
351
353
let fix_impl ~cwd ~fs dry_run yes dirs =
352
-
let dirs = collect_dirs ~fs:cwd dirs in
354
+
let dirs = collect_dirs ~cwd ~fs dirs in
353
355
let affected, total_commits, repos_with_issues =
354
356
find_and_display_ai_commits ~cwd ~fs dirs
355
357
in
···
361
363
(if repos_with_issues = 1 then "" else "s");
362
364
List.iter
363
365
(fun d ->
364
-
let branch = Precommit.current_branch ~fs:cwd d in
366
+
let branch = Precommit.current_branch ~cwd ~fs d in
365
367
let name = Option.value ~default:"HEAD" branch in
366
368
info "Would backup %s:%s before rewriting" d name)
367
369
affected
···
377
379
Eio.Fiber.all
378
380
(List.map
379
381
(fun d () ->
380
-
let backup = Precommit.backup_branch ~fs:cwd d in
382
+
let backup = Precommit.backup_branch ~cwd ~fs d in
381
383
success "%s: backed up to %s" d backup;
382
384
match Precommit.rewrite_ai_attribution ~cwd ~fs d with
383
385
| Ok _ ->
···
404
406
let doc = "Skip interactive confirmation prompt." in
405
407
Arg.(value & flag & info [ "y"; "yes" ] ~doc)
406
408
407
-
let fix chdir dry_run yes dirs =
409
+
let fix chdir dry_run yes dirs () =
408
410
Eio_main.run @@ fun env ->
409
411
let fs = Eio.Stdenv.fs env in
410
412
let cwd =
···
435
437
]
436
438
in
437
439
let info = Cmd.info "fix" ~doc ~man in
438
-
Cmd.v info Term.(const fix $ chdir $ dry_run $ yes $ dirs)
440
+
Cmd.v info
441
+
Term.(
442
+
const fix $ chdir $ dry_run $ yes $ dirs
443
+
$ Vlog.setup ~json_reporter:None "precommit")
439
444
440
445
(* {1 Main} *)
441
446
+295
-143
lib/precommit.ml
+295
-143
lib/precommit.ml
···
2
2
3
3
Installs git hooks directly without requiring the pre-commit tool. *)
4
4
5
+
let log_src = Logs.Src.create "precommit"
6
+
7
+
module Log = (val Logs.src_log log_src : Logs.LOG)
8
+
5
9
let pre_commit_hook =
6
10
{|#!/bin/sh
7
11
# Auto-format OCaml files with dune before commit
···
201
205
if is_directory ~fs path then Some path else None)
202
206
|> List.sort String.compare
203
207
204
-
let rec find_git_projects ~fs dir =
205
-
let entries = try Eio.Path.read_dir Eio.Path.(fs / dir) with _ -> [] in
208
+
(* Check if dir is inside a git repo by walking up to find .git.
209
+
Uses the full filesystem (not sandboxed cwd) to walk up to parent directories.
210
+
[cwd] is the working directory path, [fs] is the full filesystem. *)
211
+
let is_inside_git_repo ~cwd ~fs dir =
212
+
(* Get absolute path by resolving relative to cwd *)
213
+
let _, cwd_path = cwd in
214
+
(* If cwd_path is empty or ".", use the actual working directory *)
215
+
let base_path =
216
+
if cwd_path = "" || cwd_path = "." then Sys.getcwd () else cwd_path
217
+
in
218
+
let abs_dir =
219
+
if Filename.is_relative dir then Filename.concat base_path dir else dir
220
+
in
221
+
(* Normalize trailing /. *)
222
+
let abs_dir =
223
+
if
224
+
String.length abs_dir >= 2
225
+
&& String.sub abs_dir (String.length abs_dir - 2) 2 = "/."
226
+
then String.sub abs_dir 0 (String.length abs_dir - 2)
227
+
else abs_dir
228
+
in
229
+
Log.debug (fun m -> m "is_inside_git_repo: dir=%s abs_dir=%s" dir abs_dir);
230
+
let check_path path =
231
+
try
232
+
match Eio.Path.kind ~follow:true Eio.Path.(fs / path) with
233
+
| `Not_found -> `Not_found
234
+
| _ -> `Found
235
+
with Eio.Io _ -> `Error (* Permission denied or other FS error *)
236
+
in
237
+
let rec walk path =
238
+
let git_dir = Filename.concat path ".git" in
239
+
Log.debug (fun m -> m "is_inside_git_repo: checking %s" git_dir);
240
+
match check_path git_dir with
241
+
| `Found -> true (* .git exists *)
242
+
| `Error -> false (* Can't access, assume not in git repo *)
243
+
| `Not_found ->
244
+
let parent = Filename.dirname path in
245
+
if parent = path then false (* reached filesystem root *)
246
+
else walk parent
247
+
in
248
+
(* Don't count if dir itself has .git - only if an ancestor does *)
249
+
let has_git_here =
250
+
match check_path (Filename.concat abs_dir ".git") with
251
+
| `Found -> true
252
+
| _ -> false
253
+
in
254
+
if has_git_here then false else walk abs_dir
255
+
256
+
let rec find_git_projects ~cwd ~fs dir =
257
+
let entries = try Eio.Path.read_dir Eio.Path.(cwd / dir) with _ -> [] in
206
258
let child_path name = if dir = "." then name else Filename.concat dir name in
207
-
let self = if List.mem ".git" entries then [ dir ] else [] in
259
+
(* If dir has .git, include it *)
260
+
let self_has_git = List.mem ".git" entries in
261
+
(* If dir is inside a git repo (ancestor has .git), include it *)
262
+
let self_inside_repo =
263
+
(not self_has_git) && is_inside_git_repo ~cwd ~fs dir
264
+
in
265
+
let self = if self_has_git || self_inside_repo then [ dir ] else [] in
266
+
(* Only descend into children if we haven't found a git root yet *)
208
267
let children =
209
-
entries
210
-
|> List.filter_map (fun name ->
211
-
if String.length name > 0 && (name.[0] = '.' || name.[0] = '_') then
212
-
None
213
-
else
214
-
let path = child_path name in
215
-
(* Skip symlinks to avoid traversing outside the sandbox *)
216
-
if is_symlink ~fs path then None
217
-
else if is_directory ~fs path then Some path
218
-
else None)
219
-
|> List.sort String.compare
220
-
|> List.concat_map (fun sub ->
221
-
if file_exists ~fs (Filename.concat sub ".git") then [ sub ]
222
-
else find_git_projects ~fs sub)
268
+
if self_has_git || self_inside_repo then []
269
+
else
270
+
entries
271
+
|> List.filter_map (fun name ->
272
+
if String.length name > 0 && (name.[0] = '.' || name.[0] = '_') then
273
+
None
274
+
else
275
+
let path = child_path name in
276
+
(* Skip symlinks to avoid traversing outside the sandbox *)
277
+
if is_symlink ~fs:cwd path then None
278
+
else if is_directory ~fs:cwd path then Some path
279
+
else None)
280
+
|> List.sort String.compare
281
+
|> List.concat_map (fun sub ->
282
+
if file_exists ~fs:cwd (Filename.concat sub ".git") then [ sub ]
283
+
else find_git_projects ~cwd ~fs sub)
223
284
in
224
285
self @ children
225
286
···
266
327
let committer_email = Git.User.email (Git.Commit.committer commit) in
267
328
String.equal email committer_email
268
329
330
+
(* Find git root by walking up from dir.
331
+
[cwd] is the working directory path, [fs] is the full filesystem. *)
332
+
let find_git_root ~cwd ~fs dir =
333
+
let _, cwd_path = cwd in
334
+
(* If cwd_path is empty or ".", use the actual working directory *)
335
+
let base_path =
336
+
if cwd_path = "" || cwd_path = "." then Sys.getcwd () else cwd_path
337
+
in
338
+
let abs_dir =
339
+
if Filename.is_relative dir then Filename.concat base_path dir else dir
340
+
in
341
+
(* Normalize trailing /. *)
342
+
let abs_dir =
343
+
if
344
+
String.length abs_dir >= 2
345
+
&& String.sub abs_dir (String.length abs_dir - 2) 2 = "/."
346
+
then String.sub abs_dir 0 (String.length abs_dir - 2)
347
+
else abs_dir
348
+
in
349
+
Log.debug (fun m -> m "find_git_root: dir=%s abs_dir=%s" dir abs_dir);
350
+
let rec walk path =
351
+
let git_dir = Filename.concat path ".git" in
352
+
Log.debug (fun m -> m "find_git_root: checking %s" git_dir);
353
+
match Eio.Path.kind ~follow:true Eio.Path.(fs / git_dir) with
354
+
| `Not_found ->
355
+
let parent = Filename.dirname path in
356
+
if parent = path then None (* reached filesystem root *)
357
+
else walk parent
358
+
| _ -> Some path
359
+
in
360
+
walk abs_dir
361
+
269
362
let check_ai_attribution ~cwd ~fs dir =
270
-
if not (file_exists ~fs:cwd (Filename.concat dir ".git")) then []
271
-
else
272
-
let repo = Git.Repository.open_repo ~fs:cwd (Fpath.v dir) in
273
-
let user_email = get_user_email ~fs repo in
274
-
match Git.Repository.head repo with
275
-
| None -> []
276
-
| Some head_hash ->
277
-
(* Get all commits from HEAD *)
278
-
let commits =
279
-
match
280
-
Git.Rev_list.topo_sort_reverse repo head_hash ~stop:(fun _ -> false)
281
-
with
282
-
| Ok cs -> cs
283
-
| Error _ -> []
284
-
in
285
-
(* Find commits with AI attribution in message, only from current user *)
286
-
List.filter_map
287
-
(fun (info : Git.Rev_list.commit_info) ->
288
-
match Git.Repository.read repo info.hash with
289
-
| Ok (Git.Value.Commit c) when is_my_commit ~user_email c -> (
290
-
match Git.Commit.message c with
291
-
| Some msg when message_has_ai_attribution msg ->
292
-
let hash = String.sub (Git.Hash.to_hex info.hash) 0 7 in
293
-
let subject =
294
-
match String.split_on_char '\n' msg with
295
-
| subj :: _ -> String.trim subj
296
-
| [] -> ""
297
-
in
298
-
Some { hash; subject }
363
+
Log.debug (fun m -> m "check_ai_attribution: dir=%s" dir);
364
+
match find_git_root ~cwd ~fs dir with
365
+
| None ->
366
+
Log.debug (fun m ->
367
+
m "check_ai_attribution: no git root found for %s" dir);
368
+
[]
369
+
| Some git_root -> (
370
+
Log.debug (fun m -> m "check_ai_attribution: git_root=%s" git_root);
371
+
(* Use full filesystem for absolute paths *)
372
+
let repo = Git.Repository.open_repo ~fs (Fpath.v git_root) in
373
+
let user_email = get_user_email ~fs repo in
374
+
Log.debug (fun m ->
375
+
m "check_ai_attribution: git_root=%s user_email=%s" git_root
376
+
(Option.value ~default:"<none>" user_email));
377
+
match Git.Repository.head repo with
378
+
| None ->
379
+
Log.debug (fun m -> m "check_ai_attribution: no HEAD");
380
+
[]
381
+
| Some head_hash ->
382
+
Log.debug (fun m ->
383
+
m "check_ai_attribution: HEAD=%s" (Git.Hash.to_hex head_hash));
384
+
(* Get all commits from HEAD *)
385
+
let commits =
386
+
match
387
+
Git.Rev_list.topo_sort_reverse repo head_hash ~stop:(fun _ ->
388
+
false)
389
+
with
390
+
| Ok cs ->
391
+
Log.debug (fun m ->
392
+
m "check_ai_attribution: %d commits" (List.length cs));
393
+
cs
394
+
| Error (`Msg e) ->
395
+
Log.debug (fun m -> m "check_ai_attribution: error %s" e);
396
+
[]
397
+
in
398
+
(* Find commits with AI attribution in message, only from current user *)
399
+
let found = ref 0 in
400
+
let skipped_email = ref 0 in
401
+
let skipped_no_ai = ref 0 in
402
+
let result =
403
+
List.filter_map
404
+
(fun (info : Git.Rev_list.commit_info) ->
405
+
match Git.Repository.read repo info.hash with
406
+
| Ok (Git.Value.Commit c) ->
407
+
if not (is_my_commit ~user_email c) then begin
408
+
incr skipped_email;
409
+
None
410
+
end
411
+
else
412
+
let msg = Git.Commit.message c in
413
+
let has_ai =
414
+
match msg with
415
+
| Some m -> message_has_ai_attribution m
416
+
| None -> false
417
+
in
418
+
if has_ai then begin
419
+
incr found;
420
+
let hash = String.sub (Git.Hash.to_hex info.hash) 0 7 in
421
+
let subject =
422
+
match msg with
423
+
| Some m -> (
424
+
match String.split_on_char '\n' m with
425
+
| subj :: _ -> String.trim subj
426
+
| [] -> "")
427
+
| None -> ""
428
+
in
429
+
Some { hash; subject }
430
+
end
431
+
else begin
432
+
incr skipped_no_ai;
433
+
None
434
+
end
299
435
| _ -> None)
300
-
| _ -> None)
301
-
commits
436
+
commits
437
+
in
438
+
Log.debug (fun m ->
439
+
m
440
+
"check_ai_attribution: found=%d skipped_email=%d \
441
+
skipped_no_ai=%d"
442
+
!found !skipped_email !skipped_no_ai);
443
+
result)
302
444
303
-
let current_branch ~fs dir =
304
-
if not (file_exists ~fs (Filename.concat dir ".git")) then None
305
-
else
306
-
let repo = Git.Repository.open_repo ~fs (Fpath.v dir) in
307
-
Git.Repository.current_branch repo
445
+
let current_branch ~cwd ~fs dir =
446
+
match find_git_root ~cwd ~fs dir with
447
+
| None -> None
448
+
| Some git_root ->
449
+
let repo = Git.Repository.open_repo ~fs (Fpath.v git_root) in
450
+
Git.Repository.current_branch repo
308
451
309
-
let backup_branch ~fs dir =
310
-
let repo = Git.Repository.open_repo ~fs (Fpath.v dir) in
311
-
let branch =
312
-
match Git.Repository.current_branch repo with Some b -> b | None -> "HEAD"
313
-
in
314
-
let now = Unix.gettimeofday () in
315
-
let tm = Unix.localtime now in
316
-
let timestamp =
317
-
Printf.sprintf "%04d%02d%02d-%02d%02d%02d" (1900 + tm.tm_year)
318
-
(tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec
319
-
in
320
-
let backup_name = Printf.sprintf "backup/%s-before-fix-%s" branch timestamp in
321
-
match Git.Repository.head repo with
322
-
| Some hash ->
323
-
Git.Repository.write_ref repo ("refs/heads/" ^ backup_name) hash;
452
+
let backup_branch ~cwd ~fs dir =
453
+
match find_git_root ~cwd ~fs dir with
454
+
| None -> failwith (Printf.sprintf "%s: No .git directory found" dir)
455
+
| Some git_root ->
456
+
let repo = Git.Repository.open_repo ~fs (Fpath.v git_root) in
457
+
let branch =
458
+
match Git.Repository.current_branch repo with
459
+
| Some b -> b
460
+
| None -> "HEAD"
461
+
in
462
+
let now = Unix.gettimeofday () in
463
+
let tm = Unix.localtime now in
464
+
let timestamp =
465
+
Printf.sprintf "%04d%02d%02d-%02d%02d%02d" (1900 + tm.tm_year)
466
+
(tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec
467
+
in
468
+
let backup_name =
469
+
Printf.sprintf "backup/%s-before-fix-%s" branch timestamp
470
+
in
471
+
(match Git.Repository.head repo with
472
+
| Some hash ->
473
+
Git.Repository.write_ref repo ("refs/heads/" ^ backup_name) hash
474
+
| None -> ());
324
475
backup_name
325
-
| None -> backup_name
326
476
327
477
let rewrite_ai_attribution ~cwd ~fs dir =
328
-
if not (file_exists ~fs:cwd (Filename.concat dir ".git")) then
329
-
Error (Printf.sprintf "%s: No .git directory found" dir)
330
-
else
331
-
let repo = Git.Repository.open_repo ~fs:cwd (Fpath.v dir) in
332
-
let user_email = get_user_email ~fs repo in
333
-
match Git.Repository.head repo with
334
-
| None -> Ok 0
335
-
| Some head_hash ->
336
-
(* Get all commits from HEAD in topological order (oldest first) *)
337
-
let commits =
338
-
match
339
-
Git.Rev_list.topo_sort_reverse repo head_hash ~stop:(fun _ -> false)
340
-
with
341
-
| Ok cs -> cs
342
-
| Error _ -> []
343
-
in
344
-
(* Find which commits need rewriting (only from current user) *)
345
-
let needs_rewrite = Hashtbl.create 64 in
346
-
List.iter
347
-
(fun (info : Git.Rev_list.commit_info) ->
348
-
match Git.Repository.read repo info.hash with
349
-
| Ok (Git.Value.Commit c) when is_my_commit ~user_email c -> (
350
-
match Git.Commit.message c with
351
-
| Some msg when message_has_ai_attribution msg ->
352
-
Hashtbl.add needs_rewrite info.hash true
353
-
| _ -> ())
354
-
| _ -> ())
355
-
commits;
356
-
if Hashtbl.length needs_rewrite = 0 then Ok 0
357
-
else
358
-
(* Rewrite commits, building mapping of old -> new hashes *)
359
-
let hash_map = Hashtbl.create 64 in
478
+
match find_git_root ~cwd ~fs dir with
479
+
| None -> Error (Printf.sprintf "%s: No .git directory found" dir)
480
+
| Some git_root -> (
481
+
let repo = Git.Repository.open_repo ~fs (Fpath.v git_root) in
482
+
let user_email = get_user_email ~fs repo in
483
+
match Git.Repository.head repo with
484
+
| None -> Ok 0
485
+
| Some head_hash ->
486
+
(* Get all commits from HEAD in topological order (oldest first) *)
487
+
let commits =
488
+
match
489
+
Git.Rev_list.topo_sort_reverse repo head_hash ~stop:(fun _ ->
490
+
false)
491
+
with
492
+
| Ok cs -> cs
493
+
| Error _ -> []
494
+
in
495
+
(* Find which commits need rewriting (only from current user) *)
496
+
let needs_rewrite = Hashtbl.create 64 in
360
497
List.iter
361
498
(fun (info : Git.Rev_list.commit_info) ->
362
499
match Git.Repository.read repo info.hash with
363
-
| Ok (Git.Value.Commit c) ->
364
-
(* Update parent references *)
365
-
let new_parents =
366
-
List.map
367
-
(fun p ->
368
-
match Hashtbl.find_opt hash_map p with
369
-
| Some new_p -> new_p
370
-
| None -> p)
371
-
(Git.Commit.parents c)
372
-
in
373
-
let parents_changed =
374
-
not
375
-
(List.equal Git.Hash.equal new_parents
376
-
(Git.Commit.parents c))
377
-
in
378
-
let msg = Git.Commit.message c in
379
-
let needs_msg_rewrite =
380
-
match msg with
381
-
| Some m -> message_has_ai_attribution m
382
-
| None -> false
383
-
in
384
-
if parents_changed || needs_msg_rewrite then begin
385
-
let new_msg =
386
-
match msg with
387
-
| Some m -> Some (filter_message m)
388
-
| None -> None
500
+
| Ok (Git.Value.Commit c) when is_my_commit ~user_email c -> (
501
+
match Git.Commit.message c with
502
+
| Some msg when message_has_ai_attribution msg ->
503
+
Hashtbl.add needs_rewrite info.hash true
504
+
| _ -> ())
505
+
| _ -> ())
506
+
commits;
507
+
if Hashtbl.length needs_rewrite = 0 then Ok 0
508
+
else
509
+
(* Rewrite commits, building mapping of old -> new hashes *)
510
+
let hash_map = Hashtbl.create 64 in
511
+
List.iter
512
+
(fun (info : Git.Rev_list.commit_info) ->
513
+
match Git.Repository.read repo info.hash with
514
+
| Ok (Git.Value.Commit c) ->
515
+
(* Update parent references *)
516
+
let new_parents =
517
+
List.map
518
+
(fun p ->
519
+
match Hashtbl.find_opt hash_map p with
520
+
| Some new_p -> new_p
521
+
| None -> p)
522
+
(Git.Commit.parents c)
389
523
in
390
-
let new_commit =
391
-
Git.Commit.v ~tree:(Git.Commit.tree c)
392
-
~author:(Git.Commit.author c)
393
-
~committer:(Git.Commit.committer c) ~parents:new_parents
394
-
~extra:(Git.Commit.extra c) new_msg
524
+
let parents_changed =
525
+
not
526
+
(List.equal Git.Hash.equal new_parents
527
+
(Git.Commit.parents c))
395
528
in
396
-
let new_hash =
397
-
Git.Repository.write_commit repo new_commit
529
+
let msg = Git.Commit.message c in
530
+
let needs_msg_rewrite =
531
+
match msg with
532
+
| Some m -> message_has_ai_attribution m
533
+
| None -> false
398
534
in
399
-
Hashtbl.add hash_map info.hash new_hash
400
-
end
401
-
| _ -> ())
402
-
commits;
403
-
(* Update HEAD to point to the new tip *)
404
-
(match Hashtbl.find_opt hash_map head_hash with
405
-
| Some new_head -> Git.Repository.advance_head repo new_head
406
-
| None -> ());
407
-
Ok (Hashtbl.length needs_rewrite)
535
+
if parents_changed || needs_msg_rewrite then begin
536
+
let new_msg =
537
+
match msg with
538
+
| Some m -> Some (filter_message m)
539
+
| None -> None
540
+
in
541
+
let new_commit =
542
+
Git.Commit.v ~tree:(Git.Commit.tree c)
543
+
~author:(Git.Commit.author c)
544
+
~committer:(Git.Commit.committer c)
545
+
~parents:new_parents ~extra:(Git.Commit.extra c)
546
+
new_msg
547
+
in
548
+
let new_hash =
549
+
Git.Repository.write_commit repo new_commit
550
+
in
551
+
Hashtbl.add hash_map info.hash new_hash
552
+
end
553
+
| _ -> ())
554
+
commits;
555
+
(* Update HEAD to point to the new tip *)
556
+
(match Hashtbl.find_opt hash_map head_hash with
557
+
| Some new_head -> Git.Repository.advance_head repo new_head
558
+
| None -> ());
559
+
Ok (Hashtbl.length needs_rewrite))
408
560
409
561
(* Tabular output helpers *)
410
562
+17
-9
lib/precommit.mli
+17
-9
lib/precommit.mli
···
72
72
val list_subdirs : fs:_ Eio.Path.t -> string -> string list
73
73
(** [list_subdirs ~fs dir] lists subdirectories (excluding hidden ones). *)
74
74
75
-
val find_git_projects : fs:_ Eio.Path.t -> string -> string list
76
-
(** [find_git_projects ~fs dir] recursively scans [dir] for directories
75
+
val find_git_projects :
76
+
cwd:_ Eio.Path.t -> fs:_ Eio.Path.t -> string -> string list
77
+
(** [find_git_projects ~cwd ~fs dir] recursively scans [dir] for directories
77
78
containing a [.git] entry. Stops recursing into a directory once a [.git] is
78
-
found. Hidden directories are skipped. *)
79
+
found. Hidden directories are skipped. If [dir] is inside a git repository
80
+
(by checking parent directories using [fs]), it is included even if it
81
+
doesn't contain [.git] directly. [cwd] is the working directory for relative
82
+
paths, [fs] is the full filesystem for walking up to parent directories. *)
79
83
80
84
val check_all : fs:_ Eio.Path.t -> string list -> (string * hook_status) list
81
85
(** [check_all ~fs dirs] checks hook status for all directories and returns a
···
112
116
113
117
(** {1 History Rewriting} *)
114
118
115
-
val current_branch : fs:Eio.Fs.dir_ty Eio.Path.t -> string -> string option
116
-
(** [current_branch ~fs dir] returns the current branch name, or [None] if HEAD
117
-
is detached. Uses ocaml-git. *)
119
+
val current_branch :
120
+
cwd:_ Eio.Path.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> string -> string option
121
+
(** [current_branch ~cwd ~fs dir] returns the current branch name, or [None] if
122
+
HEAD is detached or no git root is found. Uses ocaml-git. [cwd] is the
123
+
working directory, [fs] is the full filesystem for walking up to parent
124
+
directories. *)
118
125
119
-
val backup_branch : fs:Eio.Fs.dir_ty Eio.Path.t -> string -> string
120
-
(** [backup_branch ~fs dir] creates a backup branch named
126
+
val backup_branch :
127
+
cwd:_ Eio.Path.t -> fs:Eio.Fs.dir_ty Eio.Path.t -> string -> string
128
+
(** [backup_branch ~cwd ~fs dir] creates a backup branch named
121
129
[backup/<branch>-before-fix-<timestamp>] and returns the backup name. Uses
122
-
ocaml-git. *)
130
+
ocaml-git. Raises [Failure] if no git root is found. *)
123
131
124
132
val rewrite_ai_attribution :
125
133
cwd:Eio.Fs.dir_ty Eio.Path.t ->
+2
test/init.t
+2
test/init.t
···
15
15
Would chmod +x ./.git/hooks/commit-msg
16
16
Would create ./.ocamlformat
17
17
ℹ Would initialise .
18
+
✓ Processed 1 directory
18
19
19
20
Test actual init creates the hooks
20
21
$ precommit init
21
22
✓ Initialised .
23
+
✓ Processed 1 directory
22
24
23
25
Verify hooks exist and are executable
24
26
$ test -x .git/hooks/pre-commit && echo "pre-commit is executable"