structure Poll :> POLL =
struct

open Util Sql Init

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, 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,
     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, 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, 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, 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, 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, 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, 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.boolToSql ready))`);
	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)), official = ^(C.boolToSql (#official poll)),
			    ready = ^(C.boolToSql (#ready 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 = Init.rowError ("choice", 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`)

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 (^(C.intToSql id), ^(C.intToSql pol), ^(C.realToSql seq), ^(C.stringToSql descr))`);
	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 => 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 => 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 => Init.rowError ("dateLtNow", row)

fun canModify (poll : poll) =
    Group.inGroupName "poll"
    orelse ((#usr poll = Init.getUserId()
	     andalso (dateLtNow (#starts poll)
		      orelse not (#ready 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 => Init.rowError ("nextSeq", row)

fun takingVotes (poll : poll) =
    #ready poll andalso 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, paypal, checkout
			          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, 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