Add before, after, and exn config directives

[bpt/mlt.git] / src / lib / web.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
 *)

(* CGI interaction *)

structure Web :> WEB =
struct
    fun for f (r1, r2) =
	if r1 < r2 then
	    let
		fun loop i =
		    if i > r2 then
			()
		    else
			(f i;
			 loop (i+1))
	    in
		loop r1
	    end
	else
	    let
		fun loop i =
		    if i < r2 then
			()
		    else
			(f i;
			 loop (i-1))
	    in
		loop r1
	    end

    val params : string list StringMap.map ref = ref StringMap.empty

    val paramStack : string list StringMap.map list ref = ref []

    fun setParam (n, v) = params := StringMap.insert (!params, n, v)
    fun setSingleParam (n, v) = setParam (n, [v])

    fun getParam v =
	(case StringMap.find (!params, v) of
	     NONE => ""
	   | SOME [] => ""
	   | SOME (s::_) => s)

    fun getMultiParam v =
	(case StringMap.find (!params, v) of
	     NONE => []
	   | SOME l => l)

    fun pushParams nvs =
	(paramStack := (!params) :: (!paramStack);
	 app setParam nvs)

    fun popParams () =
	(case !paramStack of
	     [] => raise Fail "Empty params stack in popParams"
	   | h::t => (params := h;
		      paramStack := t))

    fun withParams f nvs =
	(pushParams nvs;
	 ((f ()) handle ex => (popParams (); raise ex))
	 before popParams ())

    val text = ref ([] : string list)

    fun print x = text := x :: (!text)
    fun clear () = text := []
    fun noOutput () = !text = []
    fun output () =
	(TextIO.print "Status: 200\nContent-type: text/html\n\n";
	 TextIO.print (String.concat (List.rev (!text))))

    val getCgi = OS.Process.getEnv

    fun html s =
	let
	    fun xch #"<" = "&lt;"
	      | xch #">" = "&gt;"
	      | xch #"&" = "&amp;"
	      | xch #"\"" = "&quot;"
	      | xch ch = str ch
	in
	    foldr op^ "" (map xch (String.explode s))
	end

    fun htmlNl s =
	let
	    fun xch #"<" = "&lt;"
	      | xch #">" = "&gt;"
	      | xch #"&" = "&amp;"
	      | xch #"\"" = "&quot;"
	      | xch #"\n" = "<br />"
	      | xch ch = str ch
	in
	    foldr op^ "" (map xch (String.explode s))
	end

    exception Format of string

    fun stoiOpt s = Int.fromString s
    fun stoi s =
	(case Int.fromString s of
	     NONE => raise Format s
	   | SOME i => i)

    fun storOpt s = Real.fromString s
    fun stor s =
	(case Real.fromString s of
	     NONE => raise Format s
	   | SOME r => r)

    fun summary () =
	StringMap.foldli (fn (n, vs, s) => foldl (fn (v, s) => s ^ " VALUE: " ^ v) (s ^ " NAME: " ^ n) vs)
	"" (!params)

    val exn = ref (NONE : exn option)
    fun setExn ex = exn := SOME ex
    fun getExn () = valOf (!exn)
end