X-Git-Url: http://git.hcoop.net/hcoop/portal.git/blobdiff_plain/56dbfc3052067bd1e3fa086e08cb96d783762ad6..ccac9b41f250a2f373df28db341d8bb6bf381d61:/poll.sml diff --git a/poll.sml b/poll.sml index 2800d98..b1fe992 100644 --- a/poll.sml +++ b/poll.sml @@ -3,48 +3,48 @@ struct open Util Sql Init -type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int} +type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool} -fun mkPollRow [id, usr, title, descr, starts, ends, votes] = +fun mkPollRow [id, usr, title, descr, starts, ends, votes, official] = {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) + ends = C.stringFromSql ends, votes = C.intFromSql votes, official = C.boolFromSql official} + | mkPollRow row = Init.rowError ("poll", row) fun lookupPoll id = - case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes + case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes, official FROM Poll WHERE id = ^(C.intToSql id)`) of NONE => raise Fail "Poll not found" | SOME row => mkPollRow row fun listPolls () = - C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes + C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official FROM Poll ORDER BY ends, starts DESC, title`) fun listCurrentPolls () = - C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes + C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official 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 + C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official FROM Poll ORDER BY starts DESC, ends, title LIMIT ^(C.intToSql lim)`) -fun addPoll (usr, title, descr, starts, ends, votes) = +fun addPoll (usr, title, descr, starts, ends, votes, official) = let val db = getDb () 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), - ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes))`); - C.intFromSql id + C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes, official) + VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.stringToSql title), ^(C.stringToSql descr), + ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes), ^(C.boolToSql official))`); + id end fun modPoll (poll : poll) = @@ -55,7 +55,7 @@ fun modPoll (poll : poll) = usr = ^(C.intToSql (#usr poll)), title = ^(C.stringToSql (#title poll)), descr = ^(C.stringToSql (#descr poll)), starts = ^(C.stringToSql (#starts poll)), ends = ^(C.stringToSql (#ends poll)), - votes = ^(C.intToSql (#votes poll)) + votes = ^(C.intToSql (#votes poll)), official = ^(C.boolToSql (#official poll)) WHERE id = ^(C.intToSql (#id poll))`)) end @@ -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,32 @@ 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, paypal, checkout 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, paypal, checkout + FROM WebUser, Vote JOIN PollChoice ON cho = PollChoice.id + WHERE pol = ^(C.intToSql pol) + AND usr = WebUser.id + ORDER BY name`) + +val votingMembershipRequirement = 45 + +fun membershipLength id = + case C.oneRow (getDb ()) ($`SELECT EXTRACT(DAY FROM (CURRENT_TIMESTAMP - joined)) + FROM WebUser + WHERE id = ^(C.intToSql id)`) of + [days] => C.intFromSql days + | row => Init.rowError ("membershipLength", row) + +end