diff --git a/backend/src/app/rpc/mutations/media.clj b/backend/src/app/rpc/mutations/media.clj index 8a5d0d518..3467522f1 100644 --- a/backend/src/app/rpc/mutations/media.clj +++ b/backend/src/app/rpc/mutations/media.clj @@ -48,7 +48,7 @@ :opt-un [::id])) (sv/defmethod ::upload-file-media-object - [{:keys [pool] :as cfg} {:keys [profile-id file-id id] :as params}] + [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}] (db/with-atomic [conn pool] (let [file (select-file conn file-id)] (teams/check-edition-permissions! conn profile-id (:team-id file)) diff --git a/common/src/app/common/data.cljc b/common/src/app/common/data.cljc index 8ad5ec59a..3d227cb38 100644 --- a/common/src/app/common/data.cljc +++ b/common/src/app/common/data.cljc @@ -547,6 +547,7 @@ (cond (or (vector? v) (map? v)) [k (deep-mapm mfn v)] + :else (mfn [k v]))))] (cond @@ -567,4 +568,6 @@ (->> m (deep-mapm (fn [[k v]] - [(keyword (str/kebab (name k))) v])))) + (if (or (keyword? k) (string? k)) + [(keyword (str/kebab (name k))) v] + [k v]))))) diff --git a/common/src/app/common/file_builder.cljc b/common/src/app/common/file_builder.cljc index 3df7fbe1e..13b009128 100644 --- a/common/src/app/common/file_builder.cljc +++ b/common/src/app/common/file_builder.cljc @@ -150,20 +150,22 @@ (defn create-file ([name] - (let [id (uuid/next)] - {:id id - :name name - :data (-> init/empty-file-data - (assoc :id id)) + (create-file (uuid/next) name)) - ;; We keep the changes so we can send them to the backend - :changes []}))) + ([id name] + {:id id + :name name + :data (-> init/empty-file-data + (assoc :id id)) + + ;; We keep the changes so we can send them to the backend + :changes []})) (defn add-page [file data] (assert (nil? (:current-component-id file))) - (let [page-id (uuid/next) + (let [page-id (or (:id data) (uuid/next)) page (-> init/empty-page-data (assoc :id page-id) (d/deep-merge data))] @@ -329,10 +331,10 @@ (update :parent-stack pop))) (defn add-interaction - [file action-type event-type from-id destination-id] + [file from-id {:keys [action-type event-type destination]}] (assert (some? (lookup-shape file from-id)) (str "Cannot locate shape with id " from-id)) - (assert (some? (lookup-shape file destination-id)) (str "Cannot locate shape with id " destination-id)) + (assert (some? (lookup-shape file destination)) (str "Cannot locate shape with id " destination)) (let [interactions (->> (lookup-shape file from-id) :interactions @@ -342,7 +344,7 @@ (conjv {:action-type action-type :event-type event-type - :destination destination-id}))] + :destination destination}))] (commit-change file {:type :mod-obj diff --git a/frontend/src/app/main/ui/shapes/export.cljs b/frontend/src/app/main/ui/shapes/export.cljs index 45068e47c..b8fa606f3 100644 --- a/frontend/src/app/main/ui/shapes/export.cljs +++ b/frontend/src/app/main/ui/shapes/export.cljs @@ -29,62 +29,88 @@ :else nil)) +(defn uuid->string [m] + (->> m + (d/deep-mapm + (fn [[k v]] + (if (uuid? v) + [k (str v)] + [k v]))))) + (defn bool->str [val] (when (some? val) (str val))) +(defn add-factory [shape] + (fn add! + ([props attr] + (add! props attr str)) + + ([props attr trfn] + (let [val (get shape attr) + val (if (keyword? val) (d/name val) val) + ns-attr (str "penpot:" (-> attr d/name))] + (cond-> props + (some? val) + (obj/set! ns-attr (trfn val))))))) + (defn add-data "Adds as metadata properties that we cannot deduce from the exported SVG" [props shape] - (letfn [(add! - ([props attr] - (add! props attr str)) + (let [add! (add-factory shape) + group? (= :group (:type shape)) + rect? (= :rect (:type shape)) + text? (= :text (:type shape)) + mask? (and group? (:masked-group? shape)) + center (gsh/center-shape shape)] + (-> props + (add! :name) + (add! :blocked) + (add! :hidden) + (add! :type) + (add! :stroke-style) + (add! :stroke-alignment) + (add! :transform) + (add! :transform-inverse) + (add! :flip-x) + (add! :flip-y) + (add! :proportion) + (add! :proportion-lock) + (add! :rotation) + (obj/set! "penpot:center-x" (-> center :x str)) + (obj/set! "penpot:center-y" (-> center :y str)) - ([props attr trfn] - (let [val (get shape attr) - val (if (keyword? val) (d/name val) val) - ns-attr (str "penpot:" (-> attr d/name))] - (cond-> props - (some? val) - (obj/set! ns-attr (trfn val))))))] - (let [group? (= :group (:type shape)) - rect? (= :rect (:type shape)) - text? (= :text (:type shape)) - mask? (and group? (:masked-group? shape)) - center (gsh/center-shape shape)] - (-> props - (add! :name) - (add! :blocked) - (add! :hidden) - (add! :type) - (add! :stroke-style) - (add! :stroke-alignment) - (add! :transform) - (add! :transform-inverse) - (add! :flip-x) - (add! :flip-y) - (add! :proportion) - (add! :proportion-lock) - (add! :rotation) - (obj/set! "penpot:center-x" (-> center :x str)) - (obj/set! "penpot:center-y" (-> center :y str)) + ;; Constraints + (add! :constraints-h) + (add! :constraints-v) + (add! :fixed-scroll) - ;; Constraints - (add! :constraints-h) - (add! :constraints-v) - (add! :fixed-scroll) + (cond-> (and rect? (some? (:r1 shape))) + (-> (add! :r1) + (add! :r2) + (add! :r3) + (add! :r4))) - (cond-> (and rect? (some? (:r1 shape))) - (-> (add! :r1) - (add! :r2) - (add! :r3) - (add! :r4))) + (cond-> text? + (-> (add! :grow-type) + (add! :content (comp json/encode uuid->string)))) - (cond-> text? - (-> (add! :grow-type) - (add! :content json/encode))) + (cond-> mask? + (obj/set! "penpot:masked-group" "true"))))) - (cond-> mask? - (obj/set! "penpot:masked-group" "true")))))) + +(defn add-library-refs [props shape] + (let [add! (add-factory shape)] + (-> props + (add! :fill-color-ref-id) + (add! :fill-color-ref-file) + (add! :stroke-color-ref-id) + (add! :stroke-color-ref-file) + (add! :typography-ref-id) + (add! :typography-ref-file) + (add! :component-file) + (add! :component-id) + (add! :component-root) + (add! :shape-ref)))) (defn prefix-keys [m] (letfn [(prefix-entry [[k v]] @@ -191,7 +217,7 @@ (mf/defc export-data [{:keys [shape]}] - (let [props (-> (obj/new) (add-data shape))] + (let [props (-> (obj/new) (add-data shape) (add-library-refs shape))] [:> "penpot:shape" props [:& export-shadow-data shape] [:& export-blur-data shape] diff --git a/frontend/src/app/util/import/parser.cljs b/frontend/src/app/util/import/parser.cljs index acfa1adb4..b4d68d0b3 100644 --- a/frontend/src/app/util/import/parser.cljs +++ b/frontend/src/app/util/import/parser.cljs @@ -158,6 +158,27 @@ (d/deep-mapm (comp camelize fix-style) m))) +(defn string->uuid + "Looks in a map for keys or values that have uuid shape and converts them + into uuid objects" + [m] + (letfn [(convert [value] + (cond + (and (string? value) (re-matches uuid-regex value)) + (uuid/uuid value) + + (and (keyword? value) (re-matches uuid-regex (d/name value))) + (uuid/uuid (d/name value)) + + (vector? value) + (mapv convert value) + + :else + value))] + (->> m + (d/deep-mapm + (fn [pair] (->> pair (mapv convert))))))) + (def search-data-node? #{:rect :image :path :text :circle}) (defn get-svg-data @@ -397,7 +418,7 @@ [props node] (-> props (assoc :grow-type (get-meta node :grow-type keyword)) - (assoc :content (get-meta node :content json/decode)))) + (assoc :content (get-meta node :content (comp string->uuid json/decode))))) (defn add-group-data [props node] @@ -605,6 +626,37 @@ svg-data (or image-data pattern-data)] (:xlink:href svg-data))) +(defn add-library-refs + [props node] + + (let [fill-color-ref-id (get-meta node :fill-color-ref-id uuid/uuid) + fill-color-ref-file (get-meta node :fill-color-ref-file uuid/uuid) + stroke-color-ref-id (get-meta node :stroke-color-ref-id uuid/uuid) + stroke-color-ref-file (get-meta node :stroke-color-ref-file uuid/uuid) + component-id (get-meta node :component-id uuid/uuid) + component-file (get-meta node :component-file uuid/uuid) + shape-ref (get-meta node :shape-ref uuid/uuid) + component-root? (get-meta node :component-root str->bool)] + + (cond-> props + (some? fill-color-ref-id) + (assoc :fill-color-ref-id fill-color-ref-id + :fill-color-ref-file fill-color-ref-file) + + (some? stroke-color-ref-id) + (assoc :stroke-color-ref-id stroke-color-ref-id + :stroke-color-ref-file stroke-color-ref-file) + + (some? component-id) + (assoc :component-id component-id + :component-file component-file) + + component-root? + (assoc :component-root? component-root?) + + (some? shape-ref) + (assoc :shape-ref shape-ref)))) + (defn parse-data [type node] @@ -620,6 +672,7 @@ (add-blur node) (add-exports node) (add-svg-attrs node svg-data) + (add-library-refs node) (cond-> (= :svg-raw type) (add-svg-content node)) @@ -661,3 +714,4 @@ {:destination (get-meta node :destination uuid/uuid) :action-type (get-meta node :action-type keyword) :event-type (get-meta node :event-type keyword)}))))) + diff --git a/frontend/src/app/worker/export.cljs b/frontend/src/app/worker/export.cljs index 6a9c71ba5..34377667b 100644 --- a/frontend/src/app/worker/export.cljs +++ b/frontend/src/app/worker/export.cljs @@ -18,6 +18,12 @@ [beicon.core :as rx] [cuerdas.core :as str])) +(defn rx-expand + "Recursively projects each source value to an Observable + which is merged in the output Observable." + [f ob] + (.pipe ob (.expand ^js js/rxjsOperators f))) + (defn create-manifest "Creates a manifest entry for the given files" [team-id file-id files] @@ -40,6 +46,7 @@ :shared is-shared :pages pages :pagesIndex index + :libraries (->> (:libraries file) (into #{}) (mapv str)) :hasComponents (d/not-empty? (get-in file [:data :components])) :hasMedia (d/not-empty? (get-in file [:data :media])) :hasColors (d/not-empty? (get-in file [:data :colors])) @@ -142,16 +149,49 @@ (->> (r/render-components (:data file)) (rx/map #(vector (str (:id file) "/components.svg") %)))) +(defn fetch-file-with-libraries [file-id] + (->> (rx/zip (rp/query :file {:id file-id}) + (rp/query :file-libraries {:file-id file-id})) + (rx/map + (fn [[file file-libraries]] + (let [libraries-ids (->> file-libraries (map :id) (filterv #(not= (:id file) %)))] + (-> file + (assoc :libraries libraries-ids))))))) + +(defn collect-files + [file-id] + + (letfn [(fetch-dependencies [[files pending]] + (if (empty? pending) + ;; When not pending, we finish the generation + (rx/empty) + + ;; Still pending files, fetch the next one + (let [next (peek pending) + pending (pop pending)] + (if (contains? files next) + ;; The file is already in the result + (rx/of [files pending]) + + (->> (fetch-file-with-libraries next) + (rx/map + (fn [file] + [(-> files + (assoc (:id file) file)) + (as-> pending $ + (reduce conj $ (:libraries file)))])))))))] + (let [files {} + pending [file-id]] + (->> (rx/of [files pending]) + (rx-expand fetch-dependencies) + (rx/last) + (rx/map first))))) + (defn export-file [team-id file-id] - (let [files-stream - (->> (rx/merge (rp/query :file {:id file-id}) - (->> (rp/query :file-libraries {:file-id file-id}) - (rx/flat-map identity) - (rx/map #(assoc % :is-shared true)))) - (rx/reduce #(assoc %1 (:id %2) %2) {}) - (rx/share)) + (let [files-stream (->> (collect-files file-id) + (rx/share)) manifest-stream (->> files-stream diff --git a/frontend/src/app/worker/import.cljs b/frontend/src/app/worker/import.cljs index f80014394..21a3dc911 100644 --- a/frontend/src/app/worker/import.cljs +++ b/frontend/src/app/worker/import.cljs @@ -5,10 +5,12 @@ ;; Copyright (c) UXBOX Labs SL (ns app.worker.import + (:refer-clojure :exclude [resolve]) (:require [app.common.data :as d] [app.common.file-builder :as fb] [app.common.pages :as cp] + [app.common.text :as ct] [app.common.uuid :as uuid] [app.main.repo :as rp] [app.util.dom :as dom] @@ -18,23 +20,110 @@ [app.util.zip :as uz] [app.worker.impl :as impl] [beicon.core :as rx] + [cuerdas.core :as str] [tubax.core :as tubax])) +;;; TODO: Move to funcool/beicon + +(defn rx-merge-reduce [f seed ob] + (let [current-acc (atom seed)] + (->> (rx/concat + (rx/of seed) + (->> ob + (rx/mapcat #(f @current-acc %)) + (rx/tap #(reset! current-acc %)))) + (rx/last)))) + +(defn rx-skip-last + [n ob] + (.pipe ob (.skipLast js/rxjsOperators (int n)))) + ;; Upload changes batches size (def change-batch-size 100) +(defn get-file + "Resolves the file inside the context given its id and the data" + ([context type] + (get-file context type nil nil)) + + ([context type id] + (get-file context type id nil)) + + ([context type id media] + (let [file-id (:file-id context) + path (case type + :manifest (str "manifest.json") + :page (str file-id "/" id ".svg") + :colors (str file-id "/colors.json") + :typographies (str file-id "/typographies.json") + :media-list (str file-id "/media.json") + :media (let [ext (dom/mtype->extension (:mtype media))] + (str file-id "/media/" id "." ext)) + :components (str file-id "/components.svg")) + + svg? (str/ends-with? path "svg") + json? (str/ends-with? path "json") + other? (not (or svg? json?)) + + file-type (if other? "blob" "text")] + + (cond->> (uz/get-file (:zip context) path file-type) + svg? + (rx/map (comp tubax/xml->clj :content)) + + json? + (rx/map (comp json/decode :content)) + + other? + (rx/map :content))))) + +(defn resolve-factory + "Creates a wrapper around the atom to remap ids to new ids and keep + their relationship so they ids are coherent." + [] + (let [id-mapping-atom (atom {}) + resolve + (fn [id-mapping id] + (assert (uuid? id)) + (get id-mapping id)) + + set-id + (fn [id-mapping id] + (assert (uuid? id)) + (cond-> id-mapping + (nil? (resolve id-mapping id)) + (assoc id (uuid/next))))] + + (fn [id] + (swap! id-mapping-atom set-id id) + (resolve @id-mapping-atom id)))) + (defn create-file "Create a new file on the back-end" - [project-id file-desc] - (let [file-id (uuid/next)] + [context file-id] + (let [resolve (:resolve context) + file-id (resolve file-id)] (rp/mutation :create-temp-file {:id file-id - :name (:name file-desc) - :is-shared (:shared file-desc) - :project-id project-id + :name (:name context) + :is-shared (:shared context) + :project-id (:project-id context) :data (-> cp/empty-file-data (assoc :id file-id))}))) +(defn persist-file [file] + (rp/mutation :persist-temp-file {:id (:id file)})) + +(defn link-file-libraries + "Create a new file on the back-end" + [context file-id] + (let [resolve (:resolve context) + file-id (resolve file-id) + libraries (->> context :libraries (mapv resolve))] + (->> (rx/from libraries) + (rx/map #(hash-map :file-id file-id :library-id %)) + (rx/flat-map (partial rp/mutation :link-file-to-library))))) + (defn send-changes "Creates batches of changes to be sent to the backend" [file] @@ -58,7 +147,7 @@ (rx/map first) (rx/tap #(reset! revn (:revn %)))) - (rp/mutation :persist-temp-file {:id (:id file)})))) + (rp/mutation :persist-temp-file {:id file-id})))) (defn upload-media-files "Upload a image to the backend and returns its id" @@ -76,8 +165,34 @@ :is-local true})) (rx/flat-map #(rp/mutation! :upload-file-media-object %)))) -(defn add-shape-file - [file node] +(defn resolve-text-content [node context] + (let [resolve (:resolve context)] + (->> node + (ct/transform-nodes + (fn [item] + (-> item + (d/update-when :fill-color-ref-id resolve) + (d/update-when :fill-color-ref-file resolve) + (d/update-when :typography-ref-id resolve) + (d/update-when :typography-ref-file resolve))))))) + +(defn resolve-data-ids + [data type context] + (let [resolve (:resolve context)] + (-> data + (d/update-when :fill-color-ref-id resolve) + (d/update-when :fill-color-ref-file resolve) + (d/update-when :stroke-color-ref-id resolve) + (d/update-when :stroke-color-ref-file resolve) + (d/update-when :component-id resolve) + (d/update-when :component-file resolve) + (d/update-when :shape-ref resolve) + + (cond-> (= type :text) + (d/update-when :content resolve-text-content context))))) + +(defn process-import-node + [context file node] (let [type (cip/get-type node) close? (cip/close? node)] @@ -88,18 +203,23 @@ :svg-raw (fb/close-svg-raw file) #_default file) - (let [data (cip/parse-data type node) + (let [resolve (:resolve context) old-id (cip/get-id node) - interactions (cip/parse-interactions node) + interactions (->> (cip/parse-interactions node) + (mapv #(update % :destination resolve))) + + data (-> (cip/parse-data type node) + (resolve-data-ids type context) + (assoc :id (resolve old-id))) file (case type - :frame (fb/add-artboard file data) - :group (fb/add-group file data) - :rect (fb/create-rect file data) - :circle (fb/create-circle file data) - :path (fb/create-path file data) - :text (fb/create-text file data) - :image (fb/create-image file data) + :frame (fb/add-artboard file data) + :group (fb/add-group file data) + :rect (fb/create-rect file data) + :circle (fb/create-circle file data) + :path (fb/create-path file data) + :text (fb/create-text file data) + :image (fb/create-image file data) :svg-raw (fb/create-svg-raw file data) #_default file)] @@ -108,49 +228,24 @@ ;; We store this data for post-processing after every shape has been ;; added (cond-> file - (some? (:last-id file)) - (assoc-in [:id-mapping old-id] (:last-id file)) - (d/not-empty? interactions) - (assoc-in [:interactions old-id] interactions)))))) + (assoc-in [:interactions (:id data)] interactions)))))) -(defn post-process-file +(defn setup-interactions [file] - (letfn [(add-interaction - [id file {:keys [action-type event-type destination] :as interaction}] - (fb/add-interaction file action-type event-type id destination)) - - (add-interactions - [file [old-id interactions]] - (let [id (get-in file [:id-mapping old-id])] - (->> interactions - (mapv (fn [interaction] - (let [id (get-in file [:id-mapping (:destination interaction)])] - (assoc interaction :destination id)))) - (reduce - (partial add-interaction id) file)))) + (letfn [(add-interactions + [file [id interactions]] + (->> interactions + (reduce #(fb/add-interaction %1 id %2) file))) (process-interactions [file] - (reduce add-interactions file (:interactions file)))] + (let [interactions (:interactions file) + file (dissoc file :interactions)] + (->> interactions (reduce add-interactions file))))] - (-> file - (process-interactions) - (dissoc :id-mapping :interactions)))) - -(defn merge-reduce [f seed ob] - (let [current-acc (atom seed)] - (->> (rx/concat - (rx/of seed) - (->> ob - (rx/mapcat #(f @current-acc %)) - (rx/tap #(reset! current-acc %)))) - (rx/last)))) - -(defn skip-last - [n ob] - (.pipe ob (.skipLast js/rxjsOperators (int n)))) + (-> file process-interactions))) (defn resolve-media [file-id node] @@ -172,155 +267,189 @@ (rx/observe-on :async)))) (defn import-page - [file [page-name content]] - (if (cip/valid? content) - (let [nodes (->> content cip/node-seq) - file-id (:id file) - page-data (-> (cip/parse-page-data content) - (assoc :name page-name))] - (->> (rx/from nodes) - (rx/filter cip/shape?) - (rx/mapcat (partial resolve-media file-id)) - (rx/reduce add-shape-file (fb/add-page file page-data)) - (rx/map post-process-file) - (rx/map fb/close-page))) - (rx/empty))) + [context file [page-id page-name content]] + (let [nodes (->> content cip/node-seq) + file-id (:id file) + resolve (:resolve context) + page-data (-> (cip/parse-page-data content) + (assoc :name page-name) + (assoc :id (resolve page-id))) + file (-> file (fb/add-page page-data))] + (->> (rx/from nodes) + (rx/filter cip/shape?) + (rx/mapcat (partial resolve-media file-id)) + (rx/reduce (partial process-import-node context) file) + (rx/map (comp fb/close-page setup-interactions))))) -(defn get-page-path [dir-id id] - (str dir-id "/" id ".svg")) +(defn import-component [context file node] + (let [resolve (:resolve context) + content (cip/find-node node :g) + file-id (:id file) + old-id (cip/get-id node) + id (resolve old-id) + data (-> (cip/parse-data :group content) + (assoc :id id)) -(defn process-page [file-id zip [page-id page-name]] - (let [path (get-page-path (d/name file-id) page-id)] - (->> (uz/get-file zip path) - (rx/map (comp tubax/xml->clj :content)) - (rx/map #(vector page-name %))))) + file (-> file (fb/start-component data)) + children (cip/node-seq node)] + + (->> (rx/from children) + (rx/filter cip/shape?) + (rx/skip 1) + (rx-skip-last 1) + (rx/mapcat (partial resolve-media file-id)) + (rx/reduce (partial process-import-node context) file) + (rx/map fb/finish-component)))) + +(defn process-pages + [context file] + (let [index (:pages-index context) + get-page-data + (fn [page-id] + [page-id (get-in index [page-id :name])]) + + pages (->> (:pages context) (mapv get-page-data))] -(defn process-file-pages - [file file-id file-desc zip] - (let [index (:pages-index file-desc) - pages (->> (:pages file-desc) - (mapv #(vector % (get-in index [(keyword %) :name]))))] (->> (rx/from pages) - (rx/mapcat #(process-page file-id zip %)) - (merge-reduce import-page file)))) + (rx/mapcat + (fn [[page-id page-name]] + (->> (get-file context :page page-id) + (rx/map (fn [page-data] [page-id page-name page-data]))))) + (rx-merge-reduce (partial import-page context) file)))) (defn process-library-colors - [file file-id file-desc zip] - (if (:has-colors file-desc) - (let [add-color + [context file] + (if (:has-colors context) + (let [resolve (:resolve context) + add-color (fn [file [id color]] - (let [color (-> (d/kebab-keys color) - (d/update-in-when [:gradient :type] keyword)) - file (fb/add-library-color file color)] - (assoc file [:library-mapping id] (:last-id file)))) - - path (str (d/name file-id) "/colors.json")] - (->> (uz/get-file zip path) - (rx/mapcat (comp json/decode :content)) + (let [color (-> color + (d/update-in-when [:gradient :type] keyword) + (assoc :id (resolve id)))] + (fb/add-library-color file color)))] + (->> (get-file context :colors) + (rx/flat-map (comp d/kebab-keys cip/string->uuid)) (rx/reduce add-color file))) (rx/of file))) (defn process-library-typographies - [file file-id file-desc zip] - (if (:has-typographies file-desc) - (let [add-typography - (fn [file [id typography]] - (let [typography (d/kebab-keys typography) - file (fb/add-library-typography file typography)] - (assoc file [:library-mapping id] (:last-id file)))) - - path (str (d/name file-id) "/typographies.json")] - (->> (uz/get-file zip path) - (rx/mapcat (comp json/decode :content)) - (rx/reduce add-typography file))) + [context file] + (if (:has-typographies context) + (let [resolve (:resolve context)] + (->> (get-file context :typographies) + (rx/flat-map (comp d/kebab-keys cip/string->uuid)) + (rx/map (fn [[id typography]] + (-> typography + (d/kebab-keys) + (assoc :id (resolve id))))) + (rx/reduce fb/add-library-typography file))) (rx/of file))) (defn process-library-media - [file file-id file-desc zip] - (if (:has-media file-desc) - (let [add-media - (fn [file media] - (let [file (fb/add-library-media file (dissoc media :old-id))] - (assoc file [:library-mapping (:old-id media)] (:last-id file)))) - - path (str (d/name file-id) "/media.json")] - - (->> (uz/get-file zip path) - (rx/mapcat (comp json/decode :content)) + [context file] + (if (:has-media context) + (let [resolve (:resolve context)] + (->> (get-file context :media-list) + (rx/flat-map (comp d/kebab-keys cip/string->uuid)) (rx/flat-map (fn [[id media]] - (let [file-path (str (d/name file-id) "/media/" (d/name id) "." (dom/mtype->extension (:mtype media)))] - (->> (uz/get-file zip file-path "blob") - (rx/map (fn [{blob :content}] + (let [media (assoc media :id (resolve id))] + (->> (get-file context :media id media) + (rx/map (fn [blob] (let [content (.slice blob 0 (.-size blob) (:mtype media))] {:name (:name media) + :id (:id media) :file-id (:id file) :content content :is-local false}))) (rx/flat-map #(rp/mutation! :upload-file-media-object %)) - (rx/map (fn [response] - (-> media - (assoc :old-id id) - (assoc :id (:id response))))))))) - (rx/reduce add-media file))) + (rx/map (constantly media)))))) + (rx/reduce fb/add-library-media file))) (rx/of file))) -(defn add-component [file content] - (let [content (cip/find-node content :g) - data (cip/parse-data :group content) - file (-> file (fb/start-component data)) - id (-> (get-in content [:attrs :id]) (uuid/uuid)) - component-id (:last-id file) - file (assoc file [:library-mapping id] component-id) - nodes (cip/node-seq content)] - - (->> (rx/from nodes) - (rx/filter cip/shape?) - (rx/skip 1) - (skip-last 1) - (rx/mapcat (partial resolve-media (:id file))) - (rx/reduce add-shape-file file) - (rx/map #(fb/finish-component %))))) - (defn process-library-components - [file file-id file-desc zip] - (if (:has-components file-desc) - (let [path (str (d/name file-id) "/components.svg")] - (->> (uz/get-file zip path) - (rx/map (comp tubax/xml->clj :content)) - (rx/flat-map (fn [content] (->> (cip/node-seq content) (filter #(= :symbol (:tag %)))))) - (merge-reduce add-component file))) + [context file] + (if (:has-components context) + (let [split-components + (fn [content] (->> (cip/node-seq content) + (filter #(= :symbol (:tag %)))))] + + (->> (get-file context :components) + (rx/flat-map split-components) + (rx-merge-reduce (partial import-component context) file))) (rx/of file))) (defn process-file - [file file-id file-desc zip] - (->> (process-file-pages file file-id file-desc zip) - (rx/flat-map #(process-library-colors % file-id file-desc zip)) - (rx/flat-map #(process-library-typographies % file-id file-desc zip)) - (rx/flat-map #(process-library-media % file-id file-desc zip)) - (rx/flat-map #(process-library-components % file-id file-desc zip)) + [context file] + + (->> (rx/of file) + (rx/flat-map (partial process-pages context)) + (rx/flat-map (partial process-library-colors context)) + (rx/flat-map (partial process-library-typographies context)) + (rx/flat-map (partial process-library-media context)) + (rx/flat-map (partial process-library-components context)) (rx/flat-map send-changes) (rx/ignore))) -(defn process-package - [project-id zip-file] - (->> (uz/get-file zip-file "manifest.json") - (rx/flat-map (comp :files json/decode :content)) +(defn create-files [context manifest] + (->> manifest :files rx/from (rx/flat-map (fn [[file-id file-desc]] - (let [file-desc (d/kebab-keys file-desc)] - (->> (create-file project-id file-desc) - (rx/flat-map #(process-file % file-id file-desc zip-file)))))))) + (create-file (merge context file-desc) file-id))) + (rx/reduce #(assoc %1 (:id %2) %2) {}))) + +(defn link-libraries [context manifest] + (->> manifest :files rx/from + (rx/flat-map + (fn [[file-id file-desc]] + (link-file-libraries (merge context file-desc) file-id))))) + +(defn process-files [context manifest files] + (->> manifest :files rx/from + (rx/flat-map + (fn [[file-id file-desc]] + (let [resolve (:resolve context) + context (-> context + (merge file-desc) + (assoc :file-id file-id)) + file (get files (resolve file-id))] + (process-file context file)))))) + +(defn process-package + [context] + (->> (get-file context :manifest) + (rx/map (comp d/kebab-keys cip/string->uuid)) + + ;; Create the temporary files + (rx/mapcat (fn [manifest] + (->> (create-files context manifest) + (rx/map #(vector manifest %))))) + + ;; Set-up the files dependencies + (rx/mapcat (fn [[manifest files]] + (rx/concat + (link-libraries context manifest) + (rx/of [manifest files])))) + + ;; Creates files data + (rx/mapcat (fn [[manifest files]] + (process-files context manifest files))) + + ;; Mark temporary files as persisted + (rx/mapcat persist-file))) (defmethod impl/handler :import-file [{:keys [project-id files]}] - (->> (rx/from files) - (rx/flat-map uz/load-from-url) - (rx/flat-map (partial process-package project-id)) - (rx/catch - (fn [err] - (.error js/console "ERROR" err (clj->js (.-data err))))))) + (let [context {:project-id project-id + :resolve (resolve-factory)}] + (->> (rx/from files) + (rx/flat-map uz/load-from-url) + (rx/map #(assoc context :zip %)) + (rx/flat-map process-package) + (rx/catch + (fn [err] + (.error js/console "ERROR" err (clj->js (.-data err))))))))