summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--demo/prose6
-rw-r--r--demo/upload.ur11
-rw-r--r--demo/upload.urp5
-rw-r--r--demo/upload.urs1
-rw-r--r--src/demo.sml26
5 files changed, 39 insertions, 10 deletions
diff --git a/demo/prose b/demo/prose
index 4eb5fe93..2d4f5ea3 100644
--- a/demo/prose
+++ b/demo/prose
@@ -74,6 +74,12 @@ css.urp
<p>Ur/Web supports a structured approach to Cascading Style Sheets, where each style is a first-class value within a module. This demo shows the importing of an external style sheet with one style. By default, like other Ur/Web entities, the name of the style would be <tt>Css_quote</tt>. We use the <tt>rewrite</tt> directive in the <tt>.urp</tt> file to specify an alternate name for a particular canonical module path. The external style sheet contains a definition of a style with the alternate name that we give.</p>
+upload.urp
+
+<p>HTTP file upload is made convenient, via the abstract types <tt>blob</tt> and <tt>file</tt> in the standard library. A <tt>blob</tt> is a binary sequence, and a <tt>file</tt> combines a <tt>blob</tt> with MIME type information. An <tt>upload</tt> form input can be used to accept <tt>file</tt>s from the user.</p>
+
+<p>In the <tt>.urp</tt> file for this example, we give a whitelist of MIME types to be accepted. The application will echo back to the user any file he uploads as one of those types. You can try submitting other kinds of files to verify that they are rejected.</p>
+
listShop.urp
<p>This example shows off algebraic datatypes, parametric polymorphism, and functors.</p>
diff --git a/demo/upload.ur b/demo/upload.ur
new file mode 100644
index 00000000..505a1ae4
--- /dev/null
+++ b/demo/upload.ur
@@ -0,0 +1,11 @@
+fun echo r =
+ if blobSize (fileData r.File) > 100000 then
+ return <xml>Whoa! That one's too big.</xml>
+ else
+ returnBlob (fileData r.File) (blessMime (fileMimeType r.File))
+
+fun main () = return <xml><body>
+ <h1>The Amazing File Echoer!</h1>
+
+ <form>Upload a file: <upload{#File}/> <submit action={echo}/></form>
+</body></xml>
diff --git a/demo/upload.urp b/demo/upload.urp
new file mode 100644
index 00000000..60519aaa
--- /dev/null
+++ b/demo/upload.urp
@@ -0,0 +1,5 @@
+allow mime text/plain
+allow mime image/png
+allow mime image/gif
+
+upload
diff --git a/demo/upload.urs b/demo/upload.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/demo/upload.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/src/demo.sml b/src/demo.sml
index fb4158a4..a2312d98 100644
--- a/src/demo.sml
+++ b/src/demo.sml
@@ -363,6 +363,20 @@ fun make {prefix, dirname, guided} =
val fname = OS.Path.joinDirFile {dir = dirname,
file = "demo.urp"}
val outf = TextIO.openOut fname
+
+ fun filters kind =
+ app (fn rule : Settings.rule =>
+ (TextIO.output (outf, case #action rule of
+ Settings.Allow => "allow"
+ | Settings.Deny => "deny");
+ TextIO.output (outf, " ");
+ TextIO.output (outf, kind);
+ TextIO.output (outf, " ");
+ TextIO.output (outf, #pattern rule);
+ case #kind rule of
+ Settings.Exact => ()
+ | Settings.Prefix => TextIO.output (outf, "*");
+ TextIO.output (outf, "\n")))
in
Option.app (fn db => (TextIO.output (outf, "database ");
TextIO.output (outf, db);
@@ -391,16 +405,8 @@ fun make {prefix, dirname, guided} =
TextIO.output (outf, " ");
TextIO.output (outf, #to rule);
TextIO.output (outf, "\n"))) (#rewrites combined);
- app (fn rule =>
- (TextIO.output (outf, case #action rule of
- Settings.Allow => "allow"
- | Settings.Deny => "deny");
- TextIO.output (outf, " url ");
- TextIO.output (outf, #pattern rule);
- case #kind rule of
- Settings.Exact => ()
- | Settings.Prefix => TextIO.output (outf, "*");
- TextIO.output (outf, "\n"))) (#filterUrl combined);
+ filters "url" (#filterUrl combined);
+ filters "mime" (#filterMime combined);
TextIO.output (outf, "\n");
app (fn s =>