Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-04-11 14:31:24 -05:00
Code Issues Activity

✨ Add usability improvements to schema validation subsystem

Browse source
This commit is contained in:
Andrey Antukh 2023-11-23 13:33:01 +01:00
parent 83c6354a0a
commit 37e4939af7
40 changed files with 759 additions and 511 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
backend/src/app/rpc/commands/profile.clj
View file

@ -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]

5
backend/src/app/setup/templates.clj
View file

@ -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))]

4
common/src/app/common/data/macros.cljc
View file

@ -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

2
common/src/app/common/files/builder.cljc
View file

@ -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)]

60
common/src/app/common/files/changes.cljc
View file

@ -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)

10
common/src/app/common/files/changes_builder.cljc
View file

@ -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))

2
common/src/app/common/files/helpers.cljc
View file

@ -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`."

4
common/src/app/common/files/shapes_helpers.cljc
View file

@ -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))

279
common/src/app/common/schema.cljc
View file

@ -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))

18
common/src/app/common/types/color.cljc
View file

@ -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

8
common/src/app/common/types/container.cljc
View file

@ -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`"

12
common/src/app/common/types/file.cljc
View file

@ -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

19
common/src/app/common/types/page.cljc
View file

@ -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

45
common/src/app/common/types/shape.cljc
View file

@ -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)))

62
common/src/app/common/types/shape/interactions.cljc
View file

@ -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`"

13
common/src/app/common/types/shape/layout.cljc
View file

@ -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)))

4
common/src/app/common/types/typography.cljc
View file

@ -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

2
common/test/common_tests/types_test.cljc
View file

@ -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)]

166
frontend/src/app/main/data/comments.cljs
View file

@ -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 _]

22
frontend/src/app/main/data/dashboard.cljs
View file

@ -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 [_]

53
frontend/src/app/main/data/messages.cljs
View file

@ -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

26
frontend/src/app/main/data/shortcuts.cljs
View file

@ -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

63
frontend/src/app/main/data/users.cljs
View file

@ -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 [_ _ _]

51
frontend/src/app/main/data/viewer.cljs
View file

@ -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

12
frontend/src/app/main/data/workspace.cljs
View file

@ -669,8 +669,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 +715,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 _]

10
frontend/src/app/main/data/workspace/changes.cljs
View file

@ -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 set of uuid's"
(sm/check-set-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

5
frontend/src/app/main/data/workspace/colors.cljs
View 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 [_ _ _]

62
frontend/src/app/main/data/workspace/comments.cljs
View file

@ -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 _]

4
frontend/src/app/main/data/workspace/guides.cljs
View file

@ -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

31
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -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]

37
frontend/src/app/main/data/workspace/media.cljs
View file

@ -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 [_ _ _]

48
frontend/src/app/main/data/workspace/notifications.cljs
View file

@ -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 _]

10
frontend/src/app/main/data/workspace/path/changes.cljs
View file

@ -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]

36
frontend/src/app/main/data/workspace/path/common.cljs
View file

@ -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))

8
frontend/src/app/main/data/workspace/path/drawing.cljs
View file

@ -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)))

2
frontend/src/app/main/data/workspace/persistence.cljs
View file

@ -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

12
frontend/src/app/main/data/workspace/shapes.cljs
View file

@ -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

22
frontend/src/app/main/data/workspace/undo.cljs
View file

@ -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

13
frontend/src/app/main/ui/dashboard/project_menu.cljs
View file

@ -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)

27
frontend/src/app/worker.cljs
View file

@ -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})))