From e68ddb8014e01a51952aa8077fa1e85c4a1fa014 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 14 Apr 2005 22:25:04 +0000 Subject: [PATCH] Poll administration --- poll.mlt | 219 +++++++++++++++++++++++++++++++++++++++++++++++++++++ poll.sig | 30 ++++++++ poll.sml | 154 +++++++++++++++++++++++++++++++++++++ portal.mlt | 7 +- tables.sql | 43 ++++++++++- 5 files changed, 450 insertions(+), 3 deletions(-) create mode 100644 poll.mlt create mode 100644 poll.sig create mode 100644 poll.sml diff --git a/poll.mlt b/poll.mlt new file mode 100644 index 0000000..19e1eba --- /dev/null +++ b/poll.mlt @@ -0,0 +1,219 @@ +<% @header[("title", ["Polls"])]; + +val pollAdmin = Group.inGroupName "poll"; + +ref editingPoll = NONE; +ref showNormal = true; + +if $"cmd" = "list" then + showNormal := false %> + +

All polls

+ +<% foreach pol in Poll.listPolls () do %> +
  • <% Web.html (#title pol) %> +<% if pollAdmin then %>[Delete] <% end %> +
    • +<% end + +elseif $"cmd" = "add" then + val title = $"title"; + val starts = $"starts"; + val ends = $"ends"; + val votes = Web.stoi ($"votes"); + if title = "" then + %>

    Your poll must have a title.

    <% + elseif not (Poll.dateGeNow starts) then + %>

    That start date is in the past!

    <% + elseif not (Poll.dateLe (starts, ends)) then + %>

    The end date comes before the start date!

    <% + elseif votes <= 0 then + %>

    You must specify a positive number of votes per person.

    <% + else + val id = Poll.addPoll (Init.getUserId(), title, $"descr", starts, ends, votes); + editingPoll := SOME id; + %>

    Poll added!

    <% + end + +elseif $"mod" <> "" then + showNormal := false; + val poll = Poll.lookupPoll (Web.stoi ($"mod")); + + Poll.requireCanModify poll %> +

    Modify poll

    + +
    +"> + + + + + + + +
    Title:
    Start date:
    End date:
    Max votes/person:
    Description:
    +
    + +<% 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 + %>

    Your poll must have a title.

    <% + elseif not (Poll.dateGeNow starts) then + %>

    That start date is in the past!

    <% + elseif not (Poll.dateLe (starts, ends)) then + %>

    The end date comes before the start date!

    <% + elseif votes <= 0 then + %>

    You must specify a positive number of votes per person.

    <% + else + Poll.modPoll {poll with title = title, descr = $"descr", starts = starts, ends = ends, votes = votes}; + editingPoll := SOME (#id poll); + %>

    Poll record saved.

    <% + end + +elseif $"del" <> "" then + Group.requireGroupName "poll"; + showNormal := false; + val poll = Poll.lookupPoll (Web.stoi ($"del")) %> +

    Are you sure you want to delete poll <% Web.html (#title poll) %>?

    + ">Yes, delete <% Web.html (#title poll) %>! + +<% elseif $"del2" <> "" then + Group.requireGroupName "poll"; + val poll = Poll.lookupPoll (Web.stoi ($"del2")); + Poll.deletePoll (Web.stoi ($"del2")) %> +

    <% Web.html (#title poll) %> deleted!

    + +<% elseif $"addChoice" <> "" then + val id = Web.stoi ($"addChoice"); + editingPoll := SOME id; + val descr = $"descr"; + if descr = "" then + %>

    Your poll choice must have a description.

    <% + else + val id = Poll.addChoice (id, Web.stor ($"seq"), descr); + %>

    Choice added!

    <% + 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 %> + +
    + + + + + +
    Text:
    Sequence#:
    +
    + +<% 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 + %>

    Your poll choice must have a description.

    <% + else + Poll.modChoice {cho with seq = Web.stor ($"seq"), descr = descr}; + %>

    Choice saved!

    <% + 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 %> +

    Are you sure you want to delete choice "<% Web.html (#descr cho) %>"?

    + ">Yes, delete "<% Web.html (#descr cho) %>"! + +<% 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) %> +

    "<% Web.html (#descr cho) %>" deleted!

    + +<% elseif $"id" <> "" then + editingPoll := SOME (Web.stoi ($"id")) + +end %> + +<% switch editingPoll of + SOME id => + val pol = Poll.lookupPoll id; + val canModify = Poll.canModify pol %> + + +<% if canModify then %><% end %> + + + + + + +
    Edit poll data
    Poll#: <% id %>
    Title: <% Web.html (#title pol) %>
    Start: <% Web.html (#starts pol) %>
    End: <% Web.html (#ends pol) %>
    Votes/person: <% #votes pol %>
    Description: <% Web.htmlNl (#descr pol) %>
    + +

    Choices

    + +<% foreach cho in Poll.listChoices id do %> +
  • <% Web.html (#descr cho) %> +<% if canModify then %> +(<% #seq cho %>) +[Modify] +[Delete] +<% end %>
    • +<% end %> + +<% if canModify then %> +

    +

    Add a new choice

    + +
    + + + + + +
    Text:
    Sequence#:
    +
    + +<% end %> +<% | NONE => +if showNormal then %> + +Show all polls
    + +

    Create a poll

    + +
    + + + + + + + + +
    Title:
    Start date:
    End date:
    Max votes/person:
    Description:
    +
    + +<% end +end %> + +<% @footer[] %> \ No newline at end of file diff --git a/poll.sig b/poll.sig new file mode 100644 index 0000000..3a47db8 --- /dev/null +++ b/poll.sig @@ -0,0 +1,30 @@ +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 diff --git a/poll.sml b/poll.sml new file mode 100644 index 0000000..a30d733 --- /dev/null +++ b/poll.sml @@ -0,0 +1,154 @@ +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 diff --git a/portal.mlt b/portal.mlt index c7bce36..44df241 100644 --- a/portal.mlt +++ b/portal.mlt @@ -1,6 +1,8 @@ -<% @header [] %> +<% val you = Init.getUser(); +val bal = Balance.lookupBalance (#bal you); +@header [] %> -

    Your recent account activity

    +

    Your recent account activity

    @@ -8,5 +10,6 @@ <% end %>
    Date Description Amount
    <% #d trn %> <% Web.html (#descr trn) %> <% amount %>/<% #amount trn %>
    +Balance: $<% #amount bal %> <% @footer [] %> \ No newline at end of file diff --git a/tables.sql b/tables.sql index 3105801..e35fe1d 100644 --- a/tables.sql +++ b/tables.sql @@ -27,12 +27,24 @@ CREATE TABLE WebGroup( 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, @@ -61,4 +73,33 @@ CREATE TABLE Charge( 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); + + -- 2.20.1