src/lib/main.sml

(*
 * Dynamic web page generation with Standard ML
 * Copyright (C) 2003  Adam Chlipala
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public
 * License as published by the Free Software Foundation; either
 * version 2.1 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)

(* Main CGI program interface *)

functor MainFn (Templates : TEMPLATES) :> MAIN =
struct
    val templates = foldl StringMap.insert' StringMap.empty Templates.templates

    fun main (_, args) =
	let
	    val _ = Cgi.init ()
	    val cgiFields = Cgi.cgi_fieldnames ()
	    fun mapper name = (name, Cgi.cgi_field_strings name)
	in
	    Web.pushParams (map mapper cgiFields);
	    Templates.beforeFn ();
	    case args of
		[] => (print "Status: 500\nContent-type: text/html\n\n<html><head><title>500 error</title></head><body><h2>500 error</h2>No template was specified</body></html>\n";
		       OS.Process.failure)
	      | (name::_) =>
		(case StringMap.find (templates, name) of
		     NONE => (print "Status: 404\nContent-type: text/html\n\n<html><head><title>404 error</title></head><body><h2>404 error</h2>Template not found</body></html>\n";
			      OS.Process.failure)
		   | SOME f => (f ();
				Templates.afterFn ();
				Web.output ();
				OS.Process.success))
	end handle ex => (Web.setExn ex;
			  Web.clear ();
			  Templates.exnFn ();
			  if Web.noOutput () then
			      (print "Status: 500\nContent-type: text/plain\n\nAn exception!\n\n";
			       app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex))
			  else
			      Web.output ();
			  OS.Process.failure)
end
Commit	Line	Data
	1	(*
	2	* Dynamic web page generation with Standard ML
	3	* Copyright (C) 2003 Adam Chlipala
	4	*
	5	* This library is free software; you can redistribute it and/or
	6	* modify it under the terms of the GNU Lesser General Public
	7	* License as published by the Free Software Foundation; either
	8	* version 2.1 of the License, or (at your option) any later version.
	9	*
	10	* This library is distributed in the hope that it will be useful,
	11	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	13	* Lesser General Public License for more details.
	14	*
	15	* You should have received a copy of the GNU Lesser General Public
	16	* License along with this library; if not, write to the Free Software
	17	* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	18	*)
	19
	20	(* Main CGI program interface *)
	21
	22	functor MainFn (Templates : TEMPLATES) :> MAIN =
	23	struct
	24	val templates = foldl StringMap.insert' StringMap.empty Templates.templates
	25
	26	fun main (_, args) =
	27	let
	28	val _ = Cgi.init ()
	29	val cgiFields = Cgi.cgi_fieldnames ()
	30	fun mapper name = (name, Cgi.cgi_field_strings name)
	31	in
	32	Web.pushParams (map mapper cgiFields);
	33	Templates.beforeFn ();
	34	case args of
	35	[] => (print "Status: 500\nContent-type: text/html\n\n<html><head><title>500 error</title></head><body><h2>500 error</h2>No template was specified</body></html>\n";
	36	OS.Process.failure)
	37	\| (name::_) =>
	38	(case StringMap.find (templates, name) of
	39	NONE => (print "Status: 404\nContent-type: text/html\n\n<html><head><title>404 error</title></head><body><h2>404 error</h2>Template not found</body></html>\n";
	40	OS.Process.failure)
	41	\| SOME f => (f ();
	42	Templates.afterFn ();
	43	Web.output ();
	44	OS.Process.success))
	45	end handle ex => (Web.setExn ex;
	46	Web.clear ();
	47	Templates.exnFn ();
	48	if Web.noOutput () then
	49	(print "Status: 500\nContent-type: text/plain\n\nAn exception!\n\n";
	50	app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory ex))
	51	else
	52	Web.output ();
	53	OS.Process.failure)
	54	end