diff tests/dbupload.ur @ 1867:216a3a67ebe3

Tweak Sergey's patch to work with Postgres
author Adam Chlipala <adam@chlipala.net>
date Fri, 13 Sep 2013 10:24:10 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/dbupload.ur	Fri Sep 13 10:24:10 2013 -0400
@@ -0,0 +1,25 @@
+table t : { Id : int, Blob : blob, MimeType : string }
+sequence s
+
+fun getImage id : transaction page =
+    r <- oneRow1 (SELECT t.Blob, t.MimeType
+                  FROM t
+                  WHERE t.Id = {[id]});
+    returnBlob r.Blob (blessMime r.MimeType)
+
+fun main () : transaction page =
+    let
+        fun handle r =
+            id <- nextval s;
+            dml (INSERT INTO t (Id, Blob, MimeType)
+                 VALUES ({[id]}, {[fileData r.File]}, {[fileMimeType r.File]}));
+            main ()
+    in
+        x <- queryX1 (SELECT t.Id FROM t)
+                     (fn r => <xml><img src={url (getImage r.Id)}/><br/></xml>);
+        return <xml><body>
+          <form><upload{#File}/> <submit action={handle}/></form>
+          <hr/>
+          {x}
+        </body></xml>
+    end