A monorepo management tool for the agentic ages
1(** Vendor cache - a persistent bare git repository for caching upstream fetches.
2
3 The cache stores fetched repositories as remotes/branches, allowing multiple
4 unpac projects to share fetched content without re-downloading. *)
5
6(** {1 Types} *)
7
8type t = Eio.Fs.dir_ty Eio.Path.t
9(** Path to the cache bare repository *)
10
11(** {1 Cache Location} *)
12
13let default_path () =
14 let cache_home =
15 match Sys.getenv_opt "XDG_CACHE_HOME" with
16 | Some dir -> dir
17 | None ->
18 match Sys.getenv_opt "HOME" with
19 | Some home -> Filename.concat home ".cache"
20 | None -> "/tmp"
21 in
22 Filename.concat cache_home "unpac/vendor-cache"
23
24(** {1 Initialization} *)
25
26let init ~proc_mgr ~fs ?path () =
27 let cache_path = match path with
28 | Some p -> p
29 | None -> default_path ()
30 in
31 let cache = Eio.Path.(fs / cache_path) in
32
33 (* Check if already initialized *)
34 if Eio.Path.is_directory cache then
35 cache
36 else begin
37 (* Create parent directories *)
38 let parent = Filename.dirname cache_path in
39 let parent_path = Eio.Path.(fs / parent) in
40 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 parent_path;
41
42 (* Initialize bare repository *)
43 Eio.Path.mkdirs ~exists_ok:false ~perm:0o755 cache;
44 Git.run_exn ~proc_mgr ~cwd:cache ["init"; "--bare"] |> ignore;
45 cache
46 end
47
48(** {1 Remote Naming}
49
50 We use URL-based remote names to avoid conflicts.
51 e.g., "github.com/dbuenzli/astring" for https://github.com/dbuenzli/astring.git *)
52
53let url_to_remote_name url =
54 (* Strip protocol and .git suffix *)
55 let url =
56 let prefixes = ["https://"; "http://"; "git://"; "ssh://"; "git@"] in
57 List.fold_left (fun u prefix ->
58 if String.starts_with ~prefix u then
59 String.sub u (String.length prefix) (String.length u - String.length prefix)
60 else u
61 ) url prefixes
62 in
63 let url =
64 if String.ends_with ~suffix:".git" url then
65 String.sub url 0 (String.length url - 4)
66 else url
67 in
68 (* Replace : with / for git@ style URLs *)
69 String.map (fun c -> if c = ':' then '/' else c) url
70
71let branch_name ~remote ~branch =
72 remote ^ "/" ^ branch
73
74(** {1 Cache Operations} *)
75
76let has_remote ~proc_mgr cache remote_name =
77 match Git.remote_url ~proc_mgr ~cwd:cache remote_name with
78 | Some _ -> true
79 | None -> false
80
81let ensure_remote ~proc_mgr cache ~url =
82 let remote_name = url_to_remote_name url in
83 if has_remote ~proc_mgr cache remote_name then
84 remote_name
85 else begin
86 Git.run_exn ~proc_mgr ~cwd:cache
87 ["remote"; "add"; remote_name; url] |> ignore;
88 remote_name
89 end
90
91let fetch ~proc_mgr cache ~url =
92 let remote_name = ensure_remote ~proc_mgr cache ~url in
93 Git.fetch ~proc_mgr ~cwd:cache ~remote:remote_name;
94 remote_name
95
96let get_ref ~proc_mgr cache ~url ~branch =
97 let remote_name = url_to_remote_name url in
98 let ref_name = branch_name ~remote:remote_name ~branch in
99 match Git.rev_parse ~proc_mgr ~cwd:cache ref_name with
100 | Some sha -> Some sha
101 | None -> None
102
103(** Fetch to cache, then clone ref into project's bare repo *)
104let fetch_to_project ~proc_mgr ~cache ~project_git ~url ~branch =
105 (* First, fetch to cache (include tags, force update to avoid conflicts) *)
106 let remote_name = ensure_remote ~proc_mgr cache ~url in
107 Git.run_exn ~proc_mgr ~cwd:cache
108 ["fetch"; "--tags"; "--force"; remote_name] |> ignore;
109
110 (* Determine if this is a branch or tag *)
111 let branch_ref = branch_name ~remote:remote_name ~branch in
112 let tag_ref = "refs/tags/" ^ branch in
113
114 (* Check which ref exists in cache *)
115 let cache_ref =
116 match Git.rev_parse ~proc_mgr ~cwd:cache branch_ref with
117 | Some _ -> branch_ref
118 | None ->
119 (* Try as a tag *)
120 match Git.rev_parse ~proc_mgr ~cwd:cache tag_ref with
121 | Some _ -> tag_ref
122 | None -> failwith (Printf.sprintf "Ref not found: %s (tried branch %s and tag %s)"
123 branch branch_ref tag_ref)
124 in
125
126 (* Now fetch from cache into project *)
127 let cache_path = snd cache in
128
129 (* Add cache as a remote in project if not exists *)
130 let cache_remote = "vendor-cache" in
131 (match Git.remote_url ~proc_mgr ~cwd:project_git cache_remote with
132 | None ->
133 Git.run_exn ~proc_mgr ~cwd:project_git
134 ["remote"; "add"; cache_remote; cache_path] |> ignore
135 | Some _ -> ());
136
137 (* Fetch the specific ref from cache *)
138 Git.run_exn ~proc_mgr ~cwd:project_git
139 ["fetch"; cache_remote; cache_ref ^ ":" ^ cache_ref] |> ignore;
140
141 cache_ref
142
143(** {1 Listing} *)
144
145let list_remotes ~proc_mgr cache =
146 Git.run_lines ~proc_mgr ~cwd:cache ["remote"]
147
148let list_branches ~proc_mgr cache =
149 Git.run_lines ~proc_mgr ~cwd:cache ["branch"; "-a"]
150 |> List.filter_map (fun line ->
151 let line = String.trim line in
152 if String.starts_with ~prefix:"* " line then
153 Some (String.sub line 2 (String.length line - 2))
154 else if line <> "" then
155 Some line
156 else
157 None)