structure Contact :> CONTACT =
struct

open Util Sql Init


(* Managing kinds *)

type kind = {id :int, name : string, makeUrl : (string * string) option}

fun makerToSql NONE = "FALSE, NULL, NULL"
  | makerToSql (SOME (pre, post)) = $`TRUE, ^(C.stringToSql pre), ^(C.stringToSql post)`

fun makerToSqlUpd NONE = "url = FALSE, urlPrefix = NULL, urlPostfix = NULL"
  | makerToSqlUpd (SOME (pre, post)) = $`url = TRUE, urlPrefix = ^(C.stringToSql pre), urlPostfix = ^(C.stringToSql post)`

fun mkKindRow [id, name, url, urlPrefix, urlPostfix] =
    {id = C.intFromSql id, name = C.stringFromSql name, 
     makeUrl = (if C.boolFromSql url then
		    SOME (C.stringFromSql urlPrefix, C.stringFromSql urlPostfix)
		else
		    NONE)}
  | mkKindRow row = Init.rowError ("kind", row)

fun addKind (name, makeUrl) =
    let
	val db = getDb ()
	val id = nextSeq (db, "ContactKindSeq")
    in
	C.dml db ($`INSERT INTO ContactKind (id, name, url, urlPrefix, urlPostfix)
                    VALUES (^(C.intToSql id), ^(C.stringToSql name), ^(makerToSql makeUrl))`);
	id
    end

fun lookupKind id =
    let
	val c = getDb ()
    in
	(case C.oneOrNoRows c ($`SELECT id, name, url, urlPrefix, urlPostfix FROM ContactKind WHERE id = ^(C.intToSql id)`) of
	     NONE => raise Fail "Contact kind not found"
	   | SOME r => mkKindRow r)
    end

fun modKind (kind : kind) =
    let
	val db = getDb ()
    in
	ignore (C.dml db ($`UPDATE ContactKind
			    SET name = ^(C.stringToSql (#name kind)), ^(makerToSqlUpd (#makeUrl kind))
			    WHERE id = ^(C.intToSql (#id kind))`))
    end

fun deleteKind id =
    ignore (C.dml (getDb ()) ($`DELETE FROM ContactKind WHERE id = ^(C.intToSql id)`))

fun listKinds () =
    C.map (getDb ()) mkKindRow ($`SELECT id, name, url, urlPrefix, urlPostfix FROM ContactKind
   				  ORDER BY name`)

(* Managing contact entries *)

datatype priv =
	 PUBLIC
       | MEMBERS
       | ADMINS

val privFromInt =
    fn 0 => PUBLIC
     | 1 => MEMBERS
     | 2 => ADMINS
     | _ => raise C.Sql "Bad contact private information"

fun privFromSql v = privFromInt (C.intFromSql v)

val privToSql =
    fn PUBLIC => "0"
     | MEMBERS => "1"
     | ADMINS => "2"

val privToInt =
    fn PUBLIC => 0
     | MEMBERS => 1
     | ADMINS => 2

type contact = {id :int, usr : int, knd : int, v : string, priv : priv}

fun mkContactRow [id, usr, knd, v, priv] =
    {id = C.intFromSql id, usr = C.intFromSql usr, knd = C.intFromSql knd,
     v = C.stringFromSql v, priv = privFromSql priv}
  | mkContactRow row = Init.rowError ("contact", row)

fun addContact (usr, knd, v, priv) =
    let
	val db = getDb ()
	val id = nextSeq (db, "ContactSeq")
    in
	C.dml db ($`INSERT INTO Contact (id, usr, knd, v, priv)
                    VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql knd), ^(C.stringToSql v), ^(privToSql priv))`);
	id
    end

fun lookupContact id =
    let
	val c = getDb ()
    in
	(case C.oneOrNoRows c ($`SELECT id, usr, knd, v, priv FROM Contact WHERE id = ^(C.intToSql id)`) of
	     NONE => raise Fail "Contact not found"
	   | SOME r => mkContactRow r)
    end

fun modContact (ct : contact) =
    let
	val db = getDb ()
    in
	ignore (C.dml db ($`UPDATE Contact
			    SET usr = ^(C.intToSql (#usr ct)), knd = ^(C.intToSql (#knd ct)),
			       v = ^(C.stringToSql (#v ct)), priv = ^(privToSql (#priv ct))
			    WHERE id = ^(C.intToSql (#id ct))`))
    end

fun deleteContact id =
    ignore (C.dml (getDb ()) ($`DELETE FROM Contact WHERE id = ^(C.intToSql id)`))

fun mkUserContactRow r =
    if length r >= 5 then
	(mkKindRow (List.take (r, 5)), mkContactRow (List.drop (r, 5)))
    else
	Init.rowError ("kind/contact", r)

fun listUserContacts (usr, priv) =
    C.map (getDb ()) mkUserContactRow ($`SELECT ContactKind.id, name, url, urlPrefix, urlPostfix, Contact.id, usr, knd, v, priv
				         FROM Contact JOIN ContactKind ON knd = ContactKind.id
				         WHERE usr = ^(C.intToSql usr)
					    AND priv <= ^(privToSql priv)
   				         ORDER BY name, v`)

fun mkKindContactRow r =
    case r of
	name :: rest => (C.stringFromSql name, mkContactRow rest)
      | _ => Init.rowError ("name/contact", r)

fun listContactsByKind (knd, priv) =
    C.map (getDb ()) mkKindContactRow ($`SELECT name, Contact.id, usr, knd, v, priv
				         FROM Contact JOIN WebUser ON WebUser.id = usr
				         WHERE knd = ^(C.intToSql knd)
					    AND priv <= ^(privToSql priv)
   				         ORDER BY name`)

fun format (kind : kind, cont : contact) =
    case #makeUrl kind of
	SOME (pre, post) => String.concat ["<a href=\"", pre, Web.html (#v cont), post, "\">", Web.html (#v cont), "</a>"]
      | NONE => Web.html (#v cont)

end