structure Gen :> GEN =
struct

structure C = PgClient

structure IntKey = struct
   type ord_key = int
   val compare = Int.compare
end

structure NM = BinaryMapFn(IntKey)

val outputDir = "/home/hcoop/public_html/dyn/"

fun generate () =
    let
	val db = C.conn "dbname='hcoop_hcoop'"

	fun procOutput (outf, cmdline) =
	    let
		val proc = Unix.execute cmdline
		val ins = Unix.textInstreamOf proc
			   
		fun loop () =
		    case TextIO.inputLine ins of
			NONE => ()
		      | SOME s => (TextIO.output (outf, s); loop ())
	    in
		loop ();
		ignore (Unix.reap proc)
	    end

	fun header (outf, title) =
	    procOutput (outf, ("/usr/local/bin/hcoop_header", [title]))

	fun footer outf =
	    procOutput (outf, ("/usr/local/bin/hcoop_footer", []))

	fun genMemberList () =
	    let
		val outf = TextIO.openOut (outputDir ^ "members.html")

		fun printOne ([name, rname, usr], (total, anon)) =
		    let
			val name = C.stringFromSql name
			val rname = C.stringFromSql rname
			val isAnon = C.isNull usr
		    in
			if not isAnon then
			    (TextIO.output (outf, "<tr> <td><a href=\"member/");
			     TextIO.output (outf, name);
			     TextIO.output (outf, ".html\">");
			     TextIO.output (outf, name);
			     TextIO.output (outf, "</a></td> <td>");
			     TextIO.output (outf, rname);
			     TextIO.output (outf, "</td> </tr>\n"))
			else
			    ();
			(total + 1, (if C.isNull usr then anon + 1 else anon))
		    end
		  | printOne _ = raise Fail "Bad printOne line"

		val _ = header (outf, "HCoop Member List")
		val _ = TextIO.output (outf, "<table>\n")
		val (total, anon) = C.fold db printOne (0, 0)
					   "SELECT name, rname, usr FROM WebUserPaying LEFT OUTER JOIN DirectoryPref ON id = usr ORDER BY name"
	    in
		TextIO.output (outf, "</table><br><br>\n\nUnlisted members: ");
		TextIO.output (outf, Int.toString anon);
		TextIO.output (outf, " out of ");
		TextIO.output (outf, Int.toString total);
		TextIO.output (outf, " total.\n");
		footer outf;
		TextIO.closeOut outf
	    end

	fun genMemberPages () =
	    let
		fun doOne [id, name, rname, joined, usr] =
		    let
			val id = C.intFromSql id
			val name = C.stringFromSql name
			val rname = C.stringFromSql rname
			val joined = C.timestampFromSql joined
			val anon = C.isNull usr
		    in
			if anon then
			    ()
			else
			    let
				val outf = TextIO.openOut (String.concat [outputDir, "member/", name, ".html"])

				val _ = header (outf, "HCoop member: " ^ name)
				val _ = TextIO.output (outf, "<table>\n<tr> <td align=\"right\"><b>Member</b>:</td> <td>")
				val _ = TextIO.output (outf, name)
				val _ = TextIO.output (outf, "</td> </tr>\n<tr> <td align=\"right\"><b>Name</b>:</td> <td>")
				val _ = TextIO.output (outf, rname)
				val _ = TextIO.output (outf, "</td> </tr>\n<tr> <td align=\"right\"><b>Joined</b>:</td> <td>")
				val _ = TextIO.output (outf, Date.toString (Date.fromTimeLocal joined))

				fun doLocation [id] = C.intFromSql id
				  | doLocation _ = raise Fail "Bad location row"

				val locations = C.map db doLocation (String.concat ["SELECT id FROM Location JOIN Lives ON loc = id AND usr = ",
										    Int.toString id])

				fun printLocation id =
				    let
					val (name, parent) =
					    case C.oneRow db ("SELECT name, parent FROM Location WHERE id = " ^ Int.toString id) of
						[name, parent] => (C.stringFromSql name, if C.isNull parent then NONE else SOME (C.intFromSql parent))
					      | _ => raise Fail "Bad printLocation row"
				    in
					case parent of
					    NONE => ()
					  | SOME parent => (printLocation parent;
						     TextIO.output (outf, " : "));
					TextIO.output (outf, name)
				    end

				val first = ref true

				fun appLocation id = 
				    (if !first then
					 first := false
				     else
					 TextIO.output (outf, ", ");
				     printLocation id)

				val _ = case locations of
					    [] => ()
					  | _ =>
					    (TextIO.output (outf, "<tr> </tr>\n\n<tr> <td align=\"right\"><b>Locations</b>:</td> <td>");
					     app appLocation locations;
					     TextIO.output (outf, "</td> </tr>\n"))

				fun doLink [url, title, descr] = (C.stringFromSql url, C.stringFromSql title, C.stringFromSql descr)
				  | doLink _ = raise Fail "Bad link row"

				val links = C.map db doLink (String.concat ["SELECT url, title, descr FROM Link WHERE usr = ",
									    Int.toString id,
									    " ORDER BY title"])

				fun appLink (url, title, descr) = 
				    (TextIO.output (outf, "<tr> <td></td> <td><b><a href=\"");
				     TextIO.output (outf, Web.html url);
				     TextIO.output (outf, "\">");
				     TextIO.output (outf, Web.html title);
				     TextIO.output (outf, "</a></b>");
				     if descr <> "" then
					 TextIO.output (outf, ": ")
				     else
					 ();
				     TextIO.output (outf, Web.html descr);
				     TextIO.output (outf, "</td> </tr>\n"))

				val _ = case links of
					    [] => ()
					  | _ =>
					    (TextIO.output (outf, "<tr> </tr>\n\n<tr> <td><b>Hosted sites</b></td> </tr>\n");
					     app appLink links)

				fun doContact [v, name, url, urlPrefix, urlPostfix] =
				    (C.stringFromSql v, C.stringFromSql name,
				     if C.boolFromSql url then SOME (C.stringFromSql urlPrefix, C.stringFromSql urlPostfix) else NONE)
				  | doContact _ = raise Fail "Bad contact row"

				val contacts = C.map db doContact (String.concat ["SELECT v, name, url, urlPrefix, urlPostfix",
										  "   FROM Contact JOIN ContactKind ON knd = ContactKind.id",
										  "   WHERE priv = 0",
										  "      AND usr = ",
										  Int.toString id,
										  "   ORDER BY name, v"])

				fun appContact (v, name, url) =
				    let
					val link =
					    case url of
						SOME (pre, post) => String.concat ["<a href=\"", pre, Web.html v, post, "\">", Web.html v, "</a>"]
					      | NONE => v
				    in
					TextIO.output (outf, "<tr> <td align=\"right\" valign=\"top\"><b>");
					TextIO.output (outf, Web.html name);
					TextIO.output (outf, "</b>:</td>\n<td>");
					TextIO.output (outf, link);
					TextIO.output (outf, "</td> </tr>\n")
				    end

				val _ = case contacts of
					    [] => ()
					  | _ =>
					    (TextIO.output (outf, "<tr> </tr>\n\n<tr> <td><b>Contact information</b></td> </tr>\n");
					     app appContact contacts)
			    in
				TextIO.output (outf, "</table>\n");
				footer outf;
				TextIO.closeOut outf
			    end
		    end
		  | doOne _ = raise Fail "Bad member row"
	    in
		ignore (OS.Process.system ("/bin/rm " ^ outputDir ^ "member/*.html"));
		C.app db doOne "SELECT id, name, rname, joined, usr FROM WebUserPaying LEFT OUTER JOIN DirectoryPref ON usr = id"
	    end

	fun genLocations () =
	    let
		val outf = TextIO.openOut (outputDir ^ "locs.html")

		val _ = header (outf, "HCoop: Where members live")

		fun countResidents () =
		    let
			fun mkLivesRow [loc, usr] =
			    {loc = C.intFromSql loc, usr = C.intFromSql usr}
			  | mkLivesRow row = raise Fail "Bad lives row"

			fun folder (row, count) =
			    let
				fun addToParents (id, count) =
				    let
					val count = NM.insert (count, id, (case NM.find (count, id) of
									       NONE => 1
									     | SOME n => n+1))
				    in
					case C.oneRow db ("SELECT parent FROM Location WHERE id = " ^ C.intToSql id) of
					    [p] => if C.isNull p then
						       count
						   else
						       addToParents (C.intFromSql p, count)
					  | r => raise Fail "Bad addToParents row"
				    end

				val lives = mkLivesRow row
			    in
				addToParents (#loc lives, count)
			    end
		    in
			C.fold db folder NM.empty "SELECT loc, usr FROM Lives JOIN WebUserActive ON id = usr"
		    end

		val res = countResidents ()

		fun locationTree root =
		    let
			fun doOne [id, name] =
			    let
				val id = C.intFromSql id
				val name = C.stringFromSql name
			    in
				case NM.find (res, id) of
				    NONE => ()
				  | SOME n =>
				    (TextIO.output (outf, "<li> ");
				     TextIO.output (outf, Web.html name);
				     TextIO.output (outf, " (");
				     TextIO.output (outf, Int.toString n);
				     TextIO.output (outf, ")");
				     TextIO.output (outf, "</li>\n<ul>\n");
				     locationTree (SOME id);
				     TextIO.output (outf, "</ul>\n"))
			    end
			  | doOne _ = raise Fail "Bad locationTree row"
		    in
			C.app db doOne (String.concat ["SELECT id, name FROM Location WHERE parent ",
						       (case root of NONE => "IS NULL" | SOME p => "= " ^ Int.toString p),
						       " ORDER BY name"])
		    end
	    in
		locationTree NONE;
		footer outf;
		TextIO.closeOut outf
	    end

	fun genLinks () =
	    let
		val outf = TextIO.openOut (outputDir ^ "sites.html")

		val _ = header (outf, "HCoop: Hosted sites")

		fun doLink [url, title, descr, name] = (C.stringFromSql url, C.stringFromSql title, C.stringFromSql descr, C.stringFromSql name)
		  | doLink _ = raise Fail "Bad link' row"

		val links = C.map db doLink (String.concat ["SELECT url, title, descr, name FROM Link",
							    " JOIN WebUserPaying ON WebUserPaying.id = usr",
							    " JOIN DirectoryPref ON WebUserPaying.id = DirectoryPref.usr",
							    " ORDER BY title"])

		fun appLink (url, title, descr, name) = 
		    (TextIO.output (outf, "<tr> <td><b><a href=\"");
		     TextIO.output (outf, Web.html url);
		     TextIO.output (outf, "\">");
		     TextIO.output (outf, Web.html title);
		     TextIO.output (outf, "</a></b></td> <td>");
		     TextIO.output (outf, Web.html descr);
		     TextIO.output (outf, "</td> <td><a href=\"member/");
		     TextIO.output (outf, name);
		     TextIO.output (outf, ".html\">");
		     TextIO.output (outf, name);
		     TextIO.output (outf, "</a></td> </tr>\n"))
	    in
		TextIO.output (outf, "<table>\n");
		app appLink links;
		footer outf;
		TextIO.closeOut outf
	    end
    in
	genMemberList ();
	genMemberPages ();
	genLocations ();
	genLinks ();
	OS.Process.success
    end

fun main _ = (generate ())
    handle
    C.Sql s => (print "SQL exception: \n";
		print s;
		print "\n";
		OS.Process.failure)
  | Fail s => (print "Fail: ";
	       print s;
	       print "\n";
	       OS.Process.failure)
  | IO.Io {name, function, ...} => (print "IO exception ";
				    print function;
				    print ": ";
				    print name;
				    print "\n";
				    OS.Process.failure)
  | ex => (print "Exception!\n";
		  List.app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex);
		  OS.Process.failure)

end