aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2010-01-02 13:31:59 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2010-01-02 13:31:59 -0500
commit547adaccb0b29cc02ff89013f84ae6446665144d (patch)
tree8003213999cf3e6ad98db16c29cd135654599d1a
parent869bd80eacff24151b92e496ee6b0cade56d9e59 (diff)
Proper 404 generation
-rw-r--r--include/urweb.h1
-rw-r--r--lib/ur/top.ur18
-rw-r--r--lib/ur/top.urs10
-rw-r--r--src/c/urweb.c4
-rw-r--r--src/cjr_print.sml6
5 files changed, 37 insertions, 2 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 46ef9558..51f1407d 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -188,6 +188,7 @@ uw_Basis_time uw_Basis_unsqlTime(uw_context, uw_Basis_string);
uw_Basis_string uw_Basis_requestHeader(uw_context, uw_Basis_string);
void uw_write_header(uw_context, uw_Basis_string);
+void uw_clear_headers(uw_context);
uw_Basis_string uw_Basis_get_cookie(uw_context, uw_Basis_string c);
uw_unit uw_Basis_set_cookie(uw_context, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v, uw_Basis_time *expires, uw_Basis_bool secure);
diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index b6f6349a..613f5ec5 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -246,6 +246,24 @@ fun queryX' [tables ::: {{Type}}] [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {T
return <xml>{acc}{r}</xml>)
<xml/>
+fun queryX1' [nm ::: Name] [fs ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+ (q : sql_query [nm = fs] [])
+ (f : $fs -> transaction (xml ctx inp [])) =
+ query q
+ (fn fs acc =>
+ r <- f fs.nm;
+ return <xml>{acc}{r}</xml>)
+ <xml/>
+
+fun queryXE' [exps ::: {Type}] [ctx ::: {Unit}] [inp ::: {Type}]
+ (q : sql_query [] exps)
+ (f : $exps -> transaction (xml ctx inp [])) =
+ query q
+ (fn fs acc =>
+ r <- f fs;
+ return <xml>{acc}{r}</xml>)
+ <xml/>
+
fun hasRows [tables ::: {{Type}}] [exps ::: {Type}]
[tables ~ exps]
(q : sql_query tables exps) =
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index d23b3e01..743669ce 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -148,7 +148,15 @@ val queryX' : tables ::: {{Type}} -> exps ::: {Type} -> ctx ::: {Unit} -> inp ::
-> ($(exps ++ map (fn fields :: {Type} => $fields) tables)
-> transaction (xml ctx inp []))
-> transaction (xml ctx inp [])
-
+val queryX1' : nm ::: Name -> fs ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+ -> sql_query [nm = fs] []
+ -> ($fs -> transaction (xml ctx inp []))
+ -> transaction (xml ctx inp [])
+val queryXE' : exps ::: {Type} -> ctx ::: {Unit} -> inp ::: {Type}
+ -> sql_query [] exps
+ -> ($exps -> transaction (xml ctx inp []))
+ -> transaction (xml ctx inp [])
+
val hasRows : tables ::: {{Type}} -> exps ::: {Type}
-> [tables ~ exps] =>
sql_query tables exps
diff --git a/src/c/urweb.c b/src/c/urweb.c
index e7495347..1bfb3cd5 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1174,6 +1174,10 @@ void uw_write_header(uw_context ctx, uw_Basis_string s) {
ctx->outHeaders.front += len;
}
+void uw_clear_headers(uw_context ctx) {
+ buf_reset(&ctx->outHeaders);
+}
+
static void uw_check_script(uw_context ctx, size_t extra) {
buf_check(&ctx->script, extra);
}
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 93f50de2..2cfd0663 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -2833,7 +2833,11 @@ fun p_file env (ds, ps) =
newline,
p_list_sep newline (fn x => x) pds',
newline,
- string "uw_error(ctx, FATAL, \"Unknown page\");",
+ string "uw_clear_headers(ctx);",
+ newline,
+ string "uw_write_header(ctx, \"HTTP/1.1 404 Not Found\\r\\nContent-type: text/plain\\r\\n\");",
+ newline,
+ string "uw_write(ctx, \"Not Found\");",
newline,
string "}",
newline,