jon.recoil.org
forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
1(** Git operations for monopam.
2
3 This module provides git operations needed for managing individual checkouts
4 and git subtree operations in the monorepo. All operations use Eio for
5 process spawning. *)
6
7(** {1 Types} *)
8
9type cmd_result = { exit_code : int; stdout : string; stderr : string }
10(** Result of a git command execution. *)
11
12(** Errors from git operations. *)
13type error =
14 | Command_failed of string * cmd_result
15 (** Git command failed: (command, result) *)
16 | Not_a_repo of Fpath.t (** Path is not a git repository *)
17 | Dirty_worktree of Fpath.t (** Repository has uncommitted changes *)
18 | Remote_not_found of string (** Named remote does not exist *)
19 | Branch_not_found of string (** Named branch does not exist *)
20 | Subtree_prefix_exists of string
21 (** Subtree prefix already exists in repo *)
22 | Subtree_prefix_missing of string (** Subtree prefix does not exist *)
23 | Io_error of string (** Filesystem or process error *)
24
25val pp_error : error Fmt.t
26(** [pp_error] is a formatter for errors. *)
27
28(** {1 Repository Queries} *)
29
30val is_repo :
31 proc:_ Eio.Process.mgr -> fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> bool
32(** [is_repo ~proc ~fs path] returns true if path is a git repository. *)
33
34val is_dirty :
35 proc:_ Eio.Process.mgr -> fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> bool
36(** [is_dirty ~proc ~fs path] returns true if the repository has uncommitted
37 changes (staged or unstaged). *)
38
39val current_branch :
40 proc:_ Eio.Process.mgr ->
41 fs:Eio.Fs.dir_ty Eio.Path.t ->
42 Fpath.t ->
43 string option
44(** [current_branch ~proc ~fs path] returns the current branch name, or [None]
45 if in detached HEAD state. *)
46
47val head_commit :
48 proc:_ Eio.Process.mgr ->
49 fs:Eio.Fs.dir_ty Eio.Path.t ->
50 Fpath.t ->
51 (string, error) result
52(** [head_commit ~proc ~fs path] returns the current HEAD commit hash. *)
53
54val rev_parse :
55 proc:_ Eio.Process.mgr ->
56 fs:Eio.Fs.dir_ty Eio.Path.t ->
57 rev:string ->
58 Fpath.t ->
59 (string, error) result
60(** [rev_parse ~proc ~fs ~rev path] resolves a revision to a commit hash.
61 @param rev The revision to resolve (e.g., "HEAD", "main", "abc123") *)
62
63(** {1 Basic Operations} *)
64
65val clone :
66 proc:_ Eio.Process.mgr ->
67 fs:Eio.Fs.dir_ty Eio.Path.t ->
68 url:Uri.t ->
69 branch:string ->
70 Fpath.t ->
71 (unit, error) result
72(** [clone ~proc ~fs ~url ~branch target] clones a repository.
73
74 @param proc Eio process manager
75 @param fs Eio filesystem
76 @param url Git remote URL
77 @param branch Branch to checkout
78 @param target Destination directory *)
79
80val fetch :
81 proc:_ Eio.Process.mgr ->
82 fs:Eio.Fs.dir_ty Eio.Path.t ->
83 ?remote:string ->
84 Fpath.t ->
85 (unit, error) result
86(** [fetch ~proc ~fs ?remote path] fetches from the remote.
87
88 @param remote Remote name (default: "origin") *)
89
90val fetch_all :
91 proc:_ Eio.Process.mgr ->
92 fs:Eio.Fs.dir_ty Eio.Path.t ->
93 Fpath.t ->
94 (unit, error) result
95(** [fetch_all ~proc ~fs path] fetches from all remotes.
96
97 Runs [git fetch --all] to update all remote tracking branches. *)
98
99val merge_ff :
100 proc:_ Eio.Process.mgr ->
101 fs:Eio.Fs.dir_ty Eio.Path.t ->
102 ?remote:string ->
103 ?branch:string ->
104 Fpath.t ->
105 (unit, error) result
106(** [merge_ff ~proc ~fs ?remote ?branch path] performs a fast-forward only merge
107 from the remote tracking branch.
108
109 @param remote Remote name (default: "origin")
110 @param branch Branch to merge from (default: current branch) *)
111
112val pull :
113 proc:_ Eio.Process.mgr ->
114 fs:Eio.Fs.dir_ty Eio.Path.t ->
115 ?remote:string ->
116 ?branch:string ->
117 Fpath.t ->
118 (unit, error) result
119(** [pull ~proc ~fs ?remote ?branch path] pulls from the remote.
120
121 @param remote Remote name (default: "origin")
122 @param branch Branch to pull (default: current branch) *)
123
124val fetch_and_reset :
125 proc:_ Eio.Process.mgr ->
126 fs:Eio.Fs.dir_ty Eio.Path.t ->
127 ?remote:string ->
128 branch:string ->
129 Fpath.t ->
130 (unit, error) result
131(** [fetch_and_reset ~proc ~fs ?remote ~branch path] fetches from the remote
132 and resets the local branch to match the remote.
133
134 This is useful for repositories that should not have local changes, as it
135 discards any local modifications and sets the working tree to exactly match
136 the remote branch.
137
138 @param remote Remote name (default: "origin")
139 @param branch Branch to reset to *)
140
141val checkout :
142 proc:_ Eio.Process.mgr ->
143 fs:Eio.Fs.dir_ty Eio.Path.t ->
144 branch:string ->
145 Fpath.t ->
146 (unit, error) result
147(** [checkout ~proc ~fs ~branch path] checks out the specified branch. *)
148
149(** {1 Comparison} *)
150
151type ahead_behind = {
152 ahead : int; (** Commits ahead of upstream *)
153 behind : int; (** Commits behind upstream *)
154}
155(** Describes how a local branch relates to its upstream. *)
156
157val ahead_behind :
158 proc:_ Eio.Process.mgr ->
159 fs:Eio.Fs.dir_ty Eio.Path.t ->
160 ?remote:string ->
161 ?branch:string ->
162 Fpath.t ->
163 (ahead_behind, error) result
164(** [ahead_behind ~proc ~fs ?remote ?branch path] computes how many commits the
165 local branch is ahead/behind the remote.
166
167 @param remote Remote name (default: "origin")
168 @param branch Branch to compare (default: current branch) *)
169
170(** {1 Subtree Operations} *)
171
172(** Operations for git subtree management in the monorepo. *)
173module Subtree : sig
174 val add :
175 proc:_ Eio.Process.mgr ->
176 fs:Eio.Fs.dir_ty Eio.Path.t ->
177 repo:Fpath.t ->
178 prefix:string ->
179 url:Uri.t ->
180 branch:string ->
181 unit ->
182 (unit, error) result
183 (** [add ~proc ~fs ~repo ~prefix ~url ~branch ()] adds a new subtree to the
184 repository.
185
186 @param repo Path to the monorepo
187 @param prefix Subdirectory for the subtree
188 @param url Git remote URL for the subtree source
189 @param branch Branch to add *)
190
191 val pull :
192 proc:_ Eio.Process.mgr ->
193 fs:Eio.Fs.dir_ty Eio.Path.t ->
194 repo:Fpath.t ->
195 prefix:string ->
196 url:Uri.t ->
197 branch:string ->
198 unit ->
199 (unit, error) result
200 (** [pull ~proc ~fs ~repo ~prefix ~url ~branch ()] pulls updates from the
201 remote into the subtree.
202
203 @param repo Path to the monorepo
204 @param prefix Subdirectory of the subtree
205 @param url Git remote URL
206 @param branch Branch to pull *)
207
208 val push :
209 proc:_ Eio.Process.mgr ->
210 fs:Eio.Fs.dir_ty Eio.Path.t ->
211 repo:Fpath.t ->
212 prefix:string ->
213 url:Uri.t ->
214 branch:string ->
215 unit ->
216 (unit, error) result
217 (** [push ~proc ~fs ~repo ~prefix ~url ~branch ()] pushes subtree changes to
218 the remote.
219
220 This extracts commits that affected the subtree and pushes them to the
221 specified remote/branch.
222
223 @param repo Path to the monorepo
224 @param prefix Subdirectory of the subtree
225 @param url Git remote URL
226 @param branch Branch to push to *)
227
228 val split :
229 proc:_ Eio.Process.mgr ->
230 fs:Eio.Fs.dir_ty Eio.Path.t ->
231 repo:Fpath.t ->
232 prefix:string ->
233 unit ->
234 (string, error) result
235 (** [split ~proc ~fs ~repo ~prefix ()] extracts commits for a subtree into a
236 standalone branch.
237
238 Returns the commit hash of the split branch head. *)
239
240 val exists :
241 fs:Eio.Fs.dir_ty Eio.Path.t -> repo:Fpath.t -> prefix:string -> bool
242 (** [exists ~fs ~repo ~prefix] returns true if the subtree prefix directory
243 exists in the repository. *)
244end
245
246(** {1 Initialization} *)
247
248val init :
249 proc:_ Eio.Process.mgr ->
250 fs:Eio.Fs.dir_ty Eio.Path.t ->
251 Fpath.t ->
252 (unit, error) result
253(** [init ~proc ~fs path] initializes a new git repository. *)
254
255val commit_allow_empty :
256 proc:_ Eio.Process.mgr ->
257 fs:Eio.Fs.dir_ty Eio.Path.t ->
258 message:string ->
259 Fpath.t ->
260 (unit, error) result
261(** [commit_allow_empty ~proc ~fs ~message path] creates a commit, even if there
262 are no changes. Useful for initializing a repository. *)
263
264val push_remote :
265 proc:_ Eio.Process.mgr ->
266 fs:Eio.Fs.dir_ty Eio.Path.t ->
267 ?remote:string ->
268 ?branch:string ->
269 Fpath.t ->
270 (unit, error) result
271(** [push_remote ~proc ~fs ?remote ?branch path] pushes the current branch to
272 the remote.
273
274 @param remote Remote name (default: "origin")
275 @param branch Branch to push (default: current branch) *)
276
277val push_ref :
278 proc:_ Eio.Process.mgr ->
279 fs:Eio.Fs.dir_ty Eio.Path.t ->
280 repo:Fpath.t ->
281 target:string ->
282 ref_spec:string ->
283 unit ->
284 (unit, error) result
285(** [push_ref ~proc ~fs ~repo ~target ~ref_spec ()] pushes a specific ref to a
286 target repository or path.
287
288 @param repo Path to the git repository to push from
289 @param target Target repository path or remote name
290 @param ref_spec The refspec to push (e.g., "abc123:refs/heads/main") *)
291
292val set_push_url :
293 proc:_ Eio.Process.mgr ->
294 fs:Eio.Fs.dir_ty Eio.Path.t ->
295 ?remote:string ->
296 url:string ->
297 Fpath.t ->
298 (unit, error) result
299(** [set_push_url ~proc ~fs ?remote ~url path] sets the push URL for a remote.
300 This allows the fetch and push URLs to be different.
301
302 @param remote Remote name (default: "origin")
303 @param url The URL to use for pushing *)
304
305val get_push_url :
306 proc:_ Eio.Process.mgr ->
307 fs:Eio.Fs.dir_ty Eio.Path.t ->
308 ?remote:string ->
309 Fpath.t ->
310 string option
311(** [get_push_url ~proc ~fs ?remote path] returns the push URL for a remote, or
312 [None] if not set or the remote doesn't exist.
313
314 @param remote Remote name (default: "origin") *)
315
316(** {1 Remote Management} *)
317
318val list_remotes :
319 proc:_ Eio.Process.mgr ->
320 fs:Eio.Fs.dir_ty Eio.Path.t ->
321 Fpath.t ->
322 string list
323(** [list_remotes ~proc ~fs path] returns a list of all remote names. *)
324
325val get_remote_url :
326 proc:_ Eio.Process.mgr ->
327 fs:Eio.Fs.dir_ty Eio.Path.t ->
328 remote:string ->
329 Fpath.t ->
330 string option
331(** [get_remote_url ~proc ~fs ~remote path] returns the URL for a remote. *)
332
333val add_remote :
334 proc:_ Eio.Process.mgr ->
335 fs:Eio.Fs.dir_ty Eio.Path.t ->
336 name:string ->
337 url:string ->
338 Fpath.t ->
339 (unit, error) result
340(** [add_remote ~proc ~fs ~name ~url path] adds a new remote. *)
341
342val remove_remote :
343 proc:_ Eio.Process.mgr ->
344 fs:Eio.Fs.dir_ty Eio.Path.t ->
345 name:string ->
346 Fpath.t ->
347 (unit, error) result
348(** [remove_remote ~proc ~fs ~name path] removes a remote. *)
349
350val set_remote_url :
351 proc:_ Eio.Process.mgr ->
352 fs:Eio.Fs.dir_ty Eio.Path.t ->
353 name:string ->
354 url:string ->
355 Fpath.t ->
356 (unit, error) result
357(** [set_remote_url ~proc ~fs ~name ~url path] updates the URL for an existing
358 remote. *)
359
360val ensure_remote :
361 proc:_ Eio.Process.mgr ->
362 fs:Eio.Fs.dir_ty Eio.Path.t ->
363 name:string ->
364 url:string ->
365 Fpath.t ->
366 (unit, error) result
367(** [ensure_remote ~proc ~fs ~name ~url path] ensures a remote exists with the
368 given URL. If the remote exists with a different URL, it is updated. If the
369 remote doesn't exist, it is added. *)
370
371(** {1 Commit History} *)
372
373type log_entry = {
374 hash : string; (** Full commit hash *)
375 author : string; (** Author name *)
376 date : string; (** ISO 8601 date *)
377 subject : string; (** Commit subject line *)
378 body : string; (** Commit body *)
379}
380(** A single commit log entry. *)
381
382val log :
383 proc:_ Eio.Process.mgr ->
384 fs:Eio.Fs.dir_ty Eio.Path.t ->
385 ?since:string ->
386 ?until:string ->
387 ?path:string ->
388 Fpath.t ->
389 (log_entry list, error) result
390(** [log ~proc ~fs ?since ?until ?path repo] retrieves commit history.
391
392 @param since Include commits more recent than this date (e.g., "1 week ago")
393 @param until Include commits older than this date
394 @param path Filter to commits affecting this path (relative to repo)
395 @param repo Path to the git repository *)
396
397val log_range :
398 proc:_ Eio.Process.mgr ->
399 fs:Eio.Fs.dir_ty Eio.Path.t ->
400 base:string ->
401 tip:string ->
402 ?max_count:int ->
403 Fpath.t ->
404 (log_entry list, error) result
405(** [log_range ~proc ~fs ~base ~tip ?max_count repo] retrieves commits between
406 refs.
407
408 Gets commits reachable from [tip] but not from [base] (i.e., [base..tip]).
409
410 @param base Base ref (commits reachable from here are excluded)
411 @param tip Tip ref (commits reachable from here are included)
412 @param max_count Maximum number of commits to return
413 @param repo Path to the git repository *)
414
415val show_patch :
416 proc:_ Eio.Process.mgr ->
417 fs:Eio.Fs.dir_ty Eio.Path.t ->
418 commit:string ->
419 Fpath.t ->
420 (string, error) result
421(** [show_patch ~proc ~fs ~commit repo] returns the patch content for a commit.
422
423 Runs [git show --patch --stat commit] to get the full diff with stats. *)
424
425(** {1 Subtree Commit Analysis} *)
426
427val parse_subtree_message : string -> string option
428(** [parse_subtree_message subject] extracts the upstream commit SHA from a
429 subtree merge/squash commit message.
430
431 Handles messages like:
432 - "Squashed 'prefix/' changes from abc123..def456" -> Some "def456"
433 - "Squashed 'prefix/' content from commit abc123" -> Some "abc123"
434 - "Add 'prefix/' from commit abc123" -> Some "abc123"
435
436 Returns [None] if the message doesn't match any known pattern. *)
437
438val subtree_last_upstream_commit :
439 proc:_ Eio.Process.mgr ->
440 fs:Eio.Fs.dir_ty Eio.Path.t ->
441 repo:Fpath.t ->
442 prefix:string ->
443 unit ->
444 string option
445(** [subtree_last_upstream_commit ~proc ~fs ~repo ~prefix ()] finds the upstream
446 commit SHA that the subtree was last synced from.
447
448 Searches git log for the most recent subtree merge/squash commit for the
449 given prefix and extracts the upstream commit reference.
450
451 @param repo Path to the monorepo
452 @param prefix Subtree directory name (e.g., "ocaml-bytesrw") *)
453
454val is_ancestor :
455 proc:_ Eio.Process.mgr ->
456 fs:Eio.Fs.dir_ty Eio.Path.t ->
457 repo:Fpath.t ->
458 commit1:string ->
459 commit2:string ->
460 unit ->
461 bool
462(** [is_ancestor ~proc ~fs ~repo ~commit1 ~commit2 ()] returns true if commit1
463 is an ancestor of commit2.
464
465 Uses [git merge-base --is-ancestor]. *)
466
467val merge_base :
468 proc:_ Eio.Process.mgr ->
469 fs:Eio.Fs.dir_ty Eio.Path.t ->
470 repo:Fpath.t ->
471 commit1:string ->
472 commit2:string ->
473 unit ->
474 (string, error) result
475(** [merge_base ~proc ~fs ~repo ~commit1 ~commit2 ()] finds the common ancestor
476 of two commits. *)
477
478val count_commits_between :
479 proc:_ Eio.Process.mgr ->
480 fs:Eio.Fs.dir_ty Eio.Path.t ->
481 repo:Fpath.t ->
482 base:string ->
483 head:string ->
484 unit ->
485 int
486(** [count_commits_between ~proc ~fs ~repo ~base ~head ()] counts the number of
487 commits between base and head (exclusive of base, inclusive of head). *)
488
489(** {1 Worktree Operations} *)
490
491(** Operations for git worktree management. *)
492module Worktree : sig
493 (** A git worktree entry. *)
494 type entry = {
495 path : Fpath.t; (** Absolute path to the worktree *)
496 head : string; (** HEAD commit hash *)
497 branch : string option; (** Branch name if not detached *)
498 }
499
500 val add :
501 proc:_ Eio.Process.mgr ->
502 fs:Eio.Fs.dir_ty Eio.Path.t ->
503 repo:Fpath.t ->
504 path:Fpath.t ->
505 branch:string ->
506 unit ->
507 (unit, error) result
508 (** [add ~proc ~fs ~repo ~path ~branch ()] creates a new worktree at [path]
509 with a new branch [branch].
510
511 @param repo Path to the main repository
512 @param path Path where the worktree will be created
513 @param branch Name of the new branch to create *)
514
515 val remove :
516 proc:_ Eio.Process.mgr ->
517 fs:Eio.Fs.dir_ty Eio.Path.t ->
518 repo:Fpath.t ->
519 path:Fpath.t ->
520 force:bool ->
521 unit ->
522 (unit, error) result
523 (** [remove ~proc ~fs ~repo ~path ~force ()] removes a worktree.
524
525 @param repo Path to the main repository
526 @param path Path to the worktree to remove
527 @param force If true, remove even if there are uncommitted changes *)
528
529 val list :
530 proc:_ Eio.Process.mgr ->
531 fs:Eio.Fs.dir_ty Eio.Path.t ->
532 Fpath.t ->
533 entry list
534 (** [list ~proc ~fs repo] returns all worktrees for the repository. *)
535
536 val exists :
537 proc:_ Eio.Process.mgr ->
538 fs:Eio.Fs.dir_ty Eio.Path.t ->
539 repo:Fpath.t ->
540 path:Fpath.t ->
541 bool
542 (** [exists ~proc ~fs ~repo ~path] returns true if a worktree exists at [path]. *)
543end
544
545(** {1 Cherry-pick Operations} *)
546
547val cherry_pick :
548 proc:_ Eio.Process.mgr ->
549 fs:Eio.Fs.dir_ty Eio.Path.t ->
550 commit:string ->
551 Fpath.t ->
552 (unit, error) result
553(** [cherry_pick ~proc ~fs ~commit path] applies a single commit to the current branch.
554
555 @param commit The commit hash to cherry-pick
556 @param path Path to the repository *)
557
558val merge :
559 proc:_ Eio.Process.mgr ->
560 fs:Eio.Fs.dir_ty Eio.Path.t ->
561 ref_name:string ->
562 ?ff_only:bool ->
563 Fpath.t ->
564 (unit, error) result
565(** [merge ~proc ~fs ~ref_name ?ff_only path] merges a ref into the current branch.
566
567 @param ref_name The ref to merge (e.g., "verse/handle/main")
568 @param ff_only If true, only allow fast-forward merges (default: false)
569 @param path Path to the repository *)
570
571(** {1 Diff Operations} *)
572
573val diff_trees :
574 proc:_ Eio.Process.mgr ->
575 fs:Eio.Fs.dir_ty Eio.Path.t ->
576 source:Fpath.t ->
577 target:Fpath.t ->
578 (string, error) result
579(** [diff_trees ~proc ~fs ~source ~target] generates a diff between two
580 directory trees using [git diff --no-index].
581
582 Returns [Ok ""] if the trees are identical, [Ok diff] with the diff content
583 if they differ, or [Error] if the diff command fails.
584
585 @param source The source directory (typically the monorepo subtree)
586 @param target The target directory (typically the checkout) *)
587
588val apply_diff :
589 proc:_ Eio.Process.mgr ->
590 fs:Eio.Fs.dir_ty Eio.Path.t ->
591 cwd:Fpath.t ->
592 diff:string ->
593 (unit, error) result
594(** [apply_diff ~proc ~fs ~cwd ~diff] applies a diff to the directory at [cwd].
595
596 Uses [git apply] to apply the diff. Returns [Ok ()] if the diff was applied
597 successfully or was empty, [Error] if the apply failed. *)
598
599val add_all :
600 proc:_ Eio.Process.mgr ->
601 fs:Eio.Fs.dir_ty Eio.Path.t ->
602 Fpath.t ->
603 (unit, error) result
604(** [add_all ~proc ~fs path] stages all changes (git add -A) in the repository
605 at [path]. *)
606
607val commit :
608 proc:_ Eio.Process.mgr ->
609 fs:Eio.Fs.dir_ty Eio.Path.t ->
610 message:string ->
611 Fpath.t ->
612 (unit, error) result
613(** [commit ~proc ~fs ~message path] creates a commit with the given message
614 in the repository at [path]. *)
615
616val rm :
617 proc:_ Eio.Process.mgr ->
618 fs:Eio.Fs.dir_ty Eio.Path.t ->
619 recursive:bool ->
620 Fpath.t ->
621 string ->
622 (unit, error) result
623(** [rm ~proc ~fs ~recursive path target] removes [target] from the git index
624 in the repository at [path]. If [recursive] is true, removes directories
625 recursively (git rm -r). *)
626
627val config :
628 proc:_ Eio.Process.mgr ->
629 fs:Eio.Fs.dir_ty Eio.Path.t ->
630 key:string ->
631 value:string ->
632 Fpath.t ->
633 (unit, error) result
634(** [config ~proc ~fs ~key ~value path] sets a git config value in the
635 repository at [path]. *)
636
637val has_subtree_history :
638 proc:_ Eio.Process.mgr ->
639 fs:Eio.Fs.dir_ty Eio.Path.t ->
640 repo:Fpath.t ->
641 prefix:string ->
642 unit ->
643 bool
644(** [has_subtree_history ~proc ~fs ~repo ~prefix ()] returns true if the
645 prefix has subtree commit history (i.e., was added via git subtree add).
646 Returns false for fresh local packages that were never part of a subtree. *)
647
648val branch_rename :
649 proc:_ Eio.Process.mgr ->
650 fs:Eio.Fs.dir_ty Eio.Path.t ->
651 new_name:string ->
652 Fpath.t ->
653 (unit, error) result
654(** [branch_rename ~proc ~fs ~new_name path] renames the current branch
655 to [new_name] in the repository at [path]. Uses [git branch -M]. *)