[OCaml] Mobile-friendly clone of cgit.
Implement Tree and Blob views.
Getting real close to something good now!
Changed files
lib/git_presenters.ml
@@ -3,6 +3,7 @@
3
3
module Store = Git_unix.Store
4
4
open Lwt_result.Syntax
5
5
open Config
6
Added:
open Lwt_result.Infix
6
7
7
8
let full_path path = Filename.concat config.git_project_root path
8
9
@@ -69,8 +70,10 @@
69
70
let* refs = Store.Ref.list store in
70
71
let branches =
71
72
List.map
72
Removed:
(fun (ref, hash) ->
73
Removed:
{ name = Git.Reference.to_string ref; hash = Store.Hash.to_hex hash })
73
Added:
(fun (reference, hash) ->
74
Added:
let name = Git.Reference.to_string reference in
75
Added:
let hash = Store.Hash.to_hex hash in
76
Added:
{ name; hash })
74
77
refs
75
78
in
76
79
Lwt_result.return branches
@@ -83,37 +86,45 @@
83
86
}
84
87
85
88
type tree = { hash : string; short_hash : string; entries : tree_entry list }
89
Added:
type blob = { content : string }
86
90
87
Removed:
let to_entry _ =
88
Removed:
{
89
Removed:
hash = "foo";
90
Removed:
short_hash = String.sub "foobar" 0 8;
91
Removed:
name = "foobarbino";
92
Removed:
perm = 122;
93
Removed:
}
91
Added:
let to_entry (entry : Store.Value.Tree.entry) =
92
Added:
let perm =
93
Added:
match entry.perm with
94
Added:
| `Commit -> 0o160000
95
Added:
| `Dir -> 0o040000
96
Added:
| `Everybody -> 0o100664
97
Added:
| `Exec -> 0o100755
98
Added:
| `Link -> 0o120000
99
Added:
| `Normal -> 0o100644
100
Added:
in
101
Added:
let hash = Store.Hash.to_hex entry.node in
102
Added:
let short_hash = String.sub hash 0 8 in
103
Added:
{ hash; short_hash; name = entry.name; perm }
94
104
95
105
let present_tree tree = Store.Value.Tree.to_list tree |> List.map to_entry
96
106
97
107
let to_tree store hash =
98
Removed:
let* v = Store.read store hash in
99
Removed:
match v with
108
Added:
Store.read store hash >>= function
100
109
| Git.Value.Tree tree ->
101
110
let hash = Store.Hash.to_hex hash in
102
Removed:
Lwt_result.return
103
Removed:
{ hash; short_hash = String.sub hash 0 8; entries = present_tree tree }
104
Removed:
| _ ->
105
Removed:
Dream.log "Value is not a tree";
106
Removed:
Lwt_result.fail (`Msg "value is not a tree")
111
Added:
let short_hash = String.sub hash 0 8 in
112
Added:
let entries = present_tree tree in
113
Added:
Lwt_result.return { hash; short_hash; entries }
114
Added:
| _ -> Lwt_result.fail (`Msg "value is not a tree")
107
115
116
Added:
let to_blob store hash =
117
Added:
Store.read store hash >>= function
118
Added:
| Git.Value.Blob blob ->
119
Added:
let content = Store.Value.Blob.to_string blob in
120
Added:
Lwt_result.return { content }
121
Added:
| _ -> Lwt_result.fail (`Msg "value is not a tree")
122
Added:
108
123
let head_tree_id store =
109
Removed:
let* commit_hash = Store.Ref.resolve store Git.Reference.head in
110
Removed:
let* v = Store.read store commit_hash in
111
Removed:
match v with
124
Added:
Store.Ref.resolve store Git.Reference.head >>= Store.read store >>= function
112
125
| Git.Value.Commit commit ->
113
126
Store.Value.Commit.tree commit |> Lwt_result.return
114
Removed:
| _ ->
115
Removed:
Dream.log "no head tree id";
116
Removed:
Lwt_result.fail (`Msg "")
127
Added:
| _ -> `Msg "no head tree id" |> Lwt_result.fail
117
128
118
129
let head_tree repo =
119
130
let* store = store repo in
@@ -124,3 +135,8 @@
124
135
let* store = store repo in
125
136
let* hash = Lwt_result.return (Store.Hash.of_hex id) in
126
137
to_tree store hash
138
Added:
139
Added:
let blob_of_id repo id =
140
Added:
let* store = store repo in
141
Added:
let* hash = Lwt_result.return (Store.Hash.of_hex id) in
142
Added:
to_blob store hash
lib/handlers.ml
@@ -31,16 +31,19 @@
31
31
Views.Repo.log (repo req) commits |> Dream_html.respond
32
32
33
33
let tree_head req =
34
Removed:
Dream.log "Tree head";
35
34
let* tree = head_tree (repo req) in
36
35
Views.Repo.tree (repo req) tree |> Dream_html.respond
37
36
38
37
let tree_id req =
39
Removed:
Dream.log "Tree id";
40
38
let id = id_of_req req in
41
39
let* tree = tree_of_id (repo req) id in
42
40
Views.Repo.tree (repo req) tree |> Dream_html.respond
43
41
42
Added:
let blob_id req =
43
Added:
let id = id_of_req req in
44
Added:
let* blob = blob_of_id (repo req) id in
45
Added:
Views.Repo.blob (repo req) blob |> Dream_html.respond
46
Added:
44
47
let commit req =
45
48
let id = id_of_req req in
46
49
let* commit = commit_of_id (repo req) id in
@@ -59,6 +62,7 @@
59
62
get "/log/" log;
60
63
get "/tree/" tree_head;
61
64
get "/tree/:id" tree_id;
65
Added:
get "/blob/:id" blob_id;
62
66
get "/commit/:id" commit;
63
67
];
64
68
get "/static/**" (static "./lib/static");
lib/routes.ml
@@ -1,29 +1,29 @@
1
1
(* -*- mode: tuareg; -*- *)
2
2
3
Removed:
open Dream_html
4
Removed:
open HTML
5
Removed:
6
3
type t =
7
4
| Root
8
5
| Repo of string
9
6
| Tag of string * string
10
7
| Commit of string * string
11
Removed:
| Tree of string * string * string
12
Removed:
| Blob of string * string * string
8
Added:
| Tree of string * string
9
Added:
| Blob of string * string
13
10
14
11
let%path root_path = "/"
15
12
let%path repo_path = "/%s/"
16
13
let%path tag_path = "/%s/refs/%s"
17
14
let%path commit_path = "/%s/commit/%s"
18
Removed:
let%path tree_path = "/%s/tree/%s/%s"
19
Removed:
let%path blob_path = "/%s/blob/%s/%s"
15
Added:
let%path tree_path = "/%s/tree/%s"
16
Added:
let%path blob_path = "/%s/blob/%s"
20
17
21
Removed:
let path_attr = function
22
Removed:
| Root -> path_attr href root_path
23
Removed:
| Repo repo -> path_attr href repo_path repo
24
Removed:
| Tag (repo, branch) -> path_attr href tag_path repo branch
25
Removed:
| Commit (repo, commit) -> path_attr href commit_path repo commit
26
Removed:
| Tree (repo, commit, path) -> path_attr href tree_path repo commit path
27
Removed:
| Blob (repo, commit, path) -> path_attr href blob_path repo commit path
28
Removed:
29
Removed:
let link_to route content = a [ path_attr route ] [ content ]
18
Added:
let link_to route contents =
19
Added:
let open Dream_html in
20
Added:
let open HTML in
21
Added:
let path = function
22
Added:
| Root -> path_attr href root_path
23
Added:
| Repo repo -> path_attr href repo_path repo
24
Added:
| Tag (repo, branch) -> path_attr href tag_path repo branch
25
Added:
| Commit (repo, commit) -> path_attr href commit_path repo commit
26
Added:
| Tree (repo, hash) -> path_attr href tree_path repo hash
27
Added:
| Blob (repo, hash) -> path_attr href blob_path repo hash
28
Added:
in
29
Added:
a [ path route ] [ contents ]
lib/views.ml
@@ -1,7 +1,6 @@
1
1
(* -*- mode: tuareg; -*- *)
2
2
3
3
open Dream_html
4
Removed:
open Git_presenters
5
4
open Config
6
5
7
6
type body_data = {
@@ -16,9 +15,7 @@
16
15
17
16
let topnav repo =
18
17
let open HTML in
19
Removed:
let () = Dream.log "%s" ("current path is: " ^ repo) in
20
18
let li_of_a (path, text) =
21
Removed:
let () = Dream.log "%s" ("and path is: " ^ path) in
22
19
let is_active = String.ends_with ~suffix:path repo in
23
20
let attrs = if is_active then [ id "active" ] else [] in
24
21
let url = Printf.sprintf "/%s/%s" repo path in
@@ -98,7 +95,10 @@
98
95
Page.render body_data
99
96
100
97
module Repo = struct
98
Added:
open Git_presenters
99
Added:
101
100
let page_title repo = Printf.sprintf "%s — %s" repo (repo_description repo)
101
Added:
let li_of_author author = HTML.(li [] [ txt "%s" author ])
102
102
103
103
let li_of_branch repo (branch : branch) =
104
104
HTML.(
@@ -120,17 +120,24 @@
120
120
]);
121
121
]
122
122
123
Added:
let li_of_entry repo entry =
124
Added:
let display_name =
125
Added:
if entry.perm = 0o040000 then entry.name ^ "/" else entry.name
126
Added:
in
127
Added:
let route =
128
Added:
if entry.perm = 0o040000 then Routes.Tree (repo, entry.hash)
129
Added:
else Routes.Blob (repo, entry.hash)
130
Added:
in
131
Added:
HTML.(li [] [ Routes.link_to route @@ txt "%s" display_name ])
132
Added:
123
133
let summary repo branches commits authors =
124
Removed:
let li_of_branch = li_of_branch repo in
125
Removed:
let li_of_commit = li_of_commit repo in
126
Removed:
let li_of_author author = HTML.(li [] [ txt "%s" author ]) in
127
134
let content =
128
135
HTML.
129
136
[
130
137
h3 [] [ txt "Branches" ];
131
Removed:
ul [] (List.map li_of_branch branches);
138
Added:
ul [] (List.map (li_of_branch repo) branches);
132
139
h3 [] [ txt "Recent commits" ];
133
Removed:
ul [] (List.map li_of_commit commits);
140
Added:
ul [] (List.map (li_of_commit repo) commits);
134
141
h3 [] [ txt "Authors" ];
135
142
ul [] (List.map li_of_author authors);
136
143
]
@@ -144,9 +151,12 @@
144
151
}
145
152
146
153
let refs repo branches =
147
Removed:
let li_of_branch = li_of_branch repo in
148
154
let content =
149
Removed:
HTML.[ h3 [] [ txt "Branches" ]; ul [] (List.map li_of_branch branches) ]
155
Added:
HTML.
156
Added:
[
157
Added:
h3 [] [ txt "Branches" ];
158
Added:
ul [] (List.map (li_of_branch repo) branches);
159
Added:
]
150
160
in
151
161
Page.render ~page_title:(page_title repo)
152
162
{
@@ -157,10 +167,12 @@
157
167
}
158
168
159
169
let log repo commits =
160
Removed:
let li_of_commit = li_of_commit repo in
161
170
let content =
162
171
HTML.
163
Removed:
[ h3 [] [ txt "All commits" ]; ul [] (List.map li_of_commit commits) ]
172
Added:
[
173
Added:
h3 [] [ txt "All commits" ];
174
Added:
ul [] (List.map (li_of_commit repo) commits);
175
Added:
]
164
176
in
165
177
Page.render ~page_title:(page_title repo)
166
178
{
@@ -171,13 +183,12 @@
171
183
}
172
184
173
185
let tree repo tree =
174
Removed:
let title = Printf.sprintf "%s : %s" repo tree.short_hash in
175
Removed:
let li_of_entry entry = HTML.(li [] [ txt "%s" entry.name ]) in
186
Added:
let title = Printf.sprintf "%s" repo in
176
187
let content =
177
188
HTML.
178
189
[
179
190
h3 [] [ txt "Tree %s" tree.short_hash ];
180
Removed:
ul [] (List.map li_of_entry tree.entries);
191
Added:
ul [] (List.map (li_of_entry repo) tree.entries);
181
192
]
182
193
in
183
194
Page.render ~page_title:(page_title repo)
@@ -188,6 +199,19 @@
188
199
content;
189
200
}
190
201
202
Added:
let blob repo blob =
203
Added:
let title = Printf.sprintf "%s" repo in
204
Added:
let content =
205
Added:
HTML.[ h3 [] [ txt "Blob" ]; p [] [ txt "%s" blob.content ] ]
206
Added:
in
207
Added:
Page.render ~page_title:(page_title repo)
208
Added:
{
209
Added:
title;
210
Added:
subtitle = repo_description repo;
211
Added:
topnav = Components.topnav repo;
212
Added:
content;
213
Added:
}
214
Added:
191
215
let commit repo commit =
192
216
let message = match commit.message with Some msg -> msg | None -> "" in
193
217
let title = Printf.sprintf "%s : %s" repo commit.short_hash in
@@ -207,7 +231,7 @@
207
231
[
208
232
head []
209
233
[
210
Removed:
title [] "Fatal Error";
234
Added:
title [] "Fatal error";
211
235
link [ rel "stylesheet"; href "/static/styles.css" ];
212
236
link
213
237
[ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];