blob: f0a0317130ecbb23f78ae5f05525480b71865842 (
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
|
(* -*- 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 = 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 =
let* v = Store.read store hash in
match v with
| 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 (ref, hash) ->
{ name = Git.Reference.to_string ref; hash = Store.Hash.to_hex 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 }
let to_entry _ =
{
hash = "foo";
short_hash = String.sub "foobar" 0 8;
name = "foobarbino";
perm = 122;
}
let present_tree tree = Store.Value.Tree.to_list tree |> List.map to_entry
let to_tree store hash =
let* v = Store.read store hash in
match v with
| Git.Value.Tree tree ->
let hash = Store.Hash.to_hex hash in
Lwt_result.return
{ hash; short_hash = String.sub hash 0 8; entries = present_tree tree }
| _ ->
Dream.log "Value is not a tree";
Lwt_result.fail (`Msg "value is not a tree")
let head_tree_id store =
let* commit_hash = Store.Ref.resolve store Git.Reference.head in
let* v = Store.read store commit_hash in
match v with
| Git.Value.Commit commit ->
Store.Value.Commit.tree commit |> Lwt_result.return
| _ ->
Dream.log "no head tree id";
Lwt_result.fail (`Msg "")
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 = Lwt_result.return (Store.Hash.of_hex id) in
to_tree store hash
|
