blob: 873b1378f86ff088882b922681447f22114cec7a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
(* -*- mode: tuareg; -*- *)
module Store = Git_unix.Store
open Lwt_result.Syntax
open Config
let full_path path = Filename.concat config.git_project_root path
let store repo =
let path = full_path repo |> Fpath.v in
Store.v ~dotgit:path path
let repo_description repo =
let description_path = Filename.concat (full_path repo) "description" in
In_channel.with_open_text description_path In_channel.input_all
let short_hash hash = String.sub hash 0 8
module Commit = struct
type user = Git.User.t
type t = {
hash : string;
parents : string list;
author : user;
message : string option;
}
let to_t c =
Store.
{
hash = Value.Commit.digest c |> Hash.to_hex;
parents = Value.Commit.parents c |> List.map Hash.to_hex;
author = Value.Commit.author c;
message = Value.Commit.message c;
}
let of_id repo id =
let* store = store repo in
let hash = Store.Hash.of_hex id in
Lwt_result.bind (Store.read store hash) @@ function
| Git.Value.Commit commit -> Lwt_result.return (to_t commit)
| _ -> Lwt_result.fail @@ `Msg ("no commit matches id " ^ id)
let head repo =
let* store = store repo in
let* hash = Store.Ref.resolve store Git.Reference.head in
let id = hash |> Store.Hash.to_hex in
of_id repo id
let recent repo n =
let* head_commit = head repo in
let rec walk acc hash count =
if count = 0 then Lwt_result.return (List.rev acc)
else
let* commit = of_id repo hash in
match commit.parents with
| parent_hash :: _ -> walk (commit :: acc) parent_hash (count - 1)
| [] -> Lwt_result.return (List.rev (commit :: acc))
in
walk [] head_commit.hash n
end
module Reference = struct
type t = { name : string; hash : string }
let to_t (reference, hash) =
{ name = Git.Reference.to_string reference; hash = Store.Hash.to_hex hash }
let all repo =
let* store = store repo in
let open Lwt.Syntax in
let* references = Store.Ref.list store in
let references = List.map to_t references in
Lwt_result.return references
let branches repo =
let* references = all repo in
let is_branch reference =
not (String.starts_with ~prefix:"v" reference.name)
in
Lwt_result.return @@ List.filter is_branch references
let tags repo =
let* references = all repo in
let is_branch reference = String.starts_with ~prefix:"v" reference.name in
Lwt_result.return @@ List.filter is_branch references
let of_id repo id =
let* branches = branches repo in
let branch =
branches
|> List.find_opt (fun branch -> Filename.basename branch.name = id)
in
match branch with
| Some branch -> Lwt_result.return branch
| None -> Lwt_result.fail @@ `Msg ("no reference matches id " ^ id)
end
module Entry = struct
type t = { hash : string; name : string; perm : int }
let to_t (entry : Store.Value.Tree.entry) =
let hash = Store.Hash.to_hex entry.node in
let name = entry.name in
let perm =
match entry.perm with
| `Commit -> 0o160000
| `Dir -> 0o040000
| `Everybody -> 0o100664
| `Exec -> 0o100755
| `Link -> 0o120000
| `Normal -> 0o100644
in
{ hash; name; perm }
let is_readme { name; _ } =
String.lowercase_ascii name |> String.starts_with ~prefix:"readme"
end
module Tree = struct
type t = { hash : string; path : string; entries : Entry.t list }
let to_t tree =
let hash = Store.Value.Tree.hash tree |> Int.to_string in
let path = "/" in
let entries = Store.Value.Tree.to_list tree |> List.map Entry.to_t in
{ hash; path; entries }
let of_id repo id =
let* store = store repo in
let hash = Store.Hash.of_hex id in
Lwt_result.bind (Store.read store hash) @@ function
| Git.Value.Tree tree -> Lwt_result.return (to_t tree)
| _ -> Lwt_result.fail @@ `Msg ("no tree matches id " ^ id)
let head repo =
let* store = store repo in
let* hash = Store.Ref.resolve store Git.Reference.head in
Lwt_result.bind (Store.read store hash) @@ function
| Git.Value.Commit commit ->
let tree_id = Store.Value.Commit.tree commit |> Store.Hash.to_hex in
of_id repo tree_id
| _ -> Lwt_result.fail @@ `Msg "HEAD reference does not point to a commit"
end
module Blob = struct
type t = { content : string }
let to_t blob = { content = Store.Value.Blob.to_string blob }
let of_id repo id =
let* store = store repo in
let hash = Store.Hash.of_hex id in
Lwt_result.bind (Store.read store hash) @@ function
| Git.Value.Blob blob -> Lwt_result.return (to_t blob)
| _ -> Lwt_result.fail @@ `Msg ("no blob matches id " ^ id)
end
let blob_or_tree repo id =
let* store = store repo in
let hash = Store.Hash.of_hex id in
Lwt_result.bind (Store.read store hash) @@ function
| Git.Value.Tree tree -> Lwt_result.return @@ `Tree (Tree.to_t tree)
| Git.Value.Blob blob -> Lwt_result.return @@ `Blob (Blob.to_t blob)
| _ -> Lwt_result.fail @@ `Msg ("No tree or blob matches id " ^ id)
module Repo = struct
let has_readme repo =
let* tree = Tree.head repo in
Lwt_result.return @@ List.exists Entry.is_readme tree.entries
let readme repo =
let* tree = Tree.head repo in
match List.find_opt Entry.is_readme tree.entries with
| None -> Lwt_result.return None
| Some readme -> (
let* store = store repo in
let hash = Store.Hash.of_hex readme.hash in
Lwt_result.bind (Store.read store hash) @@ function
| Git.Value.Blob blob -> Lwt_result.return @@ Some (Blob.to_t blob)
| _ -> Lwt_result.fail @@ `Msg ("couldn't read file " ^ readme.name))
end
|
