blob: 5e5d4cd1ff9a7b69bb12a98c12ac9461650a3838 (
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
|
open Lwt.Infix
module Store = Git_unix.Store
module Value = Git.Value
type user_record = { name : string; email : string }
type commit_record = {
hash : string;
parents : string list;
author : Git.User.t;
message : string option;
}
let full_path path = Filename.concat Config.git_directory path
let store repo_path =
let path = Fpath.v @@ full_path repo_path in
Store.v ~dotgit:path path
let short_hash hash = String.sub hash 0 8
let repo_description repo_path =
let description_path = Filename.concat (full_path repo_path) "description" in
In_channel.with_open_text description_path In_channel.input_all
(* Read a Git object and turn it into our [commit_record], or propagate an error. *)
let get_commit_record store h =
Store.read store h >>= function
| Ok (Value.Commit c) ->
Lwt.return_ok
{
hash = Store.Hash.to_hex h;
parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex;
author = Store.Value.Commit.author c;
message = Store.Value.Commit.message c;
}
| Ok _ -> Lwt.return_error (`Msg "object is not a commit")
| Error e -> Lwt.return_error e
let recent_commits repo_path n =
let open Lwt_result.Syntax in
let* store = store repo_path in
let* head = Store.Ref.resolve store Git.Reference.head in
let rec walk acc hash count =
if count = 0 then Lwt.return_ok (List.rev acc)
else
get_commit_record store hash >>= function
| Error e -> Lwt.return_error e
| Ok commit -> (
match commit.parents with
| parent :: _ ->
walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1)
| [] -> Lwt.return_ok (List.rev (commit :: acc)))
in
walk [] head n
let get_commit repo_path id =
let open Lwt_result.Syntax in
let* store = store repo_path in
let id = Store.Hash.of_hex id in
get_commit_record store id
|