(* Msp.sml -- prelude for ML Server Pages
sestoft@dina.kvl.dk 2000-11-06 version 0.8
*)
(* Efficiently concatenable word sequences *)
datatype wseq =
Empty (* The empty sequence *)
| Nl (* Newline *)
| $ of string (* A string *)
| $$ of string list (* A sequence of strings *)
| && of wseq * wseq; (* Concatenation of sequences *)
infix &&
fun prmap f [] = Empty
| prmap f (x1::xr) =
let fun loop y1 [] = f y1
| loop y1 (y2::yr) = f y1 && loop y2 yr
in loop x1 xr end
fun prsep sep f [] = Empty
| prsep sep f (x1::xr) =
let fun loop y1 [] = f y1
| loop y1 (y2::yr) = f y1 && sep && loop y2 yr
in loop x1 xr end
fun flatten Empty acc = acc
| flatten Nl acc = "\n" :: acc
| flatten ($ s) acc = s :: acc
| flatten ($$ ss) acc = List.@(ss, acc)
| flatten (s1 && s2) acc = flatten s1 (flatten s2 acc)
val flatten = fn seq => String.concat(flatten seq []);
fun printseq Empty = ()
| printseq Nl = TextIO.print "\n"
| printseq ($ s) = TextIO.print s
| printseq ($$ ss) = List.app TextIO.print ss
| printseq (s1 && s2) = (printseq s1; printseq s2);
fun vec2list vec = Vector.foldr op:: [] vec
(* CGI parameter access shorthands *)
exception ParamMissing of string
exception NotInt of string * string
fun % fnm =
case Mosmlcgi.cgi_field_string fnm of
NONE => raise ParamMissing "fnm"
| SOME v => v
fun %? fnm = Option.isSome(Mosmlcgi.cgi_field_string fnm)
fun %# fnm =
case Mosmlcgi.cgi_field_string fnm of
NONE => raise ParamMissing fnm
| SOME v => (case Int.fromString v of
NONE => raise NotInt(fnm, v)
| SOME i => i)
fun %%(fnm, dflt) = Option.getOpt(Mosmlcgi.cgi_field_string fnm, dflt)
fun %%#(fnm, dflt) =
Option.getOpt(Option.mapPartial Int.fromString
(Mosmlcgi.cgi_field_string fnm), dflt)
(* HTML generic marks *)
fun mark0 tag = $$["<", tag, ">"]
fun mark0a attr tag = $$["<", tag, " ", attr, ">"]
fun mark1 tag seq = $$["<", tag, ">"] && seq && $$[""]
fun mark1a tag attr seq =
$$["<", tag, " ", attr, ">"] && seq && $$[""]
fun comment seq = $""
(* HTML documents and headers *)
fun html seq = $"" && seq && $""
fun head seq = $"" && seq && $""
fun title seq = $"" && seq && $""
fun body seq = $"" && seq && $""
fun bodya attr seq = $$[""] && seq && $""
fun htmldoc tit bod = html (head (title tit) && body bod)
(* HTML headings and vertical format *)
fun h1 seq = $"
" && seq && $"
"
fun h2 seq = $"
" && seq && $"
"
fun h3 seq = $"
" && seq && $"
"
fun h4 seq = $"
" && seq && $"
"
fun h5 seq = $"
" && seq && $"
"
fun h6 seq = $"
" && seq && $"
"
fun p seq = $"
" && seq && $"
"
fun pa attr seq = $$["
"] && seq && $"
"
fun divi seq = $"
" && seq && $"
"
fun divia attr seq = $$["
"] && seq && $"
"
fun blockquote seq = $"
" && seq && $"
"
fun blockquotea attr seq =
$$["
"] && seq && $"
"
fun center seq = $"
" && seq && $"
"
fun address seq = $"" && seq && $""
fun pre seq = $"
" && seq && $"
"
val br = $" "
fun bra attr = $$[" "]
val hr = $""
fun hra attr = $$[""]
(* HTML anchors and hyperlinks *)
fun ahref link seq = $$[""] && seq && $""
fun ahrefa link attr seq =
$$[""] && seq && $""
fun aname name seq = $$[""] && seq && $""
(* HTML text formats and style *)
fun em seq = $"" && seq && $""
fun strong seq = $"" && seq && $""
fun tt seq = $"" && seq && $""
fun sub seq = $"" && seq && $""
fun sup seq = $"" && seq && $""
fun fonta attr seq = $$[""] && seq && $""
(* HTML lists *)
fun ul seq = $"
" && seq && $"
"
fun ula attr seq = $$["
"] && seq && $"
"
fun ol seq = $"" && seq && $""
fun ola attr seq = $$[""] && seq && $""
fun li seq = $"
" && seq && $"
"
fun dl seq = $"
" && seq && $"
"
fun dla attr seq = $$["
"] && seq && $"
"
fun dt seq = $"
" && seq && $"
"
fun dd seq = $"
" && seq && $"
"
(* HTML tables *)
fun tr seq = $"
" && seq && $"
"
fun tra attr seq = $$["
"] && seq && $"
"
fun td seq = $"
" && seq && $"
"
fun tda attr seq = $$["
"] && seq && $"
"
fun th seq = $"
" && seq && $"
"
fun tha attr seq = $$["
"] && seq && $"
"
fun table seq = $"
" && seq && $"
"
fun tablea attr seq = $$["
"] && seq && $"
"
fun caption seq = $"
" && seq && $"
"
fun captiona attr seq = $$["
"] && seq && $"
"
(* HTML images and image maps *)
fun img src = $$[""]
fun imga src attr = $$[""]
fun map nam seq = $$[""
fun mapa nam attr seq =
$$[""
fun area { shape, href, coords, alt } =
$$[" $"NOHREF" | SOME r => $$["HREF=\"", r, "\" "])
&& (case alt of NONE => Empty | SOME a => $$["ALT=\"", a, "\""])
(* HTML forms etc *)
fun form action seq = $$[""
fun forma action attr seq =
$$[""
fun input typ = $$[""]
fun inputa typ attr = $$[""]
fun intext name attr = $$[""]
fun inpassword name attr =
$$[""]
fun incheckbox {name, value} attr =
$$[""]
fun inradio {name, value} attr =
$$[""]
fun inreset value attr =
$$[""]
fun insubmit value attr =
$$[""]
fun inhidden {name, value} =
$$[""]
fun textarea name seq =
$$[""
fun textareaa name attr seq =
$$[""
fun select name attr seq =
$$[""
fun option value = $$["