[enhance] Upload: Simplified API of the upload widget.

Most of the functionality that needed to be provided by the
application now is in stdlib (based on implementation on
opalang.org).

stdlib/upload/upload.opa

@@ -20,7 +20,7 @@ package stdlib.upload
 
 /**
  * @author Quentin Bourgerie
- * @author Adam Koprowski
+ * @author Adam Koprowski (re-packaging, docs, re-implementation)
  *
  *
  * {1 About this module}
@@ -29,128 +29,136 @@ package stdlib.upload
  * a file upload field.
 **/
 
-
 /**
- * Represents an uploaded file.
+ * Representation of an uploaded file.
  */
 type Upload.file = {
-  /** Name of input corresponding to the uploaded file. */
-  name : string;
+
+  /** Name of the input field corresponding to the uploaded file. */
+  field_name : string;
 
   /** Name of the uploaded file. */
   filename : string;
 
-  /** Content of the file. */
-  content : -> {partial:int}/{content:binary};
-
-  /** A function that allows to fold on headers. */
-  fold_headers : (forall('a). 'a, (string, string, 'a -> 'a) -> 'a)
-}
+  /** The mimetype of the file */
+  mimetype : string
 
-/**
- * Represents other (no file) fields of form.
- */
-type Upload.field = {
-  /** Name of field */
-  name : string;
-
-  /** Value of field */
-  value : string;
+  /** Content of the file. */
+  content : binary
 }
 
 /**
- * An uploaded data can be a file or a field.
- */
-type Upload.data = Upload.file / Upload.field
-
-/**
- * Configuration for create an uploader.
+ * Configuration of the file uploader.
  */
 type Upload.config('result) = {
-  /** Parameters for the dynamic url was created by the upload
-      manager. */
+
+  /** Parameters for the dynamic url to be created by the upload manager. */
   url_parameters : DynamicResource.parameters
 
-  /** The xhtml inserted on upload form. Beware if you set this config
-      fields take care to add a submit button. */
+  /** The content of the form.
+    * It can contain many fields, among which there should be one field
+    * for file upload:
+    * {[
+    * <input type="file" id="..." name="..." />
+    * ]}
+    */
   body_form : xhtml
 
-  /** Initial result value. */
-  init_result : 'result
-
-  /** A function that fold on datas by incomming order. */
-  fold_datas : Upload.data, 'result -> 'result
-
-  /** Perform result of datas folding. */
-  perform_result : 'result -> void
+  /** A function that will be invoked upon uploading the file */
+  process : Upload.file -> void
 }
 
 /**
  * This module provides one main [make] function which create an xhtml
  * that allows to upload file(s) from client to server.
  */
 Upload = {{
+
   /**
-   * The default configuration :
-   * - url_parameters : [{expiration={none} consumption={unlimited}
-         visibility={current_context}}]
-   * - fold_datas : return previous result, do nothing with data.
-   * - perform_result : do nothing with data
-   * - body_form : An xhtml that contains [<input type="file"
-       name="filename"/><input type="submit" value="Upload"/>]. It
-       be able to upload one file.
+   * The default configuration of a file upload widget.
+   * It creates a form with only one file upload field and
+   * does nothing upon retrieving the file.
    */
-  default_config(init_result:'result):Upload.config('result) = {
-    url_parameters = {expiration={none} consumption={unlimited} visibility={current_context}}
-    body_form = <input type="file" name="filename"/><input type="submit" value="Upload"/>
-    ~init_result
-    fold_datas(_data, result) = result
-    perform_result(_result) = void
+  default_config : Upload.config = {
+    url_parameters = {
+      expiration={none}
+      consumption={unlimited}
+      visibility={current_context}
+    }
+    body_form =
+      <input type="file" name="filename"/>
+      <input type="submit" value="Upload"/>
+    process(_) = void
   }
 
+  /* Folding on the data of the multipart form data */
+  @private
+  multifold(config)(part, fh, _) =
+    match part with
+     // fileupload field -- process
+    | ~{filename name content} ->
+         /* A hack for forall, TODO make it proprely */
+         fold_headers = @unsafe_cast(fh)
+         find_mime(header, value, acc) =
+           match header with
+           | "Content_Type" -> value
+           | _ -> acc
+         mimetype = @unsafe_cast(fold_headers)("text/plain", find_mime)
+         field_name = name
+         full_content =
+           rec aux() =
+             match content() with
+             | {partial=_} ->
+                 do Scheduler.wait(500)
+                 aux()
+             | ~{content} -> content
+            aux()
+          file = ~{filename field_name mimetype content=full_content}
+          do Scheduler.push( -> config.process(file))
+          void
+     // "regular" field -- ignore
+    | {name=_ value=_} ->
+          void
+
   /**
-   * Create an upload manager.
-   * TODO : Add more documentation...(dynamic resource etc...)
+   * Creates a form with file upload capabilities.
+   *
+   * @param config Configuration of the file-upload widget.
    */
-  make(config:Upload.config) =
+  html(config : Upload.config) : xhtml =
     /* Save creation page context because iframe is another page. */
     reset_context =
-      match ThreadContext.get({current})
+      match ThreadContext.get({current}) with
       | {key=~{client} request=_ details=_} ->
-        key = ~{client}
-        ( -> { ThreadContext.get({current}) with ~key })
-      | _ -> ( -> ThreadContext.get({current}))
-    /* The dynamic resource use for reply to upload. */
+          key = ~{client}
+          ( -> { ThreadContext.get({current}) with ~key })
+      | _ ->
+          ( -> ThreadContext.get({current}))
+    /* The dynamic resource used for the upload. */
     dynamic(request) =
       @with_thread_context(reset_context(),
         match HttpRequest.Generic.get_multipart(request) with
         | {none} ->
-          Resource.error_page("Upload fail",
-            <h1>Unexpected load request</h1>, {forbidden})
+            Resource.error_page("Upload failed", <h1>Unexpected load request</h1>,
+              {forbidden})
         | {some = multipart} ->
-          result = HttpRequest.Generic.fold_multipart(multipart, config.init_result,
-               (part, fh, acc ->
-                 match part
-                 | ~{filename name content} ->
-                   /* An hack for forall, TODO make it proprely */
-                   fold_headers = @unsafe_cast(fh)
-                   file = ~{filename name content fold_headers}
-                   config.fold_datas(file, acc)
-                 | {name=_ value=_} as x->
-                   config.fold_datas(x, acc)
-               )
-             )
-          do Scheduler.push(-> config.perform_result(result))
-          Resource.source("Upload success", "text/plain")
+            do HttpRequest.Generic.fold_multipart(multipart, void, multifold(config))
+            Resource.source("Upload successful", "text/plain")
         )
     resource = Resource.dynamic(dynamic)
     upload_url = DynamicResource.publish(resource, config.url_parameters)
-    <iframe name="iframeId"
-            id="iframeId" src="#"
-            style="width:0;height:0;border:0px solid #fff;"/>
-    <form action="{upload_url}" id="upload_form" target="iframeId"
-          method="post" enctype="multipart/form-data">
-    {config.body_form}
-    </form>
+    frame_style = css {
+      width: 0px;
+      height: 0px;
+      display: none;
+      border: 0px solid white
+    }
+    <>
+      <iframe name="iframeId" id="iframeId" src="#" style={frame_style} />
+      <form action="{upload_url}" id="upload_form" target="iframeId"
+            method="post" enctype="multipart/form-data">
+        {config.body_form}
+      </form>
+    </>
 
 }}