penpot/common/test/common_tests/helpers/files.cljc

;; 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 common-tests.helpers.files
  (:require
   [app.common.data :as d]
   [app.common.features :as ffeat]
   [app.common.files.changes :as cfc]
   [app.common.files.validate :as cfv]
   [app.common.pprint :refer [pprint]]
   [app.common.types.component :as ctk]
   [app.common.types.file :as ctf]
   [app.common.types.page :as ctp]
   [app.common.types.pages-list :as ctpl]
   [app.common.uuid :as uuid]
   [common-tests.helpers.ids-map :as thi]
   [cuerdas.core :as str]))

;; ----- Files

(defn sample-file
  [label & {:keys [page-label name] :as params}]
  (binding [ffeat/*current* #{"components/v2"}]
    (let [params (cond-> params
                   label
                   (assoc :id (thi/new-id! label))

                   page-label
                   (assoc :page-id (thi/new-id! page-label))

                   (nil? name)
                   (assoc :name "Test file"))

          file (-> (ctf/make-file (dissoc params :page-label))
                   (assoc :features #{"components/v2"}))

          page (-> file
                   :data
                   (ctpl/pages-seq)
                   (first))]

      (with-meta file
        {:current-page-id (:id page)}))))

(defn validate-file!
  ([file] (validate-file! file {}))
  ([file libraries]
   (cfv/validate-file-schema! file)
   (cfv/validate-file! file libraries)))

(defn apply-changes
  [file changes]
  (let [file' (ctf/update-file-data file #(cfc/process-changes % (:redo-changes changes) true))]
    (validate-file! file')
    file'))

;; ----- Pages

(defn sample-page
  [label & {:keys [] :as params}]
  (ctp/make-empty-page (assoc params :id (thi/new-id! label))))

(defn add-sample-page
  [file label & {:keys [] :as params}]
  (let [page (sample-page label params)]
    (-> file
        (ctf/update-file-data #(ctpl/add-page % page))
        (vary-meta assoc :current-page-id (:id page)))))

(defn get-page
  [file label]
  (ctpl/get-page (:data file) (thi/id label)))

(defn current-page-id
  [file]
  (:current-page-id (meta file)))

(defn current-page
  [file]
  (ctpl/get-page (:data file) (current-page-id file)))

(defn switch-to-page
  [file label]
  (vary-meta file assoc :current-page-id (thi/id label)))

;; ----- Debug

(defn dump-tree
  "Dump a file using dump-tree function in common.types.file."
  [file & {:keys [page-label libraries] :as params}]
  (let [params    (-> params
                      (or {:show-ids true :show-touched true})
                      (dissoc page-label libraries))
        page      (if (some? page-label)
                    (:id (get-page file page-label))
                    (current-page-id file))
        libraries (or libraries {})]

    (ctf/dump-tree file page libraries params)))

(defn pprint-file
  "Pretry print a file trying to limit the quantity of info shown."
  [file & {:keys [level length] :or {level 10 length 1000}}]
  (pprint file {:level level :length length}))

(defn dump-shape
  "Dump a shape, with each attribute in a line."
  [shape]
  (println "{")
  (doseq [[k v] (sort shape)]
    (when (some? v)
      (println (str "    " k " : " v))))
  (println "}"))

(defn- stringify-keys [m keys]
  (let [kv (-> (select-keys m keys)
               (assoc :swap-slot (when ((set keys) :swap-slot)
                                   (ctk/get-swap-slot m)))
               (assoc :swap-slot-label (when ((set keys) :swap-slot-label)
                                         (when-let [slot (ctk/get-swap-slot m)]
                                           (thi/label slot))))
               (d/without-nils))

        pretty-uuid (fn [id]
                      (let [id (str id)]
                        (str "#" (subs id (- (count id) 6)))))

        format-kv (fn [[k v]]
                    (cond
                      (uuid? v)
                      (str k " " (pretty-uuid v))

                      :else
                      (str k " " v)))]

    (when (seq kv)
      (str " [" (apply str (interpose ", " (map format-kv kv))) "]"))))

(defn- dump-page-shape
  [shape keys padding show-refs?]
  (println (str/pad (str padding
                         (when (and (:main-instance shape) show-refs?) "{")
                         (thi/label (:id shape))
                         (when (and (:main-instance shape) show-refs?) "}")
                         (when (seq keys)
                           (stringify-keys shape keys)))
                    {:length 50 :type :right})
           (if (nil? (:shape-ref shape))
             (if (and (:component-root shape) show-refs?)
               (str "# [Component " (thi/label (:component-id shape)) "]")
               "")
             (if show-refs?
               (str/format "%s--> %s%s"
                           (cond (:component-root shape) "#"
                                 (:component-id shape) "@"
                                 :else "-")
                           (if (:component-root shape)
                             (str "[Component " (thi/label (:component-id shape)) "] ")
                             "")
                           (thi/label (:shape-ref shape)))
               ""))))

(defn dump-page
  "Dump the layer tree of the page, showing labels of the shapes.
    - keys: a list of attributes of the shapes you want to show. In addition, you
            can add :swap-slot to show the slot id (if any) or :swap-slot-label
            to show the corresponding label.
    - show-refs?: if true, the component references will be shown."
  [page & {:keys [keys root-id padding show-refs?]
           :or {keys [:name :swap-slot-label] root-id uuid/zero padding "" show-refs? true}}]
  (let [lookupf (d/getf (:objects page))
        root-shape (lookupf root-id)
        shapes (map lookupf (:shapes root-shape))]
    (doseq [shape shapes]
      (dump-page-shape shape keys padding show-refs?)
      (dump-page page
                 :keys keys
                 :root-id (:id shape)
                 :padding (str padding "    ")
                 :show-refs? show-refs?))))

(defn dump-file
  "Dump the current page of the file, using dump-page above.
   Example: (thf/dump-file file :keys [:name :swap-slot-label] :show-refs? false)"
  [file & {:keys [] :as params}]
  (dump-page (current-page file) params))