gazagnaire.org
Git object storage and pack files for Eio
1(* Copyright (c) 2024-2026 Thomas Gazagnaire <thomas@gazagnaire.org>
2
3 Permission to use, copy, modify, and distribute this software for any
4 purpose with or without fee is hereby granted, provided that the above
5 copyright notice and this permission notice appear in all copies.
6
7 THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
8 WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
9 MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10 ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12 ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13 OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
14
15type entry = { path : Fpath.t; head : Hash.t; branch : string option }
16type t = { fs : Eio.Fs.dir_ty Eio.Path.t; git_dir : string }
17
18let v ~fs ~git_dir = { fs; git_dir }
19
20let err_worktree_not_found path =
21 Error (`Msg (Fmt.str "worktree '%a' not found" Fpath.pp path))
22
23(* Get the main worktree path from .git directory *)
24let main_worktree_path t =
25 (* .git dir is like /path/to/repo/.git, so parent is the worktree *)
26 if
27 String.length t.git_dir > 5
28 && String.sub t.git_dir (String.length t.git_dir - 5) 5 = "/.git"
29 then String.sub t.git_dir 0 (String.length t.git_dir - 5)
30 else Filename.dirname t.git_dir
31
32(* Get worktree name from path *)
33let name path = Fpath.basename path
34
35(* Parse HEAD file to get branch name *)
36let parse_head_file content =
37 let content = String.trim content in
38 if String.length content > 16 && String.sub content 0 16 = "ref: refs/heads/"
39 then Some (String.sub content 16 (String.length content - 16))
40 else None
41
42(* Read linked worktree entry from .git/worktrees/<name> *)
43let read_worktree_entry t name =
44 let wt_git_dir = Filename.concat t.git_dir ("worktrees/" ^ name) in
45 let gitdir_path = Eio.Path.(t.fs / wt_git_dir / "gitdir") in
46 let head_path = Eio.Path.(t.fs / wt_git_dir / "HEAD") in
47 try
48 let gitdir_content = String.trim (Eio.Path.load gitdir_path) in
49 (* gitdir contains path to the worktree's .git file, the worktree is the parent *)
50 let wt_path =
51 if Filename.check_suffix gitdir_content "/.git" then
52 String.sub gitdir_content 0 (String.length gitdir_content - 5)
53 else Filename.dirname gitdir_content
54 in
55 let head_content = Eio.Path.load head_path in
56 let branch = parse_head_file head_content in
57 let head_hash =
58 match branch with
59 | Some b -> (
60 (* Read from the shared refs *)
61 let ref_path = Eio.Path.(t.fs / t.git_dir / "refs" / "heads" / b) in
62 try
63 let hash_str = String.trim (Eio.Path.load ref_path) in
64 Hash.of_hex hash_str
65 with Eio.Io _ | Invalid_argument _ ->
66 (* Fallback: parse HEAD as direct hash *)
67 Hash.of_hex (String.trim head_content))
68 | None -> Hash.of_hex (String.trim head_content)
69 in
70 match Fpath.of_string wt_path with
71 | Ok path -> Some { path; head = head_hash; branch }
72 | Error _ -> None
73 with Eio.Io _ | Invalid_argument _ -> None
74
75let list t ~head ~current_branch =
76 (* First, add the main worktree *)
77 let main_path = main_worktree_path t in
78 let main_entry =
79 match Fpath.of_string main_path with
80 | Ok path ->
81 (* For the main worktree, use a zero hash if HEAD doesn't exist yet *)
82 let head_hash =
83 match head with
84 | Some h -> h
85 | None -> Hash.of_hex (String.make 40 '0')
86 in
87 Some { path; head = head_hash; branch = current_branch }
88 | Error _ -> None
89 in
90 (* Then list linked worktrees from .git/worktrees/ *)
91 let worktrees_dir = Filename.concat t.git_dir "worktrees" in
92 let worktrees_path = Eio.Path.(t.fs / worktrees_dir) in
93 let linked_entries =
94 try
95 let entries = Eio.Path.read_dir worktrees_path in
96 List.filter_map (read_worktree_entry t) entries
97 with Eio.Io _ -> []
98 in
99 match main_entry with Some e -> e :: linked_entries | None -> linked_entries
100
101let exists t ~path =
102 (* We need to get head and current_branch, but for exists check we can pass None *)
103 let worktrees = list t ~head:None ~current_branch:None in
104 List.exists (fun e -> Fpath.equal e.path path) worktrees
105
106let write_ref t name hash =
107 let path = Filename.concat t.git_dir name in
108 let full_path = Eio.Path.(t.fs / path) in
109 let dir = Filename.dirname path in
110 let dir_path = Eio.Path.(t.fs / dir) in
111 (try Eio.Path.mkdir ~perm:0o755 dir_path with Eio.Io _ -> ());
112 let content = Hash.to_hex hash ^ "\n" in
113 Eio.Path.save ~create:(`Or_truncate 0o644) full_path content
114
115let add t ~head ~path ~branch =
116 let name = name path in
117 let wt_git_dir = Filename.concat t.git_dir ("worktrees/" ^ name) in
118 let wt_git_dir_path = Eio.Path.(t.fs / wt_git_dir) in
119 let wt_path_str = Fpath.to_string path in
120 let wt_path = Eio.Path.(t.fs / wt_path_str) in
121 (* Create the worktree directory *)
122 (try Eio.Path.mkdirs ~perm:0o755 wt_path with Eio.Io _ -> ());
123 (* Create .git/worktrees/<name> directory *)
124 (try Eio.Path.mkdirs ~perm:0o755 wt_git_dir_path with Eio.Io _ -> ());
125 (* Write gitdir file (path to the worktree's .git file) *)
126 let gitdir_content = wt_path_str ^ "/.git\n" in
127 Eio.Path.save ~create:(`Or_truncate 0o644)
128 Eio.Path.(wt_git_dir_path / "gitdir")
129 gitdir_content;
130 (* Write HEAD file (pointing to the new branch) *)
131 let head_content = "ref: refs/heads/" ^ branch ^ "\n" in
132 Eio.Path.save ~create:(`Or_truncate 0o644)
133 Eio.Path.(wt_git_dir_path / "HEAD")
134 head_content;
135 (* Write commondir file (relative path to main .git) *)
136 Eio.Path.save ~create:(`Or_truncate 0o644)
137 Eio.Path.(wt_git_dir_path / "commondir")
138 "..\n";
139 (* Create the branch in the main repo *)
140 write_ref t ("refs/heads/" ^ branch) head;
141 (* Write .git file in the worktree *)
142 let git_file_content = "gitdir: " ^ wt_git_dir ^ "\n" in
143 Eio.Path.save ~create:(`Or_truncate 0o644)
144 Eio.Path.(wt_path / ".git")
145 git_file_content;
146 Ok ()
147
148let remove t ~path ~force =
149 if not (exists t ~path) then err_worktree_not_found path
150 else
151 let name = name path in
152 let wt_git_dir = Filename.concat t.git_dir ("worktrees/" ^ name) in
153 let wt_git_dir_path = Eio.Path.(t.fs / wt_git_dir) in
154 let wt_path_str = Fpath.to_string path in
155 let wt_path = Eio.Path.(t.fs / wt_path_str) in
156 (* Check if worktree is the main worktree *)
157 if String.equal (main_worktree_path t) wt_path_str then
158 Error (`Msg "cannot remove main worktree")
159 else begin
160 (* TODO: Check for uncommitted changes if not force *)
161 ignore force;
162 (* Remove the .git/worktrees/<name> directory *)
163 let rec remove_dir path =
164 try
165 let entries = Eio.Path.read_dir path in
166 List.iter
167 (fun entry ->
168 let entry_path = Eio.Path.(path / entry) in
169 if Eio.Path.is_directory entry_path then remove_dir entry_path
170 else Eio.Path.unlink entry_path)
171 entries;
172 Eio.Path.rmdir path
173 with Eio.Io _ -> ()
174 in
175 remove_dir wt_git_dir_path;
176 (* Remove the worktree directory *)
177 remove_dir wt_path;
178 Ok ()
179 end