structure Contact :> CONTACT =
struct
structure C = PgClient
fun main _ =
let
val db = C.conn "dbname='hcoop_hcoop' host='postgres'"
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 " ";
print (Web.html name);
print ": ";
case #url kind of
NONE => print (Web.html v)
| SOME (pre, post) =>
(print "";
print (Web.html v);
print "");
print "\n"
end
| doOne _ = raise Fail "Bad Contact row"
in
print "";
print (#name kind);
print "
\n\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 "
\n\n"
end
fun peer1 () =
let
val inf = TextIO.openIn "/afs/hcoop.net/user/h/hc/hcoop/contact/peer1.html"
fun loop () =
case TextIO.inputLine inf of
NONE => ()
| SOME line => (print line;
loop ())
in
loop ();
TextIO.closeIn inf
end
in
print "HCoop Emergency Contact InformationHCoop Emergency Contact Information
\n";
print "\n\n";
app doOne kinds;
print "Peer 1 phone numbers
\n\n";
peer1 ();
print "\n";
C.close db;
OS.Process.success
end handle C.Sql s => (print ("SQL failure: " ^ s ^ "\n");
OS.Process.failure)
end