Build the purescript bundle:
spago init
spago install aff console effect web-file web-xhr
spago build && spago bundle-module -m Upload -t index.cjs && browserify index.cjs -s Upload -o index.js
Spin up a dumb server to accept the POST request
go run main.go &
Then point your browser at ./index.html.
You might want to throttle your network connection to see it "progressing".
| <!doctype html> | |
| <html lang="en"> | |
| <head> | |
| <meta charset="utf-8"> | |
| </head> | |
| <body> | |
| <input id="uploader" type="file"> | |
| <script src="./index.js"></script> | |
| <script> | |
| document.addEventListener("DOMContentLoaded", function(_event) { | |
| document.getElementById("uploader").addEventListener("change", function(_event) { | |
| Upload.demo(this.files); | |
| }); | |
| }); | |
| </script> | |
| </body> | |
| </html> |
| package main | |
| import ( | |
| "fmt" | |
| "io/ioutil" | |
| "log" | |
| "net/http" | |
| ) | |
| func main() { | |
| http.HandleFunc("/", func(w http.ResponseWriter, r *http.Request) { | |
| w.Header().Set("Access-Control-Allow-Origin", "*") | |
| defer r.Body.Close() | |
| fmt.Println(ioutil.ReadAll(r.Body)) | |
| }) | |
| log.Fatal(http.ListenAndServe(":8000", nil)) | |
| } |
| module Upload where | |
| import Prelude | |
| import Data.Array as Array | |
| import Data.Either (Either(..)) | |
| import Data.HTTP.Method as HTTP | |
| import Data.Maybe (Maybe(..)) | |
| import Data.Traversable (traverse_) | |
| import Effect (Effect) | |
| import Effect.Aff (Aff, launchAff_) | |
| import Effect.Aff as Aff | |
| import Effect.Class (liftEffect) | |
| import Effect.Console as Console | |
| import Effect.Exception as Exception | |
| import Effect.Uncurried as EFn | |
| import Web.Event.Event as Event | |
| import Web.Event.EventTarget as EventTarget | |
| import Web.File.File (File) | |
| import Web.File.File as File | |
| import Web.File.FileList (FileList) | |
| import Web.File.FileList as FileList | |
| import Web.XHR.FormData (FormData) | |
| import Web.XHR.FormData as FormData | |
| import Web.XHR.ProgressEvent (ProgressEvent) | |
| import Web.XHR.ProgressEvent as ProgressEvent | |
| import Web.XHR.ResponseType as ResponseType | |
| import Web.XHR.XMLHttpRequest as XMLHttpRequest | |
| import Web.XHR.XMLHttpRequestUpload as XMLHttpRequestUpload | |
| type Request = | |
| { url :: String | |
| , method :: HTTP.Method | |
| , body :: FormData | |
| } | |
| type Response a = | |
| { status :: Int | |
| , statusText :: String | |
| , response :: Maybe a | |
| } | |
| upload :: Request -> (ProgressEvent -> Effect Unit) -> Aff (Response String) | |
| upload request handleProgress = | |
| Aff.makeAff \callback -> do | |
| xhr <- XMLHttpRequest.xmlHttpRequest ResponseType.string | |
| XMLHttpRequest.open (Left request.method) request.url xhr | |
| loadListener <- | |
| EventTarget.eventListener \_ -> do | |
| response <- | |
| { status:_, statusText:_, response:_ } | |
| <$> XMLHttpRequest.status xhr | |
| <*> XMLHttpRequest.statusText xhr | |
| <*> XMLHttpRequest.response xhr | |
| callback (Right response) | |
| EventTarget.addEventListener | |
| (Event.EventType "load") loadListener false (XMLHttpRequest.toEventTarget xhr) | |
| errorListener <- | |
| EventTarget.eventListener \_ -> | |
| callback $ Left (Exception.error "oh no") | |
| EventTarget.addEventListener | |
| (Event.EventType "error") errorListener false (XMLHttpRequest.toEventTarget xhr) | |
| xhrUpload <- XMLHttpRequest.upload xhr | |
| progressListener <- | |
| EventTarget.eventListener \event -> | |
| traverse_ handleProgress (ProgressEvent.fromEvent event) | |
| EventTarget.addEventListener | |
| (Event.EventType "progress") progressListener false (XMLHttpRequestUpload.toEventTarget xhrUpload) | |
| XMLHttpRequest.sendFormData request.body xhr | |
| pure $ Aff.Canceler \_error -> liftEffect (XMLHttpRequest.abort xhr) | |
| -- | Demo usage, called from js. | |
| -- | | |
| -- | You'll probably want to throttle your network connection to actually see | |
| -- | it working. | |
| demo :: EFn.EffectFn1 FileList Unit | |
| demo = EFn.mkEffectFn1 \fileList -> do | |
| formData <- FormData.new | |
| traverse_ (\file -> appendFile file formData) (fileListToArray fileList) | |
| let request = { url: "http://localhost:8000/", method: HTTP.POST, body: formData } | |
| launchAff_ $ | |
| upload request \pe -> | |
| Console.logShow $ (ProgressEvent.loaded pe / ProgressEvent.total pe) * 100.0 | |
| where | |
| fileListToArray :: FileList -> Array File | |
| fileListToArray fileList = | |
| Array.mapMaybe (\i -> FileList.item i fileList) $ | |
| Array.range 0 (max 0 (FileList.length fileList - 1)) | |
| appendFile :: File -> FormData -> Effect Unit | |
| appendFile file = | |
| FormData.appendBlob | |
| (FormData.EntryName "whatever") | |
| (File.toBlob file) | |
| (Just <<< FormData.FileName $ File.name file) |