Add all-balance summing and listing of retired balances

[hcoop/zz_old/portal.git] / poll.sml

diff --git a/poll.sml b/poll.sml
index a30d733..1d08f70 100644 (file)
--- a/poll.sml
+++ b/poll.sml
@@ -9,7 +9,7 @@ fun mkPollRow [id, usr, title, descr, starts, ends, votes] =
     {id = C.intFromSql id, usr = C.intFromSql usr, title = C.stringFromSql title,
      descr = C.stringFromSql descr, starts = C.stringFromSql starts,
      ends = C.stringFromSql ends, votes = C.intFromSql votes}
-  | mkPollRow row = raise Fail ("Bad poll row : " ^ makeSet id row)
+  | mkPollRow row = Init.rowError ("poll", row)
 
 fun lookupPoll id =
     case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes
@@ -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
@@ -35,9 +42,9 @@ fun addPoll (usr, title, descr, starts, ends, votes) =
        val id = nextSeq (db, "PollSeq")
     in
        C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes)
-                   VALUES (^id, ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql descr),
+                   VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql descr),
                            ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes))`);
-       C.intFromSql id
+       id
     end
 
 fun modPoll (poll : poll) =
@@ -63,7 +70,7 @@ type choice = {id : int, pol : int, seq : real, descr : string}
 fun mkChoiceRow [id, pol, seq, descr] =
     {id = C.intFromSql id, pol = C.intFromSql pol,
      seq = C.realFromSql seq, descr = C.stringFromSql descr}
-  | mkChoiceRow row = raise Fail ("Bad choice row : " ^ makeSet id row)
+  | mkChoiceRow row = Init.rowError ("choice", row)
 
 fun lookupChoice id =
     case C.oneOrNoRows (getDb ()) ($`SELECT id, pol, seq, descr
@@ -78,14 +85,38 @@ fun listChoices pol =
                                    WHERE pol = ^(C.intToSql pol)
                                    ORDER BY seq`)
 
+val mkChoiceRow' =
+    fn (yours :: total :: rest) => (not (C.isNull yours) andalso C.intFromSql yours <> 0,
+                                   if C.isNull total then 0 else C.intFromSql total, mkChoiceRow rest)
+     | row => Init.rowError ("choice'", 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) => (not (C.isNull yours) andalso C.intFromSql yours <> 0,
+                          mkChoiceRow rest)
+     | row => Init.rowError ("choice''", 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 ()
        val id = nextSeq (db, "PollChoiceSeq")
     in
        C.dml db ($`INSERT INTO PollChoice (id, pol, seq, descr)
-                   VALUES (^id, ^(C.intToSql pol), ^(C.realToSql seq), ^(C.stringToSql descr))`);
-       C.intFromSql id
+                   VALUES (^(C.intToSql id), ^(C.intToSql pol), ^(C.realToSql seq), ^(C.stringToSql descr))`);
+       id
     end
 
 fun modChoice (choice : choice) =
@@ -121,17 +152,22 @@ fun vote (usr, pol, chos) =
 fun dateLe (d1, d2) =
     case C.oneRow (getDb ()) ($`SELECT (EXTRACT(EPOCH FROM DATE ^(C.stringToSql d1)) <= EXTRACT(EPOCH FROM DATE ^(C.stringToSql d2)))`) of
        [res] => C.boolFromSql res
-      | row => raise Fail ("Bad dateLe row: " ^ makeSet id row)
+      | row => Init.rowError ("dateLe", row)
 
 fun dateGeNow 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 dateGeNow row: " ^ makeSet id row)
+      | row => Init.rowError ("dateGeNow", 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 => Init.rowError ("dateLeNow", 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
-      | row => raise Fail ("Bad dateLtNow row: " ^ makeSet id row)
+      | row => Init.rowError ("dateLtNow", row)
 
 fun canModify (poll : poll) =
     Group.inGroupName "poll"
@@ -149,6 +185,34 @@ fun nextSeq pol =
                                FROM PollChoice
                                WHERE pol = ^(C.intToSql pol)`) of
        [max] => if C.isNull max then 1.0 else C.realFromSql max
-      | row => raise Fail ("Bad nextSeq row: " ^ makeSet id row)
-
-end
\ No newline at end of file
+      | row => Init.rowError ("nextSeq", 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, app, shares
+                                 FROM WebUser, Vote
+                                 WHERE usr = id
+                                    AND cho = ^(C.intToSql cho)
+                                 ORDER BY name`)
+
+fun countVoters pol =
+    case C.oneRow (getDb ()) ($`SELECT COUNT(DISTINCT usr)
+                               FROM Vote JOIN PollChoice ON id = cho AND pol = ^(C.intToSql pol)`) of
+       [count] => C.intFromSql count
+      | row => Init.rowError ("countVoters", row)
+
+fun listPollVoters pol =
+    C.map (getDb ()) mkUserRow ($`SELECT DISTINCT WebUser.id, name, rname, bal, joined, app, shares
+                                 FROM WebUser, Vote JOIN PollChoice ON cho = PollChoice.id
+                                 WHERE pol = ^(C.intToSql pol)
+                                    AND usr = WebUser.id
+                                 ORDER BY name`)
+
+end