X-Git-Url: https://git.hcoop.net/hcoop/zz_old/portal.git/blobdiff_plain/57c305c1681b8b819d90b3f5a4d8c77a03926a4e..a5520ba055675fdf593cdf4e21e48749bf42f6b1:/poll.sml diff --git a/poll.sml b/poll.sml index a30d733..1d08f70 100644 --- 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