Helios_templates.index

helios/src/helios_templates.ml

-open Eliom_content.Html5.D
+open Eliom_content.Html5.F
+
+let site_title = "Helios Election Server"
+let welcome_message = "This is the default message"
 
 let base ~title ~header ~content =
   let s x = Xml.uri_of_string ("/static/" ^ x) in
   html
-    (head (Eliom_content.Html5.F.title (pcdata title)) [
+    (head (Eliom_content.Html5.F.title (pcdata (title ^ " - Helios"))) [
       link
         ~rel:[`Stylesheet]
         ~href:(s "main.css")
@@ -24,11 +27,12 @@ let base ~title ~header ~content =
     (body [
       div ~a:[a_id "content"] [
         div ~a:[a_id "header"] ([
-          a ~service:Helios_services.home_s
-            [img
-                ~src:(s "logo.gif")
-                ~a:[a_style "border:0;"; a_height 110]
-                ~alt:"Helios" ()] ();
+          a ~service:Helios_services.home [
+            img
+              ~src:(s "logo.gif")
+              ~a:[a_style "border:0;"; a_height 110]
+              ~alt:"Helios" ()
+          ] ();
           br ();
         ] @ header);
         div ~a:[a_id "contentbody"] content;
@@ -37,11 +41,72 @@ let base ~title ~header ~content =
           (* if user/voter... *)
           pcdata "not logged in.";
           br ();
-          a
-            ~service:Helios_services.heliosvotingorg_s
-            [pcdata "About Helios"] ();
+          a ~service:Helios_services.heliosvotingorg [
+            pcdata "About Helios"
+          ] ();
           (* footer links *)
           br ~a:[a_style "clear:right;"] ();
         ];
       ];
      ])
+
+let index ~user ~featured = base
+  ~title:site_title
+  ~header:[h2 [pcdata site_title]]
+  ~content:(
+    let user_box = match user with
+      | `User (user, administered, voted) ->
+        let administration_box = match administered with
+          | Some admin ->
+            let administered_box = match admin with
+              | _::_ -> ul admin
+              | [] -> 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
+          | _::_ -> ul voted
+          | [] -> em [pcdata "none yet"]
+        ] in
+        [div ~a:[a_style "font-size:1.4em;"; a_class ["highlight-box"]] user]
+        @ administration_box @ recent_votes
+      | `Login login_box ->
+        [h3 [pcdata "Log In to Start Voting"]]
+        @ login_box
+        @ [br (); br ()]
+    in
+    let featured_box = match featured with
+      | _::_ ->
+        [
+          h3 [pcdata "Currently Featured Elections"];
+          p featured;
+        ]
+      | [] ->
+        [
+          h4 [pcdata "no featured elections at the moment"];
+        ]
+    in [
+      div ~a:[a_id "mystuff"] user_box;
+      p ~a:[a_style "font-size: 1.4em;"] [pcdata welcome_message];
+      div featured_box;
+      br ~a:[a_style "clear:right;"] ();
+      br ()
+    ]
+  )

src/helios_registration.ml

 let () =
-  Eliom_registration.Html5.register ~service:Helios_services.home_s
-    (fun () () -> Lwt.return (Helios_templates.base
-                            ~title:"Helios Election Server"
-                            ~header:[]
-                            ~content:[]))
+  Eliom_registration.Html5.register
+    ~service:Helios_services.home
+    (fun () () -> Lwt.return (Helios_templates.index
+                                ~user:(`Login [])
+                                ~featured:[]))
+
+let () =
+  Eliom_registration.Html5.register
+    ~service:Helios_services.elections_administered
+    (fun () () -> Lwt.return (Helios_templates.index
+                                ~user:(`Login [])
+                                ~featured:[]))
+
+let () =
+  Eliom_registration.Html5.register
+    ~service:Helios_services.election_new
+    (fun () () -> Lwt.return (Helios_templates.index
+                                ~user:(`Login [])
+                                ~featured:[]))

src/helios_services.ml

 open Eliom_service
 open Eliom_parameter
 
-let heliosvotingorg_s = external_service
+let heliosvotingorg = external_service
   ~prefix:"http://heliosvoting.org"
   ~path:[]
   ~get_params:unit
   ()
 
-let home_s = service
+let home = service
   ~path:[]
   ~get_params:unit
   ()
+
+let elections_administered = service
+  ~path:["elections"; "administered"]
+  ~get_params:unit
+  ()
+
+let election_new = service
+  ~path:["elections"; "new"]
+  ~get_params:unit
+  ()