mirror of
https://github.com/penpot/penpot.git
synced 2025-03-20 03:31:24 -05:00
Merge pull request #3847 from penpot/niwinz-develop-enhancements-11
✨ Add enhancements and safety checks to copy paste
This commit is contained in:
commit
0528c26b5e
50 changed files with 1199 additions and 831 deletions
backend/src/app
common
frontend
src/app
main
data
errors.cljsstore.cljsui
util
worker.cljstranslations
|
@ -315,6 +315,12 @@
|
|||
(update :data cpc/process-changes changes)
|
||||
|
||||
;; If `libs` is defined, then full validation is performed
|
||||
(cond-> (contains? cf/flags :soft-file-validation)
|
||||
(soft-validate-file! libs))
|
||||
|
||||
(cond-> (contains? cf/flags :soft-file-schema-validation)
|
||||
(soft-validate-file-schema!))
|
||||
|
||||
(cond-> (and (contains? cf/flags :file-validation)
|
||||
(not skip-validate))
|
||||
(val/validate-file! libs))
|
||||
|
@ -323,12 +329,6 @@
|
|||
(not skip-validate))
|
||||
(val/validate-file-schema!))
|
||||
|
||||
(cond-> (contains? cf/flags :soft-file-validation)
|
||||
(soft-validate-file! libs))
|
||||
|
||||
(cond-> (contains? cf/flags :soft-file-schema-validation)
|
||||
(soft-validate-file-schema!))
|
||||
|
||||
(cond-> (and (contains? cfeat/*current* "fdata/objects-map")
|
||||
(not (contains? cfeat/*previous* "fdata/objects-map")))
|
||||
(enable-objects-map))
|
||||
|
|
|
@ -8,7 +8,6 @@
|
|||
(:require
|
||||
[app.auth :as auth]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.uuid :as uuid]
|
||||
|
@ -37,7 +36,7 @@
|
|||
(declare strip-private-attrs)
|
||||
(declare verify-password)
|
||||
|
||||
(def schema:profile
|
||||
(def ^:private schema:profile
|
||||
[:map {:title "Profile"}
|
||||
[:id ::sm/uuid]
|
||||
[:fullname [::sm/word-string {:max 250}]]
|
||||
|
@ -53,14 +52,12 @@
|
|||
[:props {:optional true}
|
||||
[:map-of {:title "ProfileProps"} :keyword :any]]])
|
||||
|
||||
(def valid-profile?
|
||||
(sm/pred-fn schema:profile))
|
||||
|
||||
;; --- QUERY: Get profile (own)
|
||||
|
||||
(sv/defmethod ::get-profile
|
||||
{::rpc/auth false
|
||||
::doc/added "1.18"
|
||||
::sm/params [:map]
|
||||
::sm/result schema:profile}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id]}]
|
||||
;; We need to return the anonymous profile object in two cases, when
|
||||
|
@ -93,10 +90,6 @@
|
|||
::sm/result schema:profile}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}]
|
||||
|
||||
(dm/assert!
|
||||
"expected valid profile data"
|
||||
(valid-profile? params))
|
||||
|
||||
(db/with-atomic [conn pool]
|
||||
;; NOTE: we need to retrieve the profile independently if we use
|
||||
;; it or not for explicit locking and avoid concurrent updates of
|
||||
|
|
|
@ -28,6 +28,9 @@
|
|||
(def ^:private schema:templates
|
||||
[:vector schema:template])
|
||||
|
||||
(def check-templates!
|
||||
(sm/check-fn schema:templates))
|
||||
|
||||
(defmethod ig/init-key ::setup/templates
|
||||
[_ _]
|
||||
(let [templates (-> "app/onboarding.edn" io/resource slurp edn/read-string)
|
||||
|
@ -35,7 +38,7 @@
|
|||
|
||||
(dm/verify!
|
||||
"expected a valid templates file"
|
||||
(sm/valid? schema:templates templates))
|
||||
(check-templates! templates))
|
||||
|
||||
(doseq [{:keys [id path] :as template} templates]
|
||||
(let [path (or path (fs/join dest id))]
|
||||
|
|
|
@ -140,7 +140,7 @@
|
|||
:else
|
||||
(str "expr assert: " (pr-str expr)))]
|
||||
(when *assert*
|
||||
`(binding [*assert-context* true]
|
||||
`(binding [*assert-context* ~hint]
|
||||
(when-not ~expr
|
||||
(let [hint# ~hint
|
||||
params# {:type :assertion
|
||||
|
@ -161,7 +161,7 @@
|
|||
|
||||
:else
|
||||
(str "expr assert: " (pr-str expr)))]
|
||||
`(binding [*assert-context* true]
|
||||
`(binding [*assert-context* ~hint]
|
||||
(when-not ~expr
|
||||
(let [hint# ~hint
|
||||
params# {:type :assertion
|
||||
|
|
|
@ -46,7 +46,7 @@
|
|||
(and add-container? (nil? component-id))
|
||||
(assoc :page-id (:current-page-id file)
|
||||
:frame-id (:current-frame-id file)))
|
||||
valid? (ch/valid-change? change)]
|
||||
valid? (ch/check-change! change)]
|
||||
|
||||
(when-not valid?
|
||||
(let [explain (sm/explain ::ch/change change)]
|
||||
|
|
|
@ -31,25 +31,27 @@
|
|||
;; SCHEMAS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(sm/def! ::operation
|
||||
[:multi {:dispatch :type :title "Operation" ::smd/simplified true}
|
||||
[:set
|
||||
[:map {:title "SetOperation"}
|
||||
[:type [:= :set]]
|
||||
[:attr :keyword]
|
||||
[:val :any]
|
||||
[:ignore-touched {:optional true} :boolean]
|
||||
[:ignore-geometry {:optional true} :boolean]]]
|
||||
[:set-touched
|
||||
[:map {:title "SetTouchedOperation"}
|
||||
[:type [:= :set-touched]]
|
||||
[:touched [:maybe [:set :keyword]]]]]
|
||||
[:set-remote-synced
|
||||
[:map {:title "SetRemoteSyncedOperation"}
|
||||
[:type [:= :set-remote-synced]]
|
||||
[:remote-synced {:optional true} [:maybe :boolean]]]]])
|
||||
(def ^:private
|
||||
schema:operation
|
||||
(sm/define
|
||||
[:multi {:dispatch :type :title "Operation" ::smd/simplified true}
|
||||
[:set
|
||||
[:map {:title "SetOperation"}
|
||||
[:type [:= :set]]
|
||||
[:attr :keyword]
|
||||
[:val :any]
|
||||
[:ignore-touched {:optional true} :boolean]
|
||||
[:ignore-geometry {:optional true} :boolean]]]
|
||||
[:set-touched
|
||||
[:map {:title "SetTouchedOperation"}
|
||||
[:type [:= :set-touched]]
|
||||
[:touched [:maybe [:set :keyword]]]]]
|
||||
[:set-remote-synced
|
||||
[:map {:title "SetRemoteSyncedOperation"}
|
||||
[:type [:= :set-remote-synced]]
|
||||
[:remote-synced {:optional true} [:maybe :boolean]]]]]))
|
||||
|
||||
(sm/def! ::change
|
||||
(sm/define! ::change
|
||||
[:schema
|
||||
[:multi {:dispatch :type :title "Change" ::smd/simplified true}
|
||||
[:set-option
|
||||
|
@ -79,7 +81,7 @@
|
|||
[:id ::sm/uuid]
|
||||
[:page-id {:optional true} ::sm/uuid]
|
||||
[:component-id {:optional true} ::sm/uuid]
|
||||
[:operations [:vector {:gen/max 5} ::operation]]]]
|
||||
[:operations [:vector {:gen/max 5} schema:operation]]]]
|
||||
|
||||
[:del-obj
|
||||
[:map {:title "DelObjChange"}
|
||||
|
@ -230,14 +232,14 @@
|
|||
[:type [:= :del-typography]]
|
||||
[:id ::sm/uuid]]]]])
|
||||
|
||||
(sm/def! ::changes
|
||||
(sm/define! ::changes
|
||||
[:sequential {:gen/max 2} ::change])
|
||||
|
||||
(def valid-change?
|
||||
(sm/pred-fn ::change))
|
||||
(def check-change!
|
||||
(sm/check-fn ::change))
|
||||
|
||||
(def valid-changes?
|
||||
(sm/pred-fn [:sequential ::change]))
|
||||
(def check-changes!
|
||||
(sm/check-fn ::changes))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Specific helpers
|
||||
|
@ -263,8 +265,10 @@
|
|||
;; If object has changed or is new verify is correct
|
||||
(when (and (some? shape-new)
|
||||
(not= shape-old shape-new))
|
||||
(dm/verify! (and (cts/shape? shape-new)
|
||||
(cts/valid-shape? shape-new))))))]
|
||||
(dm/verify!
|
||||
"expected valid shape"
|
||||
(and (cts/check-shape! shape-new)
|
||||
(cts/shape? shape-new))))))]
|
||||
|
||||
(->> (into #{} (map :page-id) items)
|
||||
(mapcat (fn [page-id]
|
||||
|
@ -289,7 +293,9 @@
|
|||
;; When verify? false we spec the schema validation. Currently used to make just
|
||||
;; 1 validation even if the changes are applied twice
|
||||
(when verify?
|
||||
(dm/verify! (valid-changes? items)))
|
||||
(dm/verify!
|
||||
"expected valid changes"
|
||||
(check-changes! items)))
|
||||
|
||||
(let [result (reduce #(or (process-change %1 %2) %1) data items)]
|
||||
;; Validate result shapes (only on the backend)
|
||||
|
|
|
@ -24,8 +24,8 @@
|
|||
|
||||
;; Auxiliary functions to help create a set of changes (undo + redo)
|
||||
|
||||
(def schema:changes
|
||||
[:map
|
||||
(sm/define! ::changes
|
||||
[:map {:title "changes"}
|
||||
[:redo-changes vector?]
|
||||
[:undo-changes seq?]
|
||||
[:origin {:optional true} any?]
|
||||
|
@ -33,8 +33,8 @@
|
|||
[:stack-undo? {:optional true} boolean?]
|
||||
[:undo-group {:optional true} any?]])
|
||||
|
||||
(def valid-changes?
|
||||
(sm/pred-fn schema:changes))
|
||||
(def check-changes!
|
||||
(sm/check-fn ::changes))
|
||||
|
||||
(defn empty-changes
|
||||
([origin page-id]
|
||||
|
@ -158,7 +158,7 @@
|
|||
[changes]
|
||||
(dm/assert!
|
||||
"expected valid changes"
|
||||
(valid-changes? changes))
|
||||
(check-changes! changes))
|
||||
|
||||
(if-let [file-data (::file-data (meta changes))]
|
||||
(let [index (::applied-changes-count (meta changes))
|
||||
|
|
|
@ -417,7 +417,7 @@
|
|||
[used basename]
|
||||
(dm/assert!
|
||||
"expected a set of strings"
|
||||
(sm/set-of-strings? used))
|
||||
(sm/check-set-of-strings! used))
|
||||
|
||||
(dm/assert!
|
||||
"expected a string for `basename`."
|
||||
|
|
|
@ -11,14 +11,10 @@
|
|||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape.layout :as ctl]
|
||||
[app.common.uuid :as uuid]))
|
||||
|
||||
(def valid-shape-map?
|
||||
(sm/pred-fn ::cts/shape))
|
||||
|
||||
(defn prepare-add-shape
|
||||
[changes shape objects _selected]
|
||||
(let [index (:index (meta shape))
|
||||
|
|
|
@ -26,17 +26,17 @@
|
|||
[malli.transform :as mt]
|
||||
[malli.util :as mu]))
|
||||
|
||||
(defn validate
|
||||
[s value]
|
||||
(m/validate s value {:registry sr/default-registry}))
|
||||
(defprotocol ISchemaOps
|
||||
(-validate [_ o])
|
||||
(-explain [_ o])
|
||||
(-decode [_ o]))
|
||||
|
||||
(def default-options
|
||||
{:registry sr/default-registry})
|
||||
|
||||
(defn explain
|
||||
[s value]
|
||||
(m/explain s value {:registry sr/default-registry}))
|
||||
|
||||
(defn explain-data
|
||||
[s value]
|
||||
(mu/explain-data s value {:registry sr/default-registry}))
|
||||
(m/explain s value default-options))
|
||||
|
||||
(defn schema?
|
||||
[o]
|
||||
|
@ -44,7 +44,11 @@
|
|||
|
||||
(defn schema
|
||||
[s]
|
||||
(m/schema s {:registry sr/default-registry}))
|
||||
(m/schema s default-options))
|
||||
|
||||
(defn validate
|
||||
[s value]
|
||||
(m/validate s value default-options))
|
||||
|
||||
(defn humanize
|
||||
[exp]
|
||||
|
@ -58,7 +62,7 @@
|
|||
|
||||
(defn form
|
||||
[s]
|
||||
(m/form s {:registry sr/default-registry}))
|
||||
(m/form s default-options))
|
||||
|
||||
(defn merge
|
||||
[& items]
|
||||
|
@ -115,37 +119,37 @@
|
|||
[s]
|
||||
(-> s schema m/explainer))
|
||||
|
||||
(defn lazy-validator
|
||||
[s]
|
||||
(let [vfn (delay (validator s))]
|
||||
(fn [v] (@vfn v))))
|
||||
|
||||
(defn lazy-explainer
|
||||
[s]
|
||||
(let [vfn (delay (explainer s))]
|
||||
(fn [v] (@vfn v))))
|
||||
|
||||
(defn encode
|
||||
([s val transformer]
|
||||
(m/encode s val {:registry sr/default-registry} transformer))
|
||||
(m/encode s val default-options transformer))
|
||||
([s val options transformer]
|
||||
(m/encode s val options transformer)))
|
||||
|
||||
(defn decode
|
||||
([s val transformer]
|
||||
(m/decode s val {:registry sr/default-registry} transformer))
|
||||
(m/decode s val default-options transformer))
|
||||
([s val options transformer]
|
||||
(m/decode s val options transformer)))
|
||||
|
||||
(defn decoder
|
||||
([s transformer]
|
||||
(m/decoder s {:registry sr/default-registry} transformer))
|
||||
(m/decoder s default-options transformer))
|
||||
([s options transformer]
|
||||
(m/decoder s options transformer)))
|
||||
|
||||
(defn lazy-validator
|
||||
[s]
|
||||
(let [vfn (delay (validator (if (delay? s) (deref s) s)))]
|
||||
(fn [v] (@vfn v))))
|
||||
|
||||
(defn lazy-explainer
|
||||
[s]
|
||||
(let [vfn (delay (explainer (if (delay? s) (deref s) s)))]
|
||||
(fn [v] (@vfn v))))
|
||||
|
||||
(defn lazy-decoder
|
||||
[s transformer]
|
||||
(let [vfn (delay (decoder s transformer))]
|
||||
(let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
|
||||
(fn [v] (@vfn v))))
|
||||
|
||||
(defn humanize-data
|
||||
|
@ -198,46 +202,86 @@
|
|||
([s] (lookup sr/default-registry s))
|
||||
([registry s] (schema (mr/schema registry s))))
|
||||
|
||||
(defn pred-fn
|
||||
(declare define)
|
||||
|
||||
(defn fast-check!
|
||||
"A fast path for checking process, assumes the ISchemaOps protocol
|
||||
implemented on the provided `s` schema. Sould not be used directly."
|
||||
[s value]
|
||||
(when-not ^boolean (-validate s value)
|
||||
(let [hint (d/nilv dm/*assert-context* "check error")
|
||||
explain (-explain s value)]
|
||||
(throw (ex-info hint {:type :assertion
|
||||
:code :data-validation
|
||||
:hint hint
|
||||
::explain explain}))))
|
||||
true)
|
||||
|
||||
(defn check-fn
|
||||
"Create a predefined check function"
|
||||
[s]
|
||||
(let [s (schema s)
|
||||
v-fn (lazy-validator s)
|
||||
e-fn (lazy-explainer s)]
|
||||
(fn [v]
|
||||
(let [result (v-fn v)]
|
||||
(when (and (not result) (true? dm/*assert-context*))
|
||||
(let [hint "schema validation"
|
||||
exp (e-fn v)]
|
||||
(throw (ex-info hint {:type :assertion
|
||||
:code :data-validation
|
||||
:hint hint
|
||||
::explain exp}))))
|
||||
result))))
|
||||
(let [schema (if (satisfies? ISchemaOps s) s (define s))]
|
||||
(partial fast-check! schema)))
|
||||
|
||||
(defn check!
|
||||
"A helper intended to be used on assertions for validate/check the
|
||||
schema over provided data. Raises an assertion exception, should be
|
||||
used together with `dm/assert!` or `dm/verify!`."
|
||||
[s value]
|
||||
(if (satisfies? ISchemaOps s)
|
||||
(fast-check! s value)
|
||||
(do
|
||||
(when-not ^boolean (m/validate s value default-options)
|
||||
(let [hint (d/nilv dm/*assert-context* "check error")
|
||||
explain (explain s value)]
|
||||
(throw (ex-info hint {:type :assertion
|
||||
:code :data-validation
|
||||
:hint hint
|
||||
::explain explain}))))
|
||||
true)))
|
||||
|
||||
|
||||
(defn valid?
|
||||
[s v]
|
||||
(let [result (validate s v)]
|
||||
(when (and (not result) (true? dm/*assert-context*))
|
||||
(let [hint "schema validation"
|
||||
exp (explain s v)]
|
||||
(throw (ex-info hint {:type :assertion
|
||||
:code :data-validation
|
||||
:hint hint
|
||||
::explain exp}))))
|
||||
result))
|
||||
(defn fast-validate!
|
||||
"A fast path for validation process, assumes the ISchemaOps protocol
|
||||
implemented on the provided `s` schema. Sould not be used directly."
|
||||
([s value] (fast-validate! s value nil))
|
||||
([s value options]
|
||||
(when-not ^boolean (-validate s value)
|
||||
(let [explain (-explain s value)
|
||||
options (into {:type :validation
|
||||
:code :data-validation
|
||||
::explain explain}
|
||||
options)
|
||||
hint (get options :hint "schema validation error")]
|
||||
(throw (ex-info hint options))))))
|
||||
|
||||
(defn assert-fn
|
||||
(defn validate-fn
|
||||
"Create a predefined validate function"
|
||||
[s]
|
||||
(let [f (pred-fn s)]
|
||||
(fn [v]
|
||||
(dm/assert! (f v)))))
|
||||
(let [schema (if (satisfies? ISchemaOps s) s (define s))]
|
||||
(partial fast-validate! schema)))
|
||||
|
||||
(defmacro verify-fn
|
||||
[s]
|
||||
(let [f (pred-fn s)]
|
||||
(fn [v]
|
||||
(dm/verify! (f v)))))
|
||||
(defn validate!
|
||||
"A generic validation function for predefined schemas."
|
||||
([s value] (validate! s value nil))
|
||||
([s value options]
|
||||
(if (satisfies? ISchemaOps s)
|
||||
(fast-validate! s value options)
|
||||
(when-not ^boolean (m/validate s value default-options)
|
||||
(let [explain (explain s value)
|
||||
options (into {:type :validation
|
||||
:code :data-validation
|
||||
::explain explain}
|
||||
options)
|
||||
hint (get options :hint "schema validation error")]
|
||||
(throw (ex-info hint options)))))))
|
||||
|
||||
(defn conform!
|
||||
[schema value]
|
||||
(assert (satisfies? ISchemaOps schema) "expected `schema` to satisfy ISchemaOps protocol")
|
||||
(let [params (-decode schema value)]
|
||||
(fast-validate! schema params nil)
|
||||
params))
|
||||
|
||||
(defn register! [type s]
|
||||
(let [s (if (map? s) (simple-schema s) s)]
|
||||
|
@ -247,6 +291,65 @@
|
|||
(register! type s)
|
||||
nil)
|
||||
|
||||
(defn define! [id s]
|
||||
(register! id s)
|
||||
nil)
|
||||
|
||||
(defn define
|
||||
[s]
|
||||
(let [schema (delay (schema s))
|
||||
validator (delay (validator @schema))
|
||||
explainer (delay (explainer @schema))
|
||||
decoder (delay (decoder @schema default-transformer))]
|
||||
|
||||
(reify
|
||||
m/AST
|
||||
(-to-ast [_ options] (m/-to-ast @schema options))
|
||||
|
||||
m/EntrySchema
|
||||
(-entries [_] (m/-entries @schema))
|
||||
(-entry-parser [_] (m/-entry-parser @schema))
|
||||
|
||||
m/Cached
|
||||
(-cache [_] (m/-cache @schema))
|
||||
|
||||
m/LensSchema
|
||||
(-keep [_] (m/-keep @schema))
|
||||
(-get [_ key default] (m/-get @schema key default))
|
||||
(-set [_ key value] (m/-set @schema key value))
|
||||
|
||||
m/Schema
|
||||
(-validator [_]
|
||||
(m/-validator @schema))
|
||||
(-explainer [_ path]
|
||||
(m/-explainer @schema path))
|
||||
(-parser [_]
|
||||
(m/-parser @schema))
|
||||
(-unparser [_]
|
||||
(m/-unparser @schema))
|
||||
(-transformer [_ transformer method options]
|
||||
(m/-transformer @schema transformer method options))
|
||||
(-walk [_ walker path options]
|
||||
(m/-walk @schema walker path options))
|
||||
(-properties [_]
|
||||
(m/-properties @schema))
|
||||
(-options [_]
|
||||
(m/-options @schema))
|
||||
(-children [_]
|
||||
(m/-children @schema))
|
||||
(-parent [_]
|
||||
(m/-parent @schema))
|
||||
(-form [_]
|
||||
(m/-form @schema))
|
||||
|
||||
ISchemaOps
|
||||
(-validate [_ o]
|
||||
(@validator o))
|
||||
(-explain [_ o]
|
||||
(@explainer o))
|
||||
(-decode [_ o]
|
||||
(@decoder o)))))
|
||||
|
||||
;; --- GENERATORS
|
||||
|
||||
;; FIXME: replace with sg/subseq
|
||||
|
@ -261,8 +364,8 @@
|
|||
|
||||
;; --- BUILTIN SCHEMAS
|
||||
|
||||
(def! :merge (mu/-merge))
|
||||
(def! :union (mu/-union))
|
||||
(define! :merge (mu/-merge))
|
||||
(define! :union (mu/-union))
|
||||
|
||||
(def uuid-rx
|
||||
#"^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$")
|
||||
|
@ -273,7 +376,7 @@
|
|||
(some->> (re-matches uuid-rx s) uuid/uuid)
|
||||
s))
|
||||
|
||||
(def! ::uuid
|
||||
(define! ::uuid
|
||||
{:type ::uuid
|
||||
:pred uuid?
|
||||
:type-properties
|
||||
|
@ -294,7 +397,7 @@
|
|||
s))
|
||||
|
||||
;; FIXME: add proper email generator
|
||||
(def! ::email
|
||||
(define! ::email
|
||||
{:type ::email
|
||||
:pred (fn [s]
|
||||
(and (string? s)
|
||||
|
@ -315,7 +418,7 @@
|
|||
(remove str/empty?)
|
||||
(remove str/blank?)))
|
||||
|
||||
(def! ::set-of-strings
|
||||
(define! ::set-of-strings
|
||||
{:type ::set-of-strings
|
||||
:pred #(and (set? %) (every? string? %))
|
||||
:type-properties
|
||||
|
@ -331,7 +434,7 @@
|
|||
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
|
||||
(into #{} non-empty-strings-xf v)))}})
|
||||
|
||||
(def! ::set-of-keywords
|
||||
(define! ::set-of-keywords
|
||||
{:type ::set-of-keywords
|
||||
:pred #(and (set? %) (every? keyword? %))
|
||||
:type-properties
|
||||
|
@ -347,7 +450,7 @@
|
|||
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
|
||||
(into #{} (comp non-empty-strings-xf (map keyword)) v)))}})
|
||||
|
||||
(def! ::set-of-emails
|
||||
(define! ::set-of-emails
|
||||
{:type ::set-of-emails
|
||||
:pred #(and (set? %) (every? string? %))
|
||||
:type-properties
|
||||
|
@ -363,7 +466,7 @@
|
|||
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
|
||||
(into #{} (keep parse-email) v)))}})
|
||||
|
||||
(def! ::set-of-uuid
|
||||
(define! ::set-of-uuid
|
||||
{:type ::set-of-uuid
|
||||
:pred #(and (set? %) (every? uuid? %))
|
||||
:type-properties
|
||||
|
@ -379,7 +482,7 @@
|
|||
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
|
||||
(into #{} (keep parse-uuid) v)))}})
|
||||
|
||||
(def! ::coll-of-uuid
|
||||
(define! ::coll-of-uuid
|
||||
{:type ::set-of-uuid
|
||||
:pred (partial every? uuid?)
|
||||
:type-properties
|
||||
|
@ -395,7 +498,7 @@
|
|||
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
|
||||
(into [] (keep parse-uuid) v)))}})
|
||||
|
||||
(def! ::one-of
|
||||
(define! ::one-of
|
||||
{:type ::one-of
|
||||
:min 1
|
||||
:max 1
|
||||
|
@ -418,7 +521,7 @@
|
|||
;; Integer/MIN_VALUE
|
||||
(def min-safe-int -2147483648)
|
||||
|
||||
(def! ::safe-int
|
||||
(define! ::safe-int
|
||||
{:type ::safe-int
|
||||
:pred #(and (int? %) (>= max-safe-int %) (>= % min-safe-int))
|
||||
:type-properties
|
||||
|
@ -433,7 +536,7 @@
|
|||
(parse-long s)
|
||||
s))}})
|
||||
|
||||
(def! ::safe-number
|
||||
(define! ::safe-number
|
||||
{:type ::safe-number
|
||||
:pred #(and (number? %) (>= max-safe-int %) (>= % min-safe-int))
|
||||
:type-properties
|
||||
|
@ -449,7 +552,7 @@
|
|||
(parse-double s)
|
||||
s))}})
|
||||
|
||||
(def! ::safe-double
|
||||
(define! ::safe-double
|
||||
{:type ::safe-double
|
||||
:pred #(and (double? %) (>= max-safe-int %) (>= % min-safe-int))
|
||||
:type-properties
|
||||
|
@ -464,7 +567,7 @@
|
|||
(parse-double s)
|
||||
s))}})
|
||||
|
||||
(def! ::contains-any
|
||||
(define! ::contains-any
|
||||
{:type ::contains-any
|
||||
:min 1
|
||||
:max 1
|
||||
|
@ -482,7 +585,7 @@
|
|||
{:title "contains"
|
||||
:description "contains predicate"}}))})
|
||||
|
||||
(def! ::inst
|
||||
(define! ::inst
|
||||
{:type ::inst
|
||||
:pred inst?
|
||||
:type-properties
|
||||
|
@ -493,10 +596,10 @@
|
|||
::oapi/type "number"
|
||||
::oapi/format "int64"}})
|
||||
|
||||
(def! ::fn
|
||||
(define! ::fn
|
||||
[:schema fn?])
|
||||
|
||||
(def! ::word-string
|
||||
(define! ::word-string
|
||||
{:type ::word-string
|
||||
:pred #(and (string? %) (not (str/blank? %)))
|
||||
:property-pred (m/-min-max-pred count)
|
||||
|
@ -508,7 +611,7 @@
|
|||
::oapi/type "string"
|
||||
::oapi/format "string"}})
|
||||
|
||||
(def! ::uri
|
||||
(define! ::uri
|
||||
{:type ::uri
|
||||
:pred u/uri?
|
||||
:type-properties
|
||||
|
@ -522,20 +625,20 @@
|
|||
|
||||
;; ---- PREDICATES
|
||||
|
||||
(def safe-int?
|
||||
(pred-fn ::safe-int))
|
||||
(def check-safe-int!
|
||||
(check-fn ::safe-int))
|
||||
|
||||
(def set-of-strings?
|
||||
(pred-fn ::set-of-strings))
|
||||
(def check-set-of-strings!
|
||||
(check-fn ::set-of-strings))
|
||||
|
||||
(def set-of-emails?
|
||||
(pred-fn ::set-of-emails))
|
||||
(def check-email!
|
||||
(check-fn ::email))
|
||||
|
||||
(def set-of-uuid?
|
||||
(pred-fn ::set-of-uuid))
|
||||
(def check-coll-of-uuid!
|
||||
(check-fn ::coll-of-uuid))
|
||||
|
||||
(def coll-of-uuid?
|
||||
(pred-fn ::coll-of-uuid))
|
||||
(def check-set-of-uuid!
|
||||
(check-fn ::set-of-uuid))
|
||||
|
||||
(def email?
|
||||
(pred-fn ::email))
|
||||
(def check-set-of-emails!
|
||||
(check-fn ::set-of-emails))
|
||||
|
|
|
@ -59,6 +59,19 @@
|
|||
item))
|
||||
root)))
|
||||
|
||||
(defn xform-nodes
|
||||
"The same as transform but instead of receiving a funcion, receives
|
||||
a transducer."
|
||||
[xf root]
|
||||
(let [rf (fn [_ v] v)]
|
||||
(walk/postwalk
|
||||
(fn [item]
|
||||
(let [rf (xf rf)]
|
||||
(if (map? item)
|
||||
(d/nilv (rf nil item) item)
|
||||
item)))
|
||||
root)))
|
||||
|
||||
(defn node-seq
|
||||
([root] (node-seq identity root))
|
||||
([match? root]
|
||||
|
|
|
@ -34,7 +34,7 @@
|
|||
(.. g (toString 16) (padStart 2 "0"))
|
||||
(.. b (toString 16) (padStart 2 "0"))))))
|
||||
|
||||
(sm/def! ::rgb-color
|
||||
(sm/define! ::rgb-color
|
||||
{:type ::rgb-color
|
||||
:pred #(and (string? %) (some? (re-matches rgb-color-re %)))
|
||||
:type-properties
|
||||
|
@ -46,7 +46,7 @@
|
|||
::oapi/type "integer"
|
||||
::oapi/format "int64"}})
|
||||
|
||||
(sm/def! ::image-color
|
||||
(sm/define! ::image-color
|
||||
[:map {:title "ImageColor"}
|
||||
[:name {:optional true} :string]
|
||||
[:width :int]
|
||||
|
@ -54,7 +54,7 @@
|
|||
[:mtype {:optional true} [:maybe :string]]
|
||||
[:id ::sm/uuid]])
|
||||
|
||||
(sm/def! ::gradient
|
||||
(sm/define! ::gradient
|
||||
[:map {:title "Gradient"}
|
||||
[:type [::sm/one-of #{:linear :radial "linear" "radial"}]]
|
||||
[:start-x ::sm/safe-number]
|
||||
|
@ -69,7 +69,7 @@
|
|||
[:opacity {:optional true} [:maybe ::sm/safe-number]]
|
||||
[:offset ::sm/safe-number]]]]])
|
||||
|
||||
(sm/def! ::color
|
||||
(sm/define! ::color
|
||||
[:map {:title "Color"}
|
||||
[:id {:optional true} ::sm/uuid]
|
||||
[:name {:optional true} :string]
|
||||
|
@ -83,7 +83,7 @@
|
|||
[:gradient {:optional true} [:maybe ::gradient]]
|
||||
[:image {:optional true} [:maybe ::image-color]]])
|
||||
|
||||
(sm/def! ::recent-color
|
||||
(sm/define! ::recent-color
|
||||
[:and
|
||||
[:map {:title "RecentColor"}
|
||||
[:opacity {:optional true} [:maybe ::sm/safe-number]]
|
||||
|
@ -92,11 +92,11 @@
|
|||
[:image {:optional true} [:maybe ::image-color]]]
|
||||
[::sm/contains-any {:strict true} [:color :gradient :image]]])
|
||||
|
||||
(def valid-color?
|
||||
(sm/pred-fn ::color))
|
||||
(def check-color!
|
||||
(sm/check-fn ::color))
|
||||
|
||||
(def valid-recent-color?
|
||||
(sm/pred-fn ::recent-color))
|
||||
(def check-recent-color!
|
||||
(sm/check-fn ::recent-color))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPERS
|
||||
|
|
|
@ -25,7 +25,7 @@
|
|||
(def valid-container-types
|
||||
#{:page :component})
|
||||
|
||||
(sm/def! ::container
|
||||
(sm/define! ::container
|
||||
[:map
|
||||
[:id ::sm/uuid]
|
||||
[:type {:optional true}
|
||||
|
@ -36,8 +36,8 @@
|
|||
[:objects {:optional true}
|
||||
[:map-of {:gen/max 10} ::sm/uuid :map]]])
|
||||
|
||||
(def container?
|
||||
(sm/pred-fn ::container))
|
||||
(def check-container!
|
||||
(sm/check-fn ::container))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPERS
|
||||
|
@ -71,7 +71,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid container"
|
||||
(container? container))
|
||||
(check-container! container))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid uuid for `shape-id`"
|
||||
|
|
|
@ -33,7 +33,7 @@
|
|||
;; SCHEMA
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(sm/def! ::media-object
|
||||
(sm/define! ::media-object
|
||||
[:map {:title "FileMediaObject"}
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
|
@ -42,7 +42,7 @@
|
|||
[:mtype :string]
|
||||
[:path {:optional true} [:maybe :string]]])
|
||||
|
||||
(sm/def! ::data
|
||||
(sm/define! ::data
|
||||
[:map {:title "FileData"}
|
||||
[:pages [:vector ::sm/uuid]]
|
||||
[:pages-index
|
||||
|
@ -58,11 +58,11 @@
|
|||
[:media {:optional true}
|
||||
[:map-of {:gen/max 5} ::sm/uuid ::media-object]]])
|
||||
|
||||
(def valid-file-data?
|
||||
(sm/pred-fn ::data))
|
||||
(def check-file-data!
|
||||
(sm/check-fn ::data))
|
||||
|
||||
(def valid-media-object?
|
||||
(sm/pred-fn ::media-object))
|
||||
(def check-media-object!
|
||||
(sm/check-fn ::media-object))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; INITIALIZATION
|
||||
|
|
|
@ -18,26 +18,20 @@
|
|||
;; SCHEMAS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(sm/def! ::flow
|
||||
(sm/define! ::flow
|
||||
[:map {:title "PageFlow"}
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
[:starting-frame ::sm/uuid]])
|
||||
|
||||
(def flow?
|
||||
(sm/pred-fn ::flow))
|
||||
|
||||
(sm/def! ::guide
|
||||
(sm/define! ::guide
|
||||
[:map {:title "PageGuide"}
|
||||
[:id ::sm/uuid]
|
||||
[:axis [::sm/one-of #{:x :y}]]
|
||||
[:position ::sm/safe-number]
|
||||
[:frame-id {:optional true} [:maybe ::sm/uuid]]])
|
||||
|
||||
(def guide?
|
||||
(sm/pred-fn ::guide))
|
||||
|
||||
(sm/def! ::page
|
||||
(sm/define! ::page
|
||||
[:map {:title "FilePage"}
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]
|
||||
|
@ -52,8 +46,11 @@
|
|||
[:guides {:optional true}
|
||||
[:map-of {:gen/max 2} ::sm/uuid ::guide]]]]])
|
||||
|
||||
(def page?
|
||||
(sm/pred-fn ::page))
|
||||
(def check-page-guide!
|
||||
(sm/check-fn ::guide))
|
||||
|
||||
(def check-page!
|
||||
(sm/check-fn ::page))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; INIT & HELPERS
|
||||
|
|
|
@ -77,7 +77,7 @@
|
|||
(def text-align-types
|
||||
#{"left" "right" "center" "justify"})
|
||||
|
||||
(sm/def! ::selrect
|
||||
(sm/define! ::selrect
|
||||
[:and
|
||||
{:title "Selrect"
|
||||
:gen/gen (->> (sg/tuple (sg/small-double)
|
||||
|
@ -96,10 +96,10 @@
|
|||
[:width ::sm/safe-number]
|
||||
[:height ::sm/safe-number]]])
|
||||
|
||||
(sm/def! ::points
|
||||
(sm/define! ::points
|
||||
[:vector {:gen/max 4 :gen/min 4} ::gpt/point])
|
||||
|
||||
(sm/def! ::fill
|
||||
(sm/define! ::fill
|
||||
[:map {:title "Fill"}
|
||||
[:fill-color {:optional true} ::ctc/rgb-color]
|
||||
[:fill-opacity {:optional true} ::sm/safe-number]
|
||||
|
@ -108,7 +108,7 @@
|
|||
[:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
|
||||
[:fill-image {:optional true} ::ctc/image-color]])
|
||||
|
||||
(sm/def! ::stroke
|
||||
(sm/define! ::stroke
|
||||
[:map {:title "Stroke"}
|
||||
[:stroke-color {:optional true} :string]
|
||||
[:stroke-color-ref-file {:optional true} ::sm/uuid]
|
||||
|
@ -126,7 +126,7 @@
|
|||
[:stroke-color-gradient {:optional true} ::ctc/gradient]
|
||||
[:stroke-image {:optional true} ::ctc/image-color]])
|
||||
|
||||
(sm/def! ::minimal-shape-attrs
|
||||
(sm/define! ::minimal-shape-attrs
|
||||
[:map {:title "ShapeMinimalRecord"}
|
||||
[:id {:optional false} ::sm/uuid]
|
||||
[:name {:optional false} :string]
|
||||
|
@ -142,7 +142,7 @@
|
|||
[:parent-id {:optional false} ::sm/uuid]
|
||||
[:frame-id {:optional false} ::sm/uuid]])
|
||||
|
||||
(sm/def! ::shape-attrs
|
||||
(sm/define! ::shape-attrs
|
||||
[:map {:title "ShapeAttrs"}
|
||||
[:name {:optional true} :string]
|
||||
[:component-id {:optional true} ::sm/uuid]
|
||||
|
@ -197,15 +197,12 @@
|
|||
[::sm/one-of #{:auto-width :auto-height :fixed}]]
|
||||
])
|
||||
|
||||
(def valid-shape-attrs?
|
||||
(sm/pred-fn ::shape-attrs))
|
||||
|
||||
(sm/def! ::group-attrs
|
||||
(sm/define! ::group-attrs
|
||||
[:map {:title "GroupAttrs"}
|
||||
[:type [:= :group]]
|
||||
[:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]])
|
||||
|
||||
(sm/def! ::frame-attrs
|
||||
(sm/define! ::frame-attrs
|
||||
[:map {:title "FrameAttrs"}
|
||||
[:type [:= :frame]]
|
||||
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
|
||||
|
@ -213,7 +210,7 @@
|
|||
[:show-content {:optional true} :boolean]
|
||||
[:hide-in-viewer {:optional true} :boolean]])
|
||||
|
||||
(sm/def! ::bool-attrs
|
||||
(sm/define! ::bool-attrs
|
||||
[:map {:title "BoolAttrs"}
|
||||
[:type [:= :bool]]
|
||||
[:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]
|
||||
|
@ -231,19 +228,19 @@
|
|||
[:maybe
|
||||
[:map-of {:gen/max 5} :keyword ::sm/safe-number]]]]]]])
|
||||
|
||||
(sm/def! ::rect-attrs
|
||||
(sm/define! ::rect-attrs
|
||||
[:map {:title "RectAttrs"}
|
||||
[:type [:= :rect]]])
|
||||
|
||||
(sm/def! ::circle-attrs
|
||||
(sm/define! ::circle-attrs
|
||||
[:map {:title "CircleAttrs"}
|
||||
[:type [:= :circle]]])
|
||||
|
||||
(sm/def! ::svg-raw-attrs
|
||||
(sm/define! ::svg-raw-attrs
|
||||
[:map {:title "SvgRawAttrs"}
|
||||
[:type [:= :svg-raw]]])
|
||||
|
||||
(sm/def! ::image-attrs
|
||||
(sm/define! ::image-attrs
|
||||
[:map {:title "ImageAttrs"}
|
||||
[:type [:= :image]]
|
||||
[:metadata
|
||||
|
@ -253,7 +250,7 @@
|
|||
[:mtype {:optional true} [:maybe :string]]
|
||||
[:id ::sm/uuid]]]])
|
||||
|
||||
(sm/def! ::path-attrs
|
||||
(sm/define! ::path-attrs
|
||||
[:map {:title "PathAttrs"}
|
||||
[:type [:= :path]]
|
||||
[:x {:optional true} [:maybe ::sm/safe-number]]
|
||||
|
@ -267,12 +264,12 @@
|
|||
[:command :keyword]
|
||||
[:params {:optional true} [:maybe :map]]]]]])
|
||||
|
||||
(sm/def! ::text-attrs
|
||||
(sm/define! ::text-attrs
|
||||
[:map {:title "TextAttrs"}
|
||||
[:type [:= :text]]
|
||||
[:content {:optional true} [:maybe ::ctsx/content]]])
|
||||
|
||||
(sm/def! ::shape-map
|
||||
(sm/define! ::shape-map
|
||||
[:multi {:dispatch :type :title "Shape"}
|
||||
[:group
|
||||
[:merge {:title "GroupShape"}
|
||||
|
@ -337,7 +334,7 @@
|
|||
::text-attrs
|
||||
::ctsl/layout-child-attrs]]])
|
||||
|
||||
(sm/def! ::shape
|
||||
(sm/define! ::shape
|
||||
[:and
|
||||
{:title "Shape"
|
||||
:gen/gen (->> (sg/generator ::shape-map)
|
||||
|
@ -345,13 +342,15 @@
|
|||
::shape-map
|
||||
[:fn shape?]])
|
||||
|
||||
(def valid-shape?
|
||||
(sm/pred-fn ::shape))
|
||||
(def check-shape-attrs!
|
||||
(sm/check-fn ::shape-attrs))
|
||||
|
||||
(def check-shape!
|
||||
(sm/check-fn ::shape))
|
||||
|
||||
(defn has-images?
|
||||
[{:keys [fills strokes]}]
|
||||
(or
|
||||
(or
|
||||
(some :fill-image fills)
|
||||
(some :stroke-image strokes)))
|
||||
|
||||
|
|
|
@ -71,7 +71,7 @@
|
|||
(def animation-types
|
||||
#{:dissolve :slide :push})
|
||||
|
||||
(sm/def! ::animation
|
||||
(sm/define! ::animation
|
||||
[:multi {:dispatch :animation-type :title "Animation"}
|
||||
[:dissolve
|
||||
[:map {:title "AnimationDisolve"}
|
||||
|
@ -93,10 +93,10 @@
|
|||
[:easing [::sm/one-of easing-types]]
|
||||
[:direction [::sm/one-of direction-types]]]]])
|
||||
|
||||
(def animation?
|
||||
(sm/pred-fn ::animation))
|
||||
(def check-animation!
|
||||
(sm/check-fn ::animation))
|
||||
|
||||
(sm/def! ::interaction
|
||||
(sm/define! ::interaction
|
||||
[:multi {:dispatch :action-type}
|
||||
[:navigate
|
||||
[:map
|
||||
|
@ -144,6 +144,9 @@
|
|||
[:event-type [::sm/one-of event-types]]
|
||||
[:url :string]]]])
|
||||
|
||||
(def check-interaction!
|
||||
(sm/check-fn ::interaction))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -157,15 +160,8 @@
|
|||
|
||||
(def default-delay 600)
|
||||
|
||||
|
||||
;; -- Helpers for interaction
|
||||
|
||||
(def interaction?
|
||||
(sm/pred-fn ::interaction))
|
||||
|
||||
;; (def destination?
|
||||
;; (sm/pred-fn [:maybe ::sm/uuid]))
|
||||
|
||||
(declare calc-overlay-pos-initial)
|
||||
(declare allowed-animation?)
|
||||
|
||||
|
@ -173,7 +169,7 @@
|
|||
[interaction event-type shape]
|
||||
(dm/assert!
|
||||
"Should be an interraction map"
|
||||
^boolean (interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"Should be a valid event type"
|
||||
|
@ -201,7 +197,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"Should be an interraction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"Should be a valid event type"
|
||||
|
@ -255,11 +251,11 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid delay"
|
||||
(sm/safe-int? delay))
|
||||
(sm/check-safe-int! delay))
|
||||
|
||||
(dm/assert!
|
||||
"expected compatible interaction event type"
|
||||
|
@ -286,7 +282,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected compatible interaction event type"
|
||||
|
@ -310,7 +306,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected boolean for `preserve-scroll`"
|
||||
|
@ -331,7 +327,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected a string for `url`"
|
||||
|
@ -352,7 +348,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid overlay positioning type"
|
||||
|
@ -373,7 +369,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid overlay positioning type"
|
||||
|
@ -397,7 +393,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid overlay position"
|
||||
|
@ -416,7 +412,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected boolean value for `close-click-outside`"
|
||||
|
@ -433,7 +429,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected boolean value for `background-overlay`"
|
||||
|
@ -450,7 +446,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid uuid for `position-relative-to`"
|
||||
|
@ -489,7 +485,7 @@
|
|||
;; of that frame
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected compatible interaction map"
|
||||
|
@ -587,7 +583,7 @@
|
|||
[interaction animation-type]
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid value for `animation-type`"
|
||||
|
@ -638,11 +634,11 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid duration"
|
||||
(sm/safe-int? duration))
|
||||
(sm/check-safe-int! duration))
|
||||
|
||||
(dm/assert!
|
||||
"expected compatible interaction map"
|
||||
|
@ -659,7 +655,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid easing"
|
||||
|
@ -682,7 +678,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid way"
|
||||
|
@ -703,7 +699,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid direction"
|
||||
|
@ -720,7 +716,7 @@
|
|||
(dm/assert!
|
||||
"expected valid animation map"
|
||||
(or (nil? animation)
|
||||
(animation? animation)))
|
||||
(check-animation! animation)))
|
||||
|
||||
(case (:direction animation)
|
||||
:right
|
||||
|
@ -745,7 +741,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid interaction map"
|
||||
(interaction? interaction))
|
||||
(check-interaction! interaction))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid boolean for `offset-effect`"
|
||||
|
|
|
@ -116,7 +116,7 @@
|
|||
(def grid-cell-justify-self-types
|
||||
#{:auto :start :center :end :stretch})
|
||||
|
||||
(sm/def! ::grid-cell
|
||||
(sm/define! ::grid-cell
|
||||
[:map {:title "GridCell"}
|
||||
[:id ::sm/uuid]
|
||||
[:area-name {:optional true} :string]
|
||||
|
@ -130,11 +130,14 @@
|
|||
[:shapes
|
||||
[:vector {:gen/max 1} ::sm/uuid]]])
|
||||
|
||||
(sm/def! ::grid-track
|
||||
(sm/define! ::grid-track
|
||||
[:map {:title "GridTrack"}
|
||||
[:type [::sm/one-of grid-track-types]]
|
||||
[:value {:optional true} [:maybe ::sm/safe-number]]])
|
||||
|
||||
(def check-grid-track!
|
||||
(sm/check-fn ::grid-track))
|
||||
|
||||
;; LAYOUT CHILDREN
|
||||
|
||||
(def item-margin-types
|
||||
|
@ -168,8 +171,6 @@
|
|||
[:layout-item-absolute {:optional true} :boolean]
|
||||
[:layout-item-z-index {:optional true} ::sm/safe-number]])
|
||||
|
||||
(def grid-track? (sm/pred-fn ::grid-track))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SCHEMAS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -597,7 +598,7 @@
|
|||
[parent value]
|
||||
(dm/assert!
|
||||
"expected a valid grid definition for `value`"
|
||||
(grid-track? value))
|
||||
(check-grid-track! value))
|
||||
|
||||
(let [rows (:layout-grid-rows parent)
|
||||
new-col-num (inc (count (:layout-grid-columns parent)))
|
||||
|
@ -620,7 +621,7 @@
|
|||
[parent value]
|
||||
(dm/assert!
|
||||
"expected a valid grid definition for `value`"
|
||||
(grid-track? value))
|
||||
(check-grid-track! value))
|
||||
|
||||
(let [cols (:layout-grid-columns parent)
|
||||
new-row-num (inc (count (:layout-grid-rows parent)))
|
||||
|
|
|
@ -29,8 +29,8 @@
|
|||
[:modified-at {:optional true} ::sm/inst]
|
||||
[:path {:optional true} [:maybe :string]]])
|
||||
|
||||
(def typography?
|
||||
(sm/pred-fn ::typography))
|
||||
(def check-typography!
|
||||
(sm/check-fn ::typography))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPERS
|
||||
|
|
|
@ -25,7 +25,7 @@
|
|||
(sg/check!
|
||||
(sg/for [fdata (sg/generator ::cts/shape)]
|
||||
(binding [app.common.data.macros/*assert-context* true]
|
||||
(t/is (sm/valid? ::cts/shape fdata))))))
|
||||
(t/is (sm/validate ::cts/shape fdata))))))
|
||||
|
||||
(t/deftest types-page-spec
|
||||
(-> (sg/for [fdata (sg/generator ::ctp/page)]
|
||||
|
|
|
@ -17,38 +17,40 @@
|
|||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
(def schema:comment-thread
|
||||
[:map {:title "CommentThread"}
|
||||
[:id ::sm/uuid]
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:project-id ::sm/uuid]
|
||||
[:owner-id ::sm/uuid]
|
||||
[:page-name :string]
|
||||
[:file-name :string]
|
||||
[:seqn :int]
|
||||
[:content :string]
|
||||
[:participants ::sm/set-of-uuid]
|
||||
[:created-at ::sm/inst]
|
||||
[:modified-at ::sm/inst]
|
||||
[:position ::gpt/point]
|
||||
[:count-unread-comments {:optional true} :int]
|
||||
[:count-comments {:optional true} :int]])
|
||||
(def ^:private schema:comment-thread
|
||||
(sm/define
|
||||
[:map {:title "CommentThread"}
|
||||
[:id ::sm/uuid]
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:project-id ::sm/uuid]
|
||||
[:owner-id ::sm/uuid]
|
||||
[:page-name :string]
|
||||
[:file-name :string]
|
||||
[:seqn :int]
|
||||
[:content :string]
|
||||
[:participants ::sm/set-of-uuid]
|
||||
[:created-at ::sm/inst]
|
||||
[:modified-at ::sm/inst]
|
||||
[:position ::gpt/point]
|
||||
[:count-unread-comments {:optional true} :int]
|
||||
[:count-comments {:optional true} :int]]))
|
||||
|
||||
(def schema:comment
|
||||
[:map {:title "CommentThread"}
|
||||
[:id ::sm/uuid]
|
||||
[:thread-id ::sm/uuid]
|
||||
[:owner-id ::sm/uuid]
|
||||
[:created-at ::sm/inst]
|
||||
[:modified-at ::sm/inst]
|
||||
[:content :string]])
|
||||
(def ^:private schema:comment
|
||||
(sm/define
|
||||
[:map {:title "Comment"}
|
||||
[:id ::sm/uuid]
|
||||
[:thread-id ::sm/uuid]
|
||||
[:owner-id ::sm/uuid]
|
||||
[:created-at ::sm/inst]
|
||||
[:modified-at ::sm/inst]
|
||||
[:content :string]]))
|
||||
|
||||
(def comment-thread?
|
||||
(sm/pred-fn schema:comment-thread))
|
||||
(def check-comment-thread!
|
||||
(sm/check-fn schema:comment-thread))
|
||||
|
||||
(def comment?
|
||||
(sm/pred-fn schema:comment))
|
||||
(def check-comment!
|
||||
(sm/check-fn schema:comment))
|
||||
|
||||
(declare create-draft-thread)
|
||||
(declare retrieve-comment-threads)
|
||||
|
@ -68,16 +70,20 @@
|
|||
(update-in [:comments id] assoc (:id comment) comment)))))
|
||||
|
||||
|
||||
(def schema:create-thread-on-workspace
|
||||
[:map
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:position ::gpt/point]
|
||||
[:content :string]])
|
||||
(def ^:private
|
||||
schema:create-thread-on-workspace
|
||||
(sm/define
|
||||
[:map {:title "created-thread-on-workspace"}
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:position ::gpt/point]
|
||||
[:content :string]]))
|
||||
|
||||
(defn create-thread-on-workspace
|
||||
[params]
|
||||
(dm/assert! (sm/valid? schema:create-thread-on-workspace params))
|
||||
(dm/assert!
|
||||
(sm/check! schema:create-thread-on-workspace params))
|
||||
|
||||
(ptk/reify ::create-thread-on-workspace
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
|
@ -107,17 +113,21 @@
|
|||
(update :workspace-drawing dissoc :comment)
|
||||
(update-in [:comments id] assoc (:id comment) comment)))))
|
||||
|
||||
(def schema:create-thread-on-viewer
|
||||
[:map
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:frame-id ::sm/uuid]
|
||||
[:position ::gpt/point]
|
||||
[:content :string]])
|
||||
(def ^:private
|
||||
schema:create-thread-on-viewer
|
||||
(sm/define
|
||||
[:map {:title "created-thread-on-viewer"}
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:frame-id ::sm/uuid]
|
||||
[:position ::gpt/point]
|
||||
[:content :string]]))
|
||||
|
||||
(defn create-thread-on-viewer
|
||||
[params]
|
||||
(dm/assert! (sm/valid? schema:create-thread-on-viewer params))
|
||||
(dm/assert!
|
||||
(sm/check! schema:create-thread-on-viewer params))
|
||||
|
||||
(ptk/reify ::create-thread-on-viewer
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
|
@ -146,7 +156,11 @@
|
|||
|
||||
(defn update-comment-thread
|
||||
[{:keys [id is-resolved] :as thread}]
|
||||
(dm/assert! (comment-thread? thread))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(check-comment-thread! thread))
|
||||
|
||||
(ptk/reify ::update-comment-thread
|
||||
IDeref
|
||||
(-deref [_] {:is-resolved is-resolved})
|
||||
|
@ -168,8 +182,14 @@
|
|||
|
||||
(defn add-comment
|
||||
[thread content]
|
||||
(dm/assert! (comment-thread? thread))
|
||||
(dm/assert! (string? content))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(check-comment-thread! thread))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid content"
|
||||
(string? content))
|
||||
|
||||
(letfn [(created [comment state]
|
||||
(update-in state [:comments (:id thread)] assoc (:id comment) comment))]
|
||||
|
@ -189,7 +209,10 @@
|
|||
|
||||
(defn update-comment
|
||||
[{:keys [id content thread-id] :as comment}]
|
||||
(dm/assert! (comment? comment))
|
||||
(dm/assert!
|
||||
"expected valid comment"
|
||||
(check-comment! comment))
|
||||
|
||||
(ptk/reify ::update-comment
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -204,7 +227,9 @@
|
|||
|
||||
(defn delete-comment-thread-on-workspace
|
||||
[{:keys [id] :as thread}]
|
||||
(dm/assert! (comment-thread? thread))
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(check-comment-thread! thread))
|
||||
(ptk/reify ::delete-comment-thread-on-workspace
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -222,7 +247,9 @@
|
|||
|
||||
(defn delete-comment-thread-on-viewer
|
||||
[{:keys [id] :as thread}]
|
||||
(dm/assert! (comment-thread? thread))
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(check-comment-thread! thread))
|
||||
(ptk/reify ::delete-comment-thread-on-viewer
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -241,7 +268,9 @@
|
|||
|
||||
(defn delete-comment
|
||||
[{:keys [id thread-id] :as comment}]
|
||||
(dm/assert! (comment? comment))
|
||||
(dm/assert!
|
||||
"expected valid comment"
|
||||
(check-comment! comment))
|
||||
(ptk/reify ::delete-comment
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -256,7 +285,9 @@
|
|||
|
||||
(defn refresh-comment-thread
|
||||
[{:keys [id file-id] :as thread}]
|
||||
(dm/assert! (comment-thread? thread))
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(check-comment-thread! thread))
|
||||
(letfn [(fetched [thread state]
|
||||
(assoc-in state [:comment-threads id] thread))]
|
||||
(ptk/reify ::refresh-comment-thread
|
||||
|
@ -338,7 +369,9 @@
|
|||
|
||||
(defn open-thread
|
||||
[{:keys [id] :as thread}]
|
||||
(dm/assert! (comment-thread? thread))
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(check-comment-thread! thread))
|
||||
(ptk/reify ::open-comment-thread
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -379,15 +412,18 @@
|
|||
(update [_ state]
|
||||
(update state :comments-local merge params))))
|
||||
|
||||
(def schema:create-draft
|
||||
[:map
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:position ::gpt/point]])
|
||||
(def ^:private
|
||||
schema:create-draft
|
||||
(sm/define
|
||||
[:map {:title "create-draft"}
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:position ::gpt/point]]))
|
||||
|
||||
(defn create-draft
|
||||
[params]
|
||||
(dm/assert! (sm/valid? schema:create-draft params))
|
||||
(dm/assert!
|
||||
(sm/check! schema:create-draft params))
|
||||
(ptk/reify ::create-draft
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -452,11 +488,14 @@
|
|||
(filter #(contains? (:participants %) (:id profile))))))
|
||||
|
||||
(defn update-comment-thread-frame
|
||||
([thread ]
|
||||
([thread]
|
||||
(update-comment-thread-frame thread uuid/zero))
|
||||
|
||||
([thread frame-id]
|
||||
(dm/assert! (comment-thread? thread))
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(check-comment-thread! thread))
|
||||
|
||||
(ptk/reify ::update-comment-thread-frame
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -473,7 +512,10 @@
|
|||
(defn detach-comment-thread
|
||||
"Detach comment threads that are inside a frame when that frame is deleted"
|
||||
[ids]
|
||||
(dm/assert! (sm/coll-of-uuid? ids))
|
||||
(dm/assert!
|
||||
"expected a valid coll of uuid's"
|
||||
(sm/check-coll-of-uuid! ids))
|
||||
|
||||
(ptk/reify ::detach-comment-thread
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
|
|
|
@ -468,7 +468,10 @@
|
|||
[{:keys [emails role team-id resend?] :as params}]
|
||||
(dm/assert! (keyword? role))
|
||||
(dm/assert! (uuid? team-id))
|
||||
(dm/assert! (sm/set-of-emails? emails))
|
||||
|
||||
(dm/assert!
|
||||
"expected a valid set of emails"
|
||||
(sm/check-set-of-emails! emails))
|
||||
|
||||
(ptk/reify ::invite-team-members
|
||||
IDeref
|
||||
|
@ -487,7 +490,10 @@
|
|||
|
||||
(defn copy-invitation-link
|
||||
[{:keys [email team-id] :as params}]
|
||||
(dm/assert! (sm/email? email))
|
||||
(dm/assert!
|
||||
"expected a valid email"
|
||||
(sm/check-email! email))
|
||||
|
||||
(dm/assert! (uuid? team-id))
|
||||
|
||||
(ptk/reify ::copy-invitation-link
|
||||
|
@ -515,7 +521,10 @@
|
|||
|
||||
(defn update-team-invitation-role
|
||||
[{:keys [email team-id role] :as params}]
|
||||
(dm/assert! (sm/email? email))
|
||||
(dm/assert!
|
||||
"expected a valid email"
|
||||
(sm/check-email! email))
|
||||
|
||||
(dm/assert! (uuid? team-id))
|
||||
(dm/assert! (keyword? role)) ;; FIXME validate role
|
||||
|
||||
|
@ -534,7 +543,7 @@
|
|||
|
||||
(defn delete-team-invitation
|
||||
[{:keys [email team-id] :as params}]
|
||||
(dm/assert! (sm/email? email))
|
||||
(dm/assert! (sm/check-email! email))
|
||||
(dm/assert! (uuid? team-id))
|
||||
(ptk/reify ::delete-team-invitation
|
||||
ptk/WatchEvent
|
||||
|
@ -891,9 +900,12 @@
|
|||
|
||||
(defn move-files
|
||||
[{:keys [ids project-id] :as params}]
|
||||
(dm/assert! (sm/set-of-uuid? ids))
|
||||
(dm/assert! (uuid? project-id))
|
||||
|
||||
(dm/assert!
|
||||
"expected a valid set of uuids"
|
||||
(sm/check-set-of-uuid! ids))
|
||||
|
||||
(ptk/reify ::move-files
|
||||
IDeref
|
||||
(-deref [_]
|
||||
|
|
|
@ -18,38 +18,37 @@
|
|||
(def default-animation-timeout 600)
|
||||
(def default-timeout 5000)
|
||||
|
||||
(def schema:message
|
||||
[:map {:title "Message"}
|
||||
[:type [::sm/one-of #{:success :error :info :warning}]]
|
||||
[:status {:optional true}
|
||||
[::sm/one-of #{:visible :hide}]]
|
||||
[:position {:optional true}
|
||||
[::sm/one-of #{:fixed :floating :inline}]]
|
||||
[:controls {:optional true}
|
||||
[::sm/one-of #{:none :close :inline-actions :bottom-actions}]]
|
||||
[:tag {:optional true}
|
||||
[:or :string :keyword]]
|
||||
[:timeout {:optional true}
|
||||
[:maybe :int]]
|
||||
[:actions {:optional true}
|
||||
[:vector
|
||||
[:map
|
||||
[:label :string]
|
||||
[:callback ::sm/fn]]]]
|
||||
[:links {:optional true}
|
||||
[:vector
|
||||
[:map
|
||||
[:label :string]
|
||||
[:callback ::sm/fn]]]]])
|
||||
|
||||
(def message?
|
||||
(sm/pred-fn schema:message))
|
||||
(def ^:private
|
||||
schema:message
|
||||
(sm/define
|
||||
[:map {:title "Message"}
|
||||
[:type [::sm/one-of #{:success :error :info :warning}]]
|
||||
[:status {:optional true}
|
||||
[::sm/one-of #{:visible :hide}]]
|
||||
[:position {:optional true}
|
||||
[::sm/one-of #{:fixed :floating :inline}]]
|
||||
[:controls {:optional true}
|
||||
[::sm/one-of #{:none :close :inline-actions :bottom-actions}]]
|
||||
[:tag {:optional true}
|
||||
[:or :string :keyword]]
|
||||
[:timeout {:optional true}
|
||||
[:maybe :int]]
|
||||
[:actions {:optional true}
|
||||
[:vector
|
||||
[:map
|
||||
[:label :string]
|
||||
[:callback ::sm/fn]]]]
|
||||
[:links {:optional true}
|
||||
[:vector
|
||||
[:map
|
||||
[:label :string]
|
||||
[:callback ::sm/fn]]]]]))
|
||||
|
||||
(defn show
|
||||
[data]
|
||||
(dm/assert!
|
||||
"expected valid message map"
|
||||
(message? data))
|
||||
(sm/check! schema:message data))
|
||||
|
||||
(ptk/reify ::show
|
||||
ptk/UpdateEvent
|
||||
|
|
|
@ -127,16 +127,17 @@
|
|||
|
||||
;; --- EVENT: push
|
||||
|
||||
(def schema:shortcuts
|
||||
[:map-of
|
||||
:keyword
|
||||
[:map
|
||||
[:command [:or :string [:vector :any]]]
|
||||
[:fn {:optional true} fn?]
|
||||
[:tooltip {:optional true} :string]]])
|
||||
(def ^:private
|
||||
schema:shortcuts
|
||||
(sm/define
|
||||
[:map-of :keyword
|
||||
[:map
|
||||
[:command [:or :string [:vector :any]]]
|
||||
[:fn {:optional true} fn?]
|
||||
[:tooltip {:optional true} :string]]]))
|
||||
|
||||
(def shortcuts?
|
||||
(sm/pred-fn schema:shortcuts))
|
||||
(def check-shortcuts!
|
||||
(sm/check-fn schema:shortcuts))
|
||||
|
||||
(defn- wrap-cb
|
||||
[key cb]
|
||||
|
@ -169,8 +170,11 @@
|
|||
|
||||
(defn push-shortcuts
|
||||
[key shortcuts]
|
||||
(dm/assert! (keyword? key))
|
||||
(dm/assert! (shortcuts? shortcuts))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid parameters"
|
||||
(and (keyword? key)
|
||||
(check-shortcuts! shortcuts)))
|
||||
|
||||
(ptk/reify ::push-shortcuts
|
||||
ptk/UpdateEvent
|
||||
|
|
|
@ -26,17 +26,19 @@
|
|||
|
||||
;; --- SCHEMAS
|
||||
|
||||
(def schema:profile
|
||||
[:map {:title "Profile"}
|
||||
[:id ::sm/uuid]
|
||||
[:created-at {:optional true} :any]
|
||||
[:fullname {:optional true} :string]
|
||||
[:email {:optional true} :string]
|
||||
[:lang {:optional true} :string]
|
||||
[:theme {:optional true} :string]])
|
||||
(def ^:private
|
||||
schema:profile
|
||||
(sm/define
|
||||
[:map {:title "Profile"}
|
||||
[:id ::sm/uuid]
|
||||
[:created-at {:optional true} :any]
|
||||
[:fullname {:optional true} :string]
|
||||
[:email {:optional true} :string]
|
||||
[:lang {:optional true} :string]
|
||||
[:theme {:optional true} :string]]))
|
||||
|
||||
(def profile?
|
||||
(sm/pred-fn schema:profile))
|
||||
(def check-profile!
|
||||
(sm/check-fn schema:profile))
|
||||
|
||||
;; --- HELPERS
|
||||
|
||||
|
@ -289,7 +291,10 @@
|
|||
|
||||
(defn update-profile
|
||||
[data]
|
||||
(dm/assert! (profile? data))
|
||||
(dm/assert!
|
||||
"expected valid profile data"
|
||||
(check-profile! data))
|
||||
|
||||
(ptk/reify ::update-profile
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ stream]
|
||||
|
@ -343,9 +348,13 @@
|
|||
;; Social registered users don't have old-password
|
||||
[:password-old {:optional true} [:maybe :string]]])
|
||||
|
||||
|
||||
(defn update-password
|
||||
[data]
|
||||
(dm/assert! (sm/valid? schema:update-password data))
|
||||
(dm/assert!
|
||||
"expected valid parameters"
|
||||
(sm/check! schema:update-password data))
|
||||
|
||||
(ptk/reify ::update-password
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
|
@ -475,14 +484,19 @@
|
|||
|
||||
;; --- EVENT: request-profile-recovery
|
||||
|
||||
(def schema:request-profile-recovery
|
||||
[:map {:closed true}
|
||||
[:email ::sm/email]])
|
||||
(def ^:private
|
||||
schema:request-profile-recovery
|
||||
(sm/define
|
||||
[:map {:title "request-profile-recovery" :closed true}
|
||||
[:email ::sm/email]]))
|
||||
|
||||
;; FIXME: check if we can use schema for proper filter
|
||||
(defn request-profile-recovery
|
||||
[data]
|
||||
(dm/assert! (sm/valid? schema:request-profile-recovery data))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid parameters"
|
||||
(sm/check! schema:request-profile-recovery data))
|
||||
|
||||
(ptk/reify ::request-profile-recovery
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
|
@ -496,14 +510,19 @@
|
|||
|
||||
;; --- EVENT: recover-profile (Password)
|
||||
|
||||
(def schema:recover-profile
|
||||
[:map {:closed true}
|
||||
[:password :string]
|
||||
[:token :string]])
|
||||
(def ^:private
|
||||
schema:recover-profile
|
||||
(sm/define
|
||||
[:map {:title "recover-profile" :closed true}
|
||||
[:password :string]
|
||||
[:token :string]]))
|
||||
|
||||
(defn recover-profile
|
||||
[data]
|
||||
(dm/assert! (sm/valid? schema:recover-profile data))
|
||||
(dm/assert!
|
||||
"expected valid arguments"
|
||||
(sm/check! schema:recover-profile data))
|
||||
|
||||
(ptk/reify ::recover-profile
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
|
|
|
@ -46,15 +46,20 @@
|
|||
(declare zoom-to-fill)
|
||||
(declare zoom-to-fit)
|
||||
|
||||
(def schema:initialize
|
||||
[:map
|
||||
[:file-id ::sm/uuid]
|
||||
[:share-id {:optional true} [:maybe ::sm/uuid]]
|
||||
[:page-id {:optional true} ::sm/uuid]])
|
||||
(def ^:private
|
||||
schema:initialize
|
||||
(sm/define
|
||||
[:map {:title "initialize"}
|
||||
[:file-id ::sm/uuid]
|
||||
[:share-id {:optional true} [:maybe ::sm/uuid]]
|
||||
[:page-id {:optional true} ::sm/uuid]]))
|
||||
|
||||
(defn initialize
|
||||
[{:keys [file-id share-id interactions-show?] :as params}]
|
||||
(dm/assert! (sm/valid? schema:initialize params))
|
||||
(dm/assert!
|
||||
"expected valid params"
|
||||
(sm/check! schema:initialize params))
|
||||
|
||||
(ptk/reify ::initialize
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -92,18 +97,20 @@
|
|||
|
||||
;; --- Data Fetching
|
||||
|
||||
(def schema:fetch-bundle
|
||||
[:map
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:share-id {:optional true} ::sm/uuid]])
|
||||
|
||||
(def ^:private valid-fetch-bundle-params?
|
||||
(sm/pred-fn schema:fetch-bundle))
|
||||
(def ^:private
|
||||
schema:fetch-bundle
|
||||
(sm/define
|
||||
[:map {:title "fetch-bundle"}
|
||||
[:page-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:share-id {:optional true} ::sm/uuid]]))
|
||||
|
||||
(defn- fetch-bundle
|
||||
[{:keys [file-id share-id] :as params}]
|
||||
(dm/assert! (valid-fetch-bundle-params? params))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid params"
|
||||
(sm/check! schema:fetch-bundle params))
|
||||
|
||||
(ptk/reify ::fetch-bundle
|
||||
ptk/WatchEvent
|
||||
|
@ -486,9 +493,11 @@
|
|||
(go-to-frame frame-id nil))
|
||||
|
||||
([frame-id animation]
|
||||
(dm/assert! (uuid? frame-id))
|
||||
(dm/assert! (or (nil? animation)
|
||||
(ctsi/animation? animation)))
|
||||
(dm/assert!
|
||||
"expected valid parameters"
|
||||
(and (uuid? frame-id)
|
||||
(or (nil? animation)
|
||||
(ctsi/check-animation! animation))))
|
||||
|
||||
(ptk/reify ::go-to-frame
|
||||
ptk/UpdateEvent
|
||||
|
@ -587,7 +596,7 @@
|
|||
(dm/assert! (or (nil? background-overlay)
|
||||
(boolean? background-overlay)))
|
||||
(dm/assert! (or (nil? animation)
|
||||
(ctsi/animation? animation)))
|
||||
(ctsi/check-animation! animation)))
|
||||
(ptk/reify ::open-overlay
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -617,7 +626,7 @@
|
|||
(dm/assert! (or (nil? background-overlay)
|
||||
(boolean? background-overlay)))
|
||||
(dm/assert! (or (nil? animation)
|
||||
(ctsi/animation? animation)))
|
||||
(ctsi/check-animation! animation)))
|
||||
|
||||
(ptk/reify ::toggle-overlay
|
||||
ptk/UpdateEvent
|
||||
|
@ -645,7 +654,7 @@
|
|||
([frame-id animation]
|
||||
(dm/assert! (uuid? frame-id))
|
||||
(dm/assert! (or (nil? animation)
|
||||
(ctsi/animation? animation)))
|
||||
(ctsi/check-animation! animation)))
|
||||
|
||||
(ptk/reify ::close-overlay
|
||||
ptk/UpdateEvent
|
||||
|
|
|
@ -9,6 +9,8 @@
|
|||
[app.common.attrs :as attrs]
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.common.files.helpers :as cfh]
|
||||
[app.common.geom.align :as gal]
|
||||
|
@ -17,6 +19,7 @@
|
|||
[app.common.geom.rect :as grc]
|
||||
[app.common.geom.shapes :as gsh]
|
||||
[app.common.geom.shapes.grid-layout :as gslg]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.text :as txt]
|
||||
[app.common.transit :as t]
|
||||
[app.common.types.component :as ctk]
|
||||
|
@ -77,6 +80,7 @@
|
|||
[app.util.webapi :as wapi]
|
||||
[beicon.core :as rx]
|
||||
[cljs.spec.alpha :as s]
|
||||
[clojure.set :as set]
|
||||
[cuerdas.core :as str]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
|
@ -669,8 +673,11 @@
|
|||
|
||||
(defn update-shape
|
||||
[id attrs]
|
||||
(dm/assert! (uuid? id))
|
||||
(dm/assert! (cts/valid-shape-attrs? attrs))
|
||||
(dm/assert!
|
||||
"expected valid parameters"
|
||||
(and (cts/check-shape-attrs! attrs)
|
||||
(uuid? id)))
|
||||
|
||||
(ptk/reify ::update-shape
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
|
@ -712,7 +719,10 @@
|
|||
|
||||
(defn update-selected-shapes
|
||||
[attrs]
|
||||
(dm/assert! (cts/valid-shape-attrs? attrs))
|
||||
(dm/assert!
|
||||
"expected valid shape attrs"
|
||||
(cts/check-shape-attrs! attrs))
|
||||
|
||||
(ptk/reify ::update-selected-shapes
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
|
@ -1525,60 +1535,47 @@
|
|||
|
||||
(assoc data :selected selected)))
|
||||
|
||||
;; Retrieve all ids of selected shapes with corresponding
|
||||
;; children; this is needed because each shape should be
|
||||
;; processed one by one because of async events (data url
|
||||
;; fetching).
|
||||
(collect-object-ids [objects res id]
|
||||
(let [obj (get objects id)]
|
||||
(reduce (partial collect-object-ids objects)
|
||||
(assoc res id obj)
|
||||
(:shapes obj))))
|
||||
(fetch-image [entry]
|
||||
(let [url (cf/resolve-file-media entry)]
|
||||
(->> (http/send! {:method :get
|
||||
:uri url
|
||||
:response-type :blob})
|
||||
(rx/map :body)
|
||||
(rx/mapcat wapi/read-file-as-data-url)
|
||||
(rx/map #(assoc entry :data %)))))
|
||||
|
||||
;; Prepare the shape object. Mainly needed for image shapes
|
||||
;; for retrieve the image data and convert it to the
|
||||
;; data-url.
|
||||
(prepare-object [objects parent-frame-id {:keys [type] :as obj}]
|
||||
(let [obj (maybe-translate obj objects parent-frame-id)
|
||||
(prepare-object [objects parent-frame-id obj]
|
||||
(let [obj (maybe-translate obj objects parent-frame-id)
|
||||
;; Texts can have different fills for pieces of the text
|
||||
fill-images-data (->> (or (:position-data obj) [obj])
|
||||
(map :fills)
|
||||
(reduce into [])
|
||||
(filter :fill-image)
|
||||
(map :fill-image))
|
||||
imgdata (concat
|
||||
(->> (or (:position-data obj) [obj])
|
||||
(mapcat :fills)
|
||||
(keep :fill-image))
|
||||
(->> (:strokes obj)
|
||||
(keep :stroke-image))
|
||||
(when (cfh/image-shape? obj)
|
||||
[(:metadata obj)]))]
|
||||
|
||||
stroke-images-data (->> (:strokes obj)
|
||||
(filter :stroke-image)
|
||||
(map :stroke-image))
|
||||
images-data (concat
|
||||
fill-images-data
|
||||
stroke-images-data
|
||||
(when (= type :image)
|
||||
[(:metadata obj)]))]
|
||||
|
||||
(if (> (count images-data) 0)
|
||||
(->> (rx/from images-data)
|
||||
(rx/mapcat (fn [image-data]
|
||||
(let [url (cf/resolve-file-media image-data)]
|
||||
(->> (http/send! {:method :get
|
||||
:uri url
|
||||
:response-type :blob})
|
||||
(rx/map :body)
|
||||
(rx/mapcat wapi/read-file-as-data-url)
|
||||
(rx/map #(assoc image-data :data %))))))
|
||||
(if (seq imgdata)
|
||||
(->> (rx/from imgdata)
|
||||
(rx/mapcat fetch-image)
|
||||
(rx/reduce conj [])
|
||||
(rx/map
|
||||
(fn [images]
|
||||
(assoc obj ::data images))))
|
||||
(rx/map (fn [images]
|
||||
(assoc obj ::images images))))
|
||||
(rx/of obj))))
|
||||
|
||||
;; Collects all the items together and split images into a
|
||||
;; separated data structure for a more easy paste process.
|
||||
(collect-data [res {:keys [id] :as item}]
|
||||
(let [res (update res :objects assoc id (dissoc item ::data))]
|
||||
(if (::data item)
|
||||
(update res :images into (::data item))
|
||||
res)))
|
||||
(collect-data [result {:keys [id ::images] :as item}]
|
||||
(cond-> result
|
||||
:always
|
||||
(update :objects assoc id (dissoc item ::images))
|
||||
|
||||
(some? images)
|
||||
(update :images into images)))
|
||||
|
||||
(maybe-translate [shape objects parent-frame-id]
|
||||
(if (= parent-frame-id uuid/zero)
|
||||
|
@ -1587,122 +1584,128 @@
|
|||
(gsh/translate-to-frame shape frame))))
|
||||
|
||||
(on-copy-error [error]
|
||||
(js/console.error "Clipboard blocked:" error)
|
||||
(js/console.error "clipboard blocked:" error)
|
||||
(rx/empty))]
|
||||
|
||||
(ptk/reify ::copy-selected
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [objects (wsh/lookup-page-objects state)
|
||||
selected (->> (wsh/lookup-selected state)
|
||||
(cfh/clean-loops objects))
|
||||
|
||||
parent-frame-id (cfh/common-parent-frame objects selected)
|
||||
pdata (reduce (partial collect-object-ids objects) {} selected)
|
||||
initial {:type :copied-shapes
|
||||
:file-id (:current-file-id state)
|
||||
:selected selected
|
||||
:objects {}
|
||||
:images #{}}
|
||||
selected_text (.. js/window getSelection toString)]
|
||||
|
||||
(if (not-empty selected_text)
|
||||
(let [text (wapi/get-current-selected-text)]
|
||||
(if-not (str/empty? text)
|
||||
(try
|
||||
(wapi/write-to-clipboard selected_text)
|
||||
(wapi/write-to-clipboard text)
|
||||
(catch :default e
|
||||
(on-copy-error e)))
|
||||
(->> (rx/from (seq (vals pdata)))
|
||||
(rx/merge-map (partial prepare-object objects parent-frame-id))
|
||||
(rx/reduce collect-data initial)
|
||||
(rx/map (partial sort-selected state))
|
||||
(rx/map t/encode-str)
|
||||
(rx/map wapi/write-to-clipboard)
|
||||
(rx/catch on-copy-error)
|
||||
(rx/ignore))))))))
|
||||
|
||||
(declare paste-shape)
|
||||
(declare paste-text)
|
||||
(declare paste-image)
|
||||
(declare paste-svg)
|
||||
(let [objects (wsh/lookup-page-objects state)
|
||||
selected (->> (wsh/lookup-selected state)
|
||||
(cfh/clean-loops objects))
|
||||
features (features/get-team-enabled-features state)
|
||||
|
||||
(def paste
|
||||
(ptk/reify ::paste
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
(try
|
||||
(let [clipboard-str (wapi/read-from-clipboard)
|
||||
file-id (:current-file-id state)
|
||||
frame-id (cfh/common-parent-frame objects selected)
|
||||
version (dm/get-in state [:workspace-data :version])
|
||||
|
||||
paste-transit-str
|
||||
(->> clipboard-str
|
||||
(rx/filter t/transit?)
|
||||
(rx/map t/decode-str)
|
||||
(rx/filter #(= :copied-shapes (:type %)))
|
||||
(rx/map #(select-keys % [:selected :objects]))
|
||||
(rx/map paste-shape))
|
||||
initial {:type :copied-shapes
|
||||
:features features
|
||||
:version version
|
||||
:file-id file-id
|
||||
:selected selected
|
||||
:objects {}
|
||||
:images #{}}
|
||||
|
||||
paste-plain-text-str
|
||||
(->> clipboard-str
|
||||
(rx/filter (comp not empty?))
|
||||
(rx/map paste-text))
|
||||
shapes (->> (cfh/selected-with-children objects selected)
|
||||
(keep (d/getf objects)))]
|
||||
|
||||
paste-image-str
|
||||
(->> (rx/from shapes)
|
||||
(rx/merge-map (partial prepare-object objects frame-id))
|
||||
(rx/reduce collect-data initial)
|
||||
(rx/map (partial sort-selected state))
|
||||
(rx/map #(t/encode-str % {:type :json-verbose}))
|
||||
(rx/map wapi/write-to-clipboard)
|
||||
(rx/catch on-copy-error)
|
||||
(rx/ignore)))))))))
|
||||
|
||||
(declare ^:private paste-transit)
|
||||
(declare ^:private paste-text)
|
||||
(declare ^:private paste-image)
|
||||
(declare ^:private paste-svg-text)
|
||||
(declare ^:private paste-shapes)
|
||||
|
||||
(defn paste-from-clipboard
|
||||
"Perform a `paste` operation using the Clipboard API."
|
||||
[]
|
||||
(letfn [(decode-entry [entry]
|
||||
(try
|
||||
[:transit (t/decode-str entry)]
|
||||
(catch :default _cause
|
||||
[:text entry])))
|
||||
|
||||
(process-entry [[type data]]
|
||||
(case type
|
||||
:text
|
||||
(if (str/empty? data)
|
||||
(rx/empty)
|
||||
(rx/of (paste-text data)))
|
||||
|
||||
:transit
|
||||
(rx/of (paste-transit data))))
|
||||
|
||||
(on-error [cause]
|
||||
(let [data (ex-data cause)]
|
||||
(if (:not-implemented data)
|
||||
(rx/of (msg/warn (tr "errors.clipboard-not-implemented")))
|
||||
(js/console.error "Clipboard error:" cause))
|
||||
(rx/empty)))]
|
||||
|
||||
(ptk/reify ::paste-from-clipboard
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
(->> (rx/concat
|
||||
(->> (wapi/read-from-clipboard)
|
||||
(rx/map decode-entry)
|
||||
(rx/mapcat process-entry))
|
||||
(->> (wapi/read-image-from-clipboard)
|
||||
(rx/map paste-image))]
|
||||
(rx/map paste-image)))
|
||||
(rx/take 1)
|
||||
(rx/catch on-error))))))
|
||||
|
||||
(->> (rx/concat paste-transit-str
|
||||
paste-plain-text-str
|
||||
paste-image-str)
|
||||
(rx/take 1)
|
||||
(rx/catch
|
||||
(fn [err]
|
||||
(js/console.error "Clipboard error:" err)
|
||||
(rx/empty)))))
|
||||
(catch :default e
|
||||
(let [data (ex-data e)]
|
||||
(if (:not-implemented data)
|
||||
(rx/of (msg/warn (tr "errors.clipboard-not-implemented")))
|
||||
(js/console.error "ERROR" e))))))))
|
||||
|
||||
(defn paste-from-event
|
||||
"Perform a `paste` operation from user emmited event."
|
||||
[event in-viewport?]
|
||||
(ptk/reify ::paste-from-event
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(try
|
||||
(let [objects (wsh/lookup-page-objects state)
|
||||
paste-data (wapi/read-from-paste-event event)
|
||||
image-data (wapi/extract-images paste-data)
|
||||
text-data (wapi/extract-text paste-data)
|
||||
decoded-data (and (t/transit? text-data)
|
||||
(t/decode-str text-data))
|
||||
(let [objects (wsh/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])))]
|
||||
|
||||
edit-id (get-in state [:workspace-local :edition])
|
||||
is-editing-text? (and edit-id (= :text (get-in objects [edit-id :type])))]
|
||||
|
||||
;; Some paste events can be fired while we're editing a text
|
||||
;; we forbid that scenario so the default behaviour is executed
|
||||
(when-not is-editing-text?
|
||||
;; Some paste events can be fired while we're editing a text
|
||||
;; we forbid that scenario so the default behaviour is executed
|
||||
(if is-editing?
|
||||
(rx/empty)
|
||||
(let [pdata (wapi/read-from-paste-event event)
|
||||
image-data (some-> pdata wapi/extract-images)
|
||||
text-data (some-> pdata wapi/extract-text)
|
||||
transit-data (ex/ignoring (some-> text-data t/decode-str))]
|
||||
(cond
|
||||
(and (string? text-data)
|
||||
(str/includes? text-data "<svg"))
|
||||
(rx/of (paste-svg text-data))
|
||||
(str/includes? text-data "<svg "))
|
||||
(rx/of (paste-svg-text text-data))
|
||||
|
||||
(seq image-data)
|
||||
(rx/from (map paste-image image-data))
|
||||
(->> (rx/from image-data)
|
||||
(rx/map paste-image))
|
||||
|
||||
(coll? decoded-data)
|
||||
(->> (rx/of decoded-data)
|
||||
(rx/filter #(= :copied-shapes (:type %)))
|
||||
(rx/map #(paste-shape % in-viewport?)))
|
||||
(coll? transit-data)
|
||||
(rx/of (paste-transit (assoc transit-data :in-viewport in-viewport?)))
|
||||
|
||||
(string? text-data)
|
||||
(rx/of (paste-text text-data))
|
||||
|
||||
:else
|
||||
(rx/empty))))
|
||||
|
||||
(catch :default err
|
||||
(js/console.error "Clipboard error:" err))))))
|
||||
(rx/empty))))))))
|
||||
|
||||
(defn selected-frame? [state]
|
||||
(let [selected (wsh/lookup-selected state)
|
||||
|
@ -1731,15 +1734,63 @@
|
|||
(= (:width (:selrect (first (vals paste-obj))))
|
||||
(:width (:selrect frame-obj)))))
|
||||
|
||||
(defn- paste-shape
|
||||
[{selected :selected
|
||||
paste-objects :objects ;; rename this because here comes only the clipboard shapes,
|
||||
images :images ;; not the whole page tree of shapes.
|
||||
:as data}
|
||||
in-viewport?]
|
||||
(letfn [;; Given a file-id and img (part generated by the
|
||||
;; copy-selected event), uploads the new media.
|
||||
(upload-media [file-id imgpart]
|
||||
(defn- check-paste-features!
|
||||
"Function used for check feature compability between currently
|
||||
enabled features set on the application with the provided featured
|
||||
set by the paste data."
|
||||
[enabled-features paste-features]
|
||||
(let [not-supported (-> enabled-features
|
||||
(set/difference paste-features)
|
||||
;; NOTE: we don't want to raise a feature-mismatch
|
||||
;; exception for features which don't require an
|
||||
;; explicit file migration process or has no real
|
||||
;; effect on file data structure
|
||||
(set/difference cfeat/no-migration-features))]
|
||||
|
||||
(when (seq not-supported)
|
||||
(ex/raise :type :restriction
|
||||
:code :missing-features-in-paste-content
|
||||
:feature (first not-supported)
|
||||
:hint (str/ffmt "expected features '%' not present in pasted content"
|
||||
(str/join "," not-supported)))))
|
||||
|
||||
(let [not-supported (set/difference enabled-features cfeat/supported-features)]
|
||||
(when (seq not-supported)
|
||||
(ex/raise :type :restriction
|
||||
:code :paste-feature-not-supported
|
||||
:feature (first not-supported)
|
||||
:hint (str/ffmt "features '%' not supported in the application"
|
||||
(str/join "," not-supported)))))
|
||||
|
||||
(let [not-supported (-> paste-features
|
||||
(set/difference enabled-features)
|
||||
(set/difference cfeat/backend-only-features)
|
||||
(set/difference cfeat/frontend-only-features))]
|
||||
|
||||
(when (seq not-supported)
|
||||
(ex/raise :type :restriction
|
||||
:code :paste-feature-not-enabled
|
||||
:feature (first not-supported)
|
||||
:hint (str/ffmt "paste features '%' not enabled on the application"
|
||||
(str/join "," not-supported))))))
|
||||
|
||||
(def ^:private schema:paste-data
|
||||
(sm/define
|
||||
[:map {:title "paste-data"}
|
||||
[:type [:= :copied-shapes]]
|
||||
[:features ::sm/set-of-strings]
|
||||
[:version :int]
|
||||
[:file-id ::sm/uuid]
|
||||
[:selected ::sm/set-of-uuid]
|
||||
[:objects
|
||||
[:map-of ::sm/uuid :map]]
|
||||
[:images [:set :map]]
|
||||
[:position {:optional true} ::gpt/point]]))
|
||||
|
||||
(defn- paste-transit
|
||||
[{:keys [images] :as pdata}]
|
||||
|
||||
(letfn [(upload-media [file-id imgpart]
|
||||
(->> (http/send! {:uri (:data imgpart)
|
||||
:response-type :blob
|
||||
:method :get})
|
||||
|
@ -1750,51 +1801,70 @@
|
|||
:file-id file-id
|
||||
:content blob
|
||||
:is-local true}))
|
||||
(rx/mapcat #(rp/cmd! :upload-file-media-object %))
|
||||
(rx/map (fn [media]
|
||||
(assoc media :prev-id (:id imgpart))))))
|
||||
(rx/mapcat (partial rp/cmd! :upload-file-media-object))
|
||||
(rx/map #(assoc % :prev-id (:id imgpart)))))]
|
||||
|
||||
(translate-staled-media [mdata attribute media-idx]
|
||||
(let [id (get-in mdata [attribute :id])
|
||||
(ptk/reify ::paste-transit
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [file-id (:current-file-id state)
|
||||
features (features/get-team-enabled-features state)]
|
||||
|
||||
(sm/validate! schema:paste-data pdata
|
||||
{:hint "invalid paste data"
|
||||
:code :invalid-paste-data})
|
||||
|
||||
(check-paste-features! features (:features pdata))
|
||||
(if (= file-id (:file-id pdata))
|
||||
(let [pdata (assoc pdata :images [])]
|
||||
(rx/of (paste-shapes pdata)))
|
||||
(->> (rx/from images)
|
||||
(rx/merge-map (partial upload-media file-id))
|
||||
(rx/reduce conj [])
|
||||
(rx/map #(assoc pdata :images %))
|
||||
(rx/map paste-shapes))))))))
|
||||
|
||||
(defn paste-shapes
|
||||
[{in-viewport? :in-viewport :as pdata}]
|
||||
(letfn [(translate-media [mdata media-idx attr-path]
|
||||
(let [id (get-in mdata attr-path)
|
||||
mobj (get media-idx id)]
|
||||
(if mobj
|
||||
(update mdata attribute #(assoc %
|
||||
:id (:id mobj)
|
||||
:path (:path mobj)))
|
||||
(update-in mdata attr-path (fn [value]
|
||||
(-> value
|
||||
(assoc :id (:id mobj))
|
||||
(assoc :path (:path mobj)))))
|
||||
mdata)))
|
||||
|
||||
(add-obj? [chg]
|
||||
(= (:type chg) :add-obj))
|
||||
|
||||
;; Analyze the rchange and replace staled media and
|
||||
;; references to the new uploaded media-objects.
|
||||
(process-rchange [media-idx item]
|
||||
(process-rchange [media-idx change]
|
||||
(let [;; Texts can have different fills for pieces of the text
|
||||
obj (:obj item)
|
||||
fills (mapv #(translate-staled-media % :fill-image media-idx) (:fills obj))
|
||||
strokes (mapv #(translate-staled-media % :stroke-image media-idx) (:strokes obj))
|
||||
position-data (->> (:position-data obj)
|
||||
(mapv (fn [p-data]
|
||||
(let [fills (mapv #(translate-staled-media % :fill-image media-idx) (:fills p-data))]
|
||||
(assoc p-data :fills fills)))))
|
||||
content (txt/transform-nodes #(translate-staled-media % :fill-image media-idx) (:content obj))]
|
||||
tr-fill-xf (map #(translate-media % media-idx [:fill-image :id]))
|
||||
tr-stroke-xf (map #(translate-media % media-idx [:stroke-image :id]))]
|
||||
|
||||
(if (= (:type item) :add-obj)
|
||||
(-> item
|
||||
(update-in [:obj :metadata]
|
||||
(fn [{:keys [id] :as mdata}]
|
||||
(if-let [mobj (get media-idx id)]
|
||||
(assoc mdata
|
||||
:id (:id mobj)
|
||||
:path (:path mobj))
|
||||
mdata)))
|
||||
(assoc-in [:obj :fills] fills)
|
||||
(assoc-in [:obj :strokes] strokes)
|
||||
(assoc-in [:obj :content] content)
|
||||
(cond->
|
||||
(> (count position-data) 0) (assoc-in [:obj :position-data] position-data)))
|
||||
item)))
|
||||
(if (add-obj? change)
|
||||
(update change :obj (fn [obj]
|
||||
(-> obj
|
||||
(update :fills #(into [] tr-fill-xf %))
|
||||
(update :strokes #(into [] tr-stroke-xf %))
|
||||
(d/update-when :metadata translate-media media-idx [:id])
|
||||
(d/update-when :content
|
||||
(fn [content]
|
||||
(txt/xform-nodes tr-fill-xf content)))
|
||||
(d/update-when :position-data
|
||||
(fn [position-data]
|
||||
(mapv (fn [pos-data]
|
||||
(update pos-data :fills #(into [] tr-fill-xf %)))
|
||||
position-data))))))
|
||||
change)))
|
||||
|
||||
(calculate-paste-position [state mouse-pos in-viewport?]
|
||||
(calculate-paste-position [state pobjects selected position]
|
||||
(let [page-objects (wsh/lookup-page-objects state)
|
||||
selected-objs (map #(get paste-objects %) selected)
|
||||
selected-objs (map (d/getf pobjects) selected)
|
||||
first-selected-obj (first selected-objs)
|
||||
page-selected (wsh/lookup-selected state)
|
||||
wrapper (gsh/shapes->rect selected-objs)
|
||||
|
@ -1803,12 +1873,12 @@
|
|||
frame-object (get page-objects frame-id)
|
||||
base (cfh/get-base-shape page-objects page-selected)
|
||||
index (cfh/get-position-on-parent page-objects (:id base))
|
||||
tree-root (get-tree-root-shapes paste-objects)
|
||||
tree-root (get-tree-root-shapes pobjects)
|
||||
only-one-root-shape? (and
|
||||
(< 1 (count paste-objects))
|
||||
(< 1 (count pobjects))
|
||||
(= 1 (count tree-root)))
|
||||
all-objects (merge page-objects paste-objects)
|
||||
comps-nesting-loop? (not (->> (keys paste-objects)
|
||||
all-objects (merge page-objects pobjects)
|
||||
comps-nesting-loop? (not (->> (keys pobjects)
|
||||
(map #(cfh/components-nesting-loop? all-objects % (:id base)))
|
||||
(every? nil?)))]
|
||||
|
||||
|
@ -1816,13 +1886,13 @@
|
|||
comps-nesting-loop?
|
||||
;; Avoid placing a shape as a direct or indirect child of itself,
|
||||
;; or inside its main component if it's in a copy.
|
||||
[uuid/zero uuid/zero (gpt/subtract mouse-pos orig-pos)]
|
||||
[uuid/zero uuid/zero (gpt/subtract position orig-pos)]
|
||||
|
||||
(selected-frame? state)
|
||||
|
||||
(if (or (any-same-frame-from-selected? state (keys paste-objects))
|
||||
(if (or (any-same-frame-from-selected? state (keys pobjects))
|
||||
(and only-one-root-shape?
|
||||
(frame-same-size? paste-objects (first tree-root))))
|
||||
(frame-same-size? pobjects (first tree-root))))
|
||||
;; Paste next to selected frame, if selected is itself or of the same size as the copied
|
||||
(let [selected-frame-obj (get page-objects (first page-selected))
|
||||
parent-id (:parent-id base)
|
||||
|
@ -1866,114 +1936,119 @@
|
|||
[frame-id frame-id delta (dec (count (:shapes selected-frame-obj )))]))
|
||||
|
||||
(empty? page-selected)
|
||||
(let [frame-id (ctst/top-nested-frame page-objects mouse-pos)
|
||||
delta (gpt/subtract mouse-pos orig-pos)]
|
||||
(let [frame-id (ctst/top-nested-frame page-objects position)
|
||||
delta (gpt/subtract position orig-pos)]
|
||||
[frame-id frame-id delta])
|
||||
|
||||
:else
|
||||
(let [frame-id (:frame-id base)
|
||||
parent-id (:parent-id base)
|
||||
delta (if in-viewport?
|
||||
(gpt/subtract mouse-pos orig-pos)
|
||||
(gpt/subtract position orig-pos)
|
||||
(gpt/subtract (gpt/point (:selrect base)) orig-pos))]
|
||||
[frame-id parent-id delta index]))))
|
||||
|
||||
;; Change the indexes of the pasted shapes
|
||||
(change-add-obj-index [paste-objects selected index change]
|
||||
(let [index (or index -1) ;; if there is no current element selected, we want the first (inc index) to be 0
|
||||
(change-add-obj-index [objects selected index change]
|
||||
(let [;; if there is no current element selected, we want
|
||||
;; the first (inc index) to be 0
|
||||
index (d/nilv index -1)
|
||||
set-index (fn [[result index] id]
|
||||
[(assoc result id index) (inc index)])
|
||||
|
||||
;; FIXME: optimize ???
|
||||
map-ids
|
||||
(->> selected
|
||||
(map #(get-in paste-objects [% :id]))
|
||||
(map #(get-in objects [% :id]))
|
||||
(reduce set-index [{} (inc index)])
|
||||
first)]
|
||||
(if (and (= :add-obj (:type change))
|
||||
|
||||
(if (and (add-obj? change)
|
||||
(contains? map-ids (:old-id change)))
|
||||
(assoc change :index (get map-ids (:old-id change)))
|
||||
change)))
|
||||
|
||||
;; Proceed with the standard shape paste process.
|
||||
(do-paste [it state mouse-pos media]
|
||||
(let [libraries (wsh/get-libraries state)
|
||||
file-id (:current-file-id state)
|
||||
page (wsh/lookup-page state)
|
||||
page-objects (:objects page)
|
||||
media-idx (d/index-by :prev-id media)
|
||||
(process-shape [file-id frame-id parent-id shape]
|
||||
(cond-> shape
|
||||
:always
|
||||
(assoc :frame-id frame-id :parent-id parent-id)
|
||||
|
||||
;; Calculate position for the pasted elements
|
||||
[frame-id parent-id delta index] (calculate-paste-position state mouse-pos in-viewport?)
|
||||
(and (or (cfh/group-shape? shape)
|
||||
(cfh/bool-shape? shape))
|
||||
(nil? (:shapes shape)))
|
||||
(assoc :shapes [])
|
||||
|
||||
;; We don't want to change the structure of component copies
|
||||
;; If the parent-id or the frame-id are component-copies, we need to get the first not copy parent
|
||||
parent-id (:id (ctn/get-first-not-copy-parent page-objects parent-id))
|
||||
frame-id (:id (ctn/get-first-not-copy-parent page-objects frame-id))
|
||||
(cfh/text-shape? shape)
|
||||
(ctt/remove-external-typographies file-id)))]
|
||||
|
||||
process-shape
|
||||
(fn [_ shape]
|
||||
(let [assign-shapes? (and (or (cfh/group-shape? shape)
|
||||
(cfh/bool-shape? shape))
|
||||
(nil? (:shapes shape)))]
|
||||
(-> shape
|
||||
(assoc :frame-id frame-id :parent-id parent-id)
|
||||
(cond-> assign-shapes?
|
||||
(assoc :shapes []))
|
||||
;; if is a text, remove references to external typographies
|
||||
(cond-> (= (:type shape) :text)
|
||||
(ctt/remove-external-typographies file-id)))))
|
||||
|
||||
paste-objects (->> paste-objects (d/mapm process-shape))
|
||||
|
||||
all-objects (merge (:objects page) paste-objects)
|
||||
|
||||
library-data (wsh/get-file state file-id)
|
||||
|
||||
changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries library-data file-id)
|
||||
(pcb/amend-changes (partial process-rchange media-idx))
|
||||
(pcb/amend-changes (partial change-add-obj-index paste-objects selected index)))
|
||||
|
||||
;; Adds a resize-parents operation so the groups are updated. We add all the new objects
|
||||
new-objects-ids (->> changes :redo-changes (filter #(= (:type %) :add-obj)) (mapv :id))
|
||||
|
||||
drop-cell
|
||||
(when (ctl/grid-layout? all-objects parent-id)
|
||||
(gslg/get-drop-cell frame-id all-objects mouse-pos))
|
||||
|
||||
changes (pcb/resize-parents changes new-objects-ids)
|
||||
|
||||
selected (->> changes
|
||||
:redo-changes
|
||||
(filter #(= (:type %) :add-obj))
|
||||
(filter #(selected (:old-id %)))
|
||||
(map #(get-in % [:obj :id]))
|
||||
(into (d/ordered-set)))
|
||||
|
||||
changes
|
||||
(cond-> changes
|
||||
(some? drop-cell)
|
||||
(pcb/update-shapes [parent-id]
|
||||
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
|
||||
|
||||
undo-id (js/Symbol)]
|
||||
|
||||
(rx/of (dwu/start-undo-transaction undo-id)
|
||||
(dch/commit-changes changes)
|
||||
(dws/select-shapes selected)
|
||||
(ptk/data-event :layout/update [frame-id])
|
||||
(dwu/commit-undo-transaction undo-id))))]
|
||||
|
||||
(ptk/reify ::paste-shape
|
||||
(ptk/reify ::paste-shapes
|
||||
ptk/WatchEvent
|
||||
(watch [it state _]
|
||||
(let [file-id (:current-file-id state)
|
||||
mouse-pos (deref ms/mouse-position)]
|
||||
(if (= file-id (:file-id data))
|
||||
(do-paste it state mouse-pos [])
|
||||
(->> (rx/from images)
|
||||
(rx/merge-map (partial upload-media file-id))
|
||||
(rx/reduce conj [])
|
||||
(rx/mapcat (partial do-paste it state mouse-pos)))))))))
|
||||
(let [
|
||||
file-id (:current-file-id state)
|
||||
page (wsh/lookup-page state)
|
||||
|
||||
media-idx (->> (:media pdata)
|
||||
(d/index-by :prev-id))
|
||||
|
||||
selected (:selected pdata)
|
||||
objects (:objects pdata)
|
||||
|
||||
position (deref ms/mouse-position)
|
||||
|
||||
;; Calculate position for the pasted elements
|
||||
[frame-id
|
||||
parent-id
|
||||
delta
|
||||
index] (calculate-paste-position state objects selected position)
|
||||
|
||||
;; We don't want to change the structure of component
|
||||
;; copies If the parent-id or the frame-id are
|
||||
;; component-copies, we need to get the first not copy
|
||||
;; parent
|
||||
parent-id (:id (ctn/get-first-not-copy-parent (:objects page) parent-id))
|
||||
frame-id (:id (ctn/get-first-not-copy-parent (:objects page) frame-id))
|
||||
|
||||
objects (update-vals objects (partial process-shape file-id frame-id parent-id))
|
||||
all-objects (merge (:objects page) objects)
|
||||
|
||||
libraries (wsh/get-libraries state)
|
||||
ldata (wsh/get-file state file-id)
|
||||
|
||||
drop-cell (when (ctl/grid-layout? all-objects parent-id)
|
||||
(gslg/get-drop-cell frame-id all-objects position))
|
||||
|
||||
changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries ldata file-id)
|
||||
(pcb/amend-changes (partial process-rchange media-idx))
|
||||
(pcb/amend-changes (partial change-add-obj-index objects selected index)))
|
||||
|
||||
;; Adds a resize-parents operation so the groups are
|
||||
;; updated. We add all the new objects
|
||||
changes (->> (:redo-changes changes)
|
||||
(filter add-obj?)
|
||||
(map :id)
|
||||
(pcb/resize-parents changes))
|
||||
|
||||
selected (into (d/ordered-set)
|
||||
(comp
|
||||
(filter add-obj?)
|
||||
(filter #(contains? selected (:old-id %)))
|
||||
(map :obj)
|
||||
(map :id))
|
||||
(:redo-changes changes))
|
||||
|
||||
changes (cond-> changes
|
||||
(some? drop-cell)
|
||||
(pcb/update-shapes [parent-id]
|
||||
#(ctl/add-children-to-cell % selected all-objects drop-cell)))
|
||||
|
||||
undo-id (js/Symbol)]
|
||||
|
||||
(rx/of (dwu/start-undo-transaction undo-id)
|
||||
(dch/commit-changes changes)
|
||||
(dws/select-shapes selected)
|
||||
(ptk/data-event :layout/update [frame-id])
|
||||
(dwu/commit-undo-transaction undo-id)))))))
|
||||
|
||||
(defn as-content [text]
|
||||
(let [paragraphs (->> (str/lines text)
|
||||
|
@ -1998,7 +2073,7 @@
|
|||
:else
|
||||
(deref ms/mouse-position)))
|
||||
|
||||
(defn paste-text
|
||||
(defn- paste-text
|
||||
[text]
|
||||
(dm/assert! (string? text))
|
||||
(ptk/reify ::paste-text
|
||||
|
@ -2025,10 +2100,10 @@
|
|||
(dwu/commit-undo-transaction undo-id))))))
|
||||
|
||||
;; TODO: why not implement it in terms of upload-media-workspace?
|
||||
(defn- paste-svg
|
||||
(defn- paste-svg-text
|
||||
[text]
|
||||
(dm/assert! (string? text))
|
||||
(ptk/reify ::paste-svg
|
||||
(ptk/reify ::paste-svg-text
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [position (calculate-paste-position state)
|
||||
|
@ -2038,14 +2113,14 @@
|
|||
|
||||
(defn- paste-image
|
||||
[image]
|
||||
(ptk/reify ::paste-bin-impl
|
||||
(ptk/reify ::paste-image
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [file-id (get-in state [:workspace-file :id])
|
||||
(let [file-id (dm/get-in state [:workspace-file :id])
|
||||
position (calculate-paste-position state)
|
||||
params {:file-id file-id
|
||||
:blobs [image]
|
||||
:position position}]
|
||||
params {:file-id file-id
|
||||
:blobs [image]
|
||||
:position position}]
|
||||
(rx/of (dwm/upload-media-workspace params))))))
|
||||
|
||||
(defn toggle-distances-display [value]
|
||||
|
|
|
@ -53,7 +53,11 @@
|
|||
([ids update-fn] (update-shapes ids update-fn nil))
|
||||
([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-remote? ignore-touched undo-group]
|
||||
:or {reg-objects? false save-undo? true stack-undo? false ignore-remote? false ignore-touched false}}]
|
||||
(dm/assert! (sm/coll-of-uuid? ids))
|
||||
|
||||
(dm/assert!
|
||||
"expected a valid coll of uuid's"
|
||||
(sm/check-coll-of-uuid! ids))
|
||||
|
||||
(dm/assert! (fn? update-fn))
|
||||
|
||||
(ptk/reify ::update-shapes
|
||||
|
@ -212,8 +216,8 @@
|
|||
(try
|
||||
(dm/assert!
|
||||
"expect valid vector of changes"
|
||||
(and (cpc/valid-changes? redo-changes)
|
||||
(cpc/valid-changes? undo-changes)))
|
||||
(and (cpc/check-changes! redo-changes)
|
||||
(cpc/check-changes! undo-changes)))
|
||||
|
||||
(update-in state path (fn [file]
|
||||
(-> file
|
||||
|
|
|
@ -278,7 +278,10 @@
|
|||
|
||||
(defn add-shadow
|
||||
[ids shadow]
|
||||
(dm/assert! (sm/coll-of-uuid? ids))
|
||||
(dm/assert!
|
||||
"expected a valid coll of uuid's"
|
||||
(sm/check-coll-of-uuid! ids))
|
||||
|
||||
(ptk/reify ::add-shadow
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
|
|
|
@ -81,7 +81,10 @@
|
|||
|
||||
(defn center-to-comment-thread
|
||||
[{:keys [position] :as thread}]
|
||||
(dm/assert! (dcm/comment-thread? thread))
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(dcm/check-comment-thread! thread))
|
||||
|
||||
(ptk/reify ::center-to-comment-thread
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
@ -97,7 +100,9 @@
|
|||
|
||||
(defn navigate
|
||||
[thread]
|
||||
(dm/assert! (dcm/comment-thread? thread))
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(dcm/check-comment-thread! thread))
|
||||
(ptk/reify ::open-comment-thread
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ stream]
|
||||
|
@ -118,36 +123,41 @@
|
|||
(update-comment-thread-position thread [new-x new-y] nil))
|
||||
|
||||
([thread [new-x new-y] frame-id]
|
||||
(dm/assert! (dcm/comment-thread? thread))
|
||||
(ptk/reify ::update-comment-thread-position
|
||||
ptk/WatchEvent
|
||||
(watch [it state _]
|
||||
(let [thread-id (:id thread)
|
||||
page (wsh/lookup-page state)
|
||||
page-id (:id page)
|
||||
objects (wsh/lookup-page-objects state page-id)
|
||||
new-frame-id (if (nil? frame-id)
|
||||
(ctst/get-frame-id-by-position objects (gpt/point new-x new-y))
|
||||
(:frame-id thread))
|
||||
thread (assoc thread
|
||||
:position (gpt/point new-x new-y)
|
||||
:frame-id new-frame-id)
|
||||
(dm/assert!
|
||||
"expected valid comment thread"
|
||||
(dcm/check-comment-thread! thread))
|
||||
(ptk/reify ::update-comment-thread-position
|
||||
ptk/WatchEvent
|
||||
(watch [it state _]
|
||||
(let [thread-id (:id thread)
|
||||
page (wsh/lookup-page state)
|
||||
page-id (:id page)
|
||||
objects (wsh/lookup-page-objects state page-id)
|
||||
new-frame-id (if (nil? frame-id)
|
||||
(ctst/get-frame-id-by-position objects (gpt/point new-x new-y))
|
||||
(:frame-id thread))
|
||||
thread (assoc thread
|
||||
:position (gpt/point new-x new-y)
|
||||
:frame-id new-frame-id)
|
||||
|
||||
changes
|
||||
(-> (pcb/empty-changes it)
|
||||
(pcb/with-page page)
|
||||
(pcb/update-page-option :comment-threads-position assoc thread-id (select-keys thread [:position :frame-id])))]
|
||||
changes
|
||||
(-> (pcb/empty-changes it)
|
||||
(pcb/with-page page)
|
||||
(pcb/update-page-option :comment-threads-position assoc thread-id (select-keys thread [:position :frame-id])))]
|
||||
|
||||
(rx/merge
|
||||
(rx/of (dwc/commit-changes changes))
|
||||
(->> (rp/cmd! :update-comment-thread-position thread)
|
||||
(rx/catch #(rx/throw {:type :update-comment-thread-position}))
|
||||
(rx/ignore))))))))
|
||||
(rx/merge
|
||||
(rx/of (dwc/commit-changes changes))
|
||||
(->> (rp/cmd! :update-comment-thread-position thread)
|
||||
(rx/catch #(rx/throw {:type :update-comment-thread-position}))
|
||||
(rx/ignore))))))))
|
||||
|
||||
;; Move comment threads that are inside a frame when that frame is moved"
|
||||
(defmethod ptk/resolve ::move-frame-comment-threads
|
||||
[_ ids]
|
||||
(dm/assert! (sm/coll-of-uuid? ids))
|
||||
(dm/assert!
|
||||
"expected a valid coll of uuid's"
|
||||
(sm/check-coll-of-uuid! ids))
|
||||
|
||||
(ptk/reify ::move-frame-comment-threads
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
|
|
|
@ -25,7 +25,7 @@
|
|||
(defn update-guides [guide]
|
||||
(dm/assert!
|
||||
"expected valid guide"
|
||||
(ctp/guide? guide))
|
||||
(ctp/check-page-guide! guide))
|
||||
|
||||
(ptk/reify ::update-guides
|
||||
ptk/WatchEvent
|
||||
|
@ -40,7 +40,7 @@
|
|||
(defn remove-guide [guide]
|
||||
(dm/assert!
|
||||
"expected valid guide"
|
||||
(ctp/guide? guide))
|
||||
(ctp/check-page-guide! guide))
|
||||
|
||||
(ptk/reify ::remove-guide
|
||||
ptk/UpdateEvent
|
||||
|
|
|
@ -114,7 +114,10 @@
|
|||
|
||||
(defn add-recent-color
|
||||
[color]
|
||||
(dm/assert! (ctc/valid-recent-color? color))
|
||||
(dm/assert!
|
||||
"expected valid recent color map"
|
||||
(ctc/check-recent-color! color))
|
||||
|
||||
(ptk/reify ::add-recent-color
|
||||
ptk/WatchEvent
|
||||
(watch [it _ _]
|
||||
|
@ -144,8 +147,11 @@
|
|||
|
||||
(defn update-color
|
||||
[color file-id]
|
||||
(dm/assert! (ctc/valid-color? color))
|
||||
(dm/assert! (uuid? file-id))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid parameters"
|
||||
(and (ctc/check-color! color)
|
||||
(uuid? file-id)))
|
||||
|
||||
(ptk/reify ::update-color
|
||||
ptk/WatchEvent
|
||||
|
@ -183,7 +189,10 @@
|
|||
|
||||
(defn add-media
|
||||
[media]
|
||||
(dm/assert! (ctf/valid-media-object? media))
|
||||
(dm/assert!
|
||||
"expected valid media object"
|
||||
(ctf/check-media-object! media))
|
||||
|
||||
(ptk/reify ::add-media
|
||||
ptk/WatchEvent
|
||||
(watch [it _ _]
|
||||
|
@ -227,7 +236,10 @@
|
|||
([typography] (add-typography typography true))
|
||||
([typography edit?]
|
||||
(let [typography (update typography :id #(or % (uuid/next)))]
|
||||
(dm/assert! (ctt/typography? typography))
|
||||
(dm/assert!
|
||||
"expected valid typography"
|
||||
(ctt/check-typography! typography))
|
||||
|
||||
(ptk/reify ::add-typography
|
||||
IDeref
|
||||
(-deref [_] typography)
|
||||
|
@ -256,8 +268,11 @@
|
|||
|
||||
(defn update-typography
|
||||
[typography file-id]
|
||||
(dm/assert! (ctt/typography? typography))
|
||||
(dm/assert! (uuid? file-id))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid typography and file-id"
|
||||
(and (ctt/check-typography! typography)
|
||||
(uuid? file-id)))
|
||||
|
||||
(ptk/reify ::update-typography
|
||||
ptk/WatchEvent
|
||||
|
@ -607,7 +622,7 @@
|
|||
(defn ext-library-changed
|
||||
[library-id modified-at revn changes]
|
||||
(dm/assert! (uuid? library-id))
|
||||
(dm/assert! (ch/valid-changes? changes))
|
||||
(dm/assert! (ch/check-changes! changes))
|
||||
(ptk/reify ::ext-library-changed
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
|
|
|
@ -163,15 +163,6 @@
|
|||
(rx/merge-map svg->clj)
|
||||
(rx/do on-svg)))))
|
||||
|
||||
(def schema:process-media-objects
|
||||
[:map
|
||||
[:file-id ::sm/uuid]
|
||||
[:local? :boolean]
|
||||
[:name {:optional true} :string]
|
||||
[:data {:optional true} :any] ; FIXME
|
||||
[:uris {:optional true} [:sequential :string]]
|
||||
[:mtype {:optional true} :string]])
|
||||
|
||||
(defn handle-media-error [error on-error]
|
||||
(if (ex/ex-info? error)
|
||||
(handle-media-error (ex-data error) on-error)
|
||||
|
@ -205,10 +196,22 @@
|
|||
(.error js/console "ERROR" error)
|
||||
(rx/of (msg/error (tr "errors.cannot-upload")))))))
|
||||
|
||||
|
||||
(def ^:private
|
||||
schema:process-media-objects
|
||||
(sm/define
|
||||
[:map {:title "process-media-objects"}
|
||||
[:file-id ::sm/uuid]
|
||||
[:local? :boolean]
|
||||
[:name {:optional true} :string]
|
||||
[:data {:optional true} :any] ; FIXME
|
||||
[:uris {:optional true} [:sequential :string]]
|
||||
[:mtype {:optional true} :string]]))
|
||||
|
||||
(defn- process-media-objects
|
||||
[{:keys [uris on-error] :as params}]
|
||||
(dm/assert!
|
||||
(and (sm/valid? schema:process-media-objects params)
|
||||
(and (sm/check! schema:process-media-objects params)
|
||||
(or (contains? params :blobs)
|
||||
(contains? params :uris))))
|
||||
|
||||
|
@ -392,14 +395,18 @@
|
|||
:on-svg #(st/emit! (process-svg-component %)))]
|
||||
(process-media-objects params)))
|
||||
|
||||
(def schema:clone-media-object
|
||||
[:map
|
||||
[:file-id ::sm/uuid]
|
||||
[:object-id ::sm/uuid]])
|
||||
(def ^:private
|
||||
schema:clone-media-object
|
||||
(sm/define
|
||||
[:map {:title "clone-media-object"}
|
||||
[:file-id ::sm/uuid]
|
||||
[:object-id ::sm/uuid]]))
|
||||
|
||||
(defn clone-media-object
|
||||
[{:keys [file-id object-id] :as params}]
|
||||
(dm/assert! (sm/valid? schema:clone-media-object params))
|
||||
(dm/assert!
|
||||
(sm/check! schema:clone-media-object params))
|
||||
|
||||
(ptk/reify ::clone-media-objects
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
|
|
|
@ -184,18 +184,23 @@
|
|||
:updated-at (dt/now)
|
||||
:page-id page-id))))))
|
||||
|
||||
(def schema:handle-file-change
|
||||
[:map
|
||||
[:type :keyword]
|
||||
[:profile-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:session-id ::sm/uuid]
|
||||
[:revn :int]
|
||||
[:changes ::cpc/changes]])
|
||||
(def ^:private
|
||||
schema:handle-file-change
|
||||
(sm/define
|
||||
[:map {:title "handle-file-change"}
|
||||
[:type :keyword]
|
||||
[:profile-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:session-id ::sm/uuid]
|
||||
[:revn :int]
|
||||
[:changes ::cpc/changes]]))
|
||||
|
||||
(defn handle-file-change
|
||||
[{:keys [file-id changes] :as msg}]
|
||||
(dm/assert! (sm/valid? schema:handle-file-change msg))
|
||||
(dm/assert!
|
||||
"expected valid arguments"
|
||||
(sm/check! schema:handle-file-change msg))
|
||||
|
||||
(ptk/reify ::handle-file-change
|
||||
IDeref
|
||||
(-deref [_] {:changes changes})
|
||||
|
@ -241,19 +246,24 @@
|
|||
(when-not (empty? changes-by-pages)
|
||||
(rx/from (map process-page-changes changes-by-pages))))))))
|
||||
|
||||
(def schema:handle-library-change
|
||||
[:map
|
||||
[:type :keyword]
|
||||
[:profile-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:session-id ::sm/uuid]
|
||||
[:revn :int]
|
||||
[:modified-at ::sm/inst]
|
||||
[:changes ::cpc/changes]])
|
||||
(def ^:private
|
||||
schema:handle-library-change
|
||||
(sm/define
|
||||
[:map {:title "handle-library-change"}
|
||||
[:type :keyword]
|
||||
[:profile-id ::sm/uuid]
|
||||
[:file-id ::sm/uuid]
|
||||
[:session-id ::sm/uuid]
|
||||
[:revn :int]
|
||||
[:modified-at ::sm/inst]
|
||||
[:changes ::cpc/changes]]))
|
||||
|
||||
(defn handle-library-change
|
||||
[{:keys [file-id modified-at changes revn] :as msg}]
|
||||
(dm/assert! (sm/valid? schema:handle-library-change msg))
|
||||
(dm/assert!
|
||||
"expected valid arguments"
|
||||
(sm/check! schema:handle-library-change msg))
|
||||
|
||||
(ptk/reify ::handle-library-change
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
|
|
|
@ -9,7 +9,7 @@
|
|||
[app.common.data.macros :as dm]
|
||||
[app.common.files.changes-builder :as pcb]
|
||||
[app.main.data.workspace.changes :as dch]
|
||||
[app.main.data.workspace.path.common :refer [content?]]
|
||||
[app.main.data.workspace.path.common :refer [check-path-content!]]
|
||||
[app.main.data.workspace.path.helpers :as helpers]
|
||||
[app.main.data.workspace.path.state :as st]
|
||||
[app.main.data.workspace.state-helpers :as wsh]
|
||||
|
@ -19,8 +19,12 @@
|
|||
(defn generate-path-changes
|
||||
"Generates changes to update the new content of the shape"
|
||||
[it objects page-id shape old-content new-content]
|
||||
(dm/assert! (content? old-content))
|
||||
(dm/assert! (content? new-content))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid path content"
|
||||
(and (check-path-content! old-content)
|
||||
(check-path-content! new-content)))
|
||||
|
||||
(let [shape-id (:id shape)
|
||||
|
||||
[old-points old-selrect]
|
||||
|
|
|
@ -22,23 +22,27 @@
|
|||
:elliptical-arc
|
||||
:close-path})
|
||||
|
||||
(def schema:content
|
||||
[:vector {:title "PathContent"}
|
||||
[:map {:title "PathContentEntry"}
|
||||
[:command [::sm/one-of valid-commands]]
|
||||
;; FIXME: remove the `?` from prop name
|
||||
[:relative? {:optional true} :boolean]
|
||||
[:params {:optional true}
|
||||
[:map {:title "PathContentEntryParams"}
|
||||
[:x :double]
|
||||
[:y :double]
|
||||
[:c1x {:optional true} :double]
|
||||
[:c1y {:optional true} :double]
|
||||
[:c2x {:optional true} :double]
|
||||
[:c2y {:optional true} :double]]]]])
|
||||
;; FIXME: should this schema be defined on common.types ?
|
||||
|
||||
(def content?
|
||||
(sm/pred-fn schema:content))
|
||||
(def ^:private
|
||||
schema:path-content
|
||||
(sm/define
|
||||
[:vector {:title "PathContent"}
|
||||
[:map {:title "PathContentEntry"}
|
||||
[:command [::sm/one-of valid-commands]]
|
||||
;; FIXME: remove the `?` from prop name
|
||||
[:relative? {:optional true} :boolean]
|
||||
[:params {:optional true}
|
||||
[:map {:title "PathContentEntryParams"}
|
||||
[:x :double]
|
||||
[:y :double]
|
||||
[:c1x {:optional true} :double]
|
||||
[:c1y {:optional true} :double]
|
||||
[:c2x {:optional true} :double]
|
||||
[:c2y {:optional true} :double]]]]]))
|
||||
|
||||
(def check-path-content!
|
||||
(sm/check-fn schema:path-content))
|
||||
|
||||
(defn init-path []
|
||||
(ptk/reify ::init-path))
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
[app.main.data.workspace.drawing.common :as dwdc]
|
||||
[app.main.data.workspace.edition :as dwe]
|
||||
[app.main.data.workspace.path.changes :as changes]
|
||||
[app.main.data.workspace.path.common :as common :refer [content?]]
|
||||
[app.main.data.workspace.path.common :as common :refer [check-path-content!]]
|
||||
[app.main.data.workspace.path.helpers :as helpers]
|
||||
[app.main.data.workspace.path.state :as st]
|
||||
[app.main.data.workspace.path.streams :as streams]
|
||||
|
@ -262,7 +262,11 @@
|
|||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(let [content (get-in state [:workspace-drawing :object :content] [])]
|
||||
(dm/assert! (content? content))
|
||||
|
||||
(dm/assert!
|
||||
"expected valid path content"
|
||||
(check-path-content! content))
|
||||
|
||||
(if (> (count content) 1)
|
||||
(assoc-in state [:workspace-drawing :object :initialized?] true)
|
||||
state)))
|
||||
|
|
|
@ -238,7 +238,7 @@
|
|||
[file-id {:keys [revn changes]}]
|
||||
(dm/assert! (uuid? file-id))
|
||||
(dm/assert! (int? revn))
|
||||
(dm/assert! (cpc/valid-changes? changes))
|
||||
(dm/assert! (cpc/check-changes! changes))
|
||||
|
||||
(ptk/reify ::shapes-changes-persisted
|
||||
ptk/UpdateEvent
|
||||
|
|
|
@ -27,9 +27,6 @@
|
|||
[beicon.core :as rx]
|
||||
[potok.core :as ptk]))
|
||||
|
||||
(def valid-shape-map?
|
||||
(sm/pred-fn ::cts/shape))
|
||||
|
||||
(defn add-shape
|
||||
([shape]
|
||||
(add-shape shape {}))
|
||||
|
@ -37,7 +34,7 @@
|
|||
|
||||
(dm/verify!
|
||||
"expected a valid shape"
|
||||
(cts/valid-shape? shape))
|
||||
(cts/check-shape! shape))
|
||||
|
||||
(ptk/reify ::add-shape
|
||||
ptk/WatchEvent
|
||||
|
@ -94,7 +91,10 @@
|
|||
([ids] (delete-shapes nil ids {}))
|
||||
([page-id ids] (delete-shapes page-id ids {}))
|
||||
([page-id ids options]
|
||||
(dm/assert! (sm/set-of-uuid? ids))
|
||||
(dm/assert!
|
||||
"expected a valid set of uuid's"
|
||||
(sm/check-set-of-uuid! ids))
|
||||
|
||||
(ptk/reify ::delete-shapes
|
||||
ptk/WatchEvent
|
||||
(watch [it state _]
|
||||
|
@ -376,7 +376,7 @@
|
|||
|
||||
(dm/assert!
|
||||
"expected valid shape-attrs value for `flags`"
|
||||
(cts/valid-shape-attrs? flags))
|
||||
(cts/check-shape-attrs! flags))
|
||||
|
||||
(ptk/reify ::update-shape-flags
|
||||
ptk/WatchEvent
|
||||
|
|
|
@ -427,7 +427,7 @@
|
|||
|
||||
shape))]
|
||||
|
||||
(let [ids (->> (keys props) (filter changed-text?))]
|
||||
(let [ids (into #{} (filter changed-text?) (keys props))]
|
||||
(rx/of (dwu/start-undo-transaction undo-id)
|
||||
(dch/update-shapes ids update-fn {:reg-objects? true
|
||||
:stack-undo? true
|
||||
|
|
|
@ -24,13 +24,15 @@
|
|||
;; Undo / Redo
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def schema:undo-entry
|
||||
[:map
|
||||
[:undo-changes [:vector ::cpc/change]]
|
||||
[:redo-changes [:vector ::cpc/change]]])
|
||||
(def ^:private
|
||||
schema:undo-entry
|
||||
(sm/define
|
||||
[:map {:title "undo-entry"}
|
||||
[:undo-changes [:vector ::cpc/change]]
|
||||
[:redo-changes [:vector ::cpc/change]]]))
|
||||
|
||||
(def undo-entry?
|
||||
(sm/pred-fn schema:undo-entry))
|
||||
(def check-undo-entry!
|
||||
(sm/check-fn schema:undo-entry))
|
||||
|
||||
(def MAX-UNDO-SIZE 50)
|
||||
|
||||
|
@ -89,8 +91,12 @@
|
|||
|
||||
(defn append-undo
|
||||
[entry stack?]
|
||||
(dm/assert! (boolean? stack?))
|
||||
(dm/assert! (undo-entry? entry))
|
||||
(dm/assert!
|
||||
"expected valid undo entry"
|
||||
(check-undo-entry! entry))
|
||||
|
||||
(dm/assert!
|
||||
(boolean? stack?))
|
||||
|
||||
(ptk/reify ::append-undo
|
||||
ptk/UpdateEvent
|
||||
|
|
|
@ -114,17 +114,29 @@
|
|||
;; the user perspective a error flash message should be visualized but
|
||||
;; user can continue operate on the application. Can happen in backend
|
||||
;; and frontend.
|
||||
|
||||
(defmethod ptk/handle-error :validation
|
||||
[error]
|
||||
(ts/schedule
|
||||
#(st/emit! (msg/show {:content "Validation error"
|
||||
:type :error
|
||||
:timeout 3000})))
|
||||
[{:keys [code] :as error}]
|
||||
|
||||
(print-group! "Validation Error"
|
||||
(fn []
|
||||
(print-data! error)
|
||||
(print-explain! error))))
|
||||
(print-explain! error)))
|
||||
(cond
|
||||
(= code :invalid-paste-data)
|
||||
(let [message (tr "errors.paste-data-validation")]
|
||||
(st/async-emit!
|
||||
(msg/show {:content message
|
||||
:type :error
|
||||
:timeout 3000})))
|
||||
|
||||
:else
|
||||
(let [message (tr "errors.generic-validation")]
|
||||
(st/async-emit!
|
||||
(msg/show {:content message
|
||||
:type :error
|
||||
:timeout 3000})))))
|
||||
|
||||
|
||||
|
||||
;; This is a pure frontend error that can be caused by an active
|
||||
|
@ -232,6 +244,12 @@
|
|||
(let [message (tr "errors.max-quote-reached" (:target error))]
|
||||
(st/emit! (modal/show {:type :alert :message message})))
|
||||
|
||||
(or (= :paste-feature-not-enabled code)
|
||||
(= :missing-features-in-paste-content code)
|
||||
(= :paste-feature-not-supported code))
|
||||
(let [message (tr "errors.feature-not-supported" (:feature error))]
|
||||
(st/emit! (modal/show {:type :alert :message message})))
|
||||
|
||||
:else
|
||||
(ptk/handle-error {:type :server-error :data error})))
|
||||
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
(:require
|
||||
[app.common.logging :as log]
|
||||
[app.util.object :as obj]
|
||||
[app.util.timers :as tm]
|
||||
[beicon.core :as rx]
|
||||
[okulary.core :as l]
|
||||
[potok.core :as ptk]))
|
||||
|
@ -86,6 +87,10 @@
|
|||
(apply ptk/emit! state (cons event events))
|
||||
nil))
|
||||
|
||||
(defn async-emit!
|
||||
[& params]
|
||||
(tm/schedule #(apply emit! params)))
|
||||
|
||||
(defonce ongoing-tasks (l/atom #{}))
|
||||
|
||||
(add-watch ongoing-tasks ::ongoing-tasks
|
||||
|
|
|
@ -6,8 +6,6 @@
|
|||
|
||||
(ns app.main.ui.dashboard.project-menu
|
||||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.schema :as sm]
|
||||
[app.main.data.dashboard :as dd]
|
||||
[app.main.data.messages :as msg]
|
||||
[app.main.data.modal :as modal]
|
||||
|
@ -21,19 +19,8 @@
|
|||
[app.util.router :as rt]
|
||||
[rumext.v2 :as mf]))
|
||||
|
||||
(def schema:project-menu
|
||||
[:map {:title "UIProjectMenu"}
|
||||
[:project some?]
|
||||
[:show? :boolean]
|
||||
[:on-menu-close {:optional true} ::sm/fn]
|
||||
[:on-error {:optional true} ::sm/fn]
|
||||
[:top {:optional true} [:maybe :double]]
|
||||
[:left {:optional true} [:maybe :double]]
|
||||
[:on-import {:optional true} ::sm/fn]])
|
||||
|
||||
(mf/defc project-menu
|
||||
[{:keys [project show? on-edit on-menu-close top left on-import] :as props}]
|
||||
(dm/assert! (sm/valid? schema:project-menu props))
|
||||
(let [top (or top 0)
|
||||
left (or left 0)
|
||||
|
||||
|
|
|
@ -154,7 +154,7 @@
|
|||
(let [do-copy #(st/emit! (dw/copy-selected))
|
||||
do-cut #(st/emit! (dw/copy-selected)
|
||||
(dw/delete-selected))
|
||||
do-paste #(st/emit! dw/paste)
|
||||
do-paste #(st/emit! (dw/paste-from-clipboard))
|
||||
do-duplicate #(st/emit! (dw/duplicate-selected true))]
|
||||
[:*
|
||||
[:& menu-entry {:title (tr "workspace.shape.menu.copy")
|
||||
|
@ -531,7 +531,7 @@
|
|||
(mf/defc viewport-context-menu
|
||||
[]
|
||||
(let [focus (mf/deref refs/workspace-focus-selected)
|
||||
do-paste #(st/emit! dw/paste)
|
||||
do-paste #(st/emit! (dw/paste-from-clipboard))
|
||||
do-hide-ui #(st/emit! (-> (dw/toggle-layout-flag :hide-ui)
|
||||
(vary-meta assoc ::ev/origin "workspace-context-menu")))
|
||||
do-toggle-focus-mode #(st/emit! (dw/toggle-focus-mode))]
|
||||
|
|
|
@ -501,13 +501,16 @@
|
|||
:blobs (seq files)}]
|
||||
(st/emit! (dwm/upload-media-workspace params))))))))
|
||||
|
||||
(defn on-paste [disable-paste in-viewport? workspace-read-only?]
|
||||
(mf/use-callback
|
||||
(defn on-paste
|
||||
[disable-paste in-viewport? workspace-read-only?]
|
||||
(mf/use-fn
|
||||
(mf/deps workspace-read-only?)
|
||||
(fn [event]
|
||||
;; We disable the paste just after mouse-up of a middle button so when panning won't
|
||||
;; paste the content into the workspace
|
||||
;; We disable the paste just after mouse-up of a middle button so
|
||||
;; when panning won't paste the content into the workspace
|
||||
(let [tag-name (-> event dom/get-target dom/get-tag-name)]
|
||||
(when (and (not (#{"INPUT" "TEXTAREA"} tag-name)) (not @disable-paste) (not workspace-read-only?))
|
||||
(when (and (not (#{"INPUT" "TEXTAREA"} tag-name))
|
||||
(not @disable-paste)
|
||||
(not workspace-read-only?))
|
||||
(st/emit! (dw/paste-from-event event @in-viewport?)))))))
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
|
||||
(ns app.util.object
|
||||
"A collection of helpers for work with javascript objects."
|
||||
(:refer-clojure :exclude [set! new get get-in merge clone contains? array?])
|
||||
(:refer-clojure :exclude [set! new get get-in merge clone contains? array? into-array])
|
||||
(:require
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
|
@ -14,6 +14,10 @@
|
|||
[o]
|
||||
(.isArray js/Array o))
|
||||
|
||||
(defn into-array
|
||||
[o]
|
||||
(js/Array.from o))
|
||||
|
||||
(defn create [] #js {})
|
||||
|
||||
(defn get
|
||||
|
|
|
@ -93,6 +93,10 @@
|
|||
|
||||
(create-blob content mtype)))
|
||||
|
||||
(defn get-current-selected-text
|
||||
[]
|
||||
(.. js/window getSelection toString))
|
||||
|
||||
(defn write-to-clipboard
|
||||
[data]
|
||||
(assert (string? data) "`data` should be string")
|
||||
|
@ -101,44 +105,47 @@
|
|||
|
||||
(defn read-from-clipboard
|
||||
[]
|
||||
(let [cboard (unchecked-get js/navigator "clipboard")]
|
||||
(if (.-readText ^js cboard)
|
||||
(rx/from (.readText ^js cboard))
|
||||
(throw (ex-info "This browser does not implement read from clipboard protocol"
|
||||
{:not-implemented true})))))
|
||||
(try
|
||||
(let [cboard (unchecked-get js/navigator "clipboard")]
|
||||
(if (.-readText ^js cboard)
|
||||
(rx/from (.readText ^js cboard))
|
||||
(rx/throw (ex-info "This browser does not implement read from clipboard protocol"
|
||||
{:not-implemented true}))))
|
||||
(catch :default cause
|
||||
(rx/throw cause))))
|
||||
|
||||
(defn read-image-from-clipboard
|
||||
[]
|
||||
(let [cboard (unchecked-get js/navigator "clipboard")
|
||||
read-item (fn [item]
|
||||
(let [img-type (->> (.-types ^js item)
|
||||
(d/seek #(str/starts-with? % "image/")))]
|
||||
(if img-type
|
||||
(rx/from (.getType ^js item img-type))
|
||||
(rx/empty))))]
|
||||
(->> (rx/from (.read ^js cboard)) ;; Get a stream of item lists
|
||||
(rx/mapcat identity) ;; Convert each item into an emission
|
||||
(rx/switch-map read-item))))
|
||||
(try
|
||||
(let [cboard (unchecked-get js/navigator "clipboard")
|
||||
read-item (fn [item]
|
||||
(let [img-type (->> (.-types ^js item)
|
||||
(d/seek #(str/starts-with? % "image/")))]
|
||||
(if img-type
|
||||
(rx/from (.getType ^js item img-type))
|
||||
(rx/empty))))]
|
||||
(->> (rx/from (.read ^js cboard)) ;; Get a stream of item lists
|
||||
(rx/mapcat identity) ;; Convert each item into an emission
|
||||
(rx/switch-map read-item)))
|
||||
(catch :default cause
|
||||
(rx/throw cause))))
|
||||
|
||||
(defn read-from-paste-event
|
||||
[event]
|
||||
(let [target (.-target ^js event)]
|
||||
(when (and (not (.-isContentEditable target)) ;; ignore when pasting into
|
||||
(not= (.-tagName target) "INPUT")) ;; an editable control
|
||||
(when (and (not (.-isContentEditable ^js target)) ;; ignore when pasting into
|
||||
(not= (.-tagName ^js target) "INPUT")) ;; an editable control
|
||||
(.. ^js event getBrowserEvent -clipboardData))))
|
||||
|
||||
(defn extract-text
|
||||
[clipboard-data]
|
||||
(when clipboard-data
|
||||
(.getData clipboard-data "text")))
|
||||
(.getData clipboard-data "text"))
|
||||
|
||||
(defn extract-images
|
||||
"Get image files from clipboard data. Returns a native js array."
|
||||
[clipboard-data]
|
||||
(when clipboard-data
|
||||
(let [file-list (-> (.-files ^js clipboard-data))]
|
||||
(->> (range (.-length ^js file-list))
|
||||
(map #(.item ^js file-list %))
|
||||
(filter #(str/starts-with? (.-type %) "image/"))))))
|
||||
(let [files (obj/into-array (.-files ^js clipboard-data))]
|
||||
(.filter ^js files #(str/starts-with? (obj/get % "type") "image/"))))
|
||||
|
||||
(defn create-canvas-element
|
||||
[width height]
|
||||
|
|
|
@ -24,23 +24,24 @@
|
|||
|
||||
;; --- Messages Handling
|
||||
|
||||
(def schema:message
|
||||
[:map {:title "WorkerMessage"}
|
||||
[:sender-id ::sm/uuid]
|
||||
[:payload
|
||||
[:map
|
||||
[:cmd :keyword]]]
|
||||
[:buffer? {:optional true} :boolean]])
|
||||
|
||||
(def message?
|
||||
(sm/pred-fn schema:message))
|
||||
(def ^:private
|
||||
schema:message
|
||||
(sm/define
|
||||
[:map {:title "WorkerMessage"}
|
||||
[:sender-id ::sm/uuid]
|
||||
[:payload
|
||||
[:map
|
||||
[:cmd :keyword]]]
|
||||
[:buffer? {:optional true} :boolean]]))
|
||||
|
||||
(def buffer (rx/subject))
|
||||
|
||||
(defn- handle-message
|
||||
"Process the message and returns to the client"
|
||||
[{:keys [sender-id payload transfer] :as message}]
|
||||
(dm/assert! (message? message))
|
||||
(dm/assert!
|
||||
"expected valid message"
|
||||
(sm/check! schema:message message))
|
||||
(letfn [(post [msg]
|
||||
(let [msg (-> msg (assoc :reply-to sender-id) (wm/encode))]
|
||||
(.postMessage js/self msg)))
|
||||
|
@ -86,7 +87,9 @@
|
|||
(defn- drop-message
|
||||
"Sends to the client a notification that its messages have been dropped"
|
||||
[{:keys [sender-id] :as message}]
|
||||
(dm/assert! (message? message))
|
||||
(dm/assert!
|
||||
"expected valid message"
|
||||
(sm/check! schema:message message))
|
||||
(.postMessage js/self (wm/encode {:reply-to sender-id
|
||||
:dropped true})))
|
||||
|
||||
|
|
|
@ -998,6 +998,13 @@ msgstr "Email or password is incorrect."
|
|||
msgid "errors.wrong-old-password"
|
||||
msgstr "Old password is incorrect"
|
||||
|
||||
msgid "errors.validation"
|
||||
msgstr "Validation Error"
|
||||
|
||||
msgid "errors.paste-data-validation"
|
||||
msgstr "Invalid data in clipboard"
|
||||
|
||||
|
||||
#: src/app/main/ui/settings/feedback.cljs
|
||||
msgid "feedback.description"
|
||||
msgstr "Description"
|
||||
|
|
Loading…
Add table
Reference in a new issue