WIP: fix

.github/workflows/test-integration.yml

@@ -55,3 +55,5 @@ jobs:
         with:
           name: test-results
           path: frontend/test-results/
+          overwrite: true
+          retention-days: 7

frontend/package.json

@@ -26,7 +26,7 @@
     "build:wasm": "../render-wasm/build",
     "build:storybook:cljs": "clojure -M:dev:shadow-cljs compile storybook",
     "build:app:libs": "node ./scripts/build-libs.js",
-    "build:app:main": "clojure -M:dev:shadow-cljs release main worker",
+    "build:app:main": "clojure -M:dev:shadow-cljs release main worker --debug",
     "build:app": "yarn run clear:shadow-cache && yarn run build:app:main && yarn run build:app:libs",
     "e2e:server": "node ./scripts/e2e-server.js",
     "fmt:clj": "cljfmt fix --parallel=true src/ test/",

frontend/src/app/main/data/workspace/clipboard.cljs

@@ -255,6 +255,7 @@
 (defn create-paste-from-blob
   [in-viewport?]
   (fn [blob]
+    (js/console.log "create-paste-from-blob" blob)
     (let [type (.-type blob)
           result (cond
                    (= type "image/svg+xml")
@@ -288,7 +289,8 @@
   (ptk/reify ::paste-from-clipboard
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (clipboard/from-clipboard)
+      (prn "paste-from-clipboard")
+      (->> (clipboard/from-dom-api)
            (rx/mapcat default-paste-from-blob)
            (rx/take 1)))))
 
@@ -298,6 +300,7 @@
   (ptk/reify ::paste-from-event
     ptk/WatchEvent
     (watch [_ state _]
+      (prn "paste-from-event")
       (let [objects     (dsh/lookup-page-objects state)
             edit-id     (dm/get-in state [:workspace-local :edition])
             is-editing? (and edit-id (= :text (get-in objects [edit-id :type])))]
@@ -306,7 +309,7 @@
         ;; we forbid that scenario so the default behaviour is executed
         (if is-editing?
           (rx/empty)
-          (->> (clipboard/from-synthetic-clipboard-event event)
+          (->> (clipboard/from-synthetic-event event)
                (rx/mapcat (create-paste-from-blob in-viewport?))))))))
 
 (defn copy-selected-svg
@@ -476,7 +479,7 @@
                       (js/console.error "Clipboard error:" cause))
                     (rx/empty)))]
 
-          (->> (clipboard/from-clipboard)
+          (->> (clipboard/from-dom-api)
                (rx/mapcat #(.text %))
                (rx/map decode-entry)
                (rx/take 1)

frontend/src/app/main/ui/debug/playground.cljs

@@ -11,7 +11,7 @@
   []
   (let [on-paste (mf/use-fn
                   (fn [e]
-                    (let [stream (clipboard/from-clipboard-event e)]
+                    (let [stream (clipboard/from-event e)]
                       (rx/sub! stream
                                (fn [data]
                                  (js/console.log "data" data))))))
@@ -31,7 +31,7 @@
         on-click (mf/use-fn
                   (fn [e]
                     (js/console.log "event" e)
-                    (let [stream (clipboard/from-clipboard)]
+                    (let [stream (clipboard/from-dom-api)]
                       (rx/sub! stream
                                (fn [data]
                                  (js/console.log "data" data))))))]

frontend/src/app/main/ui/workspace/context_menu.cljs

@@ -181,7 +181,8 @@
         handle-hover-copy-paste
         (mf/use-callback
          (fn []
-           (->> (clipboard/from-clipboard)
+           (->> (clipboard/from-dom-api)
+                ;: FIXME: use specific API for access .text
                 (rx/mapcat #(.text %))
                 (rx/take 1)
                 (rx/subs!

frontend/src/app/util/clipboard.cljs

@@ -6,41 +6,142 @@
 
 (ns app.util.clipboard
   (:require
-   ["./clipboard.js" :as clipboard]
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [app.common.transit :as t]
+   [app.util.dom :as dom]
+   [app.util.object :as obj]
    [beicon.v2.core :as rx]))
 
+(def max-parseable-size
+  (* 16 1024 1024))
+
 (def image-types
   ["image/webp"
    "image/png"
    "image/jpeg"
    "image/svg+xml"])
 
-(def clipboard-settings #js {:decodeTransit t/decode-str})
+(def allowed-types
+  (d/ordered-set
+   "image/webp",
+   "image/png",
+   "image/jpeg",
+   "image/svg+xml",
+   "application/transit+json",
+   "text/html",
+   "text/plain"))
 
-(defn from-clipboard []
+(def exclusive-types
-  (->> (rx/from (clipboard/fromClipboard clipboard-settings))
+  (d/ordered-set
-       (rx/mapcat #(rx/from %))))
+   "application/transit+json",
+   "text/html",
+   "text/plain"))
 
-(defn from-data-transfer [data-transfer]
+(def clipboard-settings
-  (->> (rx/from (clipboard/fromDataTransfer data-transfer clipboard-settings))
+  #js {:decodeTransit t/decode-str})
-       (rx/mapcat #(rx/from %))))
 
-(defn from-clipboard-data [clipboard-data]
+(defn- parse-pain-text
-  (from-data-transfer clipboard-data))
+  [text]
+  (or (when (ex/ignoring (t/decode-str text))
+        (new js/Blob #js [text] #js {:type "application/transit+json"}))
+      (when (re-seq #"^<svg[\s>]" text)
+        (new js/Blob #js [text] #js {:type "image/svg+xml"}))
+      (new js/Blob #js [text] #js {:type "text/plain"})))
 
-(defn from-clipboard-event [event]
+(defn from-dom-api
-  (from-clipboard-data (.-clipboardData event)))
+  []
+  (let [api (.-clipboard js/navigator)]
+    (->> (rx/from (.read ^js api))
+         (rx/mapcat (comp rx/from obj/into-array))
+         (rx/mapcat (fn [item]
+                      (let [allowed-types'
+                            (->> (seq (.-types item))
+                                 (filter (fn [type] (contains? allowed-types type)))
+                                 (sort-by (fn [type] (d/index-of allowed-types type)))
+                                 (into (d/ordered-set)))
 
-(defn from-synthetic-clipboard-event [event]
+                            main-type
-  (let [target (.-target ^js event)]
+                            (first allowed-types')]
-    (when (and (not (.-isContentEditable ^js target)) ;; ignore when pasting into
-               (not= (.-tagName ^js target) "INPUT")) ;; an editable control
-      (from-clipboard-event (. ^js event getBrowserEvent)))))
 
-(defn from-drop-event [event]
+                        (cond->> (rx/from (.getType ^js item main-type))
-  (from-data-transfer (.-dataTransfer event)))
+                          (and (= (count allowed-types') 1)
+                               (= "text/plain" main-type))
+                          (rx/mapcat (fn [blob]
+                                       (if (>= max-parseable-size (.-size ^js blob))
+                                         (->> (rx/from (.text ^js blob))
+                                              (rx/map parse-pain-text))
+                                         (rx/of blob)))))))))))
 
+(defn- from-data-transfer
+  "Get clipboard stream from DataTransfer instance"
+  [data-transfer]
+  (let [sorted-items
+        (->> (seq (.-items ^js data-transfer))
+             (filter (fn [item]
+                       (contains? allowed-types (.-type ^js item))))
+             (sort-by (fn [item] (d/index-of allowed-types (.-type item)))))]
+    (->> (rx/from sorted-items)
+         (rx/mapcat (fn [item]
+                      (let [kind (.-kind ^js item)
+                            type (.-type ^js item)]
+                        (cond
+                          (= kind "file")
+                          (rx/of (.getAsFile ^js item))
+
+                          (= kind "string")
+                          (->> (rx/create (fn [subs]
+                                            (.getAsString ^js item
+                                                          (fn [text]
+                                                            (rx/push! subs (d/vec2 type text))
+                                                            (rx/end! subs)))))
+                               (rx/map (fn [[type text]]
+                                         (if (= type "text/plain")
+                                           (parse-pain-text text)
+                                           (new js/Blob #js [text] #js {:type type})))))
+                          :else
+                          (rx/empty)))))
+         (rx/filter some?)
+         (rx/reduce (fn [filtered item]
+                      (js/console.log "AAA" item)
+                      (let [type (.-type ^js item)]
+                        (if (and (contains? exclusive-types type)
+                                 (some (fn [item] (contains? exclusive-types type)) filtered))
+                          filtered
+                          (conj filtered item))))
+                    (d/ordered-set))
+         (rx/mapcat (comp rx/from seq)))))
+
+(defn from-event
+  "Get clipboard stream from event"
+  [event]
+  (let [cdata (.-clipboardData ^js event)]
+    (from-data-transfer cdata)))
+
+(defn from-synthetic-event
+  "Get clipboard stream from syntetic event"
+  [event]
+  (let [target
+        (dom/get-target event)
+
+        content-editable?
+        (dom/is-content-editable? target)
+
+        is-input?
+        (= (dom/get-tag-name target) "INPUT")]
+
+    ;; ignore when pasting into an editable control
+    (when-not (or content-editable? is-input?)
+      (-> event
+          (dom/event->browser-event)
+          (from-event)))))
+
+(defn from-drop-event
+  "Get clipboard stream from drop event"
+  [event]
+  (from-data-transfer (.-dataTransfer ^js event)))
+
+;; FIXME: rename to `write-text`
 (defn to-clipboard
   [data]
   (assert (string? data) "`data` should be string")
@@ -52,6 +153,7 @@
   (js/ClipboardItem.
    (js-obj mimetype promise)))
 
+;; FIXME: this API is very confuse
 (defn to-clipboard-promise
   [mimetype promise]
   (let [clipboard (unchecked-get js/navigator "clipboard")

frontend/src/app/util/dom.cljs

@@ -23,7 +23,7 @@
 
 (extend-type BrowserEvent
   cljs.core/IDeref
-  (-deref [it] (.getBrowserEvent it)))
+  (-deref [it] (.getBrowserEvent ^js it)))
 
 (declare get-window-size)
 
@@ -360,6 +360,10 @@
   (when (some? el)
     (.-innerText el)))
 
+(defn is-content-editable?
+  [^js el]
+  (.-isContentEditable ^js el))
+
 (defn query
   ([^string selector]
    (query globals/document selector))