3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-18 12:46:11 +02:00
Code Issues Projects Releases Packages Wiki Activity

🎉 Add malli based validation and coersion subsystem

Browse source
This commit is contained in:
Andrey Antukh 2023-03-18 10:32:26 +01:00
parent dbc08ba80f
commit 5ca3d01ea1
125 changed files with 4984 additions and 2762 deletions
Download patch file Download diff file Expand all files Collapse all files

14
frontend/src/app/config.cljs
View file

@ -6,23 +6,25 @@
(ns app.config
(:require
[app.common.data.macros :as dm]
[app.common.flags :as flags]
[app.common.spec :as us]
[app.common.uri :as u]
[app.common.version :as v]
[app.util.avatars :as avatars]
[app.util.dom :as dom]
[app.util.globals :refer [global location]]
[app.util.object :as obj]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
(set! *assert* js/goog.DEBUG)
;; --- Auxiliar Functions
(s/def ::platform #{:windows :linux :macos :other})
(s/def ::browser #{:chrome :firefox :safari :edge :other})
(def valid-browsers
#{:chrome :firefox :safari :edge :other})
(def valid-platforms
#{:windows :linux :macos :other})
(defn- parse-browser
[]
@ -114,11 +116,11 @@
;; --- Helper Functions
(defn ^boolean check-browser? [candidate]
(us/verify! ::browser candidate)
(dm/assert! (contains? valid-browsers candidate))
(= candidate @browser))
(defn ^boolean check-platform? [candidate]
(us/verify! ::platform candidate)
(dm/assert! (contains? valid-platforms candidate))
(= candidate @platform))
(defn resolve-profile-photo-url

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

@ -7,70 +7,55 @@
(ns app.main.data.comments
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.repo :as rp]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(s/def ::content ::us/string)
(s/def ::count-comments ::us/integer)
(s/def ::count-unread-comments ::us/integer)
(s/def ::created-at ::us/inst)
(s/def ::file-id ::us/uuid)
(s/def ::file-name ::us/string)
(s/def ::modified-at ::us/inst)
(s/def ::owner-id ::us/uuid)
(s/def ::page-id ::us/uuid)
(s/def ::page-name ::us/string)
(s/def ::participants (s/every ::us/uuid :kind set?))
(s/def ::position ::gpt/point)
(s/def ::project-id ::us/uuid)
(s/def ::seqn ::us/integer)
(s/def ::thread-id ::us/uuid)
(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]])
(s/def ::comment-thread
(s/keys :req-un [::us/id
::page-id
::file-id
::project-id
::page-name
::file-name
::seqn
::content
::participants
::created-at
::modified-at
::owner-id
::position]
:opt-un [::count-unread-comments
::count-comments]))
(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]])
(s/def ::comment
(s/keys :req-un [::us/id
::thread-id
::owner-id
::created-at
::modified-at
::content]))
(def comment-thread?
(sm/pred-fn schema:comment-thread))
(def comment?
(sm/pred-fn schema:comment))
(declare create-draft-thread)
(declare retrieve-comment-threads)
(declare refresh-comment-thread)
(s/def ::create-thread-on-workspace-params
(s/keys :req-un [::page-id ::file-id ::position ::content]))
(s/def ::create-thread-on-viewer-params
(s/keys :req-un [::page-id ::file-id ::position ::content ::frame-id]))
(defn created-thread-on-workspace
[{:keys [id comment page-id] :as thread}]
(ptk/reify ::created-thread-on-workspace
ptk/UpdateEvent
(update [_ state]
@ -82,10 +67,17 @@
(update :workspace-drawing dissoc :comment)
(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]])
(defn create-thread-on-workspace
[params]
(us/assert ::create-thread-on-workspace-params params)
(dm/assert! (sm/valid? schema:create-thread-on-workspace params))
(ptk/reify ::create-thread-on-workspace
ptk/WatchEvent
(watch [_ state _]
@ -115,9 +107,17 @@
(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]])
(defn create-thread-on-viewer
[params]
(us/assert! ::create-thread-on-viewer-params params)
(dm/assert! (sm/valid? schema:create-thread-on-viewer params))
(ptk/reify ::create-thread-on-viewer
ptk/WatchEvent
(watch [_ state _]
@ -135,7 +135,7 @@
(defn update-comment-thread-status
[{:keys [id] :as thread}]
(us/assert ::comment-thread thread)
(dm/assert! (comment-thread? thread))
(ptk/reify ::update-comment-thread-status
ptk/WatchEvent
(watch [_ state _]
@ -147,7 +147,7 @@
(defn update-comment-thread
[{:keys [id is-resolved] :as thread}]
(us/assert ::comment-thread thread)
(dm/assert! (comment-thread? thread))
(ptk/reify ::update-comment-thread
IDeref
(-deref [_] {:is-resolved is-resolved})
@ -169,8 +169,9 @@
(defn add-comment
[thread content]
(us/assert ::comment-thread thread)
(us/assert ::us/string content)
(dm/assert! (comment-thread? thread))
(dm/assert! (string? content))
(letfn [(created [comment state]
(update-in state [:comments (:id thread)] assoc (:id comment) comment))]
(ptk/reify ::create-comment
@ -189,7 +190,7 @@
(defn update-comment
[{:keys [id content thread-id] :as comment}]
(us/assert ::comment comment)
(dm/assert! (comment? comment))
(ptk/reify ::update-comment
ptk/UpdateEvent
(update [_ state]
@ -204,7 +205,7 @@
(defn delete-comment-thread-on-workspace
[{:keys [id] :as thread}]
(us/assert ::comment-thread thread)
(dm/assert! (comment-thread? thread))
(ptk/reify ::delete-comment-thread-on-workspace
ptk/UpdateEvent
(update [_ state]
@ -222,7 +223,7 @@
(defn delete-comment-thread-on-viewer
[{:keys [id] :as thread}]
(us/assert ::comment-thread thread)
(dm/assert! (comment-thread? thread))
(ptk/reify ::delete-comment-thread-on-viewer
ptk/UpdateEvent
(update [_ state]
@ -241,7 +242,7 @@
(defn delete-comment
[{:keys [id thread-id] :as comment}]
(us/assert ::comment comment)
(dm/assert! (comment? comment))
(ptk/reify ::delete-comment
ptk/UpdateEvent
(update [_ state]
@ -256,7 +257,7 @@
(defn refresh-comment-thread
[{:keys [id file-id] :as thread}]
(us/assert ::comment-thread thread)
(dm/assert! (comment-thread? thread))
(letfn [(fetched [thread state]
(assoc-in state [:comment-threads id] thread))]
(ptk/reify ::refresh-comment-thread
@ -269,7 +270,7 @@
(defn retrieve-comment-threads
[file-id]
(us/assert ::us/uuid file-id)
(dm/assert! (uuid? file-id))
(letfn [(set-comment-threds [state comment-thread]
(let [path [:workspace-data :pages-index (:page-id comment-thread) :options :comment-threads-position (:id comment-thread)]
thread-position (get-in state path)]
@ -296,7 +297,7 @@
(defn retrieve-comments
[thread-id]
(us/assert ::us/uuid thread-id)
(dm/assert! (uuid? thread-id))
(letfn [(fetched [comments state]
(update state :comments assoc thread-id (d/index-by :id comments)))]
(ptk/reify ::retrieve-comments
@ -310,7 +311,7 @@
(defn retrieve-unread-comment-threads
"A event used mainly in dashboard for retrieve all unread threads of a team."
[team-id]
(us/assert ::us/uuid team-id)
(dm/assert! (uuid? team-id))
(ptk/reify ::retrieve-unread-comment-threads
ptk/WatchEvent
(watch [_ _ _]
@ -326,7 +327,7 @@
(defn open-thread
[{:keys [id] :as thread}]
(us/assert ::comment-thread thread)
(dm/assert! (comment-thread? thread))
(ptk/reify ::open-comment-thread
ptk/UpdateEvent
(update [_ state]
@ -367,12 +368,15 @@
(update [_ state]
(update state :comments-local merge params))))
(s/def ::create-draft-params
(s/keys :req-un [::page-id ::file-id ::position]))
(def schema:create-draft
[:map
[:page-id ::sm/uuid]
[:file-id ::sm/uuid]
[:position ::gpt/point]])
(defn create-draft
[params]
(us/assert ::create-draft-params params)
(dm/assert! (sm/valid? schema:create-draft params))
(ptk/reify ::create-draft
ptk/UpdateEvent
(update [_ state]
@ -441,7 +445,7 @@
(update-comment-thread-frame thread uuid/zero))
([thread frame-id]
(us/assert ::comment-thread thread)
(dm/assert! (comment-thread? thread))
(ptk/reify ::update-comment-thread-frame
ptk/UpdateEvent
(update [_ state]
@ -458,8 +462,7 @@
(defn detach-comment-thread
"Detach comment threads that are inside a frame when that frame is deleted"
[ids]
(us/assert! ::us/coll-of-uuid ids)
(dm/assert! (sm/coll-of-uuid? ids))
(ptk/reify ::detach-comment-thread
ptk/WatchEvent
(watch [_ state _]

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

@ -7,8 +7,10 @@
(ns app.main.data.dashboard
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.pages :as cp]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.uri :as u]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main.data.events :as ev]
@ -23,41 +25,8 @@
[app.util.timers :as tm]
[app.util.webapi :as wapi]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; --- Specs
(s/def ::id ::us/uuid)
(s/def ::name string?)
(s/def ::team-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::created-at ::us/inst)
(s/def ::modified-at ::us/inst)
(s/def ::is-pinned ::us/boolean)
(s/def ::team
(s/keys :req-un [::id
::name
::created-at
::modified-at]))
(s/def ::project
(s/keys :req-un [::id
::name
::team-id
::created-at
::modified-at
::is-pinned]))
(s/def ::file
(s/keys :req-un [::id
::name
::project-id]
:opt-un [::created-at
::modified-at]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -68,7 +37,7 @@
(defn initialize
[{:keys [id] :as params}]
(us/assert! ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
@ -199,13 +168,13 @@
(update [_ state]
(assoc state :dashboard-search-result result))))
(s/def ::search-term (s/nilable ::us/string))
(s/def ::search
(s/keys :req-un [::search-term ]))
(def schema:search-params
[:map {:closed true}
[:search-term [:maybe :string]]])
(defn search
[params]
(us/assert! ::search params)
(dm/assert! schema:search-params params)
(ptk/reify ::search
ptk/UpdateEvent
(update [_ state]
@ -240,7 +209,7 @@
(defn fetch-files
[{:keys [project-id] :as params}]
(us/assert! ::us/uuid project-id)
(dm/assert! (uuid? project-id))
(ptk/reify ::fetch-files
ptk/WatchEvent
(watch [_ _ _]
@ -351,7 +320,6 @@
(defn toggle-file-select
[{:keys [id project-id] :as file}]
(us/assert! ::file file)
(ptk/reify ::toggle-file-select
ptk/UpdateEvent
(update [_ state]
@ -381,7 +349,7 @@
(defn create-team
[{:keys [name] :as params}]
(us/assert! ::us/string name)
(dm/assert! (string? name))
(ptk/reify ::create-team
ptk/WatchEvent
(watch [_ _ _]
@ -397,7 +365,6 @@
(defn create-team-with-invitations
[{:keys [name emails role] :as params}]
(us/assert! ::us/string name)
(ptk/reify ::create-team-with-invitations
ptk/WatchEvent
(watch [_ _ _]
@ -416,7 +383,6 @@
(defn update-team
[{:keys [id name] :as params}]
(us/assert! ::team params)
(ptk/reify ::update-team
ptk/UpdateEvent
(update [_ state]
@ -429,7 +395,9 @@
(defn update-team-photo
[file]
(us/assert! ::di/blob file)
(dm/assert!
"expected a valid blob for `file` param"
(di/blob? file))
(ptk/reify ::update-team-photo
ptk/WatchEvent
(watch [_ state _]
@ -450,8 +418,8 @@
(defn update-team-member-role
[{:keys [role member-id] :as params}]
(us/assert! ::us/uuid member-id)
(us/assert! ::us/keyword role)
(dm/assert! (uuid? member-id))
(dm/assert! (keyword? role)) ; FIXME: validate proper role?
(ptk/reify ::update-team-member-role
ptk/WatchEvent
(watch [_ state _]
@ -464,7 +432,7 @@
(defn delete-team-member
[{:keys [member-id] :as params}]
(us/assert! ::us/uuid member-id)
(dm/assert! (uuid? member-id))
(ptk/reify ::delete-team-member
ptk/WatchEvent
(watch [_ state _]
@ -477,9 +445,9 @@
(defn leave-team
[{:keys [reassign-to] :as params}]
(us/assert!
:spec (s/nilable ::us/uuid)
:val reassign-to)
(dm/assert! (or (nil? reassign-to)
(uuid? reassign-to)))
(ptk/reify ::leave-team
ptk/WatchEvent
(watch [_ state _]
@ -496,9 +464,10 @@
(defn invite-team-members
[{:keys [emails role team-id resend?] :as params}]
(us/assert! ::us/set-of-valid-emails emails)
(us/assert! ::us/keyword role)
(us/assert! ::us/uuid team-id)
(dm/assert! (keyword? role))
(dm/assert! (uuid? team-id))
(dm/assert! (sm/set-of-emails? emails))
(ptk/reify ::invite-team-members
IDeref
(-deref [_] {:role role :team-id team-id :resend? resend?})
@ -516,14 +485,13 @@
(defn copy-invitation-link
[{:keys [email team-id] :as params}]
(us/assert! ::us/email email)
(us/assert! ::us/uuid team-id)
(dm/assert! (sm/email? email))
(dm/assert! (uuid? team-id))
(ptk/reify ::copy-invitation-link
IDeref
(-deref [_] {:email email :team-id team-id})
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [on-success on-error]
@ -545,9 +513,10 @@
(defn update-team-invitation-role
[{:keys [email team-id role] :as params}]
(us/assert! ::us/email email)
(us/assert! ::us/uuid team-id)
(us/assert! ::us/keyword role)
(dm/assert! (sm/email? email))
(dm/assert! (uuid? team-id))
(dm/assert! (keyword? role)) ;; FIXME validate role
(ptk/reify ::update-team-invitation-role
IDeref
(-deref [_] {:role role})
@ -563,8 +532,8 @@
(defn delete-team-invitation
[{:keys [email team-id] :as params}]
(us/assert! ::us/email email)
(us/assert! ::us/uuid team-id)
(dm/assert! (sm/email? email))
(dm/assert! (uuid? team-id))
(ptk/reify ::delete-team-invitation
ptk/WatchEvent
(watch [_ _ _]
@ -577,7 +546,7 @@
(defn delete-team-webhook
[{:keys [id] :as params}]
(us/assert! ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::delete-team-webhook
ptk/WatchEvent
(watch [_ state _]
@ -590,17 +559,17 @@
(rx/tap on-success)
(rx/catch on-error))))))
(s/def ::mtype
(def valid-mtypes
#{"application/json"
"application/x-www-form-urlencoded"
"application/transit+json"})
(defn update-team-webhook
[{:keys [id uri mtype is-active] :as params}]
(us/assert! ::us/uuid id)
(us/assert! ::us/uri uri)
(us/assert! ::mtype mtype)
(us/assert! ::us/boolean is-active)
(dm/assert! (uuid? id))
(dm/assert! (contains? valid-mtypes mtype))
(dm/assert! (boolean? is-active))
(dm/assert! (u/uri? uri))
(ptk/reify ::update-team-webhook
ptk/WatchEvent
(watch [_ state _]
@ -615,9 +584,10 @@
(defn create-team-webhook
[{:keys [uri mtype is-active] :as params}]
(us/assert! ::us/uri uri)
(us/assert! ::mtype mtype)
(us/assert! ::us/boolean is-active)
(dm/assert! (contains? valid-mtypes mtype))
(dm/assert! (boolean? is-active))
(dm/assert! (u/uri? uri))
(ptk/reify ::create-team-webhook
ptk/WatchEvent
(watch [_ state _]
@ -636,7 +606,6 @@
(defn delete-team
[{:keys [id] :as params}]
(us/assert! ::team params)
(ptk/reify ::delete-team
ptk/WatchEvent
(watch [_ _ _]
@ -691,7 +660,7 @@
(defn duplicate-project
[{:keys [id name] :as params}]
(us/assert! ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::duplicate-project
ptk/WatchEvent
(watch [_ _ _]
@ -708,8 +677,8 @@
(defn move-project
[{:keys [id team-id] :as params}]
(us/assert! ::us/uuid id)
(us/assert! ::us/uuid team-id)
(dm/assert! (uuid? id))
(dm/assert! (uuid? team-id))
(ptk/reify ::move-project
IDeref
(-deref [_]
@ -727,7 +696,6 @@
(defn toggle-project-pin
[{:keys [id is-pinned] :as project}]
(us/assert! ::project project)
(ptk/reify ::toggle-project-pin
ptk/UpdateEvent
(update [_ state]
@ -744,7 +712,6 @@
(defn rename-project
[{:keys [id name] :as params}]
(us/assert! ::project params)
(ptk/reify ::rename-project
ptk/UpdateEvent
(update [_ state]
@ -762,7 +729,6 @@
(defn delete-project
[{:keys [id] :as params}]
(us/assert! ::project params)
(ptk/reify ::delete-project
ptk/UpdateEvent
(update [_ state]
@ -784,7 +750,6 @@
(defn delete-file
[{:keys [id project-id] :as params}]
(us/assert! ::file params)
(ptk/reify ::delete-file
ptk/UpdateEvent
(update [_ state]
@ -803,7 +768,6 @@
(defn rename-file
[{:keys [id name] :as params}]
(us/assert! ::file params)
(ptk/reify ::rename-file
IDeref
(-deref [_]
@ -826,7 +790,6 @@
(defn set-file-shared
[{:keys [id is-shared] :as params}]
(us/assert! ::file params)
(ptk/reify ::set-file-shared
IDeref
(-deref [_]
@ -853,7 +816,6 @@
(defn file-created
[{:keys [id project-id] :as file}]
(us/verify ::file file)
(ptk/reify ::file-created
IDeref
(-deref [_] {:file-id id
@ -868,7 +830,7 @@
(defn create-file
[{:keys [project-id] :as params}]
(us/assert! ::us/uuid project-id)
(dm/assert! (uuid? project-id))
(ptk/reify ::create-file
IDeref
@ -899,8 +861,8 @@
(defn duplicate-file
[{:keys [id name] :as params}]
(us/assert! ::us/uuid id)
(us/assert! ::name name)
(dm/assert! (uuid? id))
(dm/assert! (string? name))
(ptk/reify ::duplicate-file
ptk/WatchEvent
(watch [_ _ _]
@ -919,8 +881,8 @@
(defn move-files
[{:keys [ids project-id] :as params}]
(us/assert! ::us/set-of-uuid ids)
(us/assert! ::us/uuid project-id)
(dm/assert! ::sm/set-of-uuid ids)
(dm/assert! (uuid? project-id))
(ptk/reify ::move-files
IDeref
(-deref [_]
@ -947,7 +909,7 @@
;; --- EVENT: clone-template
(defn clone-template
[{:keys [template-id project-id] :as params}]
(us/assert! ::us/uuid project-id)
(dm/assert! (uuid? project-id))
(ptk/reify ::clone-template
IDeref
(-deref [_]
@ -969,7 +931,6 @@
(defn go-to-workspace
[{:keys [id project-id] :as file}]
(us/assert! ::file file)
(ptk/reify ::go-to-workspace
ptk/WatchEvent
(watch [_ _ _]

29
frontend/src/app/main/data/fonts.cljs
View file

@ -8,11 +8,11 @@
(:require
["opentype.js" :as ot]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.logging :as log]
[app.common.media :as cm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.main.data.messages :as dm]
[app.main.data.messages :as msg]
[app.main.fonts :as fonts]
[app.main.repo :as rp]
[app.main.store :as st]
@ -96,18 +96,17 @@
;; If the useTypoMetrics is not set, Firefox will also use metrics from the hhea table.
;; On Windows, all browsers use the usWin metrics, but respect the useTypoMetrics setting and if set will use the OS/2 values.
hhea-ascender (abs (-> font .-tables .-hhea .-ascender))
hhea-descender (abs (-> font .-tables .-hhea .-descender))
hhea-ascender (abs (-> ^js font .-tables .-hhea .-ascender))
hhea-descender (abs (-> ^js font .-tables .-hhea .-descender))
win-ascent (abs (-> font .-tables .-os2 .-usWinAscent))
win-descent (abs (-> font .-tables .-os2 .-usWinDescent))
win-ascent (abs (-> ^js font .-tables .-os2 .-usWinAscent))
win-descent (abs (-> ^js font .-tables .-os2 .-usWinDescent))
os2-ascent (abs (-> font .-tables .-os2 .-sTypoAscender))
os2-descent (abs (-> font .-tables .-os2 .-sTypoDescender))
os2-ascent (abs (-> ^js font .-tables .-os2 .-sTypoAscender))
os2-descent (abs (-> ^js font .-tables .-os2 .-sTypoDescender))
;; useTypoMetrics can be read from the 7th bit
f-selection (-> (-> font .-tables .-os2 .-fsSelection)
(bit-test 7))
f-selection (-> ^js font .-tables .-os2 .-fsSelection (bit-test 7))
height-warning? (or (not= hhea-ascender win-ascent)
(not= hhea-descender win-descent)
@ -183,7 +182,7 @@
#(when
(not-empty %)
(st/emit!
(dm/error
(msg/error
(if (> (count %) 1)
(tr "errors.bad-font-plural" (str/join ", " %))
(tr "errors.bad-font" (first %)))))))
@ -246,8 +245,8 @@
(defn update-font
[{:keys [id name] :as params}]
(us/assert ::us/uuid id)
(us/assert ::us/not-empty-string name)
(dm/assert! (uuid? id))
(dm/assert! (string? name))
(ptk/reify ::update-font
ptk/UpdateEvent
(update [_ state]
@ -270,7 +269,7 @@
(defn delete-font
"Delete all variants related to the provided `font-id`."
[font-id]
(us/assert ::us/uuid font-id)
(dm/assert! (uuid? font-id))
(ptk/reify ::delete-font
ptk/UpdateEvent
(update [_ state]
@ -286,7 +285,7 @@
(defn delete-font-variant
[id]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::delete-font-variants
ptk/UpdateEvent
(update [_ state]

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

@ -7,9 +7,9 @@
(ns app.main.data.messages
(:require
[app.common.data :as d]
[app.common.spec :as us]
[app.common.data.macros :as dm]
[app.common.schema :as sm]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(declare hide)
@ -18,32 +18,34 @@
(def default-animation-timeout 600)
(def default-timeout 5000)
(s/def ::type #{:success :error :info :warning})
(s/def ::position #{:fixed :floating :inline})
(s/def ::status #{:visible :hide})
(s/def ::controls #{:none :close :inline-actions :bottom-actions})
(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]]]]])
(s/def ::tag (s/or :str ::us/string :kw ::us/keyword))
(s/def ::label ::us/string)
(s/def ::callback fn?)
(s/def ::action (s/keys :req-un [::label ::callback]))
(s/def ::actions (s/every ::action :kind vector?))
(s/def ::timeout (s/nilable ::us/integer))
(s/def ::content ::us/string)
(s/def ::message
(s/keys :req-un [::type]
:opt-un [::status
::position
::controls
::tag
::timeout
::actions
::status]))
(def message?
(sm/pred-fn schema:message))
(defn show
[data]
(us/verify ::message data)
(dm/assert!
"expected valid message map"
(message? data))
(ptk/reify ::show
ptk/UpdateEvent
(update [_ state]

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

@ -8,10 +8,10 @@
(:refer-clojure :exclude [meta reset!])
(:require
["./shortcuts_impl.js$default" :as mousetrap]
[app.common.data.macros :as dm]
[app.common.logging :as log]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.config :as cf]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]))
@ -127,21 +127,16 @@
;; --- EVENT: push
(s/def ::tooltip ::us/string)
(s/def ::fn fn?)
(def schema:shortcuts
[:map-of
:keyword
[:map
[:command [:or :string [:vector :any]]]
[:fn {:optional true} fn?]
[:tooltip {:optional true} :string]]])
(s/def ::command
(s/or :str ::us/string
:vec vector?))
(s/def ::shortcut
(s/keys :req-un [::command]
:opt-un [::fn
::tooltip]))
(s/def ::shortcuts
(s/map-of ::us/keyword
::shortcut))
(def shortcuts?
(sm/pred-fn schema:shortcuts))
(defn- wrap-cb
[key cb]
@ -174,8 +169,9 @@
(defn push-shortcuts
[key shortcuts]
(us/assert ::us/keyword key)
(us/assert ::shortcuts shortcuts)
(dm/assert! (keyword? key))
(dm/assert! (shortcuts? shortcuts))
(ptk/reify ::push-shortcuts
ptk/UpdateEvent
(update [_ state]

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

@ -7,7 +7,9 @@
(ns app.main.data.users
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cf]
@ -19,36 +21,28 @@
[app.util.router :as rt]
[app.util.storage :refer [storage]]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; --- COMMON SPECS
;; --- 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 profile?
(sm/pred-fn schema:profile))
;; --- HELPERS
(defn is-authenticated?
[{:keys [id]}]
(and (uuid? id) (not= id uuid/zero)))
(s/def ::id ::us/uuid)
(s/def ::fullname ::us/string)
(s/def ::email ::us/email)
(s/def ::password ::us/string)
(s/def ::lang (s/nilable ::us/string))
(s/def ::theme (s/nilable ::us/string))
(s/def ::created-at ::us/inst)
(s/def ::password-1 ::us/string)
(s/def ::password-2 ::us/string)
(s/def ::password-old (s/nilable ::us/string))
(s/def ::profile
(s/keys :req-un [::id]
:opt-un [::created-at
::fullname
::email
::lang
::theme]))
;; --- HELPERS
(defn get-current-team-id
[profile]
(let [team-id (::current-team-id @storage)]
@ -98,7 +92,6 @@
(defn profile-fetched
[{:keys [id] :as profile}]
(us/verify ::profile profile)
(ptk/reify ::profile-fetched
IDeref
(-deref [_] profile)
@ -174,16 +167,10 @@
(get-redirect-event))
(rx/observe-on :async)))))))
(s/def ::invitation-token ::us/not-empty-string)
(s/def ::login-params
(s/keys :req-un [::email ::password]
:opt-un [::invitation-token]))
(declare login-from-register)
(defn login
[{:keys [email password invitation-token] :as data}]
(us/verify ::login-params data)
(ptk/reify ::login
ptk/WatchEvent
(watch [_ _ stream]
@ -299,7 +286,7 @@
(defn update-profile
[data]
(us/assert ::profile data)
(dm/assert! (profile? data))
(ptk/reify ::update-profile
ptk/WatchEvent
(watch [_ _ stream]
@ -307,7 +294,6 @@
on-success (:on-success mdata identity)
on-error (:on-error mdata rx/throw)]
(->> (rp/cmd! :update-profile (dissoc data :props))
(rx/catch on-error)
(rx/mapcat
(fn [_]
(rx/merge
@ -316,14 +302,16 @@
(rx/take 1)
(rx/tap on-success)
(rx/ignore))
(rx/of (profile-fetched data))))))))))
(rx/of (profile-fetched data)))))
(rx/catch on-error))))))
;; --- Request Email Change
(defn request-email-change
[{:keys [email] :as data}]
(us/assert ::us/email email)
(dm/assert! ::us/email email)
(ptk/reify ::request-email-change
ptk/WatchEvent
(watch [_ _ _]
@ -345,14 +333,15 @@
;; --- Update Password (Form)
(s/def ::update-password
(s/keys :req-un [::password-1
::password-2
::password-old]))
(def schema:update-password
[:map {:closed true}
[:password-1 :string]
[:password-2 :string]
[:password-old :string]])
(defn update-password
[data]
(us/verify ::update-password data)
(dm/assert! (sm/valid? schema:update-password data))
(ptk/reify ::update-password
ptk/WatchEvent
(watch [_ _ _]
@ -412,7 +401,10 @@
(defn update-photo
[file]
(us/verify ::di/blob file)
(dm/assert!
"expected a valid blob for `file` param"
(di/blob? file))
(ptk/reify ::update-photo
ptk/WatchEvent
(watch [_ _ _]
@ -434,8 +426,8 @@
(rx/catch on-error))))))
(defn fetch-users
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
[{:keys [team-id]}]
(dm/assert! (uuid? team-id))
(letfn [(fetched [users state]
(->> users
(d/index-by :id)
@ -447,8 +439,8 @@
(rx/map #(partial fetched %)))))))
(defn fetch-file-comments-users
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
[{:keys [team-id]}]
(dm/assert! (uuid? team-id))
(letfn [(fetched [users state]
(->> users
(d/index-by :id)
@ -479,12 +471,14 @@
;; --- EVENT: request-profile-recovery
(s/def ::request-profile-recovery
(s/keys :req-un [::email]))
(def schema:request-profile-recovery
[:map {:closed true}
[:email ::sm/email]])
;; FIXME: check if we can use schema for proper filter
(defn request-profile-recovery
[data]
(us/verify ::request-profile-recovery data)
(dm/assert! (sm/valid? schema:request-profile-recovery data))
(ptk/reify ::request-profile-recovery
ptk/WatchEvent
(watch [_ _ _]
@ -498,13 +492,14 @@
;; --- EVENT: recover-profile (Password)
(s/def ::token string?)
(s/def ::recover-profile
(s/keys :req-un [::password ::token]))
(def schema:recover-profile
[:map {:closed true}
[:password :string]
[:token :string]])
(defn recover-profile
[data]
(us/verify ::recover-profile data)
(dm/assert! (sm/valid? ::recover-profile data))
(ptk/reify ::recover-profile
ptk/WatchEvent
(watch [_ _ _]

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

@ -11,7 +11,7 @@
[app.common.files.features :as ffeat]
[app.common.geom.point :as gpt]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.transit :as t]
[app.common.types.shape-tree :as ctt]
[app.common.types.shape.interactions :as ctsi]
@ -22,12 +22,8 @@
[app.util.globals :as ug]
[app.util.router :as rt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(s/def ::nilable-boolean (s/nilable ::us/boolean))
(s/def ::nilable-animation (s/nilable ::ctsi/animation))
;; --- Local State Initialization
(def ^:private
@ -50,19 +46,15 @@
(declare zoom-to-fill)
(declare zoom-to-fit)
(s/def ::file-id ::us/uuid)
(s/def ::index ::us/integer)
(s/def ::page-id (s/nilable ::us/uuid))
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::section ::us/string)
(s/def ::initialize-params
(s/keys :req-un [::file-id]
:opt-un [::share-id ::page-id]))
(def schema:initialize
[:map
[:file-id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]
[:page-id {:optional true} ::sm/uuid]])
(defn initialize
[{:keys [file-id share-id] :as params}]
(us/assert ::initialize-params params)
(dm/assert! (sm/valid? schema:initialize params))
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
@ -77,7 +69,7 @@
ptk/WatchEvent
(watch [_ _ _]
(rx/of (fetch-bundle params)
(rx/of (fetch-bundle (d/without-nils params))
(fetch-comment-threads params)))
ptk/EffectEvent
@ -99,14 +91,15 @@
;; --- Data Fetching
(s/def ::fetch-bundle
(s/keys :req-un [::page-id ::file-id]
:opt-un [::share-id]))
(def schema:fetch-bundle
[:map
[:page-id ::sm/uuid]
[:file-id ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]])
(defn- fetch-bundle
[{:keys [file-id share-id] :as params}]
(us/assert! ::fetch-bundle params)
(dm/assert! (sm/valid? schema:fetch-bundle params))
(ptk/reify ::fetch-bundle
ptk/WatchEvent
(watch [_ state _]
@ -227,7 +220,7 @@
(defn fetch-comments
[{:keys [thread-id]}]
(us/assert ::us/uuid thread-id)
(dm/assert! (uuid thread-id))
(letfn [(fetched [comments state]
(update state :comments assoc thread-id (d/index-by :id comments)))]
(ptk/reify ::retrieve-comments
@ -391,11 +384,14 @@
(dcm/close-thread)
(rt/nav :viewer pparams (assoc qparams :index 0)))))))
(s/def ::interactions-mode #{:hide :show :show-on-click})
(def valid-interaction-modes
#{:hide :show :show-on-click})
(defn set-interactions-mode
[mode]
(us/verify ::interactions-mode mode)
(dm/assert!
"expected valid interaction mode"
(contains? valid-interaction-modes mode))
(ptk/reify ::set-interactions-mode
ptk/UpdateEvent
(update [_ state]
@ -471,8 +467,9 @@
(go-to-frame frame-id nil))
([frame-id animation]
(us/assert! ::us/uuid frame-id)
(us/assert! ::nilable-animation animation)
(dm/assert! (uuid? frame-id))
(dm/assert! (or (nil? animation)
(ctsi/animation? animation)))
(ptk/reify ::go-to-frame
ptk/UpdateEvent
@ -563,12 +560,14 @@
(defn open-overlay
[frame-id position close-click-outside background-overlay animation]
(us/assert! ::us/uuid frame-id)
(us/assert! ::gpt/point position)
(us/assert! ::nilable-boolean close-click-outside)
(us/assert! ::nilable-boolean background-overlay)
(us/assert! ::nilable-animation animation)
(dm/assert! (uuid? frame-id))
(dm/assert! (gpt/point? position))
(dm/assert! (or (nil? close-click-outside)
(boolean? close-click-outside)))
(dm/assert! (or (nil? background-overlay)
(boolean? background-overlay)))
(dm/assert! (or (nil? animation)
(ctsi/animation? animation)))
(ptk/reify ::open-overlay
ptk/UpdateEvent
(update [_ state]
@ -590,11 +589,14 @@
(defn toggle-overlay
[frame-id position close-click-outside background-overlay animation]
(us/assert! ::us/uuid frame-id)
(us/assert! ::gpt/point position)
(us/assert! ::nilable-boolean close-click-outside)
(us/assert! ::nilable-boolean background-overlay)
(us/assert! ::nilable-animation animation)
(dm/assert! (uuid? frame-id))
(dm/assert! (gpt/point? position))
(dm/assert! (or (nil? close-click-outside)
(boolean? close-click-outside)))
(dm/assert! (or (nil? background-overlay)
(boolean? background-overlay)))
(dm/assert! (or (nil? animation)
(ctsi/animation? animation)))
(ptk/reify ::toggle-overlay
ptk/UpdateEvent
@ -619,8 +621,9 @@
(defn close-overlay
([frame-id] (close-overlay frame-id nil))
([frame-id animation]
(us/assert! ::us/uuid frame-id)
(us/assert! ::nilable-animation animation)
(dm/assert! (uuid? frame-id))
(dm/assert! (or (nil? animation)
(ctsi/animation? animation)))
(ptk/reify ::close-overlay
ptk/UpdateEvent

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

@ -18,7 +18,6 @@
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.text :as txt]
[app.common.transit :as t]
[app.common.types.components-list :as ctkl]
@ -84,10 +83,6 @@
(def default-workspace-local {:zoom 1})
(s/def ::layout-name (s/nilable ::us/keyword))
(s/def ::coll-of-uuids (s/coll-of ::us/uuid))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Workspace Initialization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -101,7 +96,11 @@
(defn initialize-layout
[lname]
(us/assert! ::layout-name lname)
;; (dm/assert!
;; "expected valid layout"
;; (and (keyword? lname)
;; (contains? layout/presets lname)))
(ptk/reify ::initialize-layout
ptk/UpdateEvent
(update [_ state]
@ -298,8 +297,8 @@
(defn initialize-file
[project-id file-id]
(us/assert! ::us/uuid project-id)
(us/assert! ::us/uuid file-id)
(dm/assert! (uuid? project-id))
(dm/assert! (uuid? file-id))
(ptk/reify ::initialize-file
ptk/UpdateEvent
@ -350,7 +349,7 @@
(defn initialize-page
[page-id]
(us/assert! ::us/uuid page-id)
(dm/assert! (uuid? page-id))
(ptk/reify ::initialize-page
ptk/UpdateEvent
(update [_ state]
@ -384,7 +383,7 @@
(defn finalize-page
[page-id]
(us/assert! ::us/uuid page-id)
(dm/assert! (uuid? page-id))
(ptk/reify ::finalize-page
ptk/UpdateEvent
(update [_ state]
@ -465,8 +464,8 @@
(defn rename-page
[id name]
(us/verify ::us/uuid id)
(us/verify string? name)
(dm/assert! (uuid? id))
(dm/assert! (string? name))
(ptk/reify ::rename-page
ptk/WatchEvent
(watch [it state _]
@ -567,8 +566,8 @@
(defn update-shape
[id attrs]
(us/verify ::us/uuid id)
(us/verify ::cts/shape-attrs attrs)
(dm/assert! (uuid? id))
(dm/assert! (cts/shape-attrs? attrs))
(ptk/reify ::update-shape
ptk/WatchEvent
(watch [_ _ _]
@ -577,7 +576,7 @@
(defn start-rename-shape
[id]
(us/verify ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::start-rename-shape
ptk/UpdateEvent
(update [_ state]
@ -594,7 +593,7 @@
(defn update-selected-shapes
[attrs]
(us/verify ::cts/shape-attrs attrs)
(dm/assert! (cts/shape-attrs? attrs))
(ptk/reify ::update-selected-shapes
ptk/WatchEvent
(watch [_ state _]
@ -621,11 +620,14 @@
;; --- Shape Vertical Ordering
(s/def ::loc #{:up :down :bottom :top})
(def valid-vertical-locations
#{:up :down :bottom :top})
(defn vertical-order-selected
[loc]
(us/verify ::loc loc)
(dm/assert!
"expected valid location"
(contains? valid-vertical-locations loc))
(ptk/reify ::vertical-order-selected
ptk/WatchEvent
(watch [it state _]
@ -746,9 +748,9 @@
(defn relocate-shapes
[ids parent-id to-index & [ignore-parents?]]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify ::us/uuid parent-id)
(us/verify number? to-index)
(dm/assert! (every? uuid? ids))
(dm/assert! (uuid? parent-id))
(dm/assert! (number? to-index))
(ptk/reify ::relocate-shapes
ptk/WatchEvent
@ -935,7 +937,10 @@
(defn align-objects
[axis]
(us/verify ::gal/align-axis axis)
(dm/assert!
"expected valid align axis value"
(contains? gal/valid-align-axis axis))
(ptk/reify ::align-objects
ptk/WatchEvent
(watch [_ state _]
@ -976,7 +981,10 @@
(defn distribute-objects
[axis]
(us/verify ::gal/dist-axis axis)
(dm/assert!
"expected valid distribute axis value"
(contains? gal/valid-dist-axis axis))
(ptk/reify ::distribute-objects
ptk/WatchEvent
(watch [_ state _]
@ -1055,7 +1063,7 @@
qparams {:page-id page-id}]
(rx/of (rt/nav' :workspace pparams qparams))))))
([page-id]
(us/assert! ::us/uuid page-id)
(dm/assert! (uuid? page-id))
(ptk/reify ::go-to-page-2
ptk/WatchEvent
(watch [_ state _]
@ -1067,7 +1075,6 @@
(defn go-to-layout
[layout]
(us/verify ::layout/flag layout)
(ptk/reify ::go-to-layout
IDeref
(-deref [_] {:layout layout})
@ -1120,8 +1127,8 @@
:typographies #{}}))))
(defn go-to-main-instance
[page-id shape-id]
(us/verify ::us/uuid page-id)
(us/verify ::us/uuid shape-id)
(dm/assert! (uuid? page-id))
(dm/assert! (uuid? shape-id))
(ptk/reify ::go-to-main-instance
ptk/WatchEvent
(watch [_ state stream]
@ -1243,12 +1250,9 @@
;; Context Menu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::point gpt/point?)
(defn show-context-menu
[{:keys [position] :as params}]
(us/verify ::point position)
(dm/assert! (gpt/point? position))
(ptk/reify ::show-context-menu
ptk/UpdateEvent
(update [_ state]
@ -1282,7 +1286,7 @@
(defn show-page-item-context-menu
[{:keys [position page] :as params}]
(us/verify ::point position)
(dm/assert! (gpt/point? position))
(ptk/reify ::show-page-item-context-menu
ptk/WatchEvent
(watch [_ _ _]
@ -1729,7 +1733,7 @@
(defn paste-text
[text]
(us/assert! (string? text) "expected string as first argument")
(dm/assert! (string? text))
(ptk/reify ::paste-text
ptk/WatchEvent
(watch [_ state _]
@ -1756,7 +1760,7 @@
;; TODO: why not implement it in terms of upload-media-workspace?
(defn- paste-svg
[text]
(us/assert! (string? text) "expected string as first argument")
(dm/assert! (string? text))
(ptk/reify ::paste-svg
ptk/WatchEvent
(watch [_ state _]
@ -2067,8 +2071,8 @@
(defn update-component-annotation
"Update the component with the given annotation"
[id annotation]
(us/assert ::us/uuid id)
(us/assert ::us/string annotation)
(dm/assert! (uuid? id))
(dm/assert! (string? annotation))
(ptk/reify ::update-component-annotation
ptk/WatchEvent
(watch [it state _]

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

@ -7,12 +7,13 @@
(ns app.main.data.workspace.changes
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes :as cpc]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.changes-spec :as pcs]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.main.data.workspace.state-helpers :as wsh]
@ -20,15 +21,11 @@
[app.main.store :as st]
[app.main.worker :as uw]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module
(log/set-level! :warn)
(s/def ::coll-of-uuid
(s/every ::us/uuid))
(defonce page-change? #{:add-page :mod-page :del-page :mov-page})
(defonce update-layout-attr? #{:hidden})
@ -56,8 +53,8 @@
([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?]
:or {reg-objects? false save-undo? true stack-undo? false ignore-remote? false}}]
(us/assert ::coll-of-uuid ids)
(us/assert fn? update-fn)
(dm/assert! (sm/coll-of-uuid? ids))
(dm/assert! (fn? update-fn))
(ptk/reify ::update-shapes
ptk/WatchEvent
@ -75,7 +72,7 @@
changes (reduce
(fn [changes id]
(let [opts {:attrs attrs :ignore-geometry? (get ignore-tree id)}]
(pcb/update-shapes changes [id] update-fn opts)))
(pcb/update-shapes changes [id] update-fn (d/without-nils opts))))
(-> (pcb/empty-changes it page-id)
(pcb/set-save-undo? save-undo?)
(pcb/set-stack-undo? stack-undo?)
@ -204,8 +201,10 @@
[:workspace-data]
[:workspace-libraries file-id :data])]
(try
(us/assert ::pcs/changes redo-changes)
(us/assert ::pcs/changes undo-changes)
(dm/assert!
"expect valid vector of changes"
(and (cpc/changes? redo-changes)
(cpc/changes? undo-changes)))
(update-in state path (fn [file]
(-> file

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

@ -6,10 +6,11 @@
(ns app.main.data.workspace.comments
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.types.shape-tree :as ctst]
[app.main.data.comments :as dcm]
[app.main.data.workspace.changes :as dwc]
@ -28,7 +29,7 @@
(defn initialize-comments
[file-id]
(us/assert ::us/uuid file-id)
(dm/assert! (uuid? file-id))
(ptk/reify ::initialize-comments
ptk/WatchEvent
(watch [_ _ stream]
@ -80,7 +81,7 @@
(defn center-to-comment-thread
[{:keys [position] :as thread}]
(us/assert ::dcm/comment-thread thread)
(dm/assert! (dcm/comment-thread? thread))
(ptk/reify ::center-to-comment-thread
ptk/UpdateEvent
(update [_ state]
@ -96,7 +97,7 @@
(defn navigate
[thread]
(us/assert ::dcm/comment-thread thread)
(dm/assert! (dcm/comment-thread? thread))
(ptk/reify ::open-comment-thread
ptk/WatchEvent
(watch [_ _ stream]
@ -117,7 +118,7 @@
(update-comment-thread-position thread [new-x new-y] nil))
([thread [new-x new-y] frame-id]
(us/assert ::dcm/comment-thread thread)
(dm/assert! (dcm/comment-thread? thread))
(ptk/reify ::update-comment-thread-position
ptk/WatchEvent
(watch [it state _]
@ -146,7 +147,7 @@
;; Move comment threads that are inside a frame when that frame is moved"
(defmethod ptk/resolve ::move-frame-comment-threads
[_ ids]
(us/assert! ::us/coll-of-uuid ids)
(dm/assert! (sm/coll-of-uuid? ids))
(ptk/reify ::move-frame-comment-threads
ptk/WatchEvent
(watch [_ state _]

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

@ -6,7 +6,7 @@
(ns app.main.data.workspace.edition
(:require
[app.common.spec :as us]
[app.common.data.macros :as dm]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
[potok.core :as ptk]))
@ -17,7 +17,7 @@
(defn start-edition-mode
[id]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::start-edition-mode
ptk/UpdateEvent
(update [_ state]

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

@ -8,8 +8,8 @@
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.pages.changes-builder :as pcb]
[app.common.spec :as us]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
@ -40,7 +40,7 @@
(defn add-frame-grid
[frame-id]
(us/assert ::us/uuid frame-id)
(dm/assert! (uuid? frame-id))
(ptk/reify ::add-frame-grid
ptk/WatchEvent
(watch [_ state _]

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

@ -6,11 +6,11 @@
(ns app.main.data.workspace.guides
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb]
[app.common.spec :as us]
[app.common.types.page.guide :as ctpg]
[app.common.types.page :as ctp]
[app.main.data.workspace.changes :as dwc]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
@ -23,7 +23,10 @@
(merge guide))))
(defn update-guides [guide]
(us/verify ::ctpg/guide guide)
(dm/assert!
"expected valid guide"
(ctp/guide? guide))
(ptk/reify ::update-guides
ptk/WatchEvent
(watch [it state _]
@ -35,7 +38,10 @@
(rx/of (dwc/commit-changes changes))))))
(defn remove-guide [guide]
(us/verify ::ctpg/guide guide)
(dm/assert!
"expected valid guide"
(ctp/guide? guide))
(ptk/reify ::remove-guide
ptk/UpdateEvent
(update [_ state]
@ -62,10 +68,11 @@
guides (-> (select-keys guides ids) (vals))]
(rx/from (->> guides (mapv #(remove-guide %))))))))
(defmethod ptk/resolve ::move-frame-guides
[_ ids]
(us/assert! ::us/coll-of-uuid ids)
(dm/assert!
"expected a coll of uuids"
(every? uuid? ids))
(ptk/reify ::move-frame-guides
ptk/WatchEvent
(watch [_ state _]

6
frontend/src/app/main/data/workspace/highlight.cljs
View file

@ -6,7 +6,7 @@
(ns app.main.data.workspace.highlight
(:require
[app.common.spec :as us]
[app.common.data.macros :as dm]
[clojure.set :as set]
[potok.core :as ptk]))
@ -14,7 +14,7 @@
(defn highlight-shape
[id]
(us/verify ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::highlight-shape
ptk/UpdateEvent
(update [_ state]
@ -22,7 +22,7 @@
(defn dehighlight-shape
[id]
(us/verify ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::dehighlight-shape
ptk/UpdateEvent
(update [_ state]

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

@ -7,11 +7,11 @@
(ns app.main.data.workspace.interactions
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.types.page :as ctp]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.interactions :as ctsi]
@ -55,7 +55,7 @@
(defn remove-flow
[flow-id]
(us/verify ::us/uuid flow-id)
(dm/assert! (uuid? flow-id))
(ptk/reify ::remove-flow
ptk/WatchEvent
(watch [it state _]
@ -67,8 +67,8 @@
(defn rename-flow
[flow-id name]
(us/verify ::us/uuid flow-id)
(us/verify ::us/string name)
(dm/assert! (uuid? flow-id))
(dm/assert! (string? name))
(ptk/reify ::rename-flow
ptk/WatchEvent
(watch [it state _]
@ -81,7 +81,7 @@
(defn start-rename-flow
[id]
(us/verify ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::start-rename-flow
ptk/UpdateEvent
(update [_ state]

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

@ -7,13 +7,12 @@
(ns app.main.data.workspace.layout
"Workspace layout management events and helpers."
(:require
[app.common.spec :as us]
[app.common.data.macros :as dm]
[app.util.storage :refer [storage]]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]))
(s/def ::flag
(def valid-flags
#{:sitemap
:layers
:comments
@ -44,7 +43,8 @@
{:del #{:document-history :assets}
:add #{:sitemap :layers}}})
(s/def ::options-mode #{:design :prototype :inspect})
(def valid-options-mode
#{:design :prototype :inspect})
(def default-layout
#{:sitemap
@ -114,7 +114,7 @@
(defn set-options-mode
[mode]
(us/assert ::options-mode mode)
(dm/assert! (contains? valid-options-mode mode))
(ptk/reify ::set-options-mode
ptk/UpdateEvent
(update [_ state]

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

@ -7,26 +7,23 @@
(ns app.main.data.workspace.libraries
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.features :as ffeat]
[app.common.geom.point :as gpt]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes :as ch]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.changes-spec :as pcs]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.types.color :as ctc]
[app.common.types.component :as ctk]
[app.common.types.components-list :as ctkl]
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.file.media-object :as ctfm]
[app.common.types.typography :as ctt]
[app.common.uuid :as uuid]
[app.main.data.dashboard :as dd]
[app.main.data.events :as ev]
[app.main.data.messages :as dm]
[app.main.data.messages :as msg]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.groups :as dwg]
[app.main.data.workspace.libraries-helpers :as dwlh]
@ -42,14 +39,11 @@
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; Change this to :info :debug or :trace to debug this module, or :warn to reset to default
(log/set-level! :warn)
(s/def ::file ::dd/file)
(defn- log-changes
[changes file]
(let [extract-change
@ -116,7 +110,7 @@
color (-> color
(assoc :id id)
(assoc :name (default-color-name color)))]
(us/assert ::ctc/color color)
(dm/assert! (ctc/color? color))
(ptk/reify ::add-color
IDeref
(-deref [_] color)
@ -130,7 +124,7 @@
(defn add-recent-color
[color]
(us/assert! ::ctc/recent-color color)
(dm/assert! (ctc/recent-color? color))
(ptk/reify ::add-recent-color
ptk/WatchEvent
(watch [it _ _]
@ -160,8 +154,9 @@
(defn update-color
[color file-id]
(us/assert ::ctc/color color)
(us/assert ::us/uuid file-id)
(dm/assert! (ctc/color? color))
(dm/assert! (uuid? file-id))
(ptk/reify ::update-color
ptk/WatchEvent
(watch [it state _]
@ -169,9 +164,10 @@
(defn rename-color
[file-id id new-name]
(us/assert ::us/uuid file-id)
(us/assert ::us/uuid id)
(us/assert ::us/string new-name)
(dm/assert! (uuid? file-id))
(dm/assert! (uuid? id))
(dm/assert! (string? new-name))
(ptk/reify ::rename-color
ptk/WatchEvent
(watch [it state _]
@ -183,7 +179,7 @@
(defn delete-color
[{:keys [id] :as params}]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::delete-color
ptk/WatchEvent
(watch [it state _]
@ -195,7 +191,7 @@
(defn add-media
[media]
(us/assert ::ctfm/media-object media)
(dm/assert! (ctf/media-object? media))
(ptk/reify ::add-media
ptk/WatchEvent
(watch [it _ _]
@ -206,8 +202,8 @@
(defn rename-media
[id new-name]
(us/assert ::us/uuid id)
(us/assert ::us/string new-name)
(dm/assert! (uuid? id))
(dm/assert! (string? new-name))
(ptk/reify ::rename-media
ptk/WatchEvent
(watch [it state _]
@ -224,7 +220,7 @@
(defn delete-media
[{:keys [id] :as params}]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::delete-media
ptk/WatchEvent
(watch [it state _]
@ -238,7 +234,7 @@
([typography] (add-typography typography true))
([typography edit?]
(let [typography (update typography :id #(or % (uuid/next)))]
(us/assert ::ctt/typography typography)
(dm/assert! (ctt/typography? typography))
(ptk/reify ::add-typography
IDeref
(-deref [_] typography)
@ -267,8 +263,9 @@
(defn update-typography
[typography file-id]
(us/assert ::ctt/typography typography)
(us/assert ::us/uuid file-id)
(dm/assert! (ctt/typography? typography))
(dm/assert! (uuid? file-id))
(ptk/reify ::update-typography
ptk/WatchEvent
(watch [it state _]
@ -276,9 +273,9 @@
(defn rename-typography
[file-id id new-name]
(us/assert ::us/uuid file-id)
(us/assert ::us/uuid id)
(us/assert ::us/string new-name)
(dm/assert! (uuid? file-id))
(dm/assert! (uuid? id))
(dm/assert! (string? new-name))
(ptk/reify ::rename-typography
ptk/WatchEvent
(watch [it state _]
@ -291,7 +288,7 @@
(defn delete-typography
[id]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::delete-typography
ptk/WatchEvent
(watch [it state _]
@ -341,8 +338,8 @@
(defn rename-component
"Rename the component with the given id, in the current file library."
[id new-name]
(us/assert ::us/uuid id)
(us/assert ::us/string new-name)
(dm/assert! (uuid? id))
(dm/assert! (string? new-name))
(ptk/reify ::rename-component
ptk/WatchEvent
(watch [it state _]
@ -414,7 +411,7 @@
(defn delete-component
"Delete the component with the given id, from the current file library."
[{:keys [id] :as params}]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::delete-component
ptk/WatchEvent
(watch [it state _]
@ -432,8 +429,8 @@
(defn restore-component
"Restore a deleted component, with the given id, in the given file library."
[library-id component-id]
(us/assert ::us/uuid library-id)
(us/assert ::us/uuid component-id)
(dm/assert! (uuid? library-id))
(dm/assert! (uuid? component-id))
(ptk/reify ::restore-component
ptk/WatchEvent
(watch [it state _]
@ -460,9 +457,10 @@
"Create a new shape in the current page, from the component with the given id
in the given file library. Then selects the newly created instance."
[file-id component-id position]
(us/assert ::us/uuid file-id)
(us/assert ::us/uuid component-id)
(us/assert ::gpt/point position)
(dm/assert! (uuid? file-id))
(dm/assert! (uuid? component-id))
(dm/assert! (gpt/point? position))
(ptk/reify ::instantiate-component
ptk/WatchEvent
(watch [it state _]
@ -489,7 +487,7 @@
"Remove all references to components in the shape with the given id,
and all its children, at the current page."
[id]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::detach-component
ptk/WatchEvent
(watch [it state _]
@ -528,7 +526,7 @@
(defn nav-to-component-file
[file-id]
(us/assert ::us/uuid file-id)
(dm/assert! (uuid? file-id))
(ptk/reify ::nav-to-component-file
ptk/WatchEvent
(watch [_ state _]
@ -543,8 +541,8 @@
(defn ext-library-changed
[file-id modified-at revn changes]
(us/assert ::us/uuid file-id)
(us/assert ::pcs/changes changes)
(dm/assert! (uuid? file-id))
(dm/assert! (ch/changes? changes))
(ptk/reify ::ext-library-changed
ptk/UpdateEvent
(update [_ state]
@ -559,7 +557,7 @@
the current page. Set all attributes equal to the ones in the linked component,
and untouched."
[id]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::reset-component
ptk/WatchEvent
(watch [it state _]
@ -595,7 +593,7 @@
different of that the one we are currently editing."
([id] (update-component id nil))
([id undo-group]
(us/assert ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::update-component
ptk/WatchEvent
(watch [it state _]
@ -680,6 +678,9 @@
(declare sync-file-2nd-stage)
(def valid-asset-types
#{:colors :components :typographies})
(defn sync-file
"Synchronize the given file from the given library. Walk through all
shapes in all pages in the file that use some color, typography or
@ -694,10 +695,12 @@
([file-id library-id asset-type asset-id]
(sync-file file-id library-id asset-type asset-id nil))
([file-id library-id asset-type asset-id undo-group]
(us/assert ::us/uuid file-id)
(us/assert ::us/uuid library-id)
(us/assert (s/nilable #{:colors :components :typographies}) asset-type)
(us/assert (s/nilable ::us/uuid) asset-id)
(dm/assert! (uuid? file-id))
(dm/assert! (uuid? library-id))
(dm/assert! (or (nil? asset-type)
(contains? valid-asset-types asset-type)))
(dm/assert! (or (nil? asset-id)
(uuid? asset-id)))
(ptk/reify ::sync-file
ptk/UpdateEvent
(update [_ state]
@ -748,7 +751,7 @@
(:redo-changes changes)
file))
(rx/concat
(rx/of (dm/hide-tag :sync-dialog))
(rx/of (msg/hide-tag :sync-dialog))
(when (seq (:redo-changes changes))
(rx/of (dch/commit-changes (assoc changes ;; TODO a ver qué pasa con esto
:file-id file-id))))
@ -777,9 +780,10 @@
;; implement updated-at at component level, to detect what components have
;; not changed, and then not to apply sync and terminate the loop.
[file-id library-id asset-id undo-group]
(us/assert ::us/uuid file-id)
(us/assert ::us/uuid library-id)
(us/assert (s/nilable ::us/uuid) asset-id)
(dm/assert! (uuid? file-id))
(dm/assert! (uuid? library-id))
(dm/assert! (or (nil? asset-id)
(uuid? asset-id)))
(ptk/reify ::sync-file-2nd-stage
ptk/WatchEvent
(watch [it state _]
@ -818,7 +822,7 @@
"Get a lazy sequence of all the assets of each type in the library that have
been modified after the last sync of the library. The sync date may be
overriden by providing a ignore-until parameter.
The sequence items are tuples of (page-id shape-id asset-id asset-type)."
([library file-data] (assets-need-sync library file-data nil))
([library file-data ignore-until]
@ -828,7 +832,7 @@
(defn notify-sync-file
[file-id]
(us/assert ::us/uuid file-id)
(dm/assert! (uuid? file-id))
(ptk/reify ::notify-sync-file
ptk/WatchEvent
(watch [_ state _]
@ -839,12 +843,12 @@
(sync-file (:current-file-id state)
(:id library)))
libraries-need-sync))
(st/emit! dm/hide))
(st/emit! msg/hide))
do-dismiss #(do (st/emit! ignore-sync)
(st/emit! dm/hide))]
(st/emit! msg/hide))]
(when (seq libraries-need-sync)
(rx/of (dm/info-dialog
(rx/of (msg/info-dialog
(tr "workspace.updates.there-are-updates")
:inline-actions
[{:label (tr "workspace.updates.update")
@ -921,7 +925,6 @@
(defn- shared-files-fetched
[files]
(us/verify (s/every ::file) files)
(ptk/reify ::shared-files-fetched
ptk/UpdateEvent
(update [_ state]
@ -930,7 +933,7 @@
(defn fetch-shared-files
[{:keys [team-id] :as params}]
(us/assert ::us/uuid team-id)
(dm/assert! (uuid? team-id))
(ptk/reify ::fetch-shared-files
ptk/WatchEvent
(watch [_ _ _]

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

@ -6,18 +6,19 @@
(ns app.main.data.workspace.media
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as log]
[app.common.math :as mth]
[app.common.pages.changes-builder :as pcb]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.types.container :as ctn]
[app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.main.data.media :as dmm]
[app.main.data.messages :as dm]
[app.main.data.messages :as msg]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.libraries :as dwl]
[app.main.data.workspace.shapes :as dwsh]
@ -28,7 +29,6 @@
[app.util.http :as http]
[app.util.i18n :refer [tr]]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[cuerdas.core :as str]
[potok.core :as ptk]
[promesa.core :as p]
@ -136,47 +136,46 @@
(rx/merge-map svg->clj)
(rx/do on-svg)))))
(s/def ::local? ::us/boolean)
(s/def ::blobs ::dmm/blobs)
(s/def ::name ::us/string)
(s/def ::uris (s/coll-of ::us/string))
(s/def ::mtype ::us/string)
(s/def ::process-media-objects
(s/and
(s/keys :req-un [::file-id ::local?]
:opt-un [::name ::data ::uris ::mtype])
(fn [props]
(or (contains? props :blobs)
(contains? props :uris)))))
(def schema:process-media-objects
[:map
[:file-id ::sm/uuid]
[:local? :boolean]
[:name {:optional true} :string]
[:data {:optional true} :any] ; FIXME
[:uris {:optional true} [:vector :string]]
[:mtype {:optional true} :string]])
(defn- process-media-objects
[{:keys [uris on-error] :as params}]
(us/assert ::process-media-objects params)
(dm/assert!
(and (sm/valid? schema:process-media-objects params)
(or (contains? params :blobs)
(contains? params :uris))))
(letfn [(handle-error [error]
(if (ex/ex-info? error)
(handle-error (ex-data error))
(cond
(= (:code error) :invalid-svg-file)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(rx/of (msg/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-type-not-allowed)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(rx/of (msg/error (tr "errors.media-type-not-allowed")))
(= (:code error) :unable-to-access-to-url)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(rx/of (msg/error (tr "errors.media-type-not-allowed")))
(= (:code error) :invalid-image)
(rx/of (dm/error (tr "errors.media-type-not-allowed")))
(rx/of (msg/error (tr "errors.media-type-not-allowed")))
(= (:code error) :media-max-file-size-reached)
(rx/of (dm/error (tr "errors.media-too-large")))
(rx/of (msg/error (tr "errors.media-too-large")))
(= (:code error) :media-type-mismatch)
(rx/of (dm/error (tr "errors.media-type-mismatch")))
(rx/of (msg/error (tr "errors.media-type-mismatch")))
(= (:code error) :unable-to-optimize)
(rx/of (dm/error (:hint error)))
(rx/of (msg/error (:hint error)))
(fn? on-error)
(on-error error)
@ -188,10 +187,10 @@
ptk/WatchEvent
(watch [_ _ _]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(rx/of (msg/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (if (seq uris)
;; Media objects is a list of URL's pointing to the path
(process-uris params)
@ -201,7 +200,7 @@
;; Every stream has its own sideeffect. We need to ignore the result
(rx/ignore)
(rx/catch handle-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
(rx/finalize #(st/emit! (msg/hide-tag :media-loading)))))))))
;; Deprecated in components-v2
(defn upload-media-asset
@ -235,9 +234,9 @@
(rx/map #(vector (:name media-obj) %))
(rx/merge-map svg->clj)
(rx/catch ; When error downloading media-obj, skip it and continue with next one
#(log/error :msg (str "Error downloading " (:name media-obj) " from " path)
:hint (ex-message %)
:error %)))))
#(log/error :msg (str "Error downloading " (:name media-obj) " from " path)
:hint (ex-message %)
:error %)))))
(defn create-shapes-svg
"Convert svg elements into penpot shapes."
@ -339,14 +338,14 @@
:on-svg #(st/emit! (process-svg-component %)))]
(process-media-objects params)))
(s/def ::object-id ::us/uuid)
(s/def ::clone-media-objects-params
(s/keys :req-un [::file-id ::object-id]))
(def schema:clone-media-object
[:map
[:file-id ::sm/uuid]
[:object-id ::sm/uuid]])
(defn clone-media-object
[{:keys [file-id object-id] :as params}]
(us/assert ::clone-media-objects-params params)
(dm/assert! (sm/valid? schema:clone-media-object params))
(ptk/reify ::clone-media-objects
ptk/WatchEvent
(watch [_ _ _]
@ -358,12 +357,12 @@
:id object-id}]
(rx/concat
(rx/of (dm/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(rx/of (msg/show {:content (tr "media.loading")
:type :info
:timeout nil
:tag :media-loading}))
(->> (rp/cmd! :clone-file-media-object params)
(rx/do on-success)
(rx/catch on-error)
(rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))
(rx/finalize #(st/emit! (msg/hide-tag :media-loading)))))))))

11
frontend/src/app/main/data/workspace/modifiers.cljs
View file

@ -14,7 +14,6 @@
[app.common.math :as mth]
[app.common.pages.common :as cpc]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.types.container :as ctn]
[app.common.types.modifiers :as ctm]
[app.common.types.shape.layout :as ctl]
@ -25,7 +24,6 @@
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.undo :as dwu]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; -- temporary modifiers -------------------------------------------
@ -96,7 +94,6 @@
ignore-geometry? (and (and (< (:x distance) 1) (< (:y distance) 1))
(mth/close? (:width selrect) (:width transformed-selrect))
(mth/close? (:height selrect) (:height transformed-selrect)))]
[root transformed-root ignore-geometry?]))
(defn- get-ignore-tree
@ -157,12 +154,16 @@
(defn create-modif-tree
[ids modifiers]
(us/verify (s/coll-of uuid?) ids)
(dm/assert!
"expected valid coll of uuids"
(every? uuid? ids))
(into {} (map #(vector % {:modifiers modifiers})) ids))
(defn build-modif-tree
[ids objects get-modifier]
(us/verify (s/coll-of uuid?) ids)
(dm/assert!
"expected valid coll of uuids"
(every? uuid? ids))
(into {} (map #(vector % {:modifiers (get-modifier (get objects %))})) ids))
(defn modifier-remove-from-parent

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

@ -7,8 +7,9 @@
(ns app.main.data.workspace.notifications
(:require
[app.common.data :as d]
[app.common.pages.changes-spec :as pcs]
[app.common.spec :as us]
[app.common.data.macros :as dm]
[app.common.pages.changes :as cpc]
[app.common.schema :as sm]
[app.main.data.websocket :as dws]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.libraries :as dwl]
@ -18,7 +19,6 @@
[app.util.object :as obj]
[app.util.time :as dt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[potok.core :as ptk]))
@ -183,19 +183,18 @@
:updated-at (dt/now)
:page-id page-id))))))
(s/def ::type keyword?)
(s/def ::profile-id uuid?)
(s/def ::file-id uuid?)
(s/def ::session-id uuid?)
(s/def ::revn integer?)
(s/def ::changes ::pcs/changes)
(s/def ::file-change-event
(s/keys :req-un [::type ::profile-id ::file-id ::session-id ::revn ::changes]))
(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]])
(defn handle-file-change
[{:keys [file-id changes] :as msg}]
(us/assert ::file-change-event msg)
(dm/assert! (sm/valid? schema:handle-file-change msg))
(ptk/reify ::handle-file-change
IDeref
(-deref [_] {:changes changes})
@ -241,18 +240,19 @@
(when-not (empty? changes-by-pages)
(rx/from (map process-page-changes changes-by-pages))))))))
(s/def ::library-change-event
(s/keys :req-un [::type
::profile-id
::file-id
::session-id
::revn
::modified-at
::changes]))
(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]])
(defn handle-library-change
[{:keys [file-id modified-at changes revn] :as msg}]
(us/assert ::library-change-event msg)
(dm/assert! (sm/valid? schema:handle-library-change msg))
(ptk/reify ::handle-library-change
ptk/WatchEvent
(watch [_ state _]

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

@ -6,11 +6,11 @@
(ns app.main.data.workspace.path.changes
(:require
[app.common.data.macros :as dm]
[app.common.pages.changes-builder :as pcb]
[app.common.spec :as us]
[app.main.data.workspace.changes :as dch]
[app.main.data.workspace.path.common :refer [content?]]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.spec :as spec]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.core :as rx]
@ -19,8 +19,8 @@
(defn generate-path-changes
"Generates changes to update the new content of the shape"
[it objects page-id shape old-content new-content]
(us/verify ::spec/content old-content)
(us/verify ::spec/content new-content)
(dm/assert! (content? old-content))
(dm/assert! (content? new-content))
(let [shape-id (:id shape)
[old-points old-selrect]

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

@ -6,9 +6,40 @@
(ns app.main.data.workspace.path.common
(:require
[app.common.schema :as sm]
[app.main.data.workspace.path.state :as st]
[potok.core :as ptk]))
(def valid-commands
#{:move-to
:line-to
:line-to-horizontal
:line-to-vertical
:curve-to
:smooth-curve-to
:quadratic-bezier-curve-to
:smooth-quadratic-bezier-curve-to
: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]]]]])
(def content?
(sm/pred-fn schema:content))
(defn init-path []
(ptk/reify ::init-path))

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

@ -6,20 +6,19 @@
(ns app.main.data.workspace.path.drawing
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.flex-layout :as gsl]
[app.common.path.commands :as upc]
[app.common.path.shapes-to-path :as upsp]
[app.common.spec :as us]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
[app.main.data.workspace.changes :as dch]
[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]
[app.main.data.workspace.path.common :as common :refer [content?]]
[app.main.data.workspace.path.helpers :as helpers]
[app.main.data.workspace.path.spec :as spec]
[app.main.data.workspace.path.state :as st]
[app.main.data.workspace.path.streams :as streams]
[app.main.data.workspace.path.undo :as undo]
@ -256,7 +255,7 @@
ptk/UpdateEvent
(update [_ state]
(let [content (get-in state [:workspace-drawing :object :content] [])]
(us/verify ::spec/content content)
(dm/assert! (content? content))
(if (> (count content) 1)
(assoc-in state [:workspace-drawing :object :initialized?] true)
state)))

49
frontend/src/app/main/data/workspace/path/spec.cljs
View file

@ -1,49 +0,0 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.main.data.workspace.path.spec
(:require
[clojure.spec.alpha :as s]))
;; SCHEMAS
(s/def ::command #{:move-to
:line-to
:line-to-horizontal
:line-to-vertical
:curve-to
:smooth-curve-to
:quadratic-bezier-curve-to
:smooth-quadratic-bezier-curve-to
:elliptical-arc
:close-path})
(s/def :paths.params/x number?)
(s/def :paths.params/y number?)
(s/def :paths.params/c1x number?)
(s/def :paths.params/c1y number?)
(s/def :paths.params/c2x number?)
(s/def :paths.params/c2y number?)
(s/def ::relative? boolean?)
(s/def ::params
(s/keys :req-un [:path.params/x
:path.params/y]
:opt-un [:path.params/c1x
:path.params/c1y
:path.params/c2x
:path.params/c2y]))
(s/def ::content-entry
(s/keys :req-un [::command]
:opt-un [::params
::relative?]))
(s/def ::content
(s/coll-of ::content-entry :kind vector?))

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

@ -9,8 +9,7 @@
[app.common.data.macros :as dm]
[app.common.logging :as log]
[app.common.pages :as cp]
[app.common.pages.changes-spec :as pcs]
[app.common.spec :as us]
[app.common.pages.changes :as cpc]
[app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid]
[app.main.data.workspace.changes :as dch]
@ -21,7 +20,6 @@
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[okulary.core :as l]
[potok.core :as ptk]))
@ -137,7 +135,7 @@
(defn persist-changes
[file-id file-revn changes pending-commits]
(log/debug :hint "persist changes" :changes (count changes))
(us/verify ::us/uuid file-id)
(dm/assert! (uuid? file-id))
(ptk/reify ::persist-changes
ptk/WatchEvent
(watch [_ state _]
@ -197,7 +195,7 @@
(defn persist-synchronous-changes
[{:keys [file-id changes]}]
(us/verify ::us/uuid file-id)
(dm/assert! (uuid? file-id))
(ptk/reify ::persist-synchronous-changes
ptk/WatchEvent
(watch [_ state _]
@ -229,17 +227,16 @@
:status status
:updated-at (dt/now)))))))
(s/def ::revn ::us/integer)
(s/def ::shapes-changes-persisted
(s/keys :req-un [::revn ::pcs/changes]))
(defn shapes-persisted-event? [event]
(= (ptk/type event) ::changes-persisted))
(defn shapes-changes-persisted
[file-id {:keys [revn changes] :as params}]
(us/verify! ::us/uuid file-id)
(us/verify! ::shapes-changes-persisted params)
[file-id {:keys [revn changes]}]
(dm/assert! (uuid? file-id))
(dm/assert! (int? revn))
(dm/assert! (cpc/changes? changes))
(ptk/reify ::shapes-changes-persisted
ptk/UpdateEvent
(update [_ state]

15
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -14,7 +14,6 @@
[app.common.pages :as cp]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.types.file :as ctf]
[app.common.types.page :as ctp]
[app.common.types.shape.interactions :as ctsi]
@ -30,14 +29,10 @@
[app.main.streams :as ms]
[app.main.worker :as uw]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[clojure.set :as set]
[linked.set :as lks]
[potok.core :as ptk]))
(s/def ::ordered-set-of-uuid
(s/every uuid? :kind d/ordered-set?))
(defn interrupt? [e] (= e :interrupt))
;; --- Selection Rect
@ -122,7 +117,7 @@
(select-shape id false))
([id toggle?]
(us/verify ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::select-shape
ptk/UpdateEvent
(update [_ state]
@ -185,7 +180,7 @@
(defn deselect-shape
[id]
(us/verify ::us/uuid id)
(dm/assert! (uuid? id))
(ptk/reify ::deselect-shape
ptk/UpdateEvent
(update [_ state]
@ -209,7 +204,11 @@
(defn select-shapes
[ids]
(us/verify ::ordered-set-of-uuid ids)
(dm/assert!
"expected valid coll of uuids"
(and (every? uuid? ids)
(d/ordered-set? ids)))
(ptk/reify ::select-shapes
ptk/UpdateEvent
(update [_ state]

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

@ -12,7 +12,7 @@
[app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.types.component :as ctk]
[app.common.types.container :as ctn]
[app.common.types.page :as ctp]
@ -30,11 +30,8 @@
[app.main.features :as features]
[app.main.streams :as ms]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
(s/def ::shape-attrs ::cts/shape-attrs)
(defn get-shape-layer-position
[objects selected attrs]
@ -102,9 +99,8 @@
(defn add-shape
([attrs]
(add-shape attrs {}))
([attrs {:keys [no-select? no-update-layout?]}]
(us/verify ::shape-attrs attrs)
(dm/assert! (cts/shape-attrs? attrs))
(ptk/reify ::add-shape
ptk/WatchEvent
(watch [it state _]
@ -168,7 +164,7 @@
(defn delete-shapes
([ids] (delete-shapes nil ids))
([page-id ids]
(us/assert ::us/set-of-uuid ids)
(dm/assert! (sm/set-of-uuid? ids))
(ptk/reify ::delete-shapes
ptk/WatchEvent
(watch [it state _]
@ -449,8 +445,14 @@
(defn update-shape-flags
[ids {:keys [blocked hidden] :as flags}]
(us/verify (s/coll-of ::us/uuid) ids)
(us/assert ::shape-attrs flags)
(dm/assert!
"expected valid coll of uuids"
(every? uuid? ids))
(dm/assert!
"expected valid shape-attrs value for `flags`"
(cts/shape-attrs? flags))
(ptk/reify ::update-shape-flags
ptk/WatchEvent
(watch [_ state _]

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

@ -67,7 +67,7 @@
:cut {:tooltip (ds/meta "X")
:command (ds/c-mod "x")
:subsections [:edit]
:fn #(emit-when-no-readonly (dw/copy-selected)
:fn #(emit-when-no-readonly (dw/copy-selected)
(dw/delete-selected))}
:paste {:tooltip (ds/meta "V")
@ -110,7 +110,7 @@
;; MODIFY LAYERS
:group {:tooltip (ds/meta "G")
:command (ds/c-mod "g")
@ -222,7 +222,7 @@
:fn #(emit-when-no-readonly (dwsl/toggle-layout-flex))}
;; TOOLS
:draw-frame {:tooltip "B"
:command ["b" "a"]
:subsections [:tools :basics]
@ -300,7 +300,7 @@
:fn #(emit-when-no-readonly (dw/toggle-focus-mode))}
;; ITEM ALIGNMENT
:align-left {:tooltip (ds/alt "A")
:command "alt+a"
:subsections [:alignment]
@ -342,7 +342,7 @@
:fn #(emit-when-no-readonly (dw/distribute-objects :vertical))}
;; MAIN MENU
:toggle-rules {:tooltip (ds/meta-shift "R")
:command (ds/c-mod "shift+r")
:subsections [:main-menu]
@ -354,7 +354,7 @@
:fn #(st/emit! (dw/select-all))}
:toggle-grid {:tooltip (ds/meta "'")
;;https://github.com/ccampbell/mousetrap/issues/85
;;https://github.com/ccampbell/mousetrap/issues/85
:command [(ds/c-mod "'") (ds/c-mod "219")]
:subsections [:main-menu]
:fn #(st/emit! (toggle-layout-flag :display-grid))}
@ -402,7 +402,7 @@
:fn #(st/emit! (toggle-layout-flag :shortcuts))}
;; PANELS
:toggle-layers {:tooltip (ds/alt "L")
:command (ds/a-mod "l")
:subsections [:panels]
@ -438,7 +438,7 @@
:fn #(st/emit! (toggle-layout-flag :hide-ui))}
;; ZOOM-WORKSPACE
:increase-zoom {:tooltip "+"
:command ["+" "="]
:subsections [:zoom-workspace]
@ -475,7 +475,7 @@
:fn identity}
;; NAVIGATION
:open-viewer {:tooltip "G V"
:command "g v"
@ -501,14 +501,14 @@
:command "shift+tab"
:subsections [:navigation-workspace]
:fn #(st/emit! (dw/select-prev-shape))}
:select-next {:tooltip ds/tab
:command "tab"
:subsections [:navigation-workspace]
:fn #(st/emit! (dw/select-next-shape))}
;; SHAPE
:bool-union {:tooltip (ds/meta (ds/alt "U"))
:command (ds/c-mod "alt+u")

17
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -8,6 +8,7 @@
(:require
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
@ -38,11 +39,11 @@
(defonce default-image {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
(defn- assert-valid-num [attr num]
(us/verify!
:expr (and (d/num? num)
(<= num max-safe-int)
(>= num min-safe-int))
:hint (str/ffmt "%1 attribute has invalid value: %2" (d/name attr) num))
(dm/assert!
["%1 attribute has invalid value: %2" (d/name attr) num]
(and (d/num? num)
(<= num max-safe-int)
(>= num min-safe-int)))
;; If the number is between 0-1 we round to 1 (same in negative form
(cond
@ -52,9 +53,9 @@
(defn- assert-valid-pos-num
[attr num]
(us/verify!
:expr (pos? num)
:hint (str/ffmt "%1 attribute should be positive" (d/name attr)))
(dm/assert!
["%1 attribute should be positive" (d/name attr)]
(pos? num))
num)
(defn- svg-dimensions [data]

38
frontend/src/app/main/data/workspace/transforms.cljs
View file

@ -17,7 +17,6 @@
[app.common.math :as mth]
[app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.types.modifiers :as ctm]
[app.common.types.shape-tree :as ctst]
[app.common.types.shape.layout :as ctl]
@ -31,7 +30,6 @@
[app.main.streams :as ms]
[app.util.dom :as dom]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[potok.core :as ptk]))
;; -- Helpers --------------------------------------------------------
@ -237,9 +235,13 @@
"Change size of shapes, from the sideber options form.
Will ignore pixel snap used in the options side panel"
[ids attr value]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify #{:width :height} attr)
(us/verify ::us/number value)
(dm/assert! (number? value))
(dm/assert!
"expected valid coll of uuids"
(every? uuid? ids))
(dm/assert!
"expected valid attr"
(contains? #{:width :height} attr))
(ptk/reify ::update-dimensions
ptk/UpdateEvent
(update [_ state]
@ -261,8 +263,13 @@
"Change orientation of shapes, from the sidebar options form.
Will ignore pixel snap used in the options side panel"
[ids orientation]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify #{:horiz :vert} orientation)
(dm/assert!
"expected valid coll of uuids"
(every? uuid? ids))
(dm/assert!
"expected valid orientation"
(contains? #{:horiz :vert} orientation))
(ptk/reify ::change-orientation
ptk/UpdateEvent
(update [_ state]
@ -535,7 +542,8 @@
(finish-transform)
(dwu/commit-undo-transaction undo-id))))))))))))))
(s/def ::direction #{:up :down :right :left})
(def valid-directions
#{:up :down :right :left})
(defn reorder-selected-layout-child
[direction]
@ -660,8 +668,8 @@
(defn move-selected
"Move shapes a fixed increment in one direction, from a keyboard action."
[direction shift?]
(us/verify ::direction direction)
(us/verify boolean? shift?)
(dm/assert! (contains? valid-directions direction))
(dm/assert! (boolean? shift?))
(ptk/reify ::move-selected
ptk/WatchEvent
@ -675,16 +683,12 @@
(rx/of (reorder-selected-layout-child direction))
(rx/of (nudge-selected-shapes direction shift?)))))))
(s/def ::x number?)
(s/def ::y number?)
(s/def ::position
(s/keys :opt-un [::x ::y]))
(defn update-position
"Move shapes to a new position, from the sidebar options form."
[id position]
(us/verify ::us/uuid id)
(us/verify ::position position)
(js/console.log "DEBUG" (pr-str position))
(dm/assert! (uuid? id))
(ptk/reify ::update-position
ptk/WatchEvent
(watch [_ state _]

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

@ -7,19 +7,22 @@
(ns app.main.data.workspace.undo
(:require
[app.common.data :as d]
[app.common.pages.changes-spec :as pcs]
[app.common.spec :as us]
[cljs.spec.alpha :as s]
[app.common.data.macros :as dm]
[app.common.pages.changes :as cpc]
[app.common.schema :as sm]
[potok.core :as ptk]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Undo / Redo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::undo-changes ::pcs/changes)
(s/def ::redo-changes ::pcs/changes)
(s/def ::undo-entry
(s/keys :req-un [::undo-changes ::redo-changes]))
(def schema:undo-entry
[:map
[:undo-changes [:vector ::cpc/change]]
[:redo-changes [:vector ::cpc/change]]])
(def undo-entry?
(sm/pred-fn schema:undo-entry))
(def MAX-UNDO-SIZE 50)
@ -76,7 +79,9 @@
(defn append-undo
[entry stack?]
(us/assert ::undo-entry entry)
(dm/assert! (boolean? stack?))
(dm/assert! (undo-entry? entry))
(ptk/reify ::append-undo
ptk/UpdateEvent
(update [_ state]

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

@ -7,12 +7,12 @@
(ns app.main.data.workspace.viewport
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.align :as gal]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.math :as mth]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.streams :as ms]
[beicon.core :as rx]
@ -69,8 +69,14 @@
(defn update-viewport-position
[{:keys [x y] :or {x identity y identity}}]
(us/assert fn? x)
(us/assert fn? y)
(dm/assert!
"expected function for `x`"
(fn? x))
(dm/assert!
"expected function for `y`"
(fn? y))
(ptk/reify ::update-viewport-position
ptk/UpdateEvent
(update [_ state]

216
frontend/src/app/main/errors.cljs
View file

@ -7,12 +7,8 @@
(ns app.main.errors
"Generic error handling"
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.pprint :as pp]
[app.common.spec :as us]
[app.config :as cf]
[app.common.schema :as sm]
[app.main.data.messages :as msg]
[app.main.data.modal :as modal]
[app.main.data.users :as du]
@ -25,42 +21,56 @@
[cuerdas.core :as str]
[potok.core :as ptk]))
(defn- print-data!
[data]
(-> data
(dissoc ::sm/explain)
(dissoc :hint)
(dissoc ::trace)
(dissoc ::instance)
(pp/pprint {:width 70})))
(defn- print-explain!
[data]
(when-let [explain (::sm/explain data)]
(-> (sm/humanize-data explain)
(pp/pprint {:width 70}))))
(defn- print-trace!
[data]
(some-> data ::trace js/console.log))
(defn- print-group!
[message f]
(try
(js/console.group message)
(f)
(catch :default _ nil)
(finally
(js/console.groupEnd message))))
(defn on-error
"A general purpose error handler."
[error]
(cond
(instance? ExceptionInfo error)
(let [data (ex-data error)]
(if (contains? data :type)
(ptk/handle-error data)
(let [hint (str/ffmt "Unexpected error: '%'" (ex-message error))]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group hint)
(js/console.log (.-stack error))
(js/console.groupEnd hint))))
(map? error)
(if (map? error)
(ptk/handle-error error)
:else
(let [hint (ex-message error)
msg (dm/str "Internal Error: " hint)]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group msg)
(ex/ignoring (js/console.error error))
(js/console.groupEnd msg))))
(let [data (ex-data error)
data (-> data
(assoc :hint (or (:hint data) (ex-message error)))
(assoc ::instance error)
(assoc ::trace (.-stack error)))]
(ptk/handle-error data))))
;; Set the main potok error handler
(reset! st/on-error on-error)
(defmethod ptk/handle-error :default
[error]
(let [hint (str/ffmt "Unhandled error: '%'" (:hint error "[no hint]"))]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group hint)
(ex/ignoring (js/console.error (pr-str error)))
(js/console.groupEnd hint)))
(ts/schedule #(st/emit! (rt/assign-exception (::instance error))))
(print-group! "Unhandled Error"
(fn []
(print-trace! error)
(print-data! error))))
;; We receive a explicit authentication error; this explicitly clears
;; all profile data and redirect the user to the login page. This is
@ -85,42 +95,39 @@
:type :error
:timeout 3000})))
;; Print to the console some debug info.
(js/console.group "Validation Error:")
(ex/ignoring
(js/console.info
(pp/pprint-str (dissoc error :explain))))
(when-let [explain (:explain error)]
(js/console.group "Spec explain:")
(js/console.log explain)
(js/console.groupEnd "Spec explain:"))
(js/console.groupEnd "Validation Error:"))
(print-group! "Validation Error"
(fn []
(print-data! error))))
;; All the errors that happens on worker are handled here.
;; This is a pure frontend error that can be caused by an active
;; assertion (assertion that is preserved on production builds). From
;; the user perspective this should be treated as internal error.
(defmethod ptk/handle-error :assertion
[error]
(ts/schedule
#(st/emit! (msg/show {:content "Internal Assertion Error"
:type :error
:timeout 3000})))
(print-group! "Internal Assertion Error"
(fn []
(print-trace! error)
(print-data! error)
(print-explain! error))))
;; ;; All the errors that happens on worker are handled here.
(defmethod ptk/handle-error :worker-error
[{:keys [code data hint] :as error}]
(let [hint (or hint (:hint data) (:message data) (d/name code))
info (pp/pprint-str (dissoc data :explain))
msg (dm/str "Internal Worker Error: " hint)]
[error]
(ts/schedule
#(st/emit!
(msg/show {:content "Something wrong has happened (on worker)."
:type :error
:timeout 3000})))
(ts/schedule
#(st/emit!
(msg/show {:content "Something wrong has happened (on worker)."
:type :error
:timeout 3000})))
(js/console.group msg)
(js/console.info info)
(when-let [explain (:explain data)]
(js/console.group "Spec explain:")
(js/console.log explain)
(js/console.groupEnd "Spec explain:"))
(js/console.groupEnd msg)))
(print-group! "Internal Worker Error"
(fn []
(print-data! error))))
;; Error on parsing an SVG
;; TODO: looks unused and deprecated
@ -139,30 +146,6 @@
:type :error
:timeout 3000}))))
;; This is a pure frontend error that can be caused by an active
;; assertion (assertion that is preserved on production builds). From
;; the user perspective this should be treated as internal error.
(defmethod ptk/handle-error :assertion
[{:keys [message hint] :as error}]
(let [message (or message hint)
message (dm/str "Internal Assertion Error: " message)
context (dm/fmt "ns: '%'\nname: '%'\nfile: '%:%'"
(:ns error)
(:name error)
(dm/str @cf/public-uri "js/cljs-runtime/" (:file error))
(:line error))]
(ts/schedule
#(st/emit! (msg/show {:content "Internal error: assertion."
:type :error
:timeout 3000})))
;; Print to the console some debugging info
(js/console.group message)
(js/console.info context)
(js/console.log (us/pretty-explain error))
(js/console.groupEnd message)))
;; That are special case server-errors that should be treated
;; differently.
@ -198,49 +181,30 @@
;; uncontrolled error.
(defmethod ptk/handle-error :server-error
[{:keys [data hint] :as error}]
(let [hint (or hint (:hint data) (:message data))
info (pp/pprint-str (dissoc data :explain))
msg (dm/str "Internal Server Error: " hint)]
(ts/schedule
#(st/emit!
(msg/show {:content "Something wrong has happened (on backend)."
:type :error
:timeout 3000})))
(js/console.group msg)
(js/console.info info)
(when-let [explain (:explain data)]
(js/console.group "Spec explain:")
(js/console.log explain)
(js/console.groupEnd "Spec explain:"))
(js/console.groupEnd msg)))
(defn on-unhandled-error
[error]
(ts/schedule
#(st/emit!
(msg/show {:content "Something wrong has happened (on backend)."
:type :error
:timeout 3000})))
(print-group! "Server Error"
(fn []
(print-data! error))))
(defonce uncaught-error-handler
(letfn [(is-ignorable-exception? [cause]
(let [message (ex-message cause)]
(or (= message "Possible side-effect in debug-evaluate")
(= message "Unexpected end of input") true
(str/starts-with? message "Unexpected token "))))]
(if (instance? ExceptionInfo error)
(-> error ex-data ptk/handle-error)
(when-not (is-ignorable-exception? error)
(let [hint (ex-message error)
msg (dm/str "Unhandled Internal Error: " hint)]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group msg)
(ex/ignoring (js/console.error error))
(js/console.groupEnd msg))))))
(= message "Unexpected end of input")
(str/starts-with? message "Unexpected token "))))
(defonce uncaught-error-handler
(letfn [(on-error [event]
(on-unhandled-error [event]
(.preventDefault ^js event)
(some-> (unchecked-get event "error")
(on-unhandled-error)))]
(.addEventListener glob/window "error" on-error)
(when-let [error (unchecked-get event "error")]
(when-not (is-ignorable-exception? error)
(on-error error))))]
(.addEventListener glob/window "error" on-unhandled-error)
(fn []
(.removeEventListener glob/window "error" on-error))))
(.removeEventListener glob/window "error" on-unhandled-error))))

2
frontend/src/app/main/store.cljs
View file

@ -48,7 +48,7 @@
:on-event on-event
:on-error (fn [cause]
(when cause
(log/error :hint "unexpected exception on store" :cause cause)
#_(log/error :hint "unexpected exception on store" :cause cause)
(@on-error cause)))}))
(defonce stream

1
frontend/src/app/main/ui.cljs
View file

@ -31,7 +31,6 @@
(mf/defc on-main-error
[{:keys [error] :as props}]
(mf/with-effect
(js/console.log error)
(st/emit! (rt/assign-exception error)))
[:span "Internal application error"])

2
frontend/src/app/main/ui/components/context_menu_a11y/context_menu_a11y.cljs
View file

@ -190,7 +190,7 @@
(mf/with-effect [ids]
(tm/schedule-on-idle
(dom/focus! (dom/get-element (first ids)))))
#(dom/focus! (dom/get-element (first ids)))))
(when (and open? (some? (:levels @local)))
[:> dropdown' props

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

@ -6,9 +6,10 @@
(ns app.main.ui.dashboard.project-menu
(:require
[app.common.spec :as us]
[app.common.data.macros :as dm]
[app.common.schema :as sm]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as dm]
[app.main.data.messages :as msg]
[app.main.data.modal :as modal]
[app.main.refs :as refs]
[app.main.store :as st]
@ -18,24 +19,21 @@
[app.util.dom :as dom]
[app.util.i18n :as i18n :refer [tr]]
[app.util.router :as rt]
[cljs.spec.alpha :as s]
[rumext.v2 :as mf]))
(s/def ::project some?)
(s/def ::show? boolean?)
(s/def ::on-edit fn?)
(s/def ::on-menu-close fn?)
(s/def ::top (s/nilable ::us/number))
(s/def ::left (s/nilable ::us/number))
(s/def ::on-import fn?)
(s/def ::project-menu
(s/keys :req-un [::project ::show? ::on-edit ::on-menu-close]
:opt-un [::top ::left ::on-import]))
(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}]
(us/verify ::project-menu props)
(dm/assert! (sm/valid? schema:project-menu props))
(let [top (or top 0)
left (or left 0)
@ -45,7 +43,7 @@
on-duplicate-success
(fn [new-project]
(st/emit! (dm/success (tr "dashboard.success-duplicate-project"))
(st/emit! (msg/success (tr "dashboard.success-duplicate-project"))
(rt/nav :dashboard-files
{:team-id (:team-id new-project)
:project-id (:id new-project)})))
@ -66,12 +64,12 @@
(fn [team-id]
(let [data {:id (:id project) :team-id team-id}
mdata {:on-success #(on-move-success team-id)}]
#(st/emit! (dm/success (tr "dashboard.success-move-project"))
#(st/emit! (msg/success (tr "dashboard.success-move-project"))
(dd/move-project (with-meta data mdata)))))
delete-fn
(fn [_]
(st/emit! (dm/success (tr "dashboard.success-delete-project"))
(st/emit! (msg/success (tr "dashboard.success-delete-project"))
(dd/delete-project project)
(dd/go-to-projects (:team-id project))))

2
frontend/src/app/main/ui/dashboard/team.cljs
View file

@ -517,7 +517,7 @@
(mf/use-fn
(mf/deps email team-id)
(fn []
(let [params (with-meta {:emails [email]
(let [params (with-meta {:emails #{email}
:team-id team-id
:resend? true
:role role}

7
frontend/src/app/main/ui/hooks/resize.cljs
View file

@ -6,9 +6,9 @@
(ns app.main.ui.hooks.resize
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.logging :as log]
[app.common.spec :as us]
[app.main.ui.context :as ctx]
[app.main.ui.hooks :as hooks]
[app.util.dom :as dom]
@ -74,7 +74,10 @@
(defn use-resize-observer
[callback]
(us/assert! (some? callback) "the `callback` is mandatory")
(dm/assert!
"expected a valid callback"
(fn? callback))
(let [prev-val-ref (mf/use-ref nil)
observer-ref (mf/use-ref nil)

5
frontend/src/app/main/ui/workspace/viewport/hooks.cljs
View file

@ -109,8 +109,9 @@
(defn setup-keyboard [alt? mod? space? z? shift?]
(hooks/use-stream ms/keyboard-alt #(reset! alt? %))
(hooks/use-stream ms/keyboard-mod #((reset! mod? %)
(when-not % (reset! z? false)))) ;; In mac after command+z there is no event for the release of the z key
(hooks/use-stream ms/keyboard-mod #(do
(reset! mod? %)
(when-not % (reset! z? false)))) ;; In mac after command+z there is no event for the release of the z key
(hooks/use-stream ms/keyboard-space #(reset! space? %))
(hooks/use-stream ms/keyboard-z #(reset! z? %))
(hooks/use-stream ms/keyboard-shift #(reset! shift? %)))

4
frontend/src/app/main/ui/workspace/viewport/snap_points.cljs
View file

@ -7,9 +7,9 @@
(ns app.main.ui.workspace.viewport.snap-points
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph]
[app.common.spec :as us]
[app.common.types.shape.layout :as ctl]
[app.main.snap :as snap]
[app.util.geom.snap-points :as sp]
@ -155,7 +155,7 @@
(mf/defc snap-points
{::mf/wrap [mf/memo]}
[{:keys [layout zoom objects selected page-id drawing focus] :as props}]
(us/assert set? selected)
(dm/assert! (set? selected))
(let [shapes (into [] (keep (d/getf objects)) selected)
filter-shapes

4
frontend/src/app/util/text_editor.cljs
View file

@ -155,13 +155,13 @@
(impl/insertText state text (clj->js attrs) (clj->js style))))
(defn get-style-override [state]
(.getInlineStyleOverride state))
(.getInlineStyleOverride ^js state))
(defn set-style-override [state inline-style]
(impl/setInlineStyleOverride state inline-style))
(defn content-equals [state other]
(.equals (.getCurrentContent state) (.getCurrentContent other)))
(.equals (.getCurrentContent ^js state) (.getCurrentContent ^js other)))
(defn selection-equals [state other]
(impl/selectionEquals (.getSelection state) (.getSelection other)))

10
frontend/src/app/util/time.cljs
View file

@ -163,11 +163,11 @@
(extend-protocol IPrintWithWriter
DateTime
(-pr-writer [p writer _]
(-write writer (str/fmt "#stks/datetime \"%s\"" (format p :iso))))
(-write writer (str/fmt "#app/instant \"%s\"" (format p :iso))))
Duration
(-pr-writer [p writer _]
(-write writer (str/fmt "#stks/duration \"%s\"" (format p :iso)))))
(-write writer (str/fmt "#app/duration \"%s\"" (format p :iso)))))
(defn- resolve-format
[v]
@ -239,6 +239,6 @@
(when v
(let [v (if (datetime? v) (format v :date) v)
locale (obj/get locales locale)
f (.date (.-formatLong locale) v)]
(->> #js {:locale locale}
(dateFnsFormat v f))))))
f (-> (.-formatLong ^js locale)
(.date v))]
(dateFnsFormat v f #js {:locale locale})))))

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

@ -6,8 +6,9 @@
(ns app.worker
(:require
[app.common.data.macros :as dm]
[app.common.logging :as log]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.worker.export]
[app.worker.impl :as impl]
[app.worker.import]
@ -16,33 +17,29 @@
[app.worker.snaps]
[app.worker.thumbnails]
[beicon.core :as rx]
[cljs.spec.alpha :as s]
[promesa.core :as p]))
(log/setup! {:app :info})
;; --- Messages Handling
(s/def ::cmd keyword?)
(def schema:message
[:map {:title "WorkerMessage"}
[:sender-id ::sm/uuid]
[:payload
[:map
[:cmd :keyword]]]
[:buffer? {:optional true} :boolean]])
(s/def ::payload
(s/keys :req-un [::cmd]))
(s/def ::sender-id uuid?)
(s/def ::buffer? boolean?)
(s/def ::message
(s/keys
:opt-un [::buffer?]
:req-un [::payload ::sender-id]))
(def message?
(sm/pred-fn schema:message))
(def buffer (rx/subject))
(defn- handle-message
"Process the message and returns to the client"
[{:keys [sender-id payload] :as message}]
(us/assert ::message message)
(dm/assert! (message? message))
(letfn [(post [msg]
(let [msg (-> msg (assoc :reply-to sender-id) (wm/encode))]
(.postMessage js/self msg)))
@ -88,7 +85,7 @@
(defn- drop-message
"Sends to the client a notification that its messages have been dropped"
[{:keys [sender-id] :as message}]
(us/assert ::message message)
(dm/assert! (message? message))
(.postMessage js/self (wm/encode {:reply-to sender-id
:dropped true})))