[OCaml] Mobile-friendly clone of cgit.
Refactor resolvers.
Changed files
lib/handlers.ml
@@ -13,36 +13,37 @@
13
13
14
14
let summary req =
15
15
let repo = Dream.param req "repo" in
16
Removed:
let* branches = Resolvers.all_branches repo in
17
Removed:
let* commits = Resolvers.recent_commits repo 10 in
16
Added:
(* let* branches = Resolvers.Branch.all repo in *)
17
Added:
(* let* commits = Resolvers.Commit.recent repo 10 in *)
18
Added:
let* commits = Resolvers.Commit.head repo in
18
19
let authors = [ "John Pork"; "Sebastian Jellybean" ] in
19
Removed:
Views.Repo.summary repo branches commits authors
20
Added:
Views.Repo.summary repo () [commits] authors
20
21
21
22
let log req =
22
23
let repo = Dream.param req "repo" in
23
Removed:
let* commits = Resolvers.recent_commits repo 100 in
24
Added:
let* commits = Resolvers.Commit.recent repo 100 in
24
25
Views.Repo.log repo commits
25
26
26
27
let files_at_head req =
27
28
let repo = Dream.param req "repo" in
28
Removed:
let* tree = Resolvers.head_tree repo in
29
Added:
let* tree = Resolvers.Tree.head repo in
29
30
Views.Repo.files repo tree
30
31
31
32
let file_id req =
32
33
let repo = Dream.param req "repo" in
33
34
let id = Dream.param req "repo" in
34
Removed:
let* blob = Resolvers.blob_of_id repo id in
35
Added:
let* blob = Resolvers.Blob.of_id repo id in
35
36
Views.Repo.file repo blob
36
37
37
38
let refs req =
38
39
let repo = Dream.param req "repo" in
39
Removed:
let* branches = Resolvers.all_branches repo in
40
Removed:
Views.Repo.refs repo branches
40
Added:
(* let* branches = Resolvers.Branch.all repo in *)
41
Added:
Views.Repo.refs repo ()
41
42
42
43
let commit req =
43
44
let repo = Dream.param req "repo" in
44
45
let id = Dream.param req "id" in
45
Removed:
let* commit = Resolvers.commit_of_id repo id in
46
Added:
let* commit = Resolvers.Commit.of_id repo id in
46
47
Views.Repo.commit repo commit
47
48
end
48
49
lib/resolvers.ml
@@ -2,134 +2,152 @@
2
2
3
3
module Store = Git_unix.Store
4
4
open Lwt_result.Syntax
5
Removed:
open Lwt_result.Infix
5
Added:
6
Added:
(* open Lwt_result.Infix *)
6
7
open Config
7
8
8
9
let full_path path = Filename.concat config.git_project_root path
9
10
10
11
let store repo =
11
Removed:
let path = Fpath.v @@ full_path repo in
12
Added:
let path = full_path repo |> Fpath.v in
12
13
Store.v ~dotgit:path path
13
14
14
15
let repo_description repo =
15
16
let description_path = Filename.concat (full_path repo) "description" in
16
17
In_channel.with_open_text description_path In_channel.input_all
17
18
18
Removed:
type user = Git.User.t
19
Added:
let short_hash hash = String.sub hash 0 8
19
20
20
Removed:
type commit = {
21
Removed:
hash : string;
22
Removed:
short_hash : string;
23
Removed:
parents : string list;
24
Removed:
author : user;
25
Removed:
message : string option;
26
Removed:
}
21
Added:
module Commit = struct
22
Added:
type user = Git.User.t
27
23
28
Removed:
let to_commit store hash =
29
Removed:
Store.read store hash >>= function
30
Removed:
| Git.Value.Commit c ->
31
Removed:
let hash = Store.Hash.to_hex hash in
32
Removed:
Lwt_result.return
33
Removed:
{
34
Removed:
hash;
35
Removed:
short_hash = String.sub hash 0 8;
36
Removed:
parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex;
37
Removed:
author = Store.Value.Commit.author c;
38
Removed:
message = Store.Value.Commit.message c;
39
Removed:
}
40
Removed:
| _ -> Lwt_result.fail (`Msg "value is not a commit")
24
Added:
type t = {
25
Added:
hash : string;
26
Added:
parents : string list;
27
Added:
author : user;
28
Added:
message : string option;
29
Added:
}
41
30
42
Removed:
let commit_of_id repo id =
43
Removed:
let* store = store repo in
44
Removed:
let hash = Store.Hash.of_hex id in
45
Removed:
to_commit store hash
31
Added:
let to_t c =
32
Added:
let open Store.Value in
33
Added:
{
34
Added:
hash = Store.Value.Commit.digest c |> Store.Hash.to_hex;
35
Added:
parents = Commit.parents c |> List.map Store.Hash.to_hex;
36
Added:
author = Commit.author c;
37
Added:
message = Commit.message c;
38
Added:
}
46
39
47
Removed:
let recent_commits repo n =
48
Removed:
let* store = store repo in
49
Removed:
let* head = Store.Ref.resolve store Git.Reference.head in
50
Removed:
let rec walk acc hash count =
51
Removed:
if count = 0 then Lwt_result.return (List.rev acc)
52
Removed:
else
53
Removed:
let* commit = to_commit store hash in
54
Removed:
match commit.parents with
55
Removed:
| parent :: _ ->
56
Removed:
walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1)
57
Removed:
| [] -> Lwt_result.return (List.rev (commit :: acc))
58
Removed:
in
59
Removed:
walk [] head n
40
Added:
let of_id repo id =
41
Added:
let* store = store repo in
42
Added:
let hash = Store.Hash.of_hex id in
43
Added:
Store.read store hash
44
Added:
|> Lwt_result.map @@ function
45
Added:
| Git.Value.Commit commit -> to_t commit
46
Added:
| _ -> failwith (id ^ " does not point to a commit object")
60
47
61
Removed:
type branch = { hash : string; name : string }
48
Added:
let head repo =
49
Added:
let* store = store repo in
50
Added:
let* hash = Store.Ref.resolve store Git.Reference.head in
51
Added:
let id = hash |> Store.Hash.to_hex in
52
Added:
of_id repo id
62
53
63
Removed:
let all_branches repo =
64
Removed:
let* store = store repo in
65
Removed:
let open Lwt.Syntax in
66
Removed:
let* refs = Store.Ref.list store in
67
Removed:
let branches =
68
Removed:
List.map
69
Removed:
(fun (reference, hash) ->
70
Removed:
let name = Git.Reference.to_string reference in
71
Removed:
let hash = Store.Hash.to_hex hash in
72
Removed:
{ name; hash })
73
Removed:
refs
74
Removed:
in
75
Removed:
Lwt_result.return branches
54
Added:
let recent repo n =
55
Added:
let* head_commit = head repo in
56
Added:
let rec walk acc hash count =
57
Added:
if count = 0 then Lwt_result.return (List.rev acc)
58
Added:
else
59
Added:
let* commit = of_id repo hash in
60
Added:
match commit.parents with
61
Added:
| parent_hash :: _ -> walk (commit :: acc) parent_hash (count - 1)
62
Added:
| [] -> Lwt_result.return (List.rev (commit :: acc))
63
Added:
in
64
Added:
walk [] head_commit.hash n
65
Added:
end
76
66
77
Removed:
type tree_entry = {
78
Removed:
hash : string;
79
Removed:
short_hash : string;
80
Removed:
name : string;
81
Removed:
perm : int;
82
Removed:
}
67
Added:
(* module Branch = struct *)
68
Added:
(* type t = { hash : string; name : string } *)
83
69
84
Removed:
type tree = { hash : string; short_hash : string; entries : tree_entry list }
85
Removed:
type blob = { content : string }
70
Added:
(* let to_t (branch : Store.Reference.t) = *)
71
Added:
(* { *)
72
Added:
(* hash = Store.Reference.hash branch ; *)
73
Added:
(* name = Store.Reference.contents branch; *)
74
Added:
(* } *)
86
75
87
Removed:
let to_entry (entry : Store.Value.Tree.entry) =
88
Removed:
let perm =
89
Removed:
match entry.perm with
90
Removed:
| `Commit -> 0o160000
91
Removed:
| `Dir -> 0o040000
92
Removed:
| `Everybody -> 0o100664
93
Removed:
| `Exec -> 0o100755
94
Removed:
| `Link -> 0o120000
95
Removed:
| `Normal -> 0o100644
96
Removed:
in
97
Removed:
let hash = Store.Hash.to_hex entry.node in
98
Removed:
let short_hash = String.sub hash 0 8 in
99
Removed:
{ hash; short_hash; name = entry.name; perm }
76
Added:
(* let of_id repo id = *)
77
Added:
(* let* store = store repo in *)
78
Added:
(* let hash = Store.Hash.of_hex id in *)
79
Added:
(* Store.Ref.resolve store hash *)
80
Added:
(* |> Lwt_result.map @@ function *)
81
Added:
(* | Git.Reference.Ref branch -> to_t branch *)
82
Added:
(* | _ -> failwith "no head tree id" *)
100
83
101
Removed:
let to_tree store hash =
102
Removed:
Store.read store hash >>= function
103
Removed:
| Git.Value.Tree tree ->
104
Removed:
let hash = Store.Hash.to_hex hash in
105
Removed:
let short_hash = String.sub hash 0 8 in
106
Removed:
let entries = Store.Value.Tree.to_list tree |> List.map to_entry in
107
Removed:
Lwt_result.return { hash; short_hash; entries }
108
Removed:
| _ -> Lwt_result.fail (`Msg "value is not a tree")
84
Added:
(* let all repo = *)
85
Added:
(* let* store = store repo in *)
86
Added:
(* let* refs = Store.Ref.list store in *)
87
Added:
(* let branches = *)
88
Added:
(* List.map *)
89
Added:
(* (fun (reference, hash) -> *)
90
Added:
(* let name = Git.Reference.to_string reference in *)
91
Added:
(* let hash = Store.Hash.to_hex hash in *)
92
Added:
(* { name; hash }) *)
93
Added:
(* refs *)
94
Added:
(* in *)
95
Added:
(* Lwt_result.return branches *)
96
Added:
(* end *)
109
97
110
Removed:
let to_blob store hash =
111
Removed:
Store.read store hash >>= function
112
Removed:
| Git.Value.Blob blob ->
113
Removed:
let content = Store.Value.Blob.to_string blob in
114
Removed:
Lwt_result.return { content }
115
Removed:
| _ -> Lwt_result.fail (`Msg "value is not a blob")
98
Added:
module Entry = struct
99
Added:
type t = { hash : string; name : string; perm : int }
116
100
117
Removed:
let head_tree repo =
118
Removed:
let* store = store repo in
119
Removed:
let* hash =
120
Removed:
Store.Ref.resolve store Git.Reference.head >>= Store.read store >>= function
121
Removed:
| Git.Value.Commit commit ->
122
Removed:
Store.Value.Commit.tree commit |> Lwt_result.return
123
Removed:
| _ -> `Msg "no head tree id" |> Lwt_result.fail
124
Removed:
in
125
Removed:
to_tree store hash
101
Added:
let to_t (entry : Store.Value.Tree.entry) =
102
Added:
let perm =
103
Added:
match entry.perm with
104
Added:
| `Commit -> 0o160000
105
Added:
| `Dir -> 0o040000
106
Added:
| `Everybody -> 0o100664
107
Added:
| `Exec -> 0o100755
108
Added:
| `Link -> 0o120000
109
Added:
| `Normal -> 0o100644
110
Added:
in
111
Added:
let hash = Store.Hash.to_hex entry.node in
112
Added:
{ hash; name = entry.name; perm }
113
Added:
end
126
114
127
Removed:
let tree_of_id repo id =
128
Removed:
let* store = store repo in
129
Removed:
let hash = Store.Hash.of_hex id in
130
Removed:
to_tree store hash
115
Added:
module Tree = struct
116
Added:
type t = { hash : string; entries : Entry.t list }
131
117
132
Removed:
let blob_of_id repo id =
133
Removed:
let* store = store repo in
134
Removed:
let hash = Store.Hash.of_hex id in
135
Removed:
to_blob store hash
118
Added:
let to_t (tree : Store.Value.Tree.t) =
119
Added:
let hash = Store.Value.Tree.hash tree |> Int.to_string in
120
Added:
let entries = Store.Value.Tree.to_list tree |> List.map Entry.to_t in
121
Added:
{ hash; entries }
122
Added:
123
Added:
let of_id repo id =
124
Added:
let* store = store repo in
125
Added:
let hash = Store.Hash.of_hex id in
126
Added:
Store.read store hash
127
Added:
|> Lwt_result.map @@ function
128
Added:
| Git.Value.Tree tree -> to_t tree
129
Added:
| _ -> failwith "no head tree id"
130
Added:
131
Added:
let head repo : (t, Store.error) Lwt_result.t =
132
Added:
let* store = store repo in
133
Added:
let* hash =
134
Added:
Store.Ref.resolve store Git.Reference.head
135
Added:
|> Lwt_result.map Store.Hash.to_hex
136
Added:
in
137
Added:
of_id repo hash
138
Added:
end
139
Added:
140
Added:
module Blob = struct
141
Added:
type t = { content : string }
142
Added:
143
Added:
let to_t (blob : Store.Value.Blob.t) =
144
Added:
{ content = Store.Value.Blob.to_string blob }
145
Added:
146
Added:
let of_id repo id =
147
Added:
let* store = store repo in
148
Added:
let hash = Store.Hash.of_hex id in
149
Added:
Store.read store hash
150
Added:
|> Lwt_result.map @@ function
151
Added:
| Git.Value.Blob blob -> to_t blob
152
Added:
| _ -> failwith (id ^ " does not point to a blob object")
153
Added:
end
lib/views.ml
@@ -90,18 +90,19 @@
90
90
respond @@ Page.render body_data
91
91
92
92
module Repo = struct
93
Removed:
open Resolvers
93
Added:
let page_title repo =
94
Added:
Printf.sprintf "%s — %s" repo (Resolvers.repo_description repo)
94
95
95
Removed:
let page_title repo = Printf.sprintf "%s — %s" repo (repo_description repo)
96
96
let li_of_author author = HTML.(li [] [ txt "%s" author ])
97
97
98
Removed:
let li_of_branch repo (branch : branch) =
99
Removed:
HTML.(li [] [ Routes.link_to (Refs repo) (txt "%s" branch.name) ])
98
Added:
(* let li_of_branch repo (branch : Resolvers.Branch.t) = *)
99
Added:
(* HTML.(li [] [ Routes.link_to (Refs repo) (txt "%s" branch.name) ]) *)
100
100
101
Removed:
let li_of_commit repo commit =
101
Added:
let li_of_commit repo (commit : Resolvers.Commit.t) =
102
102
let open HTML in
103
Added:
let short_hash = Resolvers.short_hash commit.hash in
103
104
match commit.message with
104
Removed:
| None -> li [] [ txt "%s" commit.short_hash ]
105
Added:
| None -> li [] [ txt "%s" short_hash ]
105
106
| Some msg ->
106
107
li []
107
108
[
@@ -109,12 +110,12 @@
109
110
(Commit (repo, commit.hash))
110
111
(null
111
112
[
112
Removed:
span [ class_ "commit-hash" ] [ txt "%s" commit.short_hash ];
113
Added:
span [ class_ "commit-hash" ] [ txt "%s" short_hash ];
113
114
txt " — %s" msg;
114
115
]);
115
116
]
116
117
117
Removed:
let li_of_entry repo entry =
118
Added:
let li_of_entry repo (entry : Resolvers.Entry.t) =
118
119
let display_name =
119
120
if entry.perm = 0o040000 then entry.name ^ "/" else entry.name
120
121
in
@@ -124,12 +125,12 @@
124
125
in
125
126
HTML.(li [] [ Routes.link_to route @@ txt "%s" display_name ])
126
127
127
Removed:
let summary repo branches commits authors =
128
Added:
let summary repo _branches commits authors =
128
129
let content =
129
130
HTML.
130
131
[
131
132
h3 [] [ txt "Branches" ];
132
Removed:
ul [] (List.map (li_of_branch repo) branches);
133
Added:
(* ul [] (List.map (li_of_branch repo) branches); *)
133
134
h3 [] [ txt "Latest commits" ];
134
135
ul [] (List.map (li_of_commit repo) commits);
135
136
h3 [] [ txt "Authors" ];
@@ -140,24 +141,24 @@
140
141
@@ Page.render ~page_title:(page_title repo)
141
142
{
142
143
title = repo;
143
Removed:
subtitle = repo_description repo;
144
Added:
subtitle = Resolvers.repo_description repo;
144
145
topnav = Components.Topnav.(v ~active_path:Summary repo);
145
146
content;
146
147
}
147
148
148
Removed:
let refs repo branches =
149
Added:
let refs repo _branches =
149
150
let content =
150
151
HTML.
151
152
[
152
153
h3 [] [ txt "Branches" ];
153
Removed:
ul [] (List.map (li_of_branch repo) branches);
154
Added:
(* ul [] (List.map (li_of_branch repo) branches); *)
154
155
]
155
156
in
156
157
respond
157
158
@@ Page.render ~page_title:(page_title repo)
158
159
{
159
160
title = repo;
160
Removed:
subtitle = repo_description repo;
161
Added:
subtitle = Resolvers.repo_description repo;
161
162
topnav = Components.Topnav.(v ~active_path:Refs repo);
162
163
content;
163
164
}
@@ -174,30 +175,29 @@
174
175
@@ Page.render ~page_title:(page_title repo)
175
176
{
176
177
title = repo;
177
Removed:
subtitle = repo_description repo;
178
Added:
subtitle = Resolvers.repo_description repo;
178
179
topnav = Components.Topnav.(v ~active_path:Log repo);
179
180
content;
180
181
}
181
182
182
Removed:
let files repo tree =
183
Removed:
let title = Printf.sprintf "%s" repo in
183
Added:
let files repo (tree : Resolvers.Tree.t) =
184
184
let content =
185
185
HTML.
186
186
[
187
Removed:
h3 [] [ txt "Files %s" tree.short_hash ];
187
Added:
h3 [] [ txt "Files %s" @@ Resolvers.short_hash tree.hash ];
188
188
ul [] (List.map (li_of_entry repo) tree.entries);
189
189
]
190
190
in
191
191
respond
192
192
@@ Page.render ~page_title:(page_title repo)
193
193
{
194
Removed:
title;
195
Removed:
subtitle = repo_description repo;
194
Added:
title = Printf.sprintf "%s" repo;
195
Added:
subtitle = Resolvers.repo_description repo;
196
196
topnav = Components.Topnav.(v ~active_path:Files repo);
197
197
content;
198
198
}
199
199
200
Removed:
let file repo blob =
200
Added:
let file repo (blob : Resolvers.Blob.t) =
201
201
let title = Printf.sprintf "%s" repo in
202
202
let to_numbered_line number line =
203
203
let n = number + 1 in
@@ -218,20 +218,22 @@
218
218
@@ Page.render ~page_title:(page_title repo)
219
219
{
220
220
title;
221
Removed:
subtitle = repo_description repo;
221
Added:
subtitle = Resolvers.repo_description repo;
222
222
topnav = Components.Topnav.(v ~active_path:Files repo);
223
223
content;
224
224
}
225
225
226
Removed:
let commit repo commit =
226
Added:
let commit repo (commit : Resolvers.Commit.t) =
227
227
let message = match commit.message with Some msg -> msg | None -> "" in
228
Removed:
let title = Printf.sprintf "%s : %s" repo commit.short_hash in
228
Added:
let title =
229
Added:
Printf.sprintf "%s : %s" repo @@ Resolvers.short_hash commit.hash
230
Added:
in
229
231
let content = HTML.[ h3 [] [ txt "%s" message ] ] in
230
232
respond
231
233
@@ Page.render ~page_title:(page_title repo)
232
234
{
233
235
title;
234
Removed:
subtitle = repo_description repo;
236
Added:
subtitle = Resolvers.repo_description repo;
235
237
topnav = Components.Topnav.v repo;
236
238
content;
237
239
}