helios_templates.ml 9.44 KB
Newer Older
1
open Helios_datatypes_t
Stephane Glondu's avatar
Stephane Glondu committed
2
3
4
5
open Eliom_content.Html5.F

let site_title = "Helios Election Server"
let welcome_message = "This is the default message"
Stephane Glondu's avatar
Stephane Glondu committed
6

7
8
let s x = Xml.uri_of_string ("/static/" ^ x)

Stephane Glondu's avatar
Stephane Glondu committed
9
10
11
12
13
14
15
16
17
let format_user u size = Helios_services.([
  img
    ~src:(Printf.ksprintf s "auth/login-icons/%s.png" u.user_type)
    ~a:[a_style "border:0;"; a_height size]
    ~alt:u.user_type ();
  pcdata " ";
  pcdata u.user_name;
])

Stephane Glondu's avatar
Stephane Glondu committed
18
let base ~title ~header ~content =
Stephane Glondu's avatar
Stephane Glondu committed
19
20
  lwt user = Eliom_reference.get Helios_services.user in
  Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
Stephane Glondu's avatar
Stephane Glondu committed
21
    (head (Eliom_content.Html5.F.title (pcdata (title ^ " - Helios"))) [
Stephane Glondu's avatar
Stephane Glondu committed
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
      link
        ~rel:[`Stylesheet]
        ~href:(s "main.css")
        ~a:[a_mime_type "text/css"; a_media [`Screen]]
        ();
      link
        ~rel:[`Stylesheet]
        ~href:(s "helios/css/ui-lightness/jquery-ui-1.8.1.custom.css")
        ~a:[a_mime_type "text/css"]
        ();
      script (pcdata "") ~a:[a_src (s "helios/js/jquery-1.4.2.min.js")];
      script (pcdata "") ~a:[a_src (s "helios/js/jquery-ui-1.8.1.custom.min.js")];
      script (pcdata "") ~a:[a_src (s "helios/js/jqsplitdatetime.js")];
      script (pcdata "") ~a:[a_src (s "helios/helios/jquery.json.min.js")];
      (* block js *)
      (* block extra-head *)
    ])
    (body [
      div ~a:[a_id "content"] [
        div ~a:[a_id "header"] ([
Stephane Glondu's avatar
Stephane Glondu committed
42
43
44
45
46
47
          a ~service:Helios_services.home [
            img
              ~src:(s "logo.gif")
              ~a:[a_style "border:0;"; a_height 110]
              ~alt:"Helios" ()
          ] ();
Stephane Glondu's avatar
Stephane Glondu committed
48
49
50
          br ();
        ] @ header);
        div ~a:[a_id "contentbody"] content;
Stephane Glondu's avatar
Stephane Glondu committed
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
        div ~a:[a_id "footer"] (
          [span ~a:[a_style "float:right;"] [ (* footer logo *) ]] @
          (match user with
            | Some (admin_p, user) ->
              [pcdata "logged in as "] @ (format_user user 15) @ [
                pcdata " [";
                a ~service:Helios_services.logout [pcdata "logout"] ();
                pcdata "]";
                br ()
              ]
            | None ->
              [pcdata "not logged in."] @ [
                pcdata " [";
                a ~service:Helios_services.login [pcdata "log in"] ();
                pcdata "]";
                br ();
              ]
          ) @ [
            a ~service:Helios_services.project_home [
Stephane Glondu's avatar
Stephane Glondu committed
70
              pcdata "About Helios"
Stephane Glondu's avatar
Stephane Glondu committed
71
            ] ();
Stephane Glondu's avatar
Stephane Glondu committed
72
            pcdata " | Help!";
Stephane Glondu's avatar
Stephane Glondu committed
73
          (* footer links *)
Stephane Glondu's avatar
Stephane Glondu committed
74
75
76
            br ~a:[a_style "clear:right;"] ();
          ]
        )
Stephane Glondu's avatar
Stephane Glondu committed
77
      ];
Stephane Glondu's avatar
Stephane Glondu committed
78
     ]))
Stephane Glondu's avatar
Stephane Glondu committed
79

80
81
82
83
84
let not_implemented title = base
  ~title
  ~header:[h2 [pcdata title]]
  ~content:[div [pcdata "This service is not implemented."]]

85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
let login_box auth_systems = List.map
  (fun x ->
    p [
      a
        ~service:Helios_services.login
        ~a:[a_style "font-size: 1.4em;"] [
          img
            ~a:[a_style "border:0;"; a_height 35]
            ~src:(Printf.ksprintf s "auth/login-icons/%s.png" x)
            ~alt:x ();
          pcdata x;
        ] ();
    ]
  ) auth_systems

Stephane Glondu's avatar
Stephane Glondu committed
100
101
102
103
104
105
106
107
108
109
110
type answer = {
  count : int;
  answer : string;
  winner : bool;
}

type question = {
  answers : answer list;
  question : string;
}

111
112
type election_extradata = {
  election : Z.t Helios_datatypes_t.election;
Stephane Glondu's avatar
Stephane Glondu committed
113
  election_admin : Helios_services.user;
Stephane Glondu's avatar
Stephane Glondu committed
114
115
  election_trustees : string list;
  election_state : [`Finished of question list | `Stopped | `Started];
116
}
117

118
let format_one_election e =
119
  li [pcdata e.election.e_name]
120

121
let format_one_featured_election e =
122
  [
123
124
125
126
    div ~a:[a_class ["highlight-box-margin"]] ([
      a
        ~service:(Eliom_service.preapply
                    Helios_services.election_shortcut
127
                    e.election.e_short_name)
128
        ~a:[a_style "font-size: 1.4em;"]
129
        [pcdata e.election.e_name] ();
130
      pcdata " by ";
131
    ] @ format_user e.election_admin 15 @ [
132
      br ();
133
      pcdata e.election.e_description;
134
135
    ]);
    br ();
136
137
  ]

Stephane Glondu's avatar
Stephane Glondu committed
138
139
140
let index ~featured =
  lwt user = Eliom_reference.get Helios_services.user in
  base
Stephane Glondu's avatar
Stephane Glondu committed
141
142
143
  ~title:site_title
  ~header:[h2 [pcdata site_title]]
  ~content:(
Stephane Glondu's avatar
Stephane Glondu committed
144
145
146
147
    let mystuff = match user with
      | Some (admin_p, u) ->
        let administered = if admin_p then Some [] else None in
        let voted = [] in
Stephane Glondu's avatar
Stephane Glondu committed
148
149
150
        let administration_box = match administered with
          | Some admin ->
            let administered_box = match admin with
151
              | _::_ -> ul (List.map format_one_election admin)
Stephane Glondu's avatar
Stephane Glondu committed
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
              | [] -> em [pcdata "none yet"]
            in [
              h4 [pcdata "Administration"];
              administered_box;
              p [pcdata "[";
                 a ~service:Helios_services.elections_administered [
                   pcdata "see all"
                 ] ();
                 pcdata "]"];
              div ~a:[a_style "text-align:right;"] [
                a ~service:Helios_services.election_new
                  ~a:[a_style "font-size: 1.2em; padding:5px; background: #eee; border: 1px solid #888;"]
                  [
                    pcdata "create election >";
                  ] ();
              ]
            ]
          | None -> []
        in
        let recent_votes = [
          h4 [pcdata "Recent votes"];
          match voted with
174
          | _::_ -> ul (List.map format_one_election voted)
Stephane Glondu's avatar
Stephane Glondu committed
175
176
          | [] -> em [pcdata "none yet"]
        ] in
177
        [
178
179
          div ~a:[a_style "font-size:1.4em;"; a_class ["highlight-box"]]
            (format_user u 25)
180
        ]
Stephane Glondu's avatar
Stephane Glondu committed
181
        @ administration_box @ recent_votes
Stephane Glondu's avatar
Stephane Glondu committed
182
      | None ->
Stephane Glondu's avatar
Stephane Glondu committed
183
        [h3 [pcdata "Log In to Start Voting"]]
Stephane Glondu's avatar
Stephane Glondu committed
184
        @ (login_box Helios_services.auth_systems)
Stephane Glondu's avatar
Stephane Glondu committed
185
186
187
188
189
        @ [br (); br ()]
    in
    let featured_box = match featured with
      | _::_ ->
        [
190
          h3 [pcdata "Current Featured Elections"];
191
          div (List.flatten (List.map format_one_featured_election featured));
Stephane Glondu's avatar
Stephane Glondu committed
192
193
194
195
196
        ]
      | [] ->
        [
          h4 [pcdata "no featured elections at the moment"];
        ]
197
    in ([
Stephane Glondu's avatar
Stephane Glondu committed
198
      div ~a:[a_id "mystuff"] mystuff;
Stephane Glondu's avatar
Stephane Glondu committed
199
      p ~a:[a_style "font-size: 1.4em;"] [pcdata welcome_message];
200
    ] @ featured_box @ [
Stephane Glondu's avatar
Stephane Glondu committed
201
202
      br ~a:[a_style "clear:right;"] ();
      br ()
203
    ])
Stephane Glondu's avatar
Stephane Glondu committed
204
  )
Stephane Glondu's avatar
Stephane Glondu committed
205

Stephane Glondu's avatar
Stephane Glondu committed
206
let dummy_login ~service =
Stephane Glondu's avatar
Stephane Glondu committed
207
208
209
  let title = site_title ^ " — Login" in
  let form = post_form
    ~a:[a_id "login_form"; a_class ["prettyform"]]
Stephane Glondu's avatar
Stephane Glondu committed
210
    ~service
Stephane Glondu's avatar
Stephane Glondu committed
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
    (fun (username_name, admin_name) ->
      [
        tablex [tbody [
          tr [
            th [label ~a:[a_for username_name] [pcdata "Username:"]];
            td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:username_name ()];
          ];
          tr [
            th [label ~a:[a_for admin_name] [pcdata "Admin?"]];
            td [bool_checkbox ~name:admin_name ()];
          ]]
        ];
        div [
          string_input ~input_type:`Submit ~value:"Login" ();
        ]
      ]) ()
  in
  base
    ~title
    ~header:[h2 [pcdata title]]
    ~content:[div [form]]
Stephane Glondu's avatar
Stephane Glondu committed
232
233
234
235
236
237
238
239
240
241
242
243
244

let list_iteri f xs =
  let rec loop i = function
    | [] -> []
    | x :: xs -> f i x :: loop (succ i) xs
  in List.flatten (loop 0 xs)

let election_view ~election =
  let content = [
    div ~a:[a_style "float: left; margin-right: 50px;"] [pcdata "FIXME"];
    br ();
    br ();
    br ~a:[a_style "clear: left;"] ();
245
    div ~a:[a_style "margin-bottom: 25px;margin-left: 15px; border-left: 1px solid #aaa; padding-left: 5px; font-size:1.3em;"] [pcdata election.election.e_description];
Stephane Glondu's avatar
Stephane Glondu committed
246
    p ~a:[a_style "text-align: center; font-size: 1.5em;"] [
247
      a ~service:(Eliom_service.preapply Helios_services.election_questions election.election.e_uuid) [
Stephane Glondu's avatar
Stephane Glondu committed
248
        pcdata "questions (";
249
        pcdata (string_of_int (Array.length election.election.e_questions));
Stephane Glondu's avatar
Stephane Glondu committed
250
251
252
253
        pcdata ")";
      ] ();
      (* FIXME: space (&nbsp) breaks the output *)
      pcdata "  |  ";
254
      a ~service:(Eliom_service.preapply Helios_services.election_voters election.election.e_uuid) [
Stephane Glondu's avatar
Stephane Glondu committed
255
256
257
        pcdata "voters & ballots"
      ] ();
      pcdata "  |  ";
258
      a ~service:(Eliom_service.preapply Helios_services.election_trustees election.election.e_uuid) [
Stephane Glondu's avatar
Stephane Glondu committed
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
        pcdata "trustees (";
        pcdata (string_of_int (List.length election.election_trustees));
        pcdata ")";
      ] ();
    ];
    (* NOTE: administration things removed from here! *)
    br ();
    br ();
  ] @ (match election.election_state with
    | `Finished result ->
      [
        span ~a:[a_class ["highlight-box"; "round"]] [
          pcdata "This election is complete.";
        ];
        br ();
        br ();
        h3 ~a:[a_class ["highlight-box"]] [pcdata "Tally"];
      ] @ (
        list_iteri (fun i question ->
          [
            b [
              span ~a:[a_style "font-size:0.8em;"] [
                pcdata "Question #";
                pcdata (string_of_int i);
              ];
              br ();
              pcdata question.question;
            ];
            br ();
            let table xs = match xs with
              | x :: xs -> table ~a:[a_class ["pretty"]; a_style "width: auto;"] x xs
              | [] -> assert false
            in table (
              List.map (fun answer ->
                let style = if answer.winner then "font-weight:bold;" else "" in
                tr [
                  td ~a:[a_style ("padding-right:80px;" ^ style)] [pcdata answer.answer];
                  td ~a:[a_style ("text-align:right;" ^ style)] [pcdata (string_of_int answer.count)];
                ]
              ) question.answers
            );
          ]
        ) result
      )
    | `Stopped ->
      [
        (* FIXME *)
      ]
    | `Started ->
      [
        (* FIXME *)
      ]
  )
  in
313
  base ~title:election.election.e_name ~header:[] ~content