Rum file uploader

uploader.cljs

(ns uploader
  (:require
    [clojure.string :as str]
    [goog.dom :as gdom]
    [goog.userAgent :as ua]
    [rum.core :as rum]))


(defonce supports-dragndrop?
  (let [el (js/document.createElement "div")]
    (or (exists? (.-draggable el))
        (and (exists? (.-ondragstart el))
             (exists? (.-ondrop el))))))


(defonce supports-formdata?
  (exists? (.-FormData js/window)))


(def supports-modern-uploader?
  (and supports-dragndrop?
       supports-formdata?))


(defn start-dragndrop! []
  (when supports-dragndrop?
    (let [*drag-status (atom nil)
        handler (fn [e]
                  (condp contains? (.-type e)
                    ;; ignore dragndrop events if they started inside the browser
                    #{"dragstart"
                      "drag"}     (reset! *drag-status :ignore)
                    
                    #{"dragend"}  (reset! *drag-status nil)
                    
                    #{"dragover"} (let [drag-status @*drag-status]
                                    (.preventDefault e)
                                    (.stopPropagation e)
                                    (when (not= :ignore drag-status)
                                      (js/setTimeout #(js/document.body.classList.add "dragover") 0)
                                      (js/clearTimeout drag-status)
                                      (reset! *drag-status
                                        (js/setTimeout #(js/document.body.classList.remove "dragover") 200))))
                    
                    #{ "dragenter"
                       "dragleave"
                       "drop" }   (when (= :ignore @*drag-status)
                                    (.preventDefault e)
                                    (.stopPropagation e))))]
    (doseq [type ["dragstart" "drag" "dragend" "dragenter" "dragover" "dragleave" "drop"]]
      (js/document.documentElement.addEventListener type handler false)))))


(defn on-upload-progress [*state e]
  (when (.-lengthComputable e)
    (let [percent (-> (.-loaded e) (* 100) (/ (.-total e)) js/Math.floor)]
      (swap! *state assoc :percent percent))))


(defn on-upload-complete [*state on-complete e]
  (let [xhr         (.-target e)
        ready-state (.-readyState xhr)
        status      (.-status xhr)
        text        (.-responseText xhr)]
    (when (== 4 ready-state) ;; DONE
      (if (== 200 status)
        (do
          (on-complete (util/read-transit-str text))
          (reset! *state { :mode :done }))
        (do
          (logging/warn "Upload failed with response: " text)
          (reset! *state { :mode :error
                           :status status
                           :response text }))))))


(defn upload-file! [url file-param on-complete file *state]
  (cond
    (nil? file) (reset! *state { :mode :new })
    
    (not (re-matches #"image/.+" (.-type file)))
      (reset! *state { :mode     :error
                       :status   415
                       :response (i/t ::error-image) })
    
    :else
    (let [xhr     (js/XMLHttpRequest.)
          payload (doto (js/FormData.)
                    (.append file-param file))]
      (swap! *state assoc :mode :progress, :percent 0)
      (.addEventListener (.-upload xhr) "progress" (partial on-upload-progress *state) false)
      (set! (.-onreadystatechange xhr) (partial on-upload-complete *state on-complete))
      (.open xhr "POST" url)
      (.send xhr payload))))
  

(rum/defc uploader-inner [state]
  (let [{:keys [mode percent status]} state]
    (cond
      (= :progress mode)
      [:.uploader-inner_progress
        (cond
          (nil? percent)
            [:div [:span (i/t ::progress)]]
          (< percent 100)
            [:div
              [:span (i/t ::progress)]
              [:span { :style { :float "right" } } (str percent "%")]]
          :else
            [:div [:span (i/t ::progress-finishing)]])
        [:.uploader-progressbar
          [:.uploader-progressbar-inner
            { :style { :width (str (or percent 0) "%") } }]]]
            
      (= :error mode)
      [:.uploader-inner.uploader-inner_error
        (cond
          (= 415 status)
          (list
            [:.uploader-inner_error-message (i/t ::error-image)]
            [:.uploader-inner_error-action [:span.clickable (i/t ::retry)]])
          
          (= 413 status)
          (list
            [:.uploader-inner_error-message (i/t ::error-weight)]
            [:.uploader-inner_error-action [:span.clickable (i/t ::retry)]])
          
          :else
          (list
            [:.uploader-inner_error-message (i/t ::error-unknown)]
            [:.uploader-inner_error-action [:span.clickable (i/t ::retry)]]))]
      
      :else
      [:.uploader-inner
        [:span.clickable
          (cond
            (= :done mode)            (i/t ::label-another)
            ua/MOBILE                 (i/t ::label-mobile)
            supports-modern-uploader? (i/t ::label-drop)
            :else                     (i/t ::label-click))]])))


(rum/defcs modern-uploader < (rum/local { :mode :new } ::state)
  [{*state ::state} url file-param on-complete]
  (let [{:keys [mode over-count]} @*state
        ready? (not= :progress mode)
        over?  (and over-count (pos? over-count))]
    [:.uploader
      (merge-with concat
        (when over? { :class ["uploader_dragover"] })
        (when ready?
          { :class ["uploader_ready"] })
        (when ready?
          { :on-click (fn [e]
                        (let [input (.querySelector (.-currentTarget e) "input")]
                          (.click input))) })
        (when (and ready? (not ua/MOBILE))
          { :on-drag-enter (fn [_] (swap! *state update :over-count (fnil inc 0)))
            :on-drag-leave (fn [_] (swap! *state update :over-count #(max 0 (dec %))))
            :on-drop (fn [e]
                       (swap! *state dissoc :over-count)
                       (.preventDefault e)
                       (let [file (aget (.. e -dataTransfer -files ) 0)]
                         (upload-file! url file-param on-complete file *state))) }))
     
       [:form
         { :method  "post"
           :encType "multipart/form-data"
           :action  url }
         [:input { :name file-param
                   :type "file"
                   :on-change (fn [e]
                                (let [file (aget (.. e -currentTarget -files) 0)]
                                  (upload-file! url file-param on-complete file *state))) }]]
       (uploader-inner @*state)]))


(defn on-iframe-upload-complete [*state on-complete e]
  (try
    (let [iframe (.-currentTarget e)
          body   (.. iframe -contentWindow -document -body)
          text   (gdom/getTextContent body)]
      (set! (.-onload iframe) nil) ;; cleaning up callback
      (when-not (str/blank? text)
        (try
          (let [resp (util/read-transit-str text)]
            (on-complete resp)
            (reset! *state { :mode :done }))
          (catch js/Error e
            (logging/warn "Upload failed with response: " text)
            (reset! *state { :mode     :error
                             :status   500
                             :response text })))))
    (catch js/Error e
      (logging/warn "Upload failed: cannot access iframe")
      (reset! *state { :mode   :error
                       :status 500 }))))


(defn get-upload-iframe []
  (or (js/document.querySelector "iframe[name=upload-iframe]")
      (let [iframe (js/document.createElement "iframe")]
        (set! (.-name iframe) "upload-iframe")
        (set! (.-src iframe) "javascript:''")
        (set! (.-display (.-style iframe)) "none")
        (js/document.body.appendChild iframe))))


(rum/defcs iframe-uploader < (rum/local { :mode :new } ::state)
                             { :will-mount
                               (fn [state]
                                 (assoc state ::iframe-name (str "upload-" (rand)))) }
  [state url file-param on-complete]
  (let [{*state      ::state
         iframe-name ::iframe-name} state]
    [:.uploader
      (when (not= :progress (:mode @*state))
        { :class "uploader_ready" 
          :on-click (fn [e]
                      (let [input (.querySelector (.-currentTarget e) "input")]
                        (.click input))) })
     
      [:form
        { :method  "post"
          :encType "multipart/form-data"
          :action  url
          :target  "upload-iframe" #_iframe-name }
        [:input { :name file-param
                  :type "file"
                  :on-change (fn [e]
                               (reset! *state { :mode :progress })
                               (let [iframe (get-upload-iframe)
                                     form   (.. e -currentTarget -parentNode)]
                                 (set! (.-onload iframe) (partial on-iframe-upload-complete *state on-complete))
                                 (.submit form))) }]]
      (uploader-inner @*state)]))


(def uploader
  (if supports-modern-uploader? modern-uploader iframe-uploader))


(start-dragndrop!)
(uploader "/api/upload" "file" (fn [resp] (js/console.log resp)))