Mercurial > urweb
changeset 727:ba4c230b7231
Show XML
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 16 Apr 2009 12:43:55 -0400 |
| parents | 6fc633d990e7 |
| children | 2197f0e24a9f |
| files | lib/ur/basis.urs src/monoize.sml tests/jserror.ur |
| diffstat | 3 files changed, 9 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/basis.urs Thu Apr 16 12:36:01 2009 -0400 +++ b/lib/ur/basis.urs Thu Apr 16 12:43:55 2009 -0400 @@ -554,3 +554,5 @@ val onError : (xbody -> transaction unit) -> transaction unit (* Client-side only *) + +val show_xml : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> show (xml ctx use bind)
--- a/src/monoize.sml Thu Apr 16 12:36:01 2009 -0400 +++ b/src/monoize.sml Thu Apr 16 12:43:55 2009 -0400 @@ -900,6 +900,12 @@ ((L'.EFfi ("Basis", "boolToString"), loc), fm) | L.EFfi ("Basis", "show_time") => ((L'.EFfi ("Basis", "timeToString"), loc), fm) + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "show_xml"), _), _),_), _), _), _) => + let + val s = (L'.TFfi ("Basis", "string"), loc) + in + ((L'.EAbs ("s", s, s, (L'.ERel 0, loc)), loc), fm) + end | L.ECApp ((L.EFfi ("Basis", "mkShow"), _), t) => let val t = monoType env t
--- a/tests/jserror.ur Thu Apr 16 12:36:01 2009 -0400 +++ b/tests/jserror.ur Thu Apr 16 12:43:55 2009 -0400 @@ -1,3 +1,3 @@ fun main () : transaction page = return <xml> - <body onload={onError (fn s => alert "There was an error."); error <xml>Badder</xml>}/> + <body onload={onError (fn s => alert ("There was an error: " ^ show s)); error <xml>Badder</xml>}/> </xml>