Increase domain component length limit

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

diff --git a/poll.sml b/poll.sml
index 2800d98..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
@@ -42,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) =
@@ -70,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
@@ -86,8 +86,9 @@ fun listChoices 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)
+    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 ()))),
@@ -97,8 +98,9 @@ fun listChoicesWithVotes pol =
                                     ORDER BY total DESC, seq`)
 
 val mkChoiceRow'' =
-    fn (yours :: rest) => (yours <> "0", mkChoiceRow rest)
-     | row => raise Fail ("Bad choice'' row: " ^ makeSet id row)
+    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 ()))),
@@ -113,8 +115,8 @@ fun addChoice (pol, seq, descr) =
        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) =
@@ -150,22 +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 => raise Fail ("Bad dateLeNow row: " ^ makeSet id row)
+      | 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"
@@ -183,7 +185,7 @@ 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)
+      | row => Init.rowError ("nextSeq", row)
 
 fun takingVotes (poll : poll) =
     dateLeNow (#starts poll) andalso dateGeNow (#ends poll)
@@ -194,10 +196,23 @@ fun noDupes l =
       | 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
+    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`)
 
-end
\ No newline at end of file
+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