Initial support for poll 'ready' bits
authorAdam Chlipala <adamc@hcoop.net>
Tue, 4 Aug 2009 15:33:54 +0000 (15:33 +0000)
committerAdam Chlipala <adamc@hcoop.net>
Tue, 4 Aug 2009 15:33:54 +0000 (15:33 +0000)
poll.mlt
poll.sig
poll.sml
tables.sql

index 735a201..dac0ede 100644 (file)
--- a/poll.mlt
+++ b/poll.mlt
@@ -87,7 +87,7 @@ elseif $"cmd" = "add" then
        elseif votes <= 0 then
                %><h3>You must specify a positive number of votes per person.</h3><%
        else
-               val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes, official);
+               val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes, official, false);
                editingPoll := SOME id;
                %><h3>Poll added!</h3><%
        end
@@ -103,6 +103,7 @@ elseif $"mod" <> "" then
 <input type="hidden" name="id" value="<% $"mod" %>">
 <table class="blanks">
 <tr> <td>Title:</td> <td><input name="title" value="<% Web.html (#title poll) %>"></td> </tr>
+<tr> <td>Ready?</td> <td><input type="checkbox" name="ready" <% if #ready poll then " checked" else "" end %>></td> </tr>
 <tr> <td>Start date:</td> <td><input name="starts" value="<% Web.html (#starts poll) %>"></td> </tr>
 <tr> <td>End date:</td> <td><input name="ends" value="<% Web.html (#ends poll) %>"></td> </tr>
 <tr> <td>Max votes/person:</td> <td><input name="votes" value="<% #votes poll %>"></td> </tr>
@@ -122,7 +123,10 @@ elseif $"mod" <> "" then
        val ends = $"ends";
        val votes = Web.stoi ($"votes");
        val official = $"official" = "on";
-       if title = "" then
+       val ready = $"ready" = "on";
+        if not (Poll.canModify poll) then
+               %><h3>You can't modify this poll anymore, because voting is already open.</h3><%
+       elseif title = "" then
                %><h3>Your poll must have a title.</h3><%
        elseif not pollAdmin and not (Poll.dateGeNow starts) then
                %><h3>That start date is in the past!</h3><%
@@ -131,7 +135,8 @@ elseif $"mod" <> "" then
        elseif votes <= 0 then
                %><h3>You must specify a positive number of votes per person.</h3><%
        else
-               Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes, official = official};
+               Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes, official = official,
+                             ready = ready};
                editingPoll := SOME (#id poll);
                %><h3>Poll record saved.</h3><%
        end
@@ -153,7 +158,10 @@ elseif $"del" <> "" then
        val id = Web.stoi ($"addChoice");
        editingPoll := SOME id;
        val descr = $"descr";
-       if descr = "" then
+       val poll = Poll.lookupPoll id;
+        if not (Poll.canModify poll) then
+               %><h3>You can't modify this poll anymore, because voting is already open.</h3><%
+       elseif descr = "" then
                %><h3>Your poll choice must have a description.</h3><%
        else
                val id = Poll.addChoice (id, Web.stor ($"seq"), descr);
index 3542314..2392f2b 100644 (file)
--- a/poll.sig
+++ b/poll.sig
@@ -1,12 +1,12 @@
 signature POLL = sig
-    type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool}
+    type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool, ready : bool}
 
     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 * bool -> int
+    val addPoll : int * string * string * string * string * int * bool * bool -> int
     val modPoll : poll -> unit
     val deletePoll : int -> unit
 
index b1fe992..74fcaa9 100644 (file)
--- a/poll.sml
+++ b/poll.sml
@@ -3,47 +3,52 @@ struct
 
 open Util Sql Init
 
-type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool}
+type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int, official : bool, ready : bool}
 
-fun mkPollRow [id, usr, title, descr, starts, ends, votes, official] =
+fun mkPollRow [id, usr, title, descr, starts, ends, votes, official, ready] =
     {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, official = C.boolFromSql official}
+     ends = C.stringFromSql ends, votes = C.intFromSql votes, official = C.boolFromSql official,
+     ready = C.boolFromSql ready}
   | mkPollRow row = Init.rowError ("poll", row)
 
 fun lookupPoll id =
-    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes, official
+    case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                     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, official
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                  FROM Poll
+                                 WHERE ready
                                  ORDER BY ends, starts DESC, title`)
 
 fun listCurrentPolls () =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                  FROM Poll
                                  WHERE EXTRACT(EPOCH FROM starts) <= EXTRACT(EPOCH FROM CURRENT_DATE)
                                     AND EXTRACT(EPOCH FROM ends) >= EXTRACT(EPOCH FROM CURRENT_DATE)
+                                    AND (ready OR usr = ^(C.intToSql (Init.getUserId ()))) 
                                  ORDER BY ends, starts DESC, title`)
 
 fun listPollsLimit lim =
-    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official
+    C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes, official, ready
                                  FROM Poll
                                  ORDER BY starts DESC, ends, title
+                                 WHERE (ready OR usr = ^(C.intToSql (Init.getUserId ())))
                                  LIMIT ^(C.intToSql lim)`)
 
-fun addPoll (usr, title, descr, starts, ends, votes, official) =
+fun addPoll (usr, title, descr, starts, ends, votes, official, ready) =
     let
        val db = getDb ()
        val id = nextSeq (db, "PollSeq")
     in
-       C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes, official)
+       C.dml db ($`INSERT INTO Poll (id, usr, title, descr, starts, ends, votes, official, ready)
                    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))`);
+                           ^(C.stringToSql starts), ^(C.stringToSql ends), ^(C.intToSql votes), ^(C.boolToSql official),
+                           ^(C.boolToSql ready))`);
        id
     end
 
@@ -55,7 +60,8 @@ 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)), official = ^(C.boolToSql (#official poll))
+                           votes = ^(C.intToSql (#votes poll)), official = ^(C.boolToSql (#official poll)),
+                           ready = ^(C.boolToSql (#ready poll))
                            WHERE id = ^(C.intToSql (#id poll))`))
     end
 
@@ -172,7 +178,8 @@ fun dateLtNow d =
 fun canModify (poll : poll) =
     Group.inGroupName "poll"
     orelse (#usr poll = Init.getUserId()
-           andalso dateLtNow (#starts poll))
+           andalso (dateLtNow (#starts poll)
+                    orelse not (#ready poll)))
 
 fun requireCanModify poll =
     if canModify poll then
@@ -188,7 +195,7 @@ fun nextSeq pol =
       | row => Init.rowError ("nextSeq", row)
 
 fun takingVotes (poll : poll) =
-    dateLeNow (#starts poll) andalso dateGeNow (#ends poll)
+    #ready poll andalso dateLeNow (#starts poll) andalso dateGeNow (#ends poll)
 
 fun noDupes l =
     case l of
index 17d755b..ccaca80 100644 (file)
@@ -105,6 +105,7 @@ CREATE TABLE Poll(
        ends DATE NOT NULL,
        votes INTEGER NOT NULL,
        official BOOL NOT NULL,
+       ready BOOL NOT NULL,
        FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
 
 CREATE SEQUENCE PollSeq START 1;