Installs pre-commit hooks for OCaml projects that run dune fmt automatically
chore: apply dune fmt and use Alcotest.failf (E616)
Replace Alcotest.fail (Fmt.str ...) with Alcotest.failf in test_huri.
Apply dune fmt formatting across precommit, requests, qemu, and
publicsuffix packages.
+102
-107
+102
-107
lib/precommit.ml
+102
-107
lib/precommit.ml
···
354
354
let committer_email = Git.User.email (Git.Commit.committer commit) in
355
355
String.equal email committer_email
356
356
357
+
let scan_commits_for_ai_attribution repo commits user_email =
358
+
let found = ref 0 in
359
+
let skipped_email = ref 0 in
360
+
let skipped_no_ai = ref 0 in
361
+
let result =
362
+
List.filter_map
363
+
(fun (info : Git.Rev_list.commit_info) ->
364
+
match Git.Repository.read repo info.hash with
365
+
| Ok (Git.Value.Commit c) ->
366
+
if not (is_my_commit ~user_email c) then begin
367
+
incr skipped_email;
368
+
None
369
+
end
370
+
else
371
+
let msg = Git.Commit.message c in
372
+
let has_ai =
373
+
match msg with
374
+
| Some m -> message_has_ai_attribution m
375
+
| None -> false
376
+
in
377
+
if has_ai then begin
378
+
incr found;
379
+
let hash = String.sub (Git.Hash.to_hex info.hash) 0 7 in
380
+
let subject =
381
+
match msg with
382
+
| Some m -> (
383
+
match String.split_on_char '\n' m with
384
+
| subj :: _ -> String.trim subj
385
+
| [] -> "")
386
+
| None -> ""
387
+
in
388
+
Some { hash; subject }
389
+
end
390
+
else begin
391
+
incr skipped_no_ai;
392
+
None
393
+
end
394
+
| _ -> None)
395
+
commits
396
+
in
397
+
Log.debug (fun m ->
398
+
m "check_ai_attribution: found=%d skipped_email=%d skipped_no_ai=%d"
399
+
!found !skipped_email !skipped_no_ai);
400
+
result
401
+
357
402
let check_ai_attribution ctx dir =
358
403
Log.debug (fun m -> m "check_ai_attribution: dir=%s" dir);
359
404
match git_root ~cwd:ctx.cwd ~fs:ctx.fs dir with
···
363
408
[]
364
409
| Some git_root -> (
365
410
Log.debug (fun m -> m "check_ai_attribution: git_root=%s" git_root);
366
-
(* Use full filesystem for absolute paths *)
367
411
let repo = Git.Repository.open_repo ~fs:ctx.fs (Fpath.v git_root) in
368
412
let user_email = user_email ~fs:ctx.fs repo in
369
413
Log.debug (fun m ->
···
376
420
| Some head_hash ->
377
421
Log.debug (fun m ->
378
422
m "check_ai_attribution: HEAD=%s" (Git.Hash.to_hex head_hash));
379
-
(* Get all commits from HEAD *)
380
423
let commits =
381
424
match
382
425
Git.Rev_list.topo_sort_reverse repo head_hash ~stop:(fun _ ->
···
390
433
Log.debug (fun m -> m "check_ai_attribution: error %s" e);
391
434
[]
392
435
in
393
-
(* Find commits with AI attribution in message, only from current user *)
394
-
let found = ref 0 in
395
-
let skipped_email = ref 0 in
396
-
let skipped_no_ai = ref 0 in
397
-
let result =
398
-
List.filter_map
399
-
(fun (info : Git.Rev_list.commit_info) ->
400
-
match Git.Repository.read repo info.hash with
401
-
| Ok (Git.Value.Commit c) ->
402
-
if not (is_my_commit ~user_email c) then begin
403
-
incr skipped_email;
404
-
None
405
-
end
406
-
else
407
-
let msg = Git.Commit.message c in
408
-
let has_ai =
409
-
match msg with
410
-
| Some m -> message_has_ai_attribution m
411
-
| None -> false
412
-
in
413
-
if has_ai then begin
414
-
incr found;
415
-
let hash = String.sub (Git.Hash.to_hex info.hash) 0 7 in
416
-
let subject =
417
-
match msg with
418
-
| Some m -> (
419
-
match String.split_on_char '\n' m with
420
-
| subj :: _ -> String.trim subj
421
-
| [] -> "")
422
-
| None -> ""
423
-
in
424
-
Some { hash; subject }
425
-
end
426
-
else begin
427
-
incr skipped_no_ai;
428
-
None
429
-
end
430
-
| _ -> None)
431
-
commits
432
-
in
433
-
Log.debug (fun m ->
434
-
m
435
-
"check_ai_attribution: found=%d skipped_email=%d \
436
-
skipped_no_ai=%d"
437
-
!found !skipped_email !skipped_no_ai);
438
-
result)
436
+
scan_commits_for_ai_attribution repo commits user_email)
439
437
440
438
let current_branch ctx dir =
441
439
match git_root ~cwd:ctx.cwd ~fs:ctx.fs dir with
···
467
465
| None -> ());
468
466
backup_name
469
467
468
+
let mark_commits_needing_rewrite repo commits user_email =
469
+
let needs_rewrite = Hashtbl.create 64 in
470
+
List.iter
471
+
(fun (info : Git.Rev_list.commit_info) ->
472
+
match Git.Repository.read repo info.hash with
473
+
| Ok (Git.Value.Commit c) when is_my_commit ~user_email c -> (
474
+
match Git.Commit.message c with
475
+
| Some msg when message_has_ai_attribution msg ->
476
+
Hashtbl.add needs_rewrite info.hash true
477
+
| _ -> ())
478
+
| _ -> ())
479
+
commits;
480
+
needs_rewrite
481
+
482
+
let rewrite_commit_history repo commits hash_map =
483
+
List.iter
484
+
(fun (info : Git.Rev_list.commit_info) ->
485
+
match Git.Repository.read repo info.hash with
486
+
| Ok (Git.Value.Commit c) ->
487
+
let new_parents =
488
+
List.map
489
+
(fun p ->
490
+
match Hashtbl.find_opt hash_map p with
491
+
| Some new_p -> new_p
492
+
| None -> p)
493
+
(Git.Commit.parents c)
494
+
in
495
+
let parents_changed =
496
+
not (List.equal Git.Hash.equal new_parents (Git.Commit.parents c))
497
+
in
498
+
let msg = Git.Commit.message c in
499
+
let needs_msg_rewrite =
500
+
match msg with
501
+
| Some m -> message_has_ai_attribution m
502
+
| None -> false
503
+
in
504
+
if parents_changed || needs_msg_rewrite then begin
505
+
let new_msg =
506
+
match msg with Some m -> Some (filter_message m) | None -> None
507
+
in
508
+
let new_commit =
509
+
Git.Commit.v ~tree:(Git.Commit.tree c)
510
+
~author:(Git.Commit.author c)
511
+
~committer:(Git.Commit.committer c) ~parents:new_parents
512
+
~extra:(Git.Commit.extra c) new_msg
513
+
in
514
+
let new_hash = Git.Repository.write_commit repo new_commit in
515
+
Hashtbl.add hash_map info.hash new_hash
516
+
end
517
+
| _ -> ())
518
+
commits
519
+
470
520
let rewrite_ai_attribution ctx dir =
471
521
match git_root ~cwd:ctx.cwd ~fs:ctx.fs dir with
472
522
| None -> err_no_git_dir dir
···
476
526
match Git.Repository.head repo with
477
527
| None -> Ok 0
478
528
| Some head_hash ->
479
-
(* Get all commits from HEAD in topological order (oldest first) *)
480
529
let commits =
481
530
match
482
531
Git.Rev_list.topo_sort_reverse repo head_hash ~stop:(fun _ ->
···
485
534
| Ok cs -> cs
486
535
| Error _ -> []
487
536
in
488
-
(* Find which commits need rewriting (only from current user) *)
489
-
let needs_rewrite = Hashtbl.create 64 in
490
-
List.iter
491
-
(fun (info : Git.Rev_list.commit_info) ->
492
-
match Git.Repository.read repo info.hash with
493
-
| Ok (Git.Value.Commit c) when is_my_commit ~user_email c -> (
494
-
match Git.Commit.message c with
495
-
| Some msg when message_has_ai_attribution msg ->
496
-
Hashtbl.add needs_rewrite info.hash true
497
-
| _ -> ())
498
-
| _ -> ())
499
-
commits;
537
+
let needs_rewrite =
538
+
mark_commits_needing_rewrite repo commits user_email
539
+
in
500
540
if Hashtbl.length needs_rewrite = 0 then Ok 0
501
541
else
502
-
(* Rewrite commits, building mapping of old -> new hashes *)
503
542
let hash_map = Hashtbl.create 64 in
504
-
List.iter
505
-
(fun (info : Git.Rev_list.commit_info) ->
506
-
match Git.Repository.read repo info.hash with
507
-
| Ok (Git.Value.Commit c) ->
508
-
(* Update parent references *)
509
-
let new_parents =
510
-
List.map
511
-
(fun p ->
512
-
match Hashtbl.find_opt hash_map p with
513
-
| Some new_p -> new_p
514
-
| None -> p)
515
-
(Git.Commit.parents c)
516
-
in
517
-
let parents_changed =
518
-
not
519
-
(List.equal Git.Hash.equal new_parents
520
-
(Git.Commit.parents c))
521
-
in
522
-
let msg = Git.Commit.message c in
523
-
let needs_msg_rewrite =
524
-
match msg with
525
-
| Some m -> message_has_ai_attribution m
526
-
| None -> false
527
-
in
528
-
if parents_changed || needs_msg_rewrite then begin
529
-
let new_msg =
530
-
match msg with
531
-
| Some m -> Some (filter_message m)
532
-
| None -> None
533
-
in
534
-
let new_commit =
535
-
Git.Commit.v ~tree:(Git.Commit.tree c)
536
-
~author:(Git.Commit.author c)
537
-
~committer:(Git.Commit.committer c)
538
-
~parents:new_parents ~extra:(Git.Commit.extra c)
539
-
new_msg
540
-
in
541
-
let new_hash =
542
-
Git.Repository.write_commit repo new_commit
543
-
in
544
-
Hashtbl.add hash_map info.hash new_hash
545
-
end
546
-
| _ -> ())
547
-
commits;
548
-
(* Update HEAD to point to the new tip *)
543
+
rewrite_commit_history repo commits hash_map;
549
544
(match Hashtbl.find_opt hash_map head_hash with
550
545
| Some new_head -> Git.Repository.advance_head repo new_head
551
546
| None -> ());