diff --git a/backend/src/app/features/components_v2.clj b/backend/src/app/features/components_v2.clj index 663abb8c1..974f56434 100644 --- a/backend/src/app/features/components_v2.clj +++ b/backend/src/app/features/components_v2.clj @@ -776,6 +776,16 @@ (fdata/process-pointers deref) (fmg/migrate-data))) +(defn- validate-file! + [file libs throw-on-validate?] + (try + (cfv/validate-file! file libs) + (cfv/validate-file-schema! file) + (catch Throwable cause + (if throw-on-validate? + (throw cause) + (l/wrn :hint "migrate:file:validation-error" :cause cause))))) + (defn- process-file [{:keys [::db/conn] :as system} id & {:keys [validate? throw-on-validate?]}] (binding [pmap/*tracked* (pmap/create-tracked) @@ -803,13 +813,7 @@ ] (when validate? - (if throw-on-validate? - (cfv/validate-file! file libs) - (doseq [error (cfv/validate-file file libs)] - (l/wrn :hint "migrate:file:validation-error" - :file-id (str (:id file)) - :file-name (:name file) - :error error)))) + (validate-file! file libs throw-on-validate?)) (db/update! conn :file {:data (blob/encode (:data file)) diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index 352c1ed21..e910e12ea 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -276,9 +276,7 @@ (try (val/validate-file-schema! file) (catch Throwable cause - (l/error :hint "file schema validation error" :cause cause))) - - file) + (l/error :hint "file schema validation error" :cause cause)))) (defn- soft-validate-file! [file libs] @@ -286,8 +284,7 @@ (val/validate-file! file libs) (catch Throwable cause (l/error :hint "file validation error" - :cause cause))) - file) + :cause cause)))) (defn- update-file-data [{:keys [::db/conn] :as cfg} file changes skip-validate] @@ -300,7 +297,8 @@ ;; WARNING: this ruins performance; maybe we need to find ;; some other way to do general validation - libs (when (and (contains? cf/flags :file-validation) + libs (when (and (or (contains? cf/flags :file-validation) + (contains? cf/flags :soft-file-validation)) (not skip-validate)) (->> (files/get-file-libraries conn (:id file)) (into [file] (map (fn [{:keys [id]}] @@ -309,37 +307,37 @@ (-> (files/get-file cfg id :migrate? false) (feat.fdata/process-pointers deref) ; ensure all pointers resolved (fmg/migrate-file)))))) - (d/index-by :id)))] + (d/index-by :id))) - (-> (files/check-version! file) - (update :revn inc) - (update :data cpc/process-changes changes) + file (-> (files/check-version! file) + (update :revn inc) + (update :data cpc/process-changes changes))] - ;; If `libs` is defined, then full validation is performed - (cond-> (contains? cf/flags :soft-file-validation) - (soft-validate-file! libs)) + (when (contains? cf/flags :soft-file-validation) + (soft-validate-file! file libs)) - (cond-> (contains? cf/flags :soft-file-schema-validation) - (soft-validate-file-schema!)) + (when (contains? cf/flags :soft-file-schema-validation) + (soft-validate-file-schema! file)) - (cond-> (and (contains? cf/flags :file-validation) - (not skip-validate)) - (val/validate-file! libs)) + (when (and (contains? cf/flags :file-validation) + (not skip-validate)) + (val/validate-file! file libs)) - (cond-> (and (contains? cf/flags :file-schema-validation) - (not skip-validate)) - (val/validate-file-schema!)) + (when (and (contains? cf/flags :file-schema-validation) + (not skip-validate)) + (val/validate-file-schema! file)) - (cond-> (and (contains? cfeat/*current* "fdata/objects-map") - (not (contains? cfeat/*previous* "fdata/objects-map"))) - (feat.fdata/enable-objects-map)) + (cond-> file + (and (contains? cfeat/*current* "fdata/objects-map") + (not (contains? cfeat/*previous* "fdata/objects-map"))) + (feat.fdata/enable-objects-map) - (cond-> (and (contains? cfeat/*current* "fdata/pointer-map") - (not (contains? cfeat/*previous* "fdata/pointer-map"))) - (feat.fdata/enable-pointer-map)) - - (update :data blob/encode)))) + (and (contains? cfeat/*current* "fdata/pointer-map") + (not (contains? cfeat/*previous* "fdata/pointer-map"))) + (feat.fdata/enable-pointer-map) + :always + (update :data blob/encode)))) (defn- take-snapshot? "Defines the rule when file `data` snapshot should be saved." diff --git a/backend/src/app/srepl/helpers.clj b/backend/src/app/srepl/helpers.clj index d0a067427..bc8caf6c1 100644 --- a/backend/src/app/srepl/helpers.clj +++ b/backend/src/app/srepl/helpers.clj @@ -105,7 +105,7 @@ (pmg/migrate-file)))))) (d/index-by :id)) errors (validate/validate-file file libs) - changes (-> (repair/repair-file (:data file) libs errors) :redo-changes) + changes (repair/repair-file file libs errors) file (-> file (update :revn inc) diff --git a/common/src/app/common/files/repair.cljc b/common/src/app/common/files/repair.cljc index 8b6129f98..28c7a3441 100644 --- a/common/src/app/common/files/repair.cljc +++ b/common/src/app/common/files/repair.cljc @@ -28,14 +28,14 @@ (let [repair-shape (fn [shape] ; Reset geometry to minimal - (log/debug :hint " -> Reset geometry") + (log/debug :hint " -> reset geometry") (-> shape (assoc :x 0) (assoc :y 0) (assoc :width 0.01) (assoc :height 0.01) (cts/setup-rect)))] - (log/info :hint "Repairing shape :invalid-geometry" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :invalid-geometry" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -45,10 +45,10 @@ (let [repair-shape (fn [shape] ; Set parent to root frame. - (log/debug :hint " -> Set to " :parent-id uuid/zero) + (log/debug :hint " -> set to " :parent-id uuid/zero) (assoc shape :parent-id uuid/zero))] - (log/info :hint "Repairing shape :parent-not-found" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :parent-not-found" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -58,10 +58,10 @@ (let [repair-shape (fn [parent-shape] ; Add shape to parent's children list - (log/debug :hint " -> Add children to" :parent-id (:id parent-shape)) + (log/debug :hint " -> add children to" :parent-id (:id parent-shape)) (update parent-shape :shapes conj (:id shape)))] - (log/info :hint "Repairing shape :child-not-in-parent" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :child-not-in-parent" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:parent-id shape)] repair-shape)))) @@ -70,17 +70,17 @@ [_ {:keys [shape page-id args] :as error} file-data _] (let [repair-shape (fn [parent-shape] - (log/debug :hint " -> Remove child" :child-id (:child-id args)) + (log/debug :hint " -> remove child" :child-id (:child-id args)) (update parent-shape :shapes (fn [shapes] (d/removev #(= (:child-id args) %) shapes))))] - (log/info :hint "Repairing shape :child-not-found" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :child-not-found" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) (defmethod repair-error :invalid-parent [_ {:keys [shape page-id args] :as error} file-data _] - (log/info :hint "Repairing shape :invalid-parent" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :invalid-parent" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/change-parent (:parent-id args) [shape] nil {:component-swap true}))) @@ -93,10 +93,10 @@ (let [page (ctpl/get-page file-data page-id) frame (cfh/get-frame (:objects page) (:parent-id shape)) frame-id (or (:id frame) uuid/zero)] - (log/debug :hint " -> Set to " :frame-id frame-id) + (log/debug :hint " -> set to " :frame-id frame-id) (assoc shape :frame-id frame-id)))] - (log/info :hint "Repairing shape :frame-not-found" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :frame-not-found" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -109,10 +109,10 @@ (let [page (ctpl/get-page file-data page-id) frame (cfh/get-frame (:objects page) (:parent-id shape)) frame-id (or (:id frame) uuid/zero)] - (log/debug :hint " -> Set to " :frame-id frame-id) + (log/debug :hint " -> set to " :frame-id frame-id) (assoc shape :frame-id frame-id)))] - (log/info :hint "Repairing shape :invalid-frame" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :invalid-frame" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -122,10 +122,10 @@ (let [repair-shape (fn [shape] ; Set the :shape as main instance root - (log/debug :hint " -> Set :main-instance") + (log/debug :hint " -> set :main-instance") (assoc shape :main-instance true))] - (log/info :hint "Repairing shape :component-not-main" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :component-not-main" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -135,13 +135,13 @@ (let [repair-shape (fn [shape] ; Set :component-file to local file - (log/debug :hint " -> Set :component-file to local file") + (log/debug :hint " -> set :component-file to local file") (assoc shape :component-file (:id file-data)))] ; There is no solution that may recover it with confidence ;; (log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.") ;; shape)] - (log/info :hint "Repairing shape :component-main-external" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :component-main-external" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -154,13 +154,13 @@ repair-shape (fn [shape] ; Detach the shape and convert it to non instance. - (log/debug :hint " -> Detach shape" :shape-id (:id shape)) + (log/debug :hint " -> detach shape" :shape-id (:id shape)) (ctk/detach-shape shape))] ; There is no solution that may recover it with confidence ;; (log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.") ;; shape)] - (log/info :hint "Repairing shape :component-not-found" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :component-not-found" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes shape-ids repair-shape)))) @@ -172,15 +172,15 @@ repair-component (fn [component] ; Assign main instance in the component to current shape - (log/debug :hint " -> Assign main-instance-id" :component-id (:id component)) + (log/debug :hint " -> assign main-instance-id" :component-id (:id component)) (assoc component :main-instance-id (:id shape))) detach-shape (fn [shape] - (log/debug :hint " -> Detach shape" :shape-id (:id shape)) + (log/debug :hint " -> detach shape" :shape-id (:id shape)) (ctk/detach-shape shape))] - (log/info :hint "Repairing shape :invalid-main-instance-id" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :invalid-main-instance-id" :id (:id shape) :name (:name shape) :page-id page-id) (if (and (some? component) (not (:deleted component))) (-> (pcb/empty-changes nil page-id) (pcb/with-library-data file-data) @@ -195,9 +195,9 @@ (let [repair-component (fn [component] ; Assign main instance in the component to current shape - (log/debug :hint " -> Assign main-instance-page" :component-id (:id component)) + (log/debug :hint " -> assign main-instance-page" :component-id (:id component)) (assoc component :main-instance-page page-id))] - (log/info :hint "Repairing shape :invalid-main-instance-page" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :invalid-main-instance-page" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-library-data file-data) (pcb/update-component (:component-id shape) repair-component)))) @@ -210,7 +210,7 @@ (log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.") shape)] - (log/info :hint "Repairing shape :invalid-main-instance" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :invalid-main-instance" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -220,10 +220,10 @@ (let [repair-shape (fn [shape] ; Unset the :shape as main instance root - (log/debug :hint " -> Unset :main-instance") + (log/debug :hint " -> unset :main-instance") (dissoc shape :main-instance))] - (log/info :hint "Repairing shape :component-main" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :component-main" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -233,10 +233,10 @@ (let [repair-shape (fn [shape] ; Convert the shape in a top copy root. - (log/debug :hint " -> Set :component-root") + (log/debug :hint " -> set :component-root") (assoc shape :component-root true))] - (log/info :hint "Repairing shape :should-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :should-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -246,10 +246,10 @@ (let [repair-shape (fn [shape] ; Convert the shape in a nested copy root. - (log/debug :hint " -> Unset :component-root") + (log/debug :hint " -> unset :component-root") (dissoc shape :component-root))] - (log/info :hint "Repairing shape :should-not-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :should-not-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -268,17 +268,17 @@ reassign-shape (fn [shape] - (log/debug :hint " -> Reassign shape-ref to" :shape-ref (:id matching-shape)) + (log/debug :hint " -> reassign shape-ref to" :shape-ref (:id matching-shape)) (assoc shape :shape-ref (:id matching-shape))) detach-shape (fn [shape] - (log/debug :hint " -> Detach shape" :shape-id (:id shape)) + (log/debug :hint " -> detach shape" :shape-id (:id shape)) (ctk/detach-shape shape))] ; If the shape still refers to the remote component, try to find the corresponding near one ; and link to it. If not, detach the shape. - (log/info :hint "Repairing shape :ref-shape-not-found" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :ref-shape-not-found" :id (:id shape) :name (:name shape) :page-id page-id) (if (some? matching-shape) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) @@ -294,10 +294,10 @@ (let [repair-shape (fn [shape] ; Remove shape-ref - (log/debug :hint " -> Unset :shape-ref") + (log/debug :hint " -> unset :shape-ref") (dissoc shape :shape-ref))] - (log/info :hint "Repairing shape :shape-ref-in-main" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :shape-ref-in-main" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -307,10 +307,10 @@ (let [repair-shape (fn [shape] ; Convert the shape in a nested main head. - (log/debug :hint " -> Unset :component-root") + (log/debug :hint " -> unset :component-root") (dissoc shape :component-root))] - (log/info :hint "Repairing shape :root-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :root-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -320,10 +320,10 @@ (let [repair-shape (fn [shape] ; Convert the shape in a top main head. - (log/debug :hint " -> Set :component-root") + (log/debug :hint " -> set :component-root") (assoc shape :component-root true))] - (log/info :hint "Repairing shape :nested-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :nested-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -333,10 +333,10 @@ (let [repair-shape (fn [shape] ; Convert the shape in a nested copy head. - (log/debug :hint " -> Unset :component-root") + (log/debug :hint " -> unset :component-root") (dissoc shape :component-root))] - (log/info :hint "Repairing shape :root-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :root-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -346,10 +346,10 @@ (let [repair-shape (fn [shape] ; Convert the shape in a top copy root. - (log/debug :hint " -> Set :component-root") + (log/debug :hint " -> set :component-root") (assoc shape :component-root true))] - (log/info :hint "Repairing shape :nested-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :nested-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -359,10 +359,10 @@ (let [repair-shape (fn [shape] ; Detach the shape and convert it to non instance. - (log/debug :hint " -> Detach shape" :shape-id (:id shape)) + (log/debug :hint " -> detach shape" :shape-id (:id shape)) (ctk/detach-shape shape))] - (log/info :hint "Repairing shape :not-head-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :not-head-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -372,10 +372,10 @@ (let [repair-shape (fn [shape] ; Detach the shape and convert it to non instance. - (log/debug :hint " -> Detach shape" :shape-id (:id shape)) + (log/debug :hint " -> detach shape" :shape-id (:id shape)) (ctk/detach-shape shape))] - (log/info :hint "Repairing shape :not-head-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :not-head-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -388,7 +388,7 @@ (log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.") shape)] - (log/info :hint "Repairing shape :not-component-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :not-component-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -398,14 +398,14 @@ (let [repair-shape (fn [shape] ; Convert the shape in a frame. - (log/debug :hint " -> Set :type :frame") + (log/debug :hint " -> set :type :frame") (assoc shape :type :frame :fills [] :hide-in-viewer true :rx 0 :ry 0))] - (log/info :hint "Repairing shape :instance-head-not-frame" :id (:id shape) :name (:name shape) :page-id page-id) + (log/dbg :hint "repairing shape :instance-head-not-frame" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) (pcb/update-shapes [(:id shape)] repair-shape)))) @@ -417,13 +417,13 @@ ; Remove the objects key, or set it to {} if the component is deleted (if (:deleted component) (do - (log/debug :hint " -> Set :objects {}") + (log/debug :hint " -> set :objects {}") (assoc component :objects {})) (do - (log/debug :hint " -> Remove :objects") + (log/debug :hint " -> remove :objects") (dissoc component :objects))))] - (log/info :hint "Repairing component :component-nil-objects-not-allowed" :id (:id shape) :name (:name shape)) + (log/dbg :hint "repairing component :component-nil-objects-not-allowed" :id (:id shape) :name (:name shape)) (-> (pcb/empty-changes nil) (pcb/with-library-data file-data) (pcb/update-component (:id shape) repair-component)))) @@ -434,13 +434,15 @@ file) (defn repair-file - [file-data libraries errors] - (log/info :hint "Repairing file" :id (:id file-data) :error-count (count errors)) - (reduce (fn [changes error] - (pcb/concat-changes changes - (repair-error (:code error) - error - file-data - libraries))) - (pcb/empty-changes nil) - errors)) + [{:keys [data id] :as file} libraries errors] + (log/dbg :hint "repairing file" :id (str id) :errors (count errors)) + (let [{:keys [redo-changes]} + (reduce (fn [changes error] + (pcb/concat-changes changes + (repair-error (:code error) + error + data + libraries))) + (pcb/empty-changes nil) + errors)] + redo-changes)) diff --git a/common/src/app/common/files/validate.cljc b/common/src/app/common/files/validate.cljc index 4864bbc41..f6d12ada0 100644 --- a/common/src/app/common/files/validate.cljc +++ b/common/src/app/common/files/validate.cljc @@ -6,6 +6,7 @@ (ns app.common.files.validate (:require + [app.common.data.macros :as dm] [app.common.exceptions :as ex] [app.common.files.helpers :as cfh] [app.common.schema :as sm] @@ -49,50 +50,50 @@ :not-component-not-allowed :component-nil-objects-not-allowed}) -(def validation-error - [:map {:title "ValidationError"} - [:code {:optional false} [::sm/one-of error-codes]] - [:hint {:optional false} :string] - [:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken - [:file-id ::sm/uuid] - [:page-id ::sm/uuid]]) +(def ^:private + schema:error + (sm/define + [:map {:title "ValidationError"} + [:code {:optional false} [::sm/one-of error-codes]] + [:hint {:optional false} :string] + [:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken + [:shape-id {:optional true} ::sm/uuid] + [:file-id ::sm/uuid] + [:page-id ::sm/uuid]])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ERROR HANDLING ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def ^:dynamic *errors* nil) +(def ^:dynamic ^:private *errors* nil) -(defn report-error! +(defn- report-error [code hint shape file page & {:as args}] - (if (some? *errors*) - (vswap! *errors* conj {:code code - :hint hint - :shape shape - :file-id (:id file) - :page-id (:id page) - :args args}) + (let [error {:code code + :hint hint + :shape shape + :file-id (:id file) + :page-id (:id page) + :shape-id (:id shape) + :args args}] - (let [explain (str/ffmt "file %, page %, shape %" - (:id file) - (:id page) - (:id shape))] - (ex/raise :type :validation - :code code - :hint hint - :args args - :file-id (:id file) - :page-id (:id page) - :shape-id (:id shape) - ::explain explain)))) + (dm/assert! + "expected a valid `*errors*` dynamic binding" + (some? *errors*)) + + (dm/assert! + "expected valid error" + (sm/check! schema:error error)) + + (vswap! *errors* conj error))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; VALIDATION FUNCTIONS +;; PRIVATE API: VALIDATION FUNCTIONS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(declare validate-shape!) +(declare check-shape) -(defn validate-geometry! +(defn- check-geometry "Validate that the shape has valid coordinates, selrect and points." [shape file page] (when (and (not (#{:path :bool} (:type shape))) @@ -102,175 +103,175 @@ (nil? (:height shape)) (nil? (:selrect shape)) (nil? (:points shape)))) - (report-error! :invalid-geometry - "Shape greometry is invalid" - shape file page))) + (report-error :invalid-geometry + "Shape greometry is invalid" + shape file page))) -(defn validate-parent-children! +(defn- check-parent-children "Validate parent and children exists, and the link is bidirectional." [shape file page] (let [parent (ctst/get-shape page (:parent-id shape))] (if (nil? parent) - (report-error! :parent-not-found - (str/ffmt "Parent % not found" (:parent-id shape)) - shape file page) + (report-error :parent-not-found + (str/ffmt "Parent % not found" (:parent-id shape)) + shape file page) (do (when-not (cfh/root? shape) (when-not (some #{(:id shape)} (:shapes parent)) - (report-error! :child-not-in-parent - (str/ffmt "Shape % not in parent's children list" (:id shape)) - shape file page))) + (report-error :child-not-in-parent + (str/ffmt "Shape % not in parent's children list" (:id shape)) + shape file page))) (doseq [child-id (:shapes shape)] (let [child (ctst/get-shape page child-id)] (if (nil? child) - (report-error! :child-not-found - (str/ffmt "Child % not found in parent %" child-id (:id shape)) - shape file page - :parent-id (:id shape) - :child-id child-id) + (report-error :child-not-found + (str/ffmt "Child % not found in parent %" child-id (:id shape)) + shape file page + :parent-id (:id shape) + :child-id child-id) (when (not= (:parent-id child) (:id shape)) - (report-error! :invalid-parent - (str/ffmt "Child % has invalid parent %" child-id (:id shape)) - child file page - :parent-id (:id shape)))))))))) + (report-error :invalid-parent + (str/ffmt "Child % has invalid parent %" child-id (:id shape)) + child file page + :parent-id (:id shape)))))))))) -(defn validate-frame! +(defn- check-frame "Validate that the frame-id shape exists and is indeed a frame. Also it must point to the parent shape (if this is a frame) or to the frame-id of the parent (if not)." [shape file page] (let [frame (ctst/get-shape page (:frame-id shape))] (if (nil? frame) - (report-error! :frame-not-found - (str/ffmt "Frame % not found" (:frame-id shape)) - shape file page) + (report-error :frame-not-found + (str/ffmt "Frame % not found" (:frame-id shape)) + shape file page) (if (not= (:type frame) :frame) - (report-error! :invalid-frame - (str/ffmt "Frame % is not actually a frame" (:frame-id shape)) - shape file page) + (report-error :invalid-frame + (str/ffmt "Frame % is not actually a frame" (:frame-id shape)) + shape file page) (let [parent (ctst/get-shape page (:parent-id shape))] (when (some? parent) (if (= (:type parent) :frame) (when-not (= (:frame-id shape) (:id parent)) - (report-error! :invalid-frame - (str/ffmt "Frame-id should point to parent %" (:id parent)) - shape file page)) + (report-error :invalid-frame + (str/ffmt "Frame-id should point to parent %" (:id parent)) + shape file page)) (when-not (= (:frame-id shape) (:frame-id parent)) - (report-error! :invalid-frame - (str/ffmt "Frame-id should point to parent frame %" (:frame-id parent)) - shape file page))))))))) + (report-error :invalid-frame + (str/ffmt "Frame-id should point to parent frame %" (:frame-id parent)) + shape file page))))))))) -(defn validate-component-main-head! +(defn- check-component-main-head "Validate shape is a main instance head, component exists and its main-instance points to this shape." [shape file page libraries] (when (nil? (:main-instance shape)) - (report-error! :component-not-main - "Shape expected to be main instance" - shape file page)) + (report-error :component-not-main + "Shape expected to be main instance" + shape file page)) (when-not (= (:component-file shape) (:id file)) - (report-error! :component-main-external - "Main instance should refer to a component in the same file" - shape file page)) + (report-error :component-main-external + "Main instance should refer to a component in the same file" + shape file page)) (let [component (ctf/resolve-component shape file libraries :include-deleted? true)] (if (nil? component) - (report-error! :component-not-found - (str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape)) - shape file page) + (report-error :component-not-found + (str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape)) + shape file page) (do (when-not (= (:main-instance-id component) (:id shape)) - (report-error! :invalid-main-instance-id - (str/ffmt "Main instance id of component % is not valid" (:component-id shape)) - shape file page)) + (report-error :invalid-main-instance-id + (str/ffmt "Main instance id of component % is not valid" (:component-id shape)) + shape file page)) (when-not (= (:main-instance-page component) (:id page)) (let [component-page (ctf/get-component-page (:data file) component) main-component (ctst/get-shape component-page (:main-instance-id component))] ;; We must check if the same component has main instances in different pages. ;; In that case one of those instances shouldn't be main (if (:main-instance main-component) - (report-error! :component-main - "Shape not expected to be main instance" - shape file page) - (report-error! :invalid-main-instance-page - (str/ffmt "Main instance page of component % is not valid" (:component-id shape)) - shape file page)))))))) + (report-error :component-main + "Shape not expected to be main instance" + shape file page) + (report-error :invalid-main-instance-page + (str/ffmt "Main instance page of component % is not valid" (:component-id shape)) + shape file page)))))))) -(defn validate-component-not-main-head! +(defn- check-component-not-main-head "Validate shape is a not-main instance head, component exists and its main-instance does not point to this shape." [shape file page libraries] (when (true? (:main-instance shape)) - (report-error! :component-not-main - "Shape not expected to be main instance" - shape file page)) + (report-error :component-not-main + "Shape not expected to be main instance" + shape file page)) (let [library-exists? (or (= (:component-file shape) (:id file)) - (contains? libraries (:component-file shape))) + (contains? libraries (:component-file shape))) component (when library-exists? (ctf/resolve-component shape file libraries {:include-deleted? true}))] (if (nil? component) (when library-exists? - (report-error! :component-not-found - (str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape)) - shape file page)) + (report-error :component-not-found + (str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape)) + shape file page)) (when (and (= (:main-instance-id component) (:id shape)) (= (:main-instance-page component) (:id page))) - (report-error! :invalid-main-instance - (str/ffmt "Main instance of component % should not be this shape" (:id component)) - shape file page))))) + (report-error :invalid-main-instance + (str/ffmt "Main instance of component % should not be this shape" (:id component)) + shape file page))))) -(defn validate-component-not-main-not-head! +(defn- check-component-not-main-not-head "Validate that this shape is not main instance and not head." [shape file page] (when (true? (:main-instance shape)) - (report-error! :component-main - "Shape not expected to be main instance" - shape file page)) + (report-error :component-main + "Shape not expected to be main instance" + shape file page)) (when (or (some? (:component-id shape)) (some? (:component-file shape))) - (report-error! :component-main - "Shape not expected to be component head" - shape file page))) + (report-error :component-main + "Shape not expected to be component head" + shape file page))) -(defn validate-component-root! +(defn- check-component-root "Validate that this shape is an instance root." [shape file page] (when (nil? (:component-root shape)) - (report-error! :should-be-component-root - "Shape should be component root" - shape file page))) + (report-error :should-be-component-root + "Shape should be component root" + shape file page))) -(defn validate-component-not-root! +(defn- check-component-not-root "Validate that this shape is not an instance root." [shape file page] (when (true? (:component-root shape)) - (report-error! :should-not-be-component-root - "Shape should not be component root" - shape file page))) + (report-error :should-not-be-component-root + "Shape should not be component root" + shape file page))) -(defn validate-component-ref! +(defn- check-component-ref "Validate that the referenced shape exists in the near component." [shape file page libraries] (let [library-exists? (or (= (:component-file shape) (:id file)) - (contains? libraries (:component-file shape))) + (contains? libraries (:component-file shape))) ref-shape (when library-exists? (ctf/find-ref-shape file page libraries shape :include-deleted? true))] (when (and library-exists? (nil? ref-shape)) - (report-error! :ref-shape-not-found - (str/ffmt "Referenced shape % not found in near component" (:shape-ref shape)) - shape file page)))) + (report-error :ref-shape-not-found + (str/ffmt "Referenced shape % not found in near component" (:shape-ref shape)) + shape file page)))) -(defn validate-component-not-ref! +(defn- check-component-not-ref "Validate that this shape does not reference other one." [shape file page] (when (some? (:shape-ref shape)) - (report-error! :shape-ref-in-main - "Shape inside main instance should not have shape-ref" - shape file page))) + (report-error :shape-ref-in-main + "Shape inside main instance should not have shape-ref" + shape file page))) -(defn validate-shape-main-root-top! +(defn- check-shape-main-root-top "Root shape of a top main instance: - :main-instance @@ -278,78 +279,78 @@ - :component-file - :component-root" [shape file page libraries] - (validate-component-main-head! shape file page libraries) - (validate-component-root! shape file page) - (validate-component-not-ref! shape file page) + (check-component-main-head shape file page libraries) + (check-component-root shape file page) + (check-component-not-ref shape file page) (doseq [child-id (:shapes shape)] - (validate-shape! child-id file page libraries :context :main-top))) + (check-shape child-id file page libraries :context :main-top))) -(defn validate-shape-main-root-nested! +(defn- check-shape-main-root-nested "Root shape of a nested main instance - :main-instance - :component-id - :component-file" [shape file page libraries] - (validate-component-main-head! shape file page libraries) - (validate-component-not-root! shape file page) - (validate-component-not-ref! shape file page) + (check-component-main-head shape file page libraries) + (check-component-not-root shape file page) + (check-component-not-ref shape file page) (doseq [child-id (:shapes shape)] - (validate-shape! child-id file page libraries :context :main-nested))) + (check-shape child-id file page libraries :context :main-nested))) -(defn validate-shape-copy-root-top! +(defn- check-shape-copy-root-top "Root shape of a top copy instance - :component-id - :component-file - :component-root - :shape-ref" [shape file page libraries] - (validate-component-not-main-head! shape file page libraries) - (validate-component-root! shape file page) - (validate-component-ref! shape file page libraries) + (check-component-not-main-head shape file page libraries) + (check-component-root shape file page) + (check-component-ref shape file page libraries) (doseq [child-id (:shapes shape)] - (validate-shape! child-id file page libraries :context :copy-top))) + (check-shape child-id file page libraries :context :copy-top))) -(defn validate-shape-copy-root-nested! +(defn- check-shape-copy-root-nested "Root shape of a nested copy instance - :component-id - :component-file - :shape-ref" [shape file page libraries] - (validate-component-not-main-head! shape file page libraries) - (validate-component-not-root! shape file page) - (validate-component-ref! shape file page libraries) + (check-component-not-main-head shape file page libraries) + (check-component-not-root shape file page) + (check-component-ref shape file page libraries) (doseq [child-id (:shapes shape)] - (validate-shape! child-id file page libraries :context :copy-nested))) + (check-shape child-id file page libraries :context :copy-nested))) -(defn validate-shape-main-not-root! +(defn- check-shape-main-not-root "Not-root shape of a main instance (not any attribute)" [shape file page libraries] - (validate-component-not-main-not-head! shape file page) - (validate-component-not-root! shape file page) - (validate-component-not-ref! shape file page) + (check-component-not-main-not-head shape file page) + (check-component-not-root shape file page) + (check-component-not-ref shape file page) (doseq [child-id (:shapes shape)] - (validate-shape! child-id file page libraries :context :main-any))) + (check-shape child-id file page libraries :context :main-any))) -(defn validate-shape-copy-not-root! +(defn- check-shape-copy-not-root "Not-root shape of a copy instance :shape-ref" [shape file page libraries] - (validate-component-not-main-not-head! shape file page) - (validate-component-not-root! shape file page) - (validate-component-ref! shape file page libraries) + (check-component-not-main-not-head shape file page) + (check-component-not-root shape file page) + (check-component-ref shape file page libraries) (doseq [child-id (:shapes shape)] - (validate-shape! child-id file page libraries :context :copy-any))) + (check-shape child-id file page libraries :context :copy-any))) -(defn validate-shape-not-component! +(defn- check-shape-not-component "Shape is not in a component or is a fostered children (not any attribute)" [shape file page libraries] - (validate-component-not-main-not-head! shape file page) - (validate-component-not-root! shape file page) - (validate-component-not-ref! shape file page) + (check-component-not-main-not-head shape file page) + (check-component-not-root shape file page) + (check-component-not-ref shape file page) (doseq [child-id (:shapes shape)] - (validate-shape! child-id file page libraries :context :not-component))) + (check-shape child-id file page libraries :context :not-component))) -(defn validate-shape! +(defn- check-shape "Validate referential integrity and semantic coherence of a shape and all its children. Report all errors found. @@ -366,132 +367,140 @@ (let [shape (ctst/get-shape page shape-id)] (when (some? shape) (do - (validate-geometry! shape file page) - (validate-parent-children! shape file page) - (validate-frame! shape file page) + (check-geometry shape file page) + (check-parent-children shape file page) + (check-frame shape file page) (if (ctk/instance-head? shape) (if (not= :frame (:type shape)) - (report-error! :instance-head-not-frame - "Instance head should be a frame" - shape file page) + (report-error :instance-head-not-frame + "Instance head should be a frame" + shape file page) (if (ctk/instance-root? shape) (if (ctk/main-instance? shape) (if (not= context :not-component) - (report-error! :root-main-not-allowed - "Root main component not allowed inside other component" - shape file page) - (validate-shape-main-root-top! shape file page libraries)) + (report-error :root-main-not-allowed + "Root main component not allowed inside other component" + shape file page) + (check-shape-main-root-top shape file page libraries)) (if (not= context :not-component) - (report-error! :root-copy-not-allowed - "Root copy component not allowed inside other component" - shape file page) - (validate-shape-copy-root-top! shape file page libraries))) + (report-error :root-copy-not-allowed + "Root copy component not allowed inside other component" + shape file page) + (check-shape-copy-root-top shape file page libraries))) (if (ctk/main-instance? shape) (if (= context :not-component) - (report-error! :nested-main-not-allowed - "Nested main component only allowed inside other component" - shape file page) - (validate-shape-main-root-nested! shape file page libraries)) + (report-error :nested-main-not-allowed + "Nested main component only allowed inside other component" + shape file page) + (check-shape-main-root-nested shape file page libraries)) (if (= context :not-component) - (report-error! :nested-copy-not-allowed - "Nested copy component only allowed inside other component" - shape file page) - (validate-shape-copy-root-nested! shape file page libraries))))) + (report-error :nested-copy-not-allowed + "Nested copy component only allowed inside other component" + shape file page) + (check-shape-copy-root-nested shape file page libraries))))) (if (ctk/in-component-copy? shape) (if-not (#{:copy-top :copy-nested :copy-any} context) - (report-error! :not-head-copy-not-allowed - "Non-root copy only allowed inside a copy" - shape file page) - (validate-shape-copy-not-root! shape file page libraries)) + (report-error :not-head-copy-not-allowed + "Non-root copy only allowed inside a copy" + shape file page) + (check-shape-copy-not-root shape file page libraries)) (if (ctn/inside-component-main? (:objects page) shape) (if-not (#{:main-top :main-nested :main-any} context) - (report-error! :not-head-main-not-allowed - "Non-root main only allowed inside a main component" - shape file page) - (validate-shape-main-not-root! shape file page libraries)) + (report-error :not-head-main-not-allowed + "Non-root main only allowed inside a main component" + shape file page) + (check-shape-main-not-root shape file page libraries)) (if (#{:main-top :main-nested :main-any} context) - (report-error! :not-component-not-allowed - "Not compoments are not allowed inside a main" - shape file page) - (validate-shape-not-component! shape file page libraries))))))))) + (report-error :not-component-not-allowed + "Not compoments are not allowed inside a main" + shape file page) + (check-shape-not-component shape file page libraries))))))))) + +(defn- check-component + "Validate semantic coherence of a component. Report all errors found." + [component file] + (when (and (contains? component :objects) (nil? (:objects component))) + (report-error :component-nil-objects-not-allowed + "Objects list cannot be nil" + component file nil))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; PUBLIC API: VALIDATION FUNCTIONS +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defn validate-file + "Validate full referential integrity and semantic coherence on file data. + + Return a list of errors or `nil`" + [{:keys [data features] :as file} libraries] + (when (contains? features "components/v2") + (binding [*errors* (volatile! [])] + (doseq [page (filter :id (ctpl/pages-seq data))] + (let [orphans (->> page + :objects + vals + (filter #(not (contains? (:objects page) (:parent-id %)))) + (map :id))] + (check-shape uuid/zero file page libraries) + (doseq [shape-id orphans] + (check-shape shape-id file page libraries)))) + + (doseq [component (vals (:components data))] + (check-component component file)) + + (-> *errors* deref not-empty)))) + (defn validate-shape "Validate a shape and all its children. Returns a list of errors." [shape-id file page libraries] (binding [*errors* (volatile! [])] - (validate-shape! shape-id file page libraries) + (check-shape shape-id file page libraries) (deref *errors*))) -(defn validate-component! - "Validate semantic coherence of a component. Report all errors found." - [component file] - (when (and (contains? component :objects) (nil? (:objects component))) - (report-error! :component-nil-objects-not-allowed - "Objects list cannot be nil" - component file nil))) - (defn validate-component "Validate a component. Returns a list of errors." [component file] (binding [*errors* (volatile! [])] - (validate-component! component file) + (check-component component file) (deref *errors*))) -(def valid-fdata? +(def ^:private valid-fdata? "Structural validation of file data using defined schema" (sm/lazy-validator ::ctf/data)) -(def get-fdata-explain +(def ^:private get-fdata-explain "Get schema explain data for file data" (sm/lazy-explainer ::ctf/data)) (defn validate-file-schema! [{:keys [id data] :as file}] (when-not (valid-fdata? data) - (if (some? *errors*) - (vswap! *errors* conj - {:code :invalid-file-data-structure - :hint (str/ffmt "invalid file data structure found on file '%'" id) - :file-id id}) - (ex/raise :type :validation - :code :data-validation - :hint (str/ffmt "invalid file data structure found on file '%'" id) - :file-id id - ::sm/explain (get-fdata-explain data)))) - file) + (ex/raise :type :validation + :code :schema-validation + :hint (str/ffmt "invalid file data structure found on file '%'" id) + :file-id id + ::sm/explain (get-fdata-explain data)))) (defn validate-file! "Validate full referential integrity and semantic coherence on file data. - Raises a validation exception on first error found." - [{:keys [data features] :as file} libraries] - (when (contains? features "components/v2") - (doseq [page (filter :id (ctpl/pages-seq data))] - (let [orphans (->> page - :objects - vals - (filter #(not (contains? (:objects page) (:parent-id %)))) - (map :id))] - (validate-shape! uuid/zero file page libraries) - (doseq [shape-id orphans] - (validate-shape! shape-id file page libraries)))) - - (doseq [component (vals (:components data))] - (validate-component! component file))) - - file) - -(defn validate-file - "Validate structure, referencial integrity and semantic coherence of - all contents of a file. Returns a list of errors." + Raises an exception" [file libraries] - (binding [*errors* (volatile! [])] - (validate-file! file libraries) - (deref *errors*))) + (when-let [errors (validate-file file libraries)] + (ex/raise :type :validation + :code :referential-integrity + :hint "error on validating file referential integrity" + :file-id (:id file) + :details errors))) + + + diff --git a/frontend/src/debug.cljs b/frontend/src/debug.cljs index 6b421cb99..a3132c9ae 100644 --- a/frontend/src/debug.cljs +++ b/frontend/src/debug.cljs @@ -385,7 +385,7 @@ libraries (get @st/state :workspace-libraries)] (try - (->> (if shape-id + (->> (if-let [shape-id (some-> shape-id parse-uuid)] (let [page (dm/get-in file [:data :pages-index (get @st/state :current-page-id)])] (cfv/validate-shape (uuid shape-id) file page libraries)) (cfv/validate-file file libraries)) @@ -404,36 +404,39 @@ (errors/print-error! cause)))) (defn ^:export repair - [] - (let [file (assoc (get @st/state :workspace-file) - :data (get @st/state :workspace-data)) - libraries (get @st/state :workspace-libraries) - errors (cfv/validate-file file libraries)] + [reload?] + (st/emit! + (ptk/reify ::repair-current-file + ptk/EffectEvent + (effect [_ state _] + (let [features (features/get-team-enabled-features state) + sid (:session-id state) - (l/dbg :hint "repair current file" :errors (count errors)) + file (get state :workspace-file) + fdata (get state :workspace-data) - (st/emit! - (ptk/reify ::repair-current-file - ptk/WatchEvent - (watch [_ state _] - (let [features (features/get-team-enabled-features state) - sid (:session-id state) - file (get state :workspace-file) - file-data (get state :workspace-data) - libraries (get state :workspace-libraries) + file (assoc file :data fdata) + libs (get state :workspace-libraries) - changes (-> (cfr/repair-file file-data libraries errors) - (get :redo-changes)) + errors (cfv/validate-file file libs) + _ (l/dbg :hint "repair current file" :errors (count errors)) - params {:id (:id file) - :revn (:revn file) - :session-id sid - :changes changes - :features features - :skip-validate true}] + changes (cfr/repair-file file libs errors) - (->> (rp/cmd! :update-file params) - (rx/tap #(dom/reload-current-window))))))))) + params {:id (:id file) + :revn (:revn file) + :session-id sid + :changes changes + :features features + :skip-validate true}] + + + (->> (rp/cmd! :update-file params) + (rx/subs (fn [_] + (when reload? + (dom/reload-current-window))) + (fn [cause] + (errors/print-error! cause))))))))) (defn ^:export fix-orphan-shapes []