blob: dd391d846f2f54fedc3164848cced8ad561fef5d (
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
|
open Dream_html
open HTML
open Git_unix
let git_directory = Filename.concat (Unix.getenv "HOME") "git"
let err_to_string err = Fmt.to_to_string Store.pp_error err
let get_head_commit repo_path =
Lwt_main.run (
let open Lwt.Infix in
match Git.Reference.of_string "HEAD" with
| Error err ->
Lwt.return (Error ("Invalid HEAD reference string: " ^ err_to_string err))
| Ok head_ref_name ->
Store.v (Fpath.v repo_path) >>= function
| Error err ->
Lwt.return (Error ("Failed to open repository: " ^ err_to_string err))
| Ok store ->
Store.Ref.resolve store head_ref_name >>= function
| Error err ->
Lwt.return (Error ("Failed to resolve HEAD: " ^ err_to_string err))
| Ok head_oid -> Lwt.return (Ok head_oid)
(* Git.Commit.v store head_oid >>= function *)
(* | Error err -> *)
(* Lwt.return (Error ("Failed to get commit from hash: " ^ err_to_string err)) *)
(* | Ok commit -> *)
(* Lwt.return (Ok commit) *)
)
let main_content =
let open Lwt.Infix in
Lwt.async (fun _ ->
get_head_commit git_directory >>= function
| Error msg ->
Lwt.map (fun content -> [ p [] [ txt content ]]) (Error msg)
| Ok head_oid ->
Lwt.map (fun content -> [ p [] [ txt "HEAD commit hash: %s" content ]]) (Store.Hash.to_string head_oid)
)
let render = Layouts.application ~page_title:"My repositories" ~main_content
|
