Installs pre-commit hooks for OCaml projects that run dune fmt automatically
Sync from checkouts
+80
-66
+33
-35
bin/main.ml
+33
-35
bin/main.ml
···
20
20
(* {1 Common arguments} *)
21
21
22
22
let dirs =
23
-
let doc = "Directories to operate on. Defaults to the current directory." in
23
+
let doc =
24
+
"Root directories to scan for git projects. Defaults to the current \
25
+
directory. Each directory is scanned recursively for repositories \
26
+
containing a $(b,.git) entry."
27
+
in
24
28
Arg.(value & pos_all dir [ "." ] & info [] ~docv:"DIR" ~doc)
25
29
26
30
let dry_run =
27
31
let doc = "Show what would be done without making changes." in
28
32
Arg.(value & flag & info [ "n"; "dry-run" ] ~doc)
29
-
30
-
let recursive =
31
-
let doc = "Operate on all OCaml projects in subdirectories." in
32
-
Arg.(value & flag & info [ "r"; "recursive" ] ~doc)
33
33
34
34
let force =
35
35
let doc = "Install hooks even if no dune-project is found." in
···
71
71
error "%s" msg;
72
72
exit 1
73
73
74
-
let collect_dirs ~fs ~recursive dirs =
75
-
if recursive then
76
-
List.concat_map (fun d -> Precommit.find_git_projects ~fs d) dirs
77
-
else dirs
74
+
let collect_dirs ~fs dirs =
75
+
List.concat_map (fun d -> Precommit.find_git_projects ~fs d) dirs
78
76
79
77
(* {1 Init command} *)
80
78
81
-
let init_impl ~fs dry_run force hooks recursive dirs =
82
-
let dirs = collect_dirs ~fs ~recursive dirs in
79
+
let init_impl ~fs dry_run force hooks dirs =
80
+
let dirs = collect_dirs ~fs dirs in
83
81
let count = ref 0 in
84
82
List.iter
85
83
(fun d ->
···
99
97
Log.info (fun m ->
100
98
m "Processed %d director%s" !count (if !count = 1 then "y" else "ies"))
101
99
102
-
let init dry_run force hooks recursive dirs =
100
+
let init dry_run force hooks dirs =
103
101
Eio_main.run @@ fun env ->
104
102
let fs = Eio.Stdenv.cwd env in
105
-
init_impl ~fs dry_run force hooks recursive dirs
103
+
init_impl ~fs dry_run force hooks dirs
106
104
107
105
let init_cmd =
108
106
let doc = "Initialise pre-commit hooks for OCaml projects." in
···
117
115
`P "Initialise hooks in the current directory:";
118
116
`Pre " precommit init";
119
117
`P "Initialise hooks in all projects under src/:";
120
-
`Pre " precommit init -r src/";
118
+
`Pre " precommit init src/";
121
119
`P "Preview what would be done:";
122
-
`Pre " precommit init -n -r .";
120
+
`Pre " precommit init -n";
123
121
`P "Install only the AI attribution hook in a non-OCaml project:";
124
122
`Pre " precommit init -f --hooks ai";
125
123
`P "Install only the dune fmt hook:";
···
127
125
]
128
126
in
129
127
let info = Cmd.info "init" ~doc ~man in
130
-
Cmd.v info Term.(const init $ dry_run $ force $ hooks $ recursive $ dirs)
128
+
Cmd.v info Term.(const init $ dry_run $ force $ hooks $ dirs)
131
129
132
130
(* {1 Status command} *)
133
131
···
135
133
if b then Tty.Span.styled Tty.Style.(fg Tty.Color.green) "+"
136
134
else Tty.Span.styled Tty.Style.(fg Tty.Color.red) "-"
137
135
138
-
let status_impl ~fs recursive dirs =
139
-
let dirs = collect_dirs ~fs ~recursive dirs in
136
+
let status_impl ~fs dirs =
137
+
let dirs = collect_dirs ~fs dirs in
140
138
let missing = ref 0 in
141
139
let ok = ref 0 in
142
140
let rows =
···
183
181
else if !ok > 0 then
184
182
success "%d project%s properly configured" !ok (if !ok = 1 then "" else "s")
185
183
186
-
let status recursive dirs =
184
+
let status dirs =
187
185
Eio_main.run @@ fun env ->
188
186
let fs = Eio.Stdenv.cwd env in
189
-
status_impl ~fs recursive dirs
187
+
status_impl ~fs dirs
190
188
191
189
let status_cmd =
192
190
let doc = "Check pre-commit hook status." in
···
200
198
hooks, .ocamlformat, or has formatting disabled.";
201
199
`S Manpage.s_examples;
202
200
`P "Check status of all projects under src/:";
203
-
`Pre " precommit status -r src/";
201
+
`Pre " precommit status src/";
204
202
]
205
203
in
206
204
let info = Cmd.info "status" ~doc ~man in
207
-
Cmd.v info Term.(const status $ recursive $ dirs)
205
+
Cmd.v info Term.(const status $ dirs)
208
206
209
207
(* {1 Check command} *)
210
208
···
273
271
end;
274
272
(List.rev !affected_dirs, !total_commits, !repos_with_issues)
275
273
276
-
let check_impl ~process_mgr ~fs recursive dirs =
277
-
let dirs = collect_dirs ~fs ~recursive dirs in
274
+
let check_impl ~process_mgr ~fs dirs =
275
+
let dirs = collect_dirs ~fs dirs in
278
276
let _affected, total_commits, repos_with_issues =
279
277
find_and_display_ai_commits ~process_mgr ~fs dirs
280
278
in
···
287
285
end
288
286
else success "No AI attribution found in commit history"
289
287
290
-
let check recursive dirs =
288
+
let check dirs =
291
289
Eio_main.run @@ fun env ->
292
290
let fs = Eio.Stdenv.cwd env in
293
291
let process_mgr = Eio.Stdenv.process_mgr env in
294
-
check_impl ~process_mgr ~fs recursive dirs
292
+
check_impl ~process_mgr ~fs dirs
295
293
296
294
let check_cmd =
297
295
let doc = "Check git history for commits with AI attribution." in
···
303
301
'claude' in the commit message. Exit code is 1 if any are found.";
304
302
`S Manpage.s_examples;
305
303
`P "Check all projects under src/:";
306
-
`Pre " precommit check -r src/";
304
+
`Pre " precommit check src/";
307
305
]
308
306
in
309
307
let info = Cmd.info "check" ~doc ~man in
310
-
Cmd.v info Term.(const check $ recursive $ dirs)
308
+
Cmd.v info Term.(const check $ dirs)
311
309
312
310
(* {1 Fix command} *)
313
311
···
334
332
let answer = String.trim line in
335
333
answer = "y" || answer = "Y"
336
334
337
-
let fix_impl ~process_mgr ~fs dry_run yes recursive dirs =
338
-
let dirs = collect_dirs ~fs ~recursive dirs in
335
+
let fix_impl ~process_mgr ~fs dry_run yes dirs =
336
+
let dirs = collect_dirs ~fs dirs in
339
337
let affected, total_commits, repos_with_issues =
340
338
find_and_display_ai_commits ~process_mgr ~fs dirs
341
339
in
···
387
385
let doc = "Skip interactive confirmation prompt." in
388
386
Arg.(value & flag & info [ "y"; "yes" ] ~doc)
389
387
390
-
let fix dry_run yes recursive dirs =
388
+
let fix dry_run yes dirs =
391
389
Eio_main.run @@ fun env ->
392
390
let fs = Eio.Stdenv.cwd env in
393
391
let process_mgr = Eio.Stdenv.process_mgr env in
394
-
fix_impl ~process_mgr ~fs dry_run yes recursive dirs
392
+
fix_impl ~process_mgr ~fs dry_run yes dirs
395
393
396
394
let fix_cmd =
397
395
let doc = "Remove AI attribution from commit history." in
···
408
406
the interactive confirmation prompt.";
409
407
`S Manpage.s_examples;
410
408
`P "Fix all projects under the current directory:";
411
-
`Pre " precommit fix -r";
409
+
`Pre " precommit fix";
412
410
`P "Preview what would be done:";
413
-
`Pre " precommit fix -n -r .";
411
+
`Pre " precommit fix -n";
414
412
`P "Fix without confirmation prompt:";
415
413
`Pre " precommit fix -y";
416
414
]
417
415
in
418
416
let info = Cmd.info "fix" ~doc ~man in
419
-
Cmd.v info Term.(const fix $ dry_run $ yes $ recursive $ dirs)
417
+
Cmd.v info Term.(const fix $ dry_run $ yes $ dirs)
420
418
421
419
(* {1 Main} *)
422
420
+47
-31
lib/precommit.ml
+47
-31
lib/precommit.ml
···
72
72
| `Directory -> true
73
73
| _ -> false
74
74
75
+
let is_symlink ~fs path =
76
+
match Eio.Path.kind ~follow:false Eio.Path.(fs / path) with
77
+
| `Symbolic_link -> true
78
+
| _ -> false
79
+
75
80
let read_file ~fs path = Eio.Path.load Eio.Path.(fs / path)
76
81
77
82
let write_file ~fs ~dry_run path content =
···
197
202
|> List.sort String.compare
198
203
199
204
let rec find_git_projects ~fs dir =
200
-
let git_dir = Filename.concat dir ".git" in
201
-
if file_exists ~fs git_dir then [ dir ]
202
-
else
203
-
let entries = try Eio.Path.read_dir Eio.Path.(fs / dir) with _ -> [] in
205
+
let entries = try Eio.Path.read_dir Eio.Path.(fs / dir) with _ -> [] in
206
+
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
208
+
let children =
204
209
entries
205
210
|> List.filter_map (fun name ->
206
-
if String.length name > 0 && name.[0] = '.' then None
211
+
if String.length name > 0 && (name.[0] = '.' || name.[0] = '_') then
212
+
None
207
213
else
208
-
let path = Filename.concat dir name in
209
-
if is_directory ~fs path then Some path else None)
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)
210
219
|> List.sort String.compare
211
-
|> List.concat_map (fun sub -> find_git_projects ~fs sub)
220
+
|> List.concat_map (fun sub ->
221
+
if file_exists ~fs (Filename.concat sub ".git") then [ sub ]
222
+
else find_git_projects ~fs sub)
223
+
in
224
+
self @ children
212
225
213
226
let run_in_dir ~process_mgr ~fs dir cmd =
214
227
let cwd = Eio.Path.(fs / dir) in
···
218
231
in
219
232
output |> String.split_on_char '\n' |> List.filter (fun s -> s <> "")
220
233
234
+
let run_in_dir_opt ~process_mgr ~fs dir cmd =
235
+
let cwd = Eio.Path.(fs / dir) in
236
+
try
237
+
let output =
238
+
Eio.Process.parse_out process_mgr Eio.Buf_read.take_all ~cwd
239
+
[ "/bin/sh"; "-c"; cmd ]
240
+
in
241
+
Ok (output |> String.split_on_char '\n' |> List.filter (fun s -> s <> ""))
242
+
with Eio.Io _ as e -> Error (Printexc.to_string e)
243
+
221
244
type ai_commit = { hash : string; subject : string }
222
245
223
246
let check_ai_attribution ~process_mgr ~fs dir =
224
247
if not (file_exists ~fs (Filename.concat dir ".git")) then []
225
248
else
226
-
(* Get commits by the configured user that contain AI attribution patterns *)
249
+
(* Get commits by the configured user that contain AI attribution patterns.
250
+
Use run_in_dir_opt to handle repos with no commits gracefully. *)
227
251
let cmd =
228
252
"git log --format='%h %s' --grep='Co-Authored-By.*[Cc]laude' \
229
253
--author=\"$(git config user.name)\" 2>/dev/null"
230
254
in
231
-
let lines = run_in_dir ~process_mgr ~fs dir cmd in
232
-
List.filter_map
233
-
(fun line ->
234
-
if String.length line > 8 then
235
-
let hash = String.sub line 0 7 in
236
-
let subject = String.sub line 8 (String.length line - 8) in
237
-
Some { hash; subject }
238
-
else None)
239
-
lines
240
-
241
-
let run_in_dir_opt ~process_mgr ~fs dir cmd =
242
-
let cwd = Eio.Path.(fs / dir) in
243
-
try
244
-
let output =
245
-
Eio.Process.parse_out process_mgr Eio.Buf_read.take_all ~cwd
246
-
[ "/bin/sh"; "-c"; cmd ]
247
-
in
248
-
Ok (output |> String.split_on_char '\n' |> List.filter (fun s -> s <> ""))
249
-
with Eio.Io _ as e -> Error (Printexc.to_string e)
255
+
match run_in_dir_opt ~process_mgr ~fs dir cmd with
256
+
| Error _ -> [] (* No commits or command failed *)
257
+
| Ok lines ->
258
+
List.filter_map
259
+
(fun line ->
260
+
if String.length line > 8 then
261
+
let hash = String.sub line 0 7 in
262
+
let subject = String.sub line 8 (String.length line - 8) in
263
+
Some { hash; subject }
264
+
else None)
265
+
lines
250
266
251
267
let current_branch ~process_mgr ~fs dir =
252
268
match
···
280
296
Error (Printf.sprintf "%s: No .git directory found" dir)
281
297
else
282
298
let cmd =
283
-
"FILTER_BRANCH_SQUELCH_WARNING=1 git filter-branch -f --msg-filter 'sed \
284
-
\"/[Cc]o-[Aa]uthored-[Bb]y:.*[Cc]laude/d\"' -- HEAD 2>&1"
299
+
"FILTER_BRANCH_SQUELCH_WARNING=1 git filter-branch -f --msg-filter \"sed \
300
+
'/[Cc]o-[Aa]uthored-[Bb]y:.*[Cc]laude/d'\" -- HEAD 2>&1"
285
301
in
286
302
match run_in_dir_opt ~process_mgr ~fs dir cmd with
287
303
| Error e -> Error (Printf.sprintf "%s: %s" dir e)
288
304
| Ok _lines ->
289
305
(* Count how many commits were actually rewritten *)
290
306
let count_cmd =
291
-
"git log --format='%H' --all --grep='Co-Authored-By.*[Cc]laude' \
307
+
"git log --format='%H' HEAD --grep='Co-Authored-By.*[Cc]laude' \
292
308
2>/dev/null | wc -l"
293
309
in
294
310
let remaining =