blob: e098ecca7f6e3543b8bdc51b4a1b8b730298264d (
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
|
(* -*- mode: tuareg; -*- *)
module Store = Git_unix.Store
open Lwt_result.Syntax
open Lwt_result.Infix
open Config
let full_path path = Filename.concat config.git_project_root path
let store repo =
let path = Fpath.v @@ full_path repo 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
type user = Git.User.t
(* let all_authors store = *)
(* let* store = store repo in *)
type commit = {
hash : string;
short_hash : string;
parents : string list;
author : user;
message : string option;
}
let to_commit store hash =
Store.read store hash >>= function
| Git.Value.Commit c ->
let hash = Store.Hash.to_hex hash in
Lwt_result.return
{
hash;
short_hash = String.sub hash 0 8;
parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex;
author = Store.Value.Commit.author c;
message = Store.Value.Commit.message c;
}
| _ -> Lwt_result.fail (`Msg "value is not a commit")
let commit_of_id repo id =
let* store = store repo in
let hash = Store.Hash.of_hex id in
to_commit store hash
let recent_commits repo n =
let* store = store repo in
let* head = Store.Ref.resolve store Git.Reference.head in
let rec walk acc hash count =
if count = 0 then Lwt_result.return (List.rev acc)
else
let* commit = to_commit store hash in
match commit.parents with
| parent :: _ ->
walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1)
| [] -> Lwt_result.return (List.rev (commit :: acc))
in
walk [] head n
type branch = { hash : string; name : string }
let all_branches repo =
let* store = store repo in
let open Lwt.Syntax in
let* refs = Store.Ref.list store in
let branches =
List.map
(fun (reference, hash) ->
let name = Git.Reference.to_string reference in
let hash = Store.Hash.to_hex hash in
{ name; hash })
refs
in
Lwt_result.return branches
type tree_entry = {
hash : string;
short_hash : string;
name : string;
perm : int;
}
type tree = { hash : string; short_hash : string; entries : tree_entry list }
type blob = { content : string }
let to_entry (entry : Store.Value.Tree.entry) =
let perm =
match entry.perm with
| `Commit -> 0o160000
| `Dir -> 0o040000
| `Everybody -> 0o100664
| `Exec -> 0o100755
| `Link -> 0o120000
| `Normal -> 0o100644
in
let hash = Store.Hash.to_hex entry.node in
let short_hash = String.sub hash 0 8 in
{ hash; short_hash; name = entry.name; perm }
let to_tree store hash =
Store.read store hash >>= function
| Git.Value.Tree tree ->
let hash = Store.Hash.to_hex hash in
let short_hash = String.sub hash 0 8 in
let entries = Store.Value.Tree.to_list tree |> List.map to_entry in
Lwt_result.return { hash; short_hash; entries }
| _ -> Lwt_result.fail (`Msg "value is not a tree")
let to_blob store hash =
Store.read store hash >>= function
| Git.Value.Blob blob ->
let content = Store.Value.Blob.to_string blob in
Lwt_result.return { content }
| _ -> Lwt_result.fail (`Msg "value is not a blob")
let head_tree_id store =
Store.Ref.resolve store Git.Reference.head >>= Store.read store >>= function
| Git.Value.Commit commit ->
Store.Value.Commit.tree commit |> Lwt_result.return
| _ -> `Msg "no head tree id" |> Lwt_result.fail
let head_tree repo =
let* store = store repo in
let* hash = head_tree_id store in
to_tree store hash
let tree_of_id repo id =
let* store = store repo in
let hash = Store.Hash.of_hex id in
to_tree store hash
let blob_of_id repo id =
let* store = store repo in
let hash = Store.Hash.of_hex id in
to_blob store hash
|
