jon.recoil.org
forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
1type error =
2 | Git_error of Git.error
3 | Feature_exists of string
4 | Feature_not_found of string
5 | Config_error of string
6
7let pp_error ppf = function
8 | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e
9 | Feature_exists name -> Fmt.pf ppf "Feature '%s' already exists" name
10 | Feature_not_found name -> Fmt.pf ppf "Feature '%s' not found" name
11 | Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg
12
13let error_hint = function
14 | Git_error _ -> Some "Check that the monorepo is properly initialized"
15 | Feature_exists name ->
16 Some (Printf.sprintf "Run 'monopam feature remove %s' first if you want to recreate it" name)
17 | Feature_not_found name ->
18 Some (Printf.sprintf "Run 'monopam feature list' to see available features, or 'monopam feature add %s' to create it" name)
19 | Config_error _ -> Some "Run 'monopam init' to create a workspace configuration"
20
21let pp_error_with_hint ppf e =
22 pp_error ppf e;
23 match error_hint e with
24 | Some hint -> Fmt.pf ppf "@.Hint: %s" hint
25 | None -> ()
26
27type entry = {
28 name : string;
29 path : Fpath.t;
30 branch : string;
31}
32
33let pp_entry ppf e =
34 Fmt.pf ppf "%s -> %a (branch: %s)" e.name Fpath.pp e.path e.branch
35
36(* Get the work directory path: root/work *)
37let work_path config = Fpath.(Verse_config.root config / "work")
38
39(* Get the feature worktree path: root/work/<name> *)
40let feature_path config name = Fpath.(work_path config / name)
41
42let add ~proc ~fs ~config ~name () =
43 let mono = Verse_config.mono_path config in
44 let work_dir = work_path config in
45 let wt_path = feature_path config name in
46 (* Check if feature already exists *)
47 if Git.Worktree.exists ~proc ~fs ~repo:mono ~path:wt_path then
48 Error (Feature_exists name)
49 else begin
50 (* Ensure work directory exists *)
51 let work_eio = Eio.Path.(fs / Fpath.to_string work_dir) in
52 (try Eio.Path.mkdirs ~perm:0o755 work_eio with Eio.Io _ -> ());
53 (* Create the worktree with a new branch *)
54 match Git.Worktree.add ~proc ~fs ~repo:mono ~path:wt_path ~branch:name () with
55 | Error e -> Error (Git_error e)
56 | Ok () -> Ok { name; path = wt_path; branch = name }
57 end
58
59let remove ~proc ~fs ~config ~name ~force () =
60 let mono = Verse_config.mono_path config in
61 let wt_path = feature_path config name in
62 (* Check if feature exists *)
63 if not (Git.Worktree.exists ~proc ~fs ~repo:mono ~path:wt_path) then
64 Error (Feature_not_found name)
65 else
66 match Git.Worktree.remove ~proc ~fs ~repo:mono ~path:wt_path ~force () with
67 | Error e -> Error (Git_error e)
68 | Ok () -> Ok ()
69
70let list ~proc ~fs ~config () =
71 let mono = Verse_config.mono_path config in
72 let work_dir = work_path config in
73 let all_worktrees = Git.Worktree.list ~proc ~fs mono in
74 (* Filter to only worktrees under work/ directory *)
75 List.filter_map (fun (wt : Git.Worktree.entry) ->
76 (* Check if this worktree is under the work directory *)
77 let wt_str = Fpath.to_string wt.path in
78 let work_str = Fpath.to_string work_dir in
79 if String.starts_with ~prefix:work_str wt_str then
80 let name = Fpath.basename wt.path in
81 let branch = Option.value ~default:name wt.branch in
82 Some { name; path = wt.path; branch }
83 else
84 None
85 ) all_worktrees