[OCaml] Mobile-friendly clone of cgit.
Refactor Git_presenters to Resolvers.
What this module really does is resolve Git types to values usable by ogit views.
Changed files
lib/git_presenters.ml
@@ -1,138 +0,0 @@
1
Removed:
(* -*- mode: tuareg; -*- *)
2
Removed:
3
Removed:
module Store = Git_unix.Store
4
Removed:
open Lwt_result.Syntax
5
Removed:
open Lwt_result.Infix
6
Removed:
open Config
7
Removed:
8
Removed:
let full_path path = Filename.concat config.git_project_root path
9
Removed:
10
Removed:
let store repo =
11
Removed:
let path = Fpath.v @@ full_path repo in
12
Removed:
Store.v ~dotgit:path path
13
Removed:
14
Removed:
let repo_description repo =
15
Removed:
let description_path = Filename.concat (full_path repo) "description" in
16
Removed:
In_channel.with_open_text description_path In_channel.input_all
17
Removed:
18
Removed:
type user = Git.User.t
19
Removed:
20
Removed:
(* let all_authors store = *)
21
Removed:
(* let* store = store repo in *)
22
Removed:
23
Removed:
type commit = {
24
Removed:
hash : string;
25
Removed:
short_hash : string;
26
Removed:
parents : string list;
27
Removed:
author : user;
28
Removed:
message : string option;
29
Removed:
}
30
Removed:
31
Removed:
let to_commit store hash =
32
Removed:
Store.read store hash >>= function
33
Removed:
| Git.Value.Commit c ->
34
Removed:
let hash = Store.Hash.to_hex hash in
35
Removed:
Lwt_result.return
36
Removed:
{
37
Removed:
hash;
38
Removed:
short_hash = String.sub hash 0 8;
39
Removed:
parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex;
40
Removed:
author = Store.Value.Commit.author c;
41
Removed:
message = Store.Value.Commit.message c;
42
Removed:
}
43
Removed:
| _ -> Lwt_result.fail (`Msg "value is not a commit")
44
Removed:
45
Removed:
let commit_of_id repo id =
46
Removed:
let* store = store repo in
47
Removed:
let hash = Store.Hash.of_hex id in
48
Removed:
to_commit store hash
49
Removed:
50
Removed:
let recent_commits repo n =
51
Removed:
let* store = store repo in
52
Removed:
let* head = Store.Ref.resolve store Git.Reference.head in
53
Removed:
let rec walk acc hash count =
54
Removed:
if count = 0 then Lwt_result.return (List.rev acc)
55
Removed:
else
56
Removed:
let* commit = to_commit store hash in
57
Removed:
match commit.parents with
58
Removed:
| parent :: _ ->
59
Removed:
walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1)
60
Removed:
| [] -> Lwt_result.return (List.rev (commit :: acc))
61
Removed:
in
62
Removed:
walk [] head n
63
Removed:
64
Removed:
type branch = { hash : string; name : string }
65
Removed:
66
Removed:
let all_branches repo =
67
Removed:
let* store = store repo in
68
Removed:
let open Lwt.Syntax in
69
Removed:
let* refs = Store.Ref.list store in
70
Removed:
let branches =
71
Removed:
List.map
72
Removed:
(fun (reference, hash) ->
73
Removed:
let name = Git.Reference.to_string reference in
74
Removed:
let hash = Store.Hash.to_hex hash in
75
Removed:
{ name; hash })
76
Removed:
refs
77
Removed:
in
78
Removed:
Lwt_result.return branches
79
Removed:
80
Removed:
type tree_entry = {
81
Removed:
hash : string;
82
Removed:
short_hash : string;
83
Removed:
name : string;
84
Removed:
perm : int;
85
Removed:
}
86
Removed:
87
Removed:
type tree = { hash : string; short_hash : string; entries : tree_entry list }
88
Removed:
type blob = { content : string }
89
Removed:
90
Removed:
let to_entry (entry : Store.Value.Tree.entry) =
91
Removed:
let perm =
92
Removed:
match entry.perm with
93
Removed:
| `Commit -> 0o160000
94
Removed:
| `Dir -> 0o040000
95
Removed:
| `Everybody -> 0o100664
96
Removed:
| `Exec -> 0o100755
97
Removed:
| `Link -> 0o120000
98
Removed:
| `Normal -> 0o100644
99
Removed:
in
100
Removed:
let hash = Store.Hash.to_hex entry.node in
101
Removed:
let short_hash = String.sub hash 0 8 in
102
Removed:
{ hash; short_hash; name = entry.name; perm }
103
Removed:
104
Removed:
let to_tree store hash =
105
Removed:
Store.read store hash >>= function
106
Removed:
| Git.Value.Tree tree ->
107
Removed:
let hash = Store.Hash.to_hex hash in
108
Removed:
let short_hash = String.sub hash 0 8 in
109
Removed:
let entries = Store.Value.Tree.to_list tree |> List.map to_entry in
110
Removed:
Lwt_result.return { hash; short_hash; entries }
111
Removed:
| _ -> Lwt_result.fail (`Msg "value is not a tree")
112
Removed:
113
Removed:
let to_blob store hash =
114
Removed:
Store.read store hash >>= function
115
Removed:
| Git.Value.Blob blob ->
116
Removed:
let content = Store.Value.Blob.to_string blob in
117
Removed:
Lwt_result.return { content }
118
Removed:
| _ -> Lwt_result.fail (`Msg "value is not a blob")
119
Removed:
120
Removed:
let head_tree repo =
121
Removed:
let* store = store repo in
122
Removed:
let* hash =
123
Removed:
Store.Ref.resolve store Git.Reference.head >>= Store.read store >>= function
124
Removed:
| Git.Value.Commit commit ->
125
Removed:
Store.Value.Commit.tree commit |> Lwt_result.return
126
Removed:
| _ -> `Msg "no head tree id" |> Lwt_result.fail
127
Removed:
in
128
Removed:
to_tree store hash
129
Removed:
130
Removed:
let tree_of_id repo id =
131
Removed:
let* store = store repo in
132
Removed:
let hash = Store.Hash.of_hex id in
133
Removed:
to_tree store hash
134
Removed:
135
Removed:
let blob_of_id repo id =
136
Removed:
let* store = store repo in
137
Removed:
let hash = Store.Hash.of_hex id in
138
Removed:
to_blob store hash
lib/handlers.ml
@@ -3,62 +3,63 @@
3
3
let root _req = Views.root ()
4
4
5
5
module Repo = struct
6
Removed:
open Git_presenters
7
Removed:
8
6
let ( let* ) m f =
9
7
let open Lwt.Infix in
10
8
m >>= function
11
9
| Ok x -> f x
12
10
| Error e ->
13
Removed:
let msg = Format.asprintf "%a" Store.pp_error e in
14
Removed:
Views.error_page msg |> Dream_html.respond
11
Added:
let msg = Format.asprintf "%a" Resolvers.Store.pp_error e in
12
Added:
Views.error_page msg
15
13
16
Removed:
let repo req = Dream.param req "repo"
17
Removed:
let id_of_req req = Dream.param req "id"
18
Removed:
19
14
let summary req =
20
Removed:
let* branches = all_branches (repo req) in
21
Removed:
let* commits = recent_commits (repo req) 10 in
15
Added:
let repo = Dream.param req "repo" in
16
Added:
let* branches = Resolvers.all_branches repo in
17
Added:
let* commits = Resolvers.recent_commits repo 10 in
22
18
let authors = [ "John Pork"; "Sebastian Jellybean" ] in
23
Removed:
Views.Repo.summary (repo req) branches commits authors
19
Added:
Views.Repo.summary repo branches commits authors
24
20
25
21
let log req =
26
Removed:
let* commits = recent_commits (repo req) 100 in
27
Removed:
Views.Repo.log (repo req) commits
22
Added:
let repo = Dream.param req "repo" in
23
Added:
let* commits = Resolvers.recent_commits repo 100 in
24
Added:
Views.Repo.log repo commits
28
25
29
26
let files_at_head req =
30
Removed:
let* tree = head_tree (repo req) in
31
Removed:
Views.Repo.files (repo req) tree
27
Added:
let repo = Dream.param req "repo" in
28
Added:
let* tree = Resolvers.head_tree repo in
29
Added:
Views.Repo.files repo tree
32
30
33
31
let file_id req =
34
Removed:
let id = id_of_req req in
35
Removed:
let* blob = blob_of_id (repo req) id in
36
Removed:
Views.Repo.file (repo req) blob
32
Added:
let repo = Dream.param req "repo" in
33
Added:
let id = Dream.param req "repo" in
34
Added:
let* blob = Resolvers.blob_of_id repo id in
35
Added:
Views.Repo.file repo blob
37
36
38
37
let refs req =
39
Removed:
let* branches = all_branches (repo req) in
40
Removed:
Views.Repo.refs (repo req) branches
38
Added:
let repo = Dream.param req "repo" in
39
Added:
let* branches = Resolvers.all_branches repo in
40
Added:
Views.Repo.refs repo branches
41
41
42
42
let commit req =
43
Removed:
let id = id_of_req req in
44
Removed:
let* commit = commit_of_id (repo req) id in
45
Removed:
Views.Repo.commit (repo req) commit
43
Added:
let repo = Dream.param req "repo" in
44
Added:
let id = Dream.param req "id" in
45
Added:
let* commit = Resolvers.commit_of_id repo id in
46
Added:
Views.Repo.commit repo commit
46
47
end
47
48
48
49
let all_handlers =
49
Removed:
Dream.
50
Removed:
[
51
Removed:
get "/" root;
52
Removed:
scope "/:repo" []
53
Removed:
Repo.
54
Removed:
[
55
Removed:
get "/" summary;
56
Removed:
get "/summary/" summary;
57
Removed:
get "/log/" log;
58
Removed:
get "/files/" files_at_head;
59
Removed:
get "/files/:id" file_id;
60
Removed:
get "/refs/" refs;
61
Removed:
get "/commit/:id" commit;
62
Removed:
];
63
Removed:
get "/static/**" (static "./lib/static");
64
Removed:
]
50
Added:
let open Dream in
51
Added:
[
52
Added:
get "/" root;
53
Added:
scope "/:repo" []
54
Added:
Repo.
55
Added:
[
56
Added:
get "/" summary;
57
Added:
get "/summary/" summary;
58
Added:
get "/log/" log;
59
Added:
get "/files/" files_at_head;
60
Added:
get "/files/:id" file_id;
61
Added:
get "/refs/" refs;
62
Added:
get "/commit/:id" commit;
63
Added:
];
64
Added:
get "/static/**" (static "./lib/static");
65
Added:
]
lib/resolvers.ml
@@ -0,0 +1,135 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
module Store = Git_unix.Store
4
Added:
open Lwt_result.Syntax
5
Added:
open Lwt_result.Infix
6
Added:
open Config
7
Added:
8
Added:
let full_path path = Filename.concat config.git_project_root path
9
Added:
10
Added:
let store repo =
11
Added:
let path = Fpath.v @@ full_path repo in
12
Added:
Store.v ~dotgit:path path
13
Added:
14
Added:
let repo_description repo =
15
Added:
let description_path = Filename.concat (full_path repo) "description" in
16
Added:
In_channel.with_open_text description_path In_channel.input_all
17
Added:
18
Added:
type user = Git.User.t
19
Added:
20
Added:
type commit = {
21
Added:
hash : string;
22
Added:
short_hash : string;
23
Added:
parents : string list;
24
Added:
author : user;
25
Added:
message : string option;
26
Added:
}
27
Added:
28
Added:
let to_commit store hash =
29
Added:
Store.read store hash >>= function
30
Added:
| Git.Value.Commit c ->
31
Added:
let hash = Store.Hash.to_hex hash in
32
Added:
Lwt_result.return
33
Added:
{
34
Added:
hash;
35
Added:
short_hash = String.sub hash 0 8;
36
Added:
parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex;
37
Added:
author = Store.Value.Commit.author c;
38
Added:
message = Store.Value.Commit.message c;
39
Added:
}
40
Added:
| _ -> Lwt_result.fail (`Msg "value is not a commit")
41
Added:
42
Added:
let commit_of_id repo id =
43
Added:
let* store = store repo in
44
Added:
let hash = Store.Hash.of_hex id in
45
Added:
to_commit store hash
46
Added:
47
Added:
let recent_commits repo n =
48
Added:
let* store = store repo in
49
Added:
let* head = Store.Ref.resolve store Git.Reference.head in
50
Added:
let rec walk acc hash count =
51
Added:
if count = 0 then Lwt_result.return (List.rev acc)
52
Added:
else
53
Added:
let* commit = to_commit store hash in
54
Added:
match commit.parents with
55
Added:
| parent :: _ ->
56
Added:
walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1)
57
Added:
| [] -> Lwt_result.return (List.rev (commit :: acc))
58
Added:
in
59
Added:
walk [] head n
60
Added:
61
Added:
type branch = { hash : string; name : string }
62
Added:
63
Added:
let all_branches repo =
64
Added:
let* store = store repo in
65
Added:
let open Lwt.Syntax in
66
Added:
let* refs = Store.Ref.list store in
67
Added:
let branches =
68
Added:
List.map
69
Added:
(fun (reference, hash) ->
70
Added:
let name = Git.Reference.to_string reference in
71
Added:
let hash = Store.Hash.to_hex hash in
72
Added:
{ name; hash })
73
Added:
refs
74
Added:
in
75
Added:
Lwt_result.return branches
76
Added:
77
Added:
type tree_entry = {
78
Added:
hash : string;
79
Added:
short_hash : string;
80
Added:
name : string;
81
Added:
perm : int;
82
Added:
}
83
Added:
84
Added:
type tree = { hash : string; short_hash : string; entries : tree_entry list }
85
Added:
type blob = { content : string }
86
Added:
87
Added:
let to_entry (entry : Store.Value.Tree.entry) =
88
Added:
let perm =
89
Added:
match entry.perm with
90
Added:
| `Commit -> 0o160000
91
Added:
| `Dir -> 0o040000
92
Added:
| `Everybody -> 0o100664
93
Added:
| `Exec -> 0o100755
94
Added:
| `Link -> 0o120000
95
Added:
| `Normal -> 0o100644
96
Added:
in
97
Added:
let hash = Store.Hash.to_hex entry.node in
98
Added:
let short_hash = String.sub hash 0 8 in
99
Added:
{ hash; short_hash; name = entry.name; perm }
100
Added:
101
Added:
let to_tree store hash =
102
Added:
Store.read store hash >>= function
103
Added:
| Git.Value.Tree tree ->
104
Added:
let hash = Store.Hash.to_hex hash in
105
Added:
let short_hash = String.sub hash 0 8 in
106
Added:
let entries = Store.Value.Tree.to_list tree |> List.map to_entry in
107
Added:
Lwt_result.return { hash; short_hash; entries }
108
Added:
| _ -> Lwt_result.fail (`Msg "value is not a tree")
109
Added:
110
Added:
let to_blob store hash =
111
Added:
Store.read store hash >>= function
112
Added:
| Git.Value.Blob blob ->
113
Added:
let content = Store.Value.Blob.to_string blob in
114
Added:
Lwt_result.return { content }
115
Added:
| _ -> Lwt_result.fail (`Msg "value is not a blob")
116
Added:
117
Added:
let head_tree repo =
118
Added:
let* store = store repo in
119
Added:
let* hash =
120
Added:
Store.Ref.resolve store Git.Reference.head >>= Store.read store >>= function
121
Added:
| Git.Value.Commit commit ->
122
Added:
Store.Value.Commit.tree commit |> Lwt_result.return
123
Added:
| _ -> `Msg "no head tree id" |> Lwt_result.fail
124
Added:
in
125
Added:
to_tree store hash
126
Added:
127
Added:
let tree_of_id repo id =
128
Added:
let* store = store repo in
129
Added:
let hash = Store.Hash.of_hex id in
130
Added:
to_tree store hash
131
Added:
132
Added:
let blob_of_id repo id =
133
Added:
let* store = store repo in
134
Added:
let hash = Store.Hash.of_hex id in
135
Added:
to_blob store hash
lib/views.ml
@@ -11,8 +11,6 @@
11
11
}
12
12
13
13
module Components = struct
14
Removed:
open Dream_html
15
Removed:
16
14
module Topnav = struct
17
15
type t = None | Summary | Log | Files | Refs
18
16
@@ -36,23 +34,21 @@
36
34
end
37
35
38
36
module Page = struct
39
Removed:
open Dream_html
40
Removed:
open HTML
41
Removed:
42
Removed:
let header title subtitle =
43
Removed:
let subtitle =
44
Removed:
if String.starts_with ~prefix:"Unnamed repository" subtitle then ""
45
Removed:
else subtitle
37
Added:
let page_header header1 header2 =
38
Added:
let header2 =
39
Added:
if String.starts_with ~prefix:"Unnamed repository" header2 then ""
40
Added:
else header2
46
41
in
47
Removed:
null [ h1 [] [ txt "%s" title ]; h2 [] [ txt "%s" subtitle ] ]
42
Added:
HTML.(null [ h1 [] [ txt "%s" header1 ]; h2 [] [ txt "%s" header2 ] ])
48
43
49
Removed:
let footer () =
44
Added:
let page_footer () =
50
45
let today = Unix.localtime (Unix.time ()) in
51
46
let year = string_of_int (today.Unix.tm_year + 1900) in
52
47
let footer_text = Printf.sprintf "Copyright %s %s" year config.user in
53
Removed:
footer [] [ txt "%s" footer_text ]
48
Added:
HTML.footer [] [ txt "%s" footer_text ]
54
49
55
50
let render ?(page_title = "Ogit") body_data =
51
Added:
let open HTML in
56
52
html []
57
53
[
58
54
head []
@@ -64,10 +60,10 @@
64
60
];
65
61
body []
66
62
[
67
Removed:
header body_data.title body_data.subtitle;
63
Added:
page_header body_data.title body_data.subtitle;
68
64
body_data.topnav;
69
65
div [ id "main" ] body_data.content;
70
Removed:
footer ();
66
Added:
page_footer ();
71
67
];
72
68
]
73
69
end
@@ -76,7 +72,7 @@
76
72
let all_repositories =
77
73
let repos =
78
74
Sys.readdir config.git_project_root
79
Removed:
|> Array.to_list (* |> List.sort String.compare *)
75
Added:
|> Array.to_list |> List.sort String.compare
80
76
in
81
77
let li_of_repo repo =
82
78
HTML.li [] [ Routes.link_to (Routes.Repo repo) (txt "%s" repo) ]
@@ -94,7 +90,7 @@
94
90
respond @@ Page.render body_data
95
91
96
92
module Repo = struct
97
Removed:
open Git_presenters
93
Added:
open Resolvers
98
94
99
95
let page_title repo = Printf.sprintf "%s — %s" repo (repo_description repo)
100
96
let li_of_author author = HTML.(li [] [ txt "%s" author ])
@@ -242,29 +238,30 @@
242
238
end
243
239
244
240
let error_page message =
245
Removed:
HTML.(
246
Removed:
html []
247
Removed:
[
248
Removed:
head []
249
Removed:
[
250
Removed:
title [] "Fatal error";
251
Removed:
link [ rel "stylesheet"; href "/static/styles.css" ];
252
Removed:
link
253
Removed:
[ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
254
Removed:
];
255
Removed:
body []
256
Removed:
[
257
Removed:
h1 [] [ txt "Fatal Error" ];
258
Removed:
div
259
Removed:
[ id "main" ]
260
Removed:
[
261
Removed:
p [] [ b [] [ txt "%s" message ] ];
262
Removed:
p []
263
Removed:
[
264
Removed:
txt
265
Removed:
"Your best course of action is to press the 'back' \
266
Removed:
button in your browser.";
267
Removed:
];
268
Removed:
];
269
Removed:
];
270
Removed:
])
241
Added:
let open HTML in
242
Added:
respond
243
Added:
@@ html []
244
Added:
[
245
Added:
head []
246
Added:
[
247
Added:
title [] "Fatal error";
248
Added:
link [ rel "stylesheet"; href "/static/styles.css" ];
249
Added:
link
250
Added:
[ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
251
Added:
];
252
Added:
body []
253
Added:
[
254
Added:
h1 [] [ txt "Fatal Error" ];
255
Added:
div
256
Added:
[ id "main" ]
257
Added:
[
258
Added:
p [] [ b [] [ txt "%s" message ] ];
259
Added:
p []
260
Added:
[
261
Added:
txt
262
Added:
"Your best course of action is to press the 'back' \
263
Added:
button in your browser.";
264
Added:
];
265
Added:
];
266
Added:
];
267
Added:
]