--- /dev/null
+<% @header[("title", ["Polls"])];
+
+val pollAdmin = Group.inGroupName "poll";
+
+ref editingPoll = NONE;
+ref showNormal = true;
+
+if $"cmd" = "list" then
+ showNormal := false %>
+
+<h2><b>All polls</b></h2>
+
+<% foreach pol in Poll.listPolls () do %>
+<li> <a href="poll?id=<% #id pol %>"><% Web.html (#title pol) %></a>
+<% if pollAdmin then %><a href="poll?del=<% #id pol %>">[Delete]</a> <% end %>
+</li>
+<% end
+
+elseif $"cmd" = "add" then
+ val title = $"title";
+ val starts = $"starts";
+ val ends = $"ends";
+ val votes = Web.stoi ($"votes");
+ if title = "" then
+ %><h3><b>Your poll must have a title.</b></h3><%
+ elseif not (Poll.dateGeNow starts) then
+ %><h3><b>That start date is in the past!</b></h3><%
+ elseif not (Poll.dateLe (starts, ends)) then
+ %><h3><b>The end date comes before the start date!</b></h3><%
+ elseif votes <= 0 then
+ %><h3><b>You must specify a positive number of votes per person.</b></h3><%
+ else
+ val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes);
+ editingPoll := SOME id;
+ %><h3><b>Poll added!</b></h3><%
+ end
+
+elseif $"mod" <> "" then
+ showNormal := false;
+ val poll = Poll.lookupPoll (Web.stoi ($"mod"));
+
+ Poll.requireCanModify poll %>
+<h3><b>Modify poll</b></h3>
+
+<form action="poll">
+<input type="hidden" name="id" value="<% $"mod" %>">
+<table>
+<tr> <td align="right"><b>Title</b>:</td> <td><input name="title" value="<% Web.html (#title poll) %>"></td> </tr>
+<tr> <td align="right"><b>Start date</b>:</td> <td><input name="starts" value="<% Web.html (#starts poll) %>"></td> </tr>
+<tr> <td align="right"><b>End date</b>:</td> <td><input name="ends" value="<% Web.html (#ends poll) %>"></td> </tr>
+<tr> <td align="right"><b>Max votes/person</b>:</td> <td><input name="votes" value="<% #votes poll %>"></td> </tr>
+<tr> <td align="right" valign="top"><b>Description</b>:</td> <td><textarea name="descr" wrap="soft" rows="5" cols="80"><% Web.html (#descr poll) %></textarea></td> </tr>
+<tr> <td><input type="submit" name="cmd" value="Save"></td> </tr>
+</table>
+</form>
+
+<% elseif $"cmd" = "Save" then
+ val poll = Poll.lookupPoll (Web.stoi ($"id"));
+
+ Poll.requireCanModify poll;
+
+ val title = $"title";
+ val starts = $"starts";
+ val ends = $"ends";
+ val votes = Web.stoi ($"votes");
+ if title = "" then
+ %><h3><b>Your poll must have a title.</b></h3><%
+ elseif not (Poll.dateGeNow starts) then
+ %><h3><b>That start date is in the past!</b></h3><%
+ elseif not (Poll.dateLe (starts, ends)) then
+ %><h3><b>The end date comes before the start date!</b></h3><%
+ elseif votes <= 0 then
+ %><h3><b>You must specify a positive number of votes per person.</b></h3><%
+ else
+ Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes};
+ editingPoll := SOME (#id poll);
+ %><h3><b>Poll record saved.</b></h3><%
+ end
+
+elseif $"del" <> "" then
+ Group.requireGroupName "poll";
+ showNormal := false;
+ val poll = Poll.lookupPoll (Web.stoi ($"del")) %>
+ <h3><b>Are you sure you want to delete poll <a href="poll?id=<% #id poll %>"><% Web.html (#title poll) %></a>?</b></h3>
+ <a href="poll?del2=<% $"del" %>">Yes, delete <% Web.html (#title poll) %>!</a>
+
+<% elseif $"del2" <> "" then
+ Group.requireGroupName "poll";
+ val poll = Poll.lookupPoll (Web.stoi ($"del2"));
+ Poll.deletePoll (Web.stoi ($"del2")) %>
+ <h3><b><% Web.html (#title poll) %> deleted!</b></h3>
+
+<% elseif $"addChoice" <> "" then
+ val id = Web.stoi ($"addChoice");
+ editingPoll := SOME id;
+ val descr = $"descr";
+ if descr = "" then
+ %><h3><b>Your poll choice must have a description.</b></h3><%
+ else
+ val id = Poll.addChoice (id, Web.stor ($"seq"), descr);
+ %><h3><b>Choice added!</b></h3><%
+ end
+
+elseif $"modChoice" <> "" then
+ showNormal := false;
+ val id = Web.stoi ($"modChoice");
+ val cho = Poll.lookupChoice id;
+ val poll = Poll.lookupPoll (#pol cho);
+ Poll.requireCanModify poll %>
+
+<form action="poll">
+<input type="hidden" name="saveChoice" value="<% id %>">
+<table>
+<tr> <td align="right"><b>Text</b>:</td> <td><input name="descr" value="<% Web.html (#descr cho) %>"></td> </tr>
+<tr> <td align="right"><b>Sequence#</b>:</td> <td><input name="seq" value="<% #seq cho %>"></td> </tr>
+<tr> <td><input type="submit" value="Save"></td> </tr>
+</table>
+</form>
+
+<% elseif $"saveChoice" <> "" then
+ val id = Web.stoi ($"saveChoice");
+ val cho = Poll.lookupChoice id;
+ val poll = Poll.lookupPoll (#pol cho);
+ Poll.requireCanModify poll;
+ editingPoll := SOME (#id poll);
+ val descr = $"descr";
+ if descr = "" then
+ %><h3><b>Your poll choice must have a description.</b></h3><%
+ else
+ Poll.modChoice {cho with seq = Web.stor ($"seq"), descr = descr};
+ %><h3><b>Choice saved!</b></h3><%
+ end
+
+elseif $"delChoice" <> "" then
+ val id = Web.stoi ($"delChoice");
+ val cho = Poll.lookupChoice id;
+ val poll = Poll.lookupPoll (#pol cho);
+ Poll.requireCanModify poll;
+ showNormal := false %>
+ <h3><b>Are you sure you want to delete choice "<% Web.html (#descr cho) %>"</a>?</b></h3>
+ <a href="poll?delChoice2=<% $"delChoice" %>">Yes, delete "<% Web.html (#descr cho) %>"!</a>
+
+<% elseif $"delChoice2" <> "" then
+ val id = Web.stoi ($"delChoice2");
+ val cho = Poll.lookupChoice id;
+ val poll = Poll.lookupPoll (#pol cho);
+ Poll.requireCanModify poll;
+ Poll.deleteChoice id;
+ editingPoll := SOME (#id poll) %>
+ <h3><b>"<% Web.html (#descr cho) %>" deleted!</b></h3>
+
+<% elseif $"id" <> "" then
+ editingPoll := SOME (Web.stoi ($"id"))
+
+end %>
+
+<% switch editingPoll of
+ SOME id =>
+ val pol = Poll.lookupPoll id;
+ val canModify = Poll.canModify pol %>
+
+<table>
+<% if canModify then %><tr> <td></td> <td><a href="poll?mod=<% id %>">Edit poll data</a></td> </tr><% end %>
+<tr> <td align="right"><b>Poll#</b>:</td> <td><% id %></td> </tr>
+<tr> <td align="right"><b>Title</b>:</td> <td><% Web.html (#title pol) %></td> </tr>
+<tr> <td align="right"><b>Start</b>:</td> <td><% Web.html (#starts pol) %></td> </tr>
+<tr> <td align="right"><b>End</b>:</td> <td><% Web.html (#ends pol) %></td> </tr>
+<tr> <td align="right"><b>Votes/person</b>:</td> <td><% #votes pol %></td> </tr>
+<tr> <td align="right" valign="top"><b>Description</b>:</td> <td><% Web.htmlNl (#descr pol) %></td> </tr>
+</table>
+
+<h3><b>Choices</b></h3>
+
+<% foreach cho in Poll.listChoices id do %>
+ <li> <% Web.html (#descr cho) %>
+<% if canModify then %>
+<i>(<% #seq cho %>)</i>
+<a href="poll?modChoice=<% #id cho %>">[Modify]</a>
+<a href="poll?delChoice=<% #id cho %>">[Delete]</a>
+<% end %></li>
+<% end %>
+
+<% if canModify then %>
+<br><hr><br>
+<h3><b>Add a new choice</b></h3>
+
+<form action="poll">
+<input type="hidden" name="addChoice" value="<% id %>">
+<table>
+<tr> <td align="right"><b>Text</b>:</td> <td><input name="descr"></td> </tr>
+<tr> <td align="right"><b>Sequence#</b>:</td> <td><input name="seq" value="<% Poll.nextSeq id %>"></td> </tr>
+<tr> <td><input type="submit" value="Add"></td> </tr>
+</table>
+</form>
+
+<% end %>
+<% | NONE =>
+if showNormal then %>
+
+<a href="poll?cmd=list">Show all polls</a><br>
+
+<h3><b>Create a poll</b></h3>
+
+<form action="poll">
+<input type="hidden" name="cmd" value="add">
+<table>
+<tr> <td align="right"><b>Title</b>:</td> <td><input name="title"></td> </tr>
+<tr> <td align="right"><b>Start date</b>:</td> <td><input name="starts"></td> </tr>
+<tr> <td align="right"><b>End date</b>:</td> <td><input name="ends"></td> </tr>
+<tr> <td align="right"><b>Max votes/person</b>:</td> <td><input name="votes"></td> </tr>
+<tr> <td align="right" valign="top"><b>Description</b>:</td> <td><textarea name="descr" wrap="soft" rows="5" cols="80"></textarea></td> </tr>
+<tr> <td><input type="submit" value="Create"></td> </tr>
+</table>
+</form>
+
+<% end
+end %>
+
+<% @footer[] %>
\ No newline at end of file
--- /dev/null
+signature POLL = sig
+ type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int}
+
+ val lookupPoll : int -> poll
+ val listPolls : unit -> poll list
+ val listPollsLimit : int -> poll list
+
+ val addPoll : int * string * string * string * string * int -> int
+ val modPoll : poll -> unit
+ val deletePoll : int -> unit
+
+ type choice = {id : int, pol : int, seq : real, descr : string}
+
+ val lookupChoice : int -> choice
+ val addChoice : int * real * string -> int
+ val modChoice : choice -> unit
+ val deleteChoice : int -> unit
+ val listChoices : int -> choice list
+
+ val vote : int * int * int list -> unit
+
+ val dateLe : string * string -> bool
+ val dateGeNow : string -> bool
+ val dateLtNow : string -> bool
+
+ val canModify : poll -> bool
+ val requireCanModify : poll -> unit
+
+ val nextSeq : int -> real
+end
\ No newline at end of file
--- /dev/null
+structure Poll :> POLL =
+struct
+
+open Util Sql Init
+
+type poll = {id : int, usr : int, title : string, descr : string, starts : string, ends : string, votes : int}
+
+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)
+
+fun lookupPoll id =
+ case C.oneOrNoRows (getDb ()) ($`SELECT id, usr, title, descr, starts, ends, votes
+ 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
+ FROM Poll
+ ORDER BY starts DESC, ends, title`)
+
+fun listPollsLimit lim =
+ C.map (getDb ()) mkPollRow ($`SELECT id, usr, title, descr, starts, ends, votes
+ FROM Poll
+ ORDER BY starts DESC, ends, title
+ LIMIT ^(C.intToSql lim)`)
+
+fun addPoll (usr, title, descr, starts, ends, votes) =
+ 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
+ end
+
+fun modPoll (poll : poll) =
+ let
+ val db = getDb ()
+ in
+ ignore (C.dml db ($`UPDATE Poll SET
+ 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))
+ WHERE id = ^(C.intToSql (#id poll))`))
+ end
+
+fun deletePoll id =
+ ignore (C.dml (getDb ()) ($`DELETE FROM Poll WHERE id = ^(C.intToSql id)`))
+
+
+(* Poll choices *)
+
+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)
+
+fun lookupChoice id =
+ case C.oneOrNoRows (getDb ()) ($`SELECT id, pol, seq, descr
+ FROM PollChoice
+ WHERE id = ^(C.intToSql id)`) of
+ NONE => raise Fail "Poll choice not found"
+ | SOME row => mkChoiceRow row
+
+fun listChoices pol =
+ C.map (getDb ()) mkChoiceRow ($`SELECT 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
+ end
+
+fun modChoice (choice : choice) =
+ let
+ val db = getDb ()
+ in
+ ignore (C.dml db ($`UPDATE PollChoice SET
+ pol = ^(C.intToSql (#pol choice)), seq = ^(C.realToSql (#seq choice)),
+ descr = ^(C.stringToSql (#descr choice))
+ WHERE id = ^(C.intToSql (#id choice))`))
+ end
+
+fun deleteChoice id =
+ ignore (C.dml (getDb ()) ($`DELETE FROM PollChoice WHERE id = ^(C.intToSql id)`))
+
+
+(* Member voting *)
+
+fun vote (usr, pol, chos) =
+ let
+ val db = getDb ()
+
+ fun voteOnce cho =
+ ignore (C.dml db ($`INSERT INTO Vote (usr, cho) VALUES (^(C.intToSql usr), ^(C.intToSql cho))`))
+ in
+ ignore (C.dml db ($`DELETE FROM Vote WHERE cho IN (SELECT id FROM PollChoice WHERE pol = ^(C.intToSql pol)) AND usr = ^(C.intToSql usr)`));
+ app voteOnce chos
+ end
+
+
+(* Date comparison *)
+
+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)
+
+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)
+
+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)
+
+fun canModify (poll : poll) =
+ Group.inGroupName "poll"
+ orelse (#usr poll = Init.getUserId()
+ andalso dateLtNow (#starts poll))
+
+fun requireCanModify poll =
+ if canModify poll then
+ ()
+ else
+ raise Init.Access "Not authorized to edit that poll"
+
+fun nextSeq pol =
+ case C.oneRow (getDb ()) ($`SELECT MAX(seq)+1
+ 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
-<% @header [] %>
+<% val you = Init.getUser();
+val bal = Balance.lookupBalance (#bal you);
+@header [] %>
-<h3><b>Your recent account activity</b></h3>
+<h3><b><a href="money">Your recent account activity</a></b></h3>
<table>
<tr> <td><b>Date</b></td> <td><b>Description</b></td> <td><b>Amount</b></td> </tr>
<tr> <td><% #d trn %></td> <td><a href="money?trn=<% #id trn %>"><% Web.html (#descr trn) %></a></td> <td><% amount %>/<% #amount trn %></td> </tr>
<% end %>
</table>
+<b>Balance: $<% #amount bal %></b>
<% @footer [] %>
\ No newline at end of file
id INTEGER PRIMARY KEY,
name TEXT NOT NULL);
-CREATE SEQUENCE WebGroupSeq START 1;
+CREATE SEQUENCE WebGroupSeq START 4;
INSERT INTO WebGroup
(id, name) VALUES
(0, 'root');
+INSERT INTO WebGroup
+ (id, name) VALUES
+ (1, 'money');
+
+INSERT INTO WebGroup
+ (id, name) VALUES
+ (2, 'paying');
+
+INSERT INTO WebGroup
+ (id, name) VALUES
+ (3, 'poll');
+
CREATE TABLE Membership(
grp INTEGER NOT NULL,
usr INTEGER NOT NULL,
FOREIGN KEY (trn) REFERENCES Transaction(id) ON DELETE CASCADE,
FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
+CREATE TABLE Poll(
+ id INTEGER PRIMARY KEY,
+ usr INTEGER NOT NULL,
+ title TEXT NOT NULL,
+ descr TEXT NOT NULL,
+ starts DATE NOT NULL,
+ ends DATE NOT NULL,
+ votes INTEGER NOT NULL,
+ FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE);
+
+CREATE SEQUENCE PollSeq START 1;
+
+CREATE TABLE PollChoice(
+ id INTEGER PRIMARY KEY,
+ pol INTEGER NOT NULL,
+ seq REAL NOT NULL,
+ descr TEXT NOT NULL,
+ FOREIGN KEY (pol) REFERENCES Poll(id) ON DELETE CASCADE);
+
+CREATE SEQUENCE PollChoiceSeq START 1;
+
+CREATE TABLE Vote(
+ usr INTEGER NOT NULL,
+ cho INTEGER NOT NULL,
+ PRIMARY KEY (usr, cho),
+ FOREIGN KEY (usr) REFERENCES WebUser(id) ON DELETE CASCADE,
+ FOREIGN KEY (cho) REFERENCES PollChoice(id) ON DELETE CASCADE);
+
+
HCoop / hcoop / zz_old / portal.git / commitdiff