lib/views.ml


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

type head_data = { page_title : string }

type body_data = {
  title : string;
  subtitle : string;
  topnav : Dream_html.node;
  content : Dream_html.node list;
}

module Layout = struct
  open Dream_html
  open HTML

  let header title subtitle =
    null [ h1 [] [ txt "%s" title ]; h2 [] [ txt "%s" subtitle ] ]

  let footer =
    let today = Unix.localtime (Unix.time ()) in
    let year = string_of_int (today.Unix.tm_year + 1900) in
    let footer_text = Printf.sprintf "Copyright %s %s" year Config.author in
    footer [] [ txt "%s" footer_text ]

  let default_head_data = { page_title = "Ogit" }

  let application ?(head_data = default_head_data) body_data =
    html []
      [
        head []
          [
            title [] "%s" head_data.page_title;
            link [ rel "stylesheet"; href "/static/styles.css" ];
          ];
        body []
          [
            header "Ogit" body_data.subtitle;
            body_data.topnav;
            div [ id "main" ] body_data.content;
            footer;
          ];
      ]
end

module Ogit_root = struct
  open Dream_html
  open HTML

  let repositories_in directory =
    try
      let repos =
        Sys.readdir directory |> Array.to_list |> List.sort String.compare
      in
      let li_of_repo repo = li [] [ a [ href "%s" repo ] [ txt "%s" repo ] ] in
      div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ]
    with Sys_error _ ->
      div [] [ txt "Error: Unable to read repository list." ]

  let body_data =
    {
      title = "My repositories";
      subtitle = "Repositories for " ^ Config.author;
      topnav = null [];
      content = [ repositories_in Config.git_directory ];
    }

  let render () = Layout.application body_data
end

module Repo_root = struct
  open Dream_html
  open HTML
  (* open Lwt.Syntax *)

  let render repo_path =
    (* let* title_result = Git_helpers.get_head_commit_hash repo_path in *)
    (* let title = *)
    (*   match title_result with Ok hash -> hash | Error msg -> "Error: " ^ msg *)
    (* in *)
    let title = "Finble" in
    let subtitle = Filename.concat Config.git_directory repo_path in
    let topnav =
      nav
        [ id "top" ]
        [
          ul []
            [
              li [] [ a [ href "/" ] [ txt "summary" ] ];
              li [] [ a [ href "/" ] [ txt "refs" ] ];
              li [] [ a [ href "/" ] [ txt "log" ] ];
              li [] [ a [ href "/" ] [ txt "tree" ] ];
              li [] [ a [ href "/" ] [ txt "commit" ] ];
              li [] [ a [ href "/" ] [ txt "diff" ] ];
            ];
        ]
    in
    let recent_commits = Git_unhelpers.get_git_log repo_path in
    let li_of_commit commit =
      li [] [ a [ href "%s" commit ] [ txt "%s" commit ] ]
    in
    let content =
      [
        h3 [] [ txt "Recent commits" ];
        ul [] @@ List.map li_of_commit recent_commits;
      ]
    in
    let body_data = { title; subtitle; topnav; content } in
    Lwt.return @@ Layout.application body_data
end

module Repo_tree = struct
  open Dream_html
  open HTML
  open Lwt.Syntax

  let render repo_path =
    let* title_result = Git_helpers.get_head_commit_hash repo_path in
    let title =
      match title_result with Ok hash -> hash | Error msg -> "Error: " ^ msg
    in
    let subtitle = "Dinglefops" in
    let topnav = null [] in
    let content = [ txt "foobar" ] in
    let body_data = { title; subtitle; topnav; content } in
    Lwt.return @@ Layout.application body_data
end