From 56dbfc3052067bd1e3fa086e08cb96d783762ad6 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 15 Apr 2005 00:34:27 +0000 Subject: [PATCH] Poll voting --- poll.mlt | 124 ++++++++++++++++++++++++++++++++++++++++++++++++----- poll.sig | 9 ++++ poll.sml | 51 +++++++++++++++++++++- portal.mlt | 8 ++++ 4 files changed, 181 insertions(+), 11 deletions(-) diff --git a/poll.mlt b/poll.mlt index 19e1eba..3abe588 100644 --- a/poll.mlt +++ b/poll.mlt @@ -16,6 +16,55 @@ if $"cmd" = "list" then <% end +elseif $"vote" <> "" then + showNormal := false; + val id = Web.stoi ($"vote"); + val poll = Poll.lookupPoll id %> + + + + + + + + +
Poll#: <% id %>
Title: <% Web.html (#title poll) %>
Start: <% Web.html (#starts poll) %>
End: <% Web.html (#ends poll) %>
Votes/person: <% #votes poll %>
Description: <% Web.htmlNl (#descr poll) %>
+ +

Choices

+ +
+ +<% val choices = Poll.listChoicesWithMyVotes id; +if #votes poll = 1 then %> + +<% end +foreach (you, cho) in choices do %> + +<% end %>

+ +
+ +<% 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 + %>

You can't vote for that many different choices!

<% + elseif not (Poll.noDupes votes) then + %>

You can't vote multiple times for the same choice!

<% + else + Poll.vote (Init.getUserId (), id, votes) + %>

Thanks for voting!

+<% end + elseif $"cmd" = "add" then val title = $"title"; val starts = $"starts"; @@ -149,6 +198,43 @@ elseif $"delChoice" <> "" then editingPoll := SOME (#id poll) %>

"<% Web.html (#descr cho) %>" deleted!

+<% elseif $"report" <> "" then + showNormal := false; + val id = Web.stoi ($"report"); + + val poll = Poll.lookupPoll id; + val canModify = Poll.canModify poll %> + +

Vote Report

+ + + + + + + + +
Poll#: <% id %>
Title: <% Web.html (#title poll) %>
Start: <% Web.html (#starts poll) %>
End: <% Web.html (#ends poll) %>
Votes/person: <% #votes poll %>
Description: <% Web.htmlNl (#descr poll) %>
+ +

+ + + +<% foreach (_, total, cho) in Poll.listChoicesWithVotes id do %> + <% +end %> +
Votes Choice Voters
<% total %> <% Web.html (#descr cho) %> +<% ref first = true; + foreach user in Poll.listVoters (#id cho) do + if first then + first := false + else + %>, <% + end + %><% #name user %><% + end + %>
+ <% 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 %> <% if canModify then %><% end %> - - - - - + + + + +
Edit poll data
Poll#: <% id %>
Title: <% Web.html (#title pol) %>
Start: <% Web.html (#starts pol) %>
End: <% Web.html (#ends pol) %>
Votes/person: <% #votes pol %>
Description: <% Web.htmlNl (#descr pol) %>
Title: <% Web.html (#title poll) %>
Start: <% Web.html (#starts poll) %>
End: <% Web.html (#ends poll) %>
Votes/person: <% #votes poll %>
Description: <% Web.htmlNl (#descr poll) %>
-

Choices

+

Choices<% if Poll.takingVotes poll then %>(Vote!)<% end %>

+ +<% if Poll.takingVotes poll then %> + + +<% foreach (you, total, cho) in Poll.listChoicesWithVotes id do %> + + + +<% if canModify then %> + +<% end %> +<% end %> +
You Total
<% if you then %>X<% end %><% total %><% Web.html (#descr cho) %>(<% #seq cho %>) +[Modify] +[Delete]
-<% foreach cho in Poll.listChoices id do %> +Vote Report +<% else +foreach cho in Poll.listChoices id do %>
  • <% Web.html (#descr cho) %> <% if canModify then %> (<% #seq cho %>) [Modify] [Delete] <% end %>
    • -<% end %> +<% end +end %> <% if canModify then %>

    diff --git a/poll.sig b/poll.sig index 3a47db8..d459f04 100644 --- 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 --- 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 --- a/portal.mlt +++ b/portal.mlt @@ -12,4 +12,12 @@ val bal = Balance.lookupBalance (#bal you); Balance: $<% #amount bal %> +

    Current polls

    + +<% foreach pol in Poll.listCurrentPolls () do %> +
  • <% Web.html (#title pol) %> +<% if Poll.takingVotes pol then %>[VOTE]<% end %> +(<% Web.html (#starts pol) %> to <% Web.html (#ends pol) %>)
    • +<% end %> + <% @footer [] %> \ No newline at end of file -- 2.20.1