--- /dev/null
+structure Contact :> CONTACT =
+struct
+
+structure C = PgClient
+
+fun main _ =
+ let
+ val db = C.conn "dbname='hcoop_hcoop'"
+
+ fun allEmails () =
+ let
+ fun s [v] = C.stringFromSql v
+ | s _ = raise Fail "Bad allEmails row"
+ in
+ C.map db s
+ "SELECT v FROM Contact JOIN ContactKind ON knd = ContactKind.id AND ContactKind.name = 'Non-hcoop e-mail' ORDER BY v"
+ end
+
+ fun kindRow [id, name, url, urlPrefix, urlPostfix] =
+ {id = C.intFromSql id,
+ name = C.stringFromSql name,
+ url = if C.boolFromSql url then
+ SOME (C.stringFromSql urlPrefix,
+ C.stringFromSql urlPostfix)
+ else
+ NONE}
+ | kindRow _ = raise Fail "Bad ContactKind row"
+
+ val kinds = C.map db kindRow "SELECT id, name, url, urlPrefix, urlPostfix FROM ContactKind ORDER BY name"
+
+ fun doOne (kind : {id : int, name : string, url : (string * string) option}) =
+ let
+ fun doOne [name, v] =
+ let
+ val name = C.stringFromSql name
+ val v = C.stringFromSql v
+ in
+ print "<li> ";
+ print (Web.html name);
+ print ": ";
+ case #url kind of
+ NONE => print (Web.html v)
+ | SOME (pre, post) =>
+ (print "<a href=\"";
+ print (Web.html (pre ^ v ^ post));
+ print "\">";
+ print (Web.html v);
+ print "</a>");
+ print "</li>\n"
+ end
+ | doOne _ = raise Fail "Bad Contact row"
+ in
+ print "<h2>";
+ print (#name kind);
+ print "</h2>\n<ol>\n";
+
+ C.app db doOne ("SELECT name, v FROM Contact JOIN WebUserActive ON usr = WebUserActive.id"
+ ^ " WHERE knd = " ^ C.intToSql (#id kind)
+ ^ " ORDER BY name, v");
+
+ print "</ol>\n\n"
+ end
+ in
+ print "<html><head><title>HCoop Emergency Contact Information</title></head><body><h1>HCoop Emergency Contact Information</h1>\n";
+
+ print "<h2><a href=\"mailto:";
+ print (String.concatWith "," (allEmails ()));
+ print "\">E-mail everyone (off-HCoop addresses)</a></h2>\n\n";
+
+ app doOne kinds;
+ print "</body></html>\n";
+ C.close db;
+ OS.Process.success
+ end handle C.Sql s => (print ("SQL failure: " ^ s ^ "\n");
+ OS.Process.failure)
+
+end
HCoop / bpt / portal.git / commitdiff