Poll voting

diff --git a/poll.mlt b/poll.mlt
index 19e1eba..3abe588 100644 (file)
--- a/poll.mlt
+++ b/poll.mlt
@@ -16,6 +16,55 @@ if $"cmd" = "list" then
 </li>
 <% end
 
+elseif $"vote" <> "" then
+       showNormal := false;    
+       val id = Web.stoi ($"vote");
+       val poll = Poll.lookupPoll id %>
+
+<table>
+<tr> <td align="right"><b>Poll#</b>:</td> <td><% id %></td> </tr>
+<tr> <td align="right"><b>Title</b>:</td> <td><% Web.html (#title poll) %></td> </tr>
+<tr> <td align="right"><b>Start</b>:</td> <td><% Web.html (#starts poll) %></td> </tr>
+<tr> <td align="right"><b>End</b>:</td> <td><% Web.html (#ends poll) %></td> </tr>
+<tr> <td align="right"><b>Votes/person</b>:</td> <td><% #votes poll %></td> </tr>
+<tr> <td align="right" valign="top"><b>Description</b>:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr>
+</table>
+
+<h3><b>Choices</b></h3>
+
+<form action="poll">
+<input type="hidden" name="vote2" value="<% id %>">
+<% val choices = Poll.listChoicesWithMyVotes id;
+if #votes poll = 1 then %>
+<select name="v">
+<option value="">Abstain</option>
+<% else %>
+<select name="v" multiple size="<% length choices %>">
+<% end
+foreach (you, cho) in choices do %>
+       <option value="<% #id cho %>"<% if you then %> selected<% end %>><% Web.html (#descr cho) %></option>
+<% end %></select><br><br>
+<input type="submit" value="Vote">
+</form>
+
+<% elseif $"vote2" <> "" then
+       val id = Web.stoi ($"vote2");
+       val poll = Poll.lookupPoll id;
+       editingPoll := SOME id;
+
+       val votes = case Web.getMultiParam "v" of
+                 [""] => []
+               | v => map Web.stoi v;
+
+       if length votes > #votes poll then
+               %><h3><b>You can't vote for that many different choices!</b></h3><%
+       elseif not (Poll.noDupes votes) then
+               %><h3><b>You can't vote multiple times for the same choice!</b></h3><%
+       else
+               Poll.vote (Init.getUserId (), id, votes)
+               %><h3><b>Thanks for voting!</b></h3>
+<%     end
+
 elseif $"cmd" = "add" then
        val title = $"title";
        val starts = $"starts";
@@ -149,6 +198,43 @@ elseif $"delChoice" <> "" then
        editingPoll := SOME (#id poll) %>
        <h3><b>"<% Web.html (#descr cho) %>" deleted!</b></h3>
 
+<% elseif $"report" <> "" then
+       showNormal := false;
+       val id = Web.stoi ($"report");
+               
+       val poll = Poll.lookupPoll id;
+       val canModify = Poll.canModify poll %>
+
+<h3><b>Vote Report</b></h3>
+
+<table>
+<tr> <td align="right"><b>Poll#</b>:</td> <td><% id %></td> </tr>
+<tr> <td align="right"><b>Title</b>:</td> <td><% Web.html (#title poll) %></td> </tr>
+<tr> <td align="right"><b>Start</b>:</td> <td><% Web.html (#starts poll) %></td> </tr>
+<tr> <td align="right"><b>End</b>:</td> <td><% Web.html (#ends poll) %></td> </tr>
+<tr> <td align="right"><b>Votes/person</b>:</td> <td><% #votes poll %></td> </tr>
+<tr> <td align="right" valign="top"><b>Description</b>:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr>
+</table>
+
+<br><hr><br>
+
+<table>
+<tr> <td><b>Votes</b></td> <td><b>Choice</b></td> <td><b>Voters</b></td> </tr>
+<% foreach (_, total, cho) in Poll.listChoicesWithVotes id do %>
+       <tr> <td><% total %></td> <td><% Web.html (#descr cho) %></td> <td>
+<%     ref first = true;
+       foreach user in Poll.listVoters (#id cho) do
+               if first then
+                       first := false
+               else
+                       %>, <%
+               end
+               %><a href="user?id=<% #id user %>"><% #name user %></a><%
+       end
+       %></td> </tr><%
+end %>
+</table>
+
 <% elseif $"id" <> "" then
        editingPoll := SOME (Web.stoi ($"id"))
 
@@ -156,29 +242,47 @@ end %>
 
 <% switch editingPoll of
          SOME id =>
-               val pol = Poll.lookupPoll id;
-               val canModify = Poll.canModify pol %>
+               val poll = Poll.lookupPoll id;
+               val canModify = Poll.canModify poll %>
 
 <table>
 <% if canModify then %><tr> <td></td> <td><a href="poll?mod=<% id %>">Edit poll data</a></td> </tr><% end %>
 <tr> <td align="right"><b>Poll#</b>:</td> <td><% id %></td> </tr>
-<tr> <td align="right"><b>Title</b>:</td> <td><% Web.html (#title pol) %></td> </tr>
-<tr> <td align="right"><b>Start</b>:</td> <td><% Web.html (#starts pol) %></td> </tr>
-<tr> <td align="right"><b>End</b>:</td> <td><% Web.html (#ends pol) %></td> </tr>
-<tr> <td align="right"><b>Votes/person</b>:</td> <td><% #votes pol %></td> </tr>
-<tr> <td align="right" valign="top"><b>Description</b>:</td> <td><% Web.htmlNl (#descr pol) %></td> </tr>
+<tr> <td align="right"><b>Title</b>:</td> <td><% Web.html (#title poll) %></td> </tr>
+<tr> <td align="right"><b>Start</b>:</td> <td><% Web.html (#starts poll) %></td> </tr>
+<tr> <td align="right"><b>End</b>:</td> <td><% Web.html (#ends poll) %></td> </tr>
+<tr> <td align="right"><b>Votes/person</b>:</td> <td><% #votes poll %></td> </tr>
+<tr> <td align="right" valign="top"><b>Description</b>:</td> <td><% Web.htmlNl (#descr poll) %></td> </tr>
 </table>
 
-<h3><b>Choices</b></h3>
+<h3><b>Choices<% if Poll.takingVotes poll then %><a href="poll?vote=<% id %>">(Vote!)</a><% end %></b></h3>
+
+<% if Poll.takingVotes poll then %>
+<table>
+<tr> <td><b>You</b></td> <td><b>Total</b></td> </tr>
+<% foreach (you, total, cho) in Poll.listChoicesWithVotes id do %>
+       <tr> <td align="center"><% if you then %>X<% end %></td>
+       <td align="center"><% total %></td>
+       <td><% Web.html (#descr cho) %></td>
+<% if canModify then %>
+<td><i>(<% #seq cho %>)</i>
+<a href="poll?modChoice=<% #id cho %>">[Modify]</a>
+<a href="poll?delChoice=<% #id cho %>">[Delete]</a></td>
+<% end %></tr>
+<% end %>
+</table>
 
-<% foreach cho in Poll.listChoices id do %>
+<a href="poll?report=<% id %>">Vote Report</a>
+<% else
+foreach cho in Poll.listChoices id do %>
        <li> <% Web.html (#descr cho) %>
 <% if canModify then %>
 <i>(<% #seq cho %>)</i>
 <a href="poll?modChoice=<% #id cho %>">[Modify]</a>
 <a href="poll?delChoice=<% #id cho %>">[Delete]</a>
 <% end %></li>
-<% end %>
+<% end
+end %>
 
 <% if canModify then %>
 <br><hr><br>

diff --git a/poll.sig b/poll.sig
index 3a47db8..d459f04 100644 (file)
--- a/poll.sig
+++ b/poll.sig
@@ -3,6 +3,7 @@ signature POLL = sig
 
     val lookupPoll : int -> poll
     val listPolls : unit -> poll list
+    val listCurrentPolls : unit -> poll list
     val listPollsLimit : int -> poll list
 
     val addPoll : int * string * string * string * string * int -> int
@@ -21,10 +22,18 @@ signature POLL = sig
 
     val dateLe : string * string -> bool
     val dateGeNow : string -> bool
+    val dateLeNow : string -> bool
     val dateLtNow : string -> bool
 
     val canModify : poll -> bool
     val requireCanModify : poll -> unit
 
     val nextSeq : int -> real
+                        
+    val takingVotes : poll -> bool
+    val listChoicesWithVotes : int -> (bool * int * choice) list
+    val listChoicesWithMyVotes : int -> (bool * choice) list
+
+    val noDupes : ''a list -> bool
+    val listVoters : int -> Init.user list
 end
\ No newline at end of file

diff --git a/poll.sml b/poll.sml
index a30d733..2800d98 100644 (file)
--- a/poll.sml
+++ b/poll.sml
@@ -21,7 +21,14 @@ fun lookupPoll id =
 fun listPolls () =
     C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
                                  FROM Poll
-                                 ORDER BY starts DESC, ends, title`)
+                                 ORDER BY ends, starts DESC, title`)
+
+fun listCurrentPolls () =
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+                                 FROM Poll
+                                 WHERE EXTRACT(EPOCH FROM starts) <= EXTRACT(EPOCH FROM CURRENT_DATE)
+                                    AND EXTRACT(EPOCH FROM ends) >= EXTRACT(EPOCH FROM CURRENT_DATE)
+                                 ORDER BY ends, starts DESC, title`)
 
 fun listPollsLimit lim =
     C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
@@ -78,6 +85,28 @@ fun listChoices pol =
                                    WHERE pol = ^(C.intToSql pol)
                                    ORDER BY seq`)
 
+val mkChoiceRow' =
+    fn (yours :: total :: rest) => (yours <> "0", if C.isNull total then 0 else C.intFromSql total, mkChoiceRow rest)
+     | row => raise Fail ("Bad choice' row: " ^ makeSet id row)
+
+fun listChoicesWithVotes pol =
+    C.map (getDb ()) mkChoiceRow' ($`SELECT (SELECT COUNT( * ) FROM Vote V WHERE V.cho = id AND V.usr = ^(C.intToSql (Init.getUserId ()))),
+                                       (SELECT COUNT( * ) FROM Vote V WHERE V.cho = id) AS total, id, pol, seq, descr
+                                    FROM PollChoice
+                                    WHERE pol = ^(C.intToSql pol)
+                                    ORDER BY total DESC, seq`)
+
+val mkChoiceRow'' =
+    fn (yours :: rest) => (yours <> "0", mkChoiceRow rest)
+     | row => raise Fail ("Bad choice'' row: " ^ makeSet id row)
+
+fun listChoicesWithMyVotes pol =
+    C.map (getDb ()) mkChoiceRow'' ($`SELECT (SELECT COUNT( * ) FROM Vote V WHERE V.cho = id AND V.usr = ^(C.intToSql (Init.getUserId ()))),
+                                        id, pol, seq, descr
+                                     FROM PollChoice
+                                     WHERE pol = ^(C.intToSql pol)
+                                     ORDER BY seq`)
+
 fun addChoice (pol, seq, descr) =
     let
        val db = getDb ()
@@ -128,6 +157,11 @@ fun dateGeNow d =
        [res] => C.boolFromSql res
       | row => raise Fail ("Bad dateGeNow row: " ^ makeSet id row)
 
+fun dateLeNow d =
+    case C.oneRow (getDb ()) ($`SELECT (EXTRACT(EPOCH FROM CURRENT_DATE) >= EXTRACT(EPOCH FROM DATE ^(C.stringToSql d)))`) of
+       [res] => C.boolFromSql res
+      | row => raise Fail ("Bad dateLeNow row: " ^ makeSet id row)
+
 fun dateLtNow d =
     case C.oneRow (getDb ()) ($`SELECT (EXTRACT(EPOCH FROM CURRENT_DATE) > EXTRACT(EPOCH FROM DATE ^(C.stringToSql d)))`) of
        [res] => C.boolFromSql res
@@ -151,4 +185,19 @@ fun nextSeq pol =
        [max] => if C.isNull max then 1.0 else C.realFromSql max
       | row => raise Fail ("Bad nextSeq row: " ^ makeSet id row)
 
+fun takingVotes (poll : poll) =
+    dateLeNow (#starts poll) andalso dateGeNow (#ends poll)
+
+fun noDupes l =
+    case l of
+       [] => true
+      | h::t => List.all (fn x => x <> h) t andalso noDupes t
+
+fun listVoters cho =
+    C.map (getDb ()) mkUserRow ($`SELECT id, name, rname, bal, joined
+                                 FROM WebUser, Vote
+                                 WHERE usr = id
+                                    AND cho = ^(C.intToSql cho)
+                                 ORDER BY name`)
+
 end
\ No newline at end of file

diff --git a/portal.mlt b/portal.mlt
index 44df241..0b4f014 100644 (file)
--- a/portal.mlt
+++ b/portal.mlt
@@ -12,4 +12,12 @@ val bal = Balance.lookupBalance (#bal you);
 </table>
 <b>Balance: $<% #amount bal %></b>
 
+<h3><b><a href="poll">Current polls</a></b></h3>
+
+<% foreach pol in Poll.listCurrentPolls () do %>
+<li> <a href="poll?id=<% #id pol %>"><% Web.html (#title pol) %></a>
+<% if Poll.takingVotes pol then %><a href="poll?vote=<% #id pol %>">[VOTE]</a><% end %>
+(<% Web.html (#starts pol) %> to <% Web.html (#ends pol) %>)</li>
+<% end %>
+
 <% @footer [] %>
\ No newline at end of file