penpot/frontend/src/app/main/data/tokens.cljs

;; 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.tokens
  (:require
   [app.common.data :as d]
   [app.common.data.macros :as dm]
   [app.common.files.changes-builder :as pcb]
   [app.common.geom.point :as gpt]
   [app.common.types.shape :as cts]
   [app.common.uuid :as uuid]
   [app.main.data.changes :as dch]
   [app.main.data.workspace.shapes :as dwsh]
   [app.main.refs :as refs]
   [app.main.ui.workspace.tokens.common :refer [workspace-shapes]]
   [app.main.ui.workspace.tokens.token :as wtt]
   [beicon.v2.core :as rx]
   [clojure.data :as data]
   [cuerdas.core :as str]
   [potok.v2.core :as ptk]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; TODO HYMA: Copied over from workspace.cljs
(defn update-shape
  [id attrs]
  (dm/assert!
   "expected valid parameters"
   (and (cts/check-shape-attrs! attrs)
        (uuid? id)))

  (ptk/reify ::update-shape
    ptk/WatchEvent
    (watch [_ _ _]
      (rx/of (dwsh/update-shapes [id] #(merge % attrs))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TOKENS Actions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn toggle-or-apply-token
  "Remove any shape attributes from token if they exists.
  Othewise apply token attributes."
  [shape token]
  (let [[shape-leftover token-leftover _matching] (data/diff (:applied-tokens shape) token)]
    (merge {} shape-leftover token-leftover)))

(defn get-shape-from-state [shape-id state]
  (let [current-page-id (get state :current-page-id)
        shape (-> (workspace-shapes (:workspace-data state) current-page-id #{shape-id})
                  (first))]
    shape))

(defn token-from-attributes [token attributes]
  (->> (map (fn [attr] [attr (wtt/token-identifier token)]) attributes)
       (into {})))

(defn unapply-token-id [shape attributes]
  (update shape :applied-tokens d/without-keys attributes))

(defn apply-token-to-attributes [{:keys [shape token attributes]}]
  (let [token (token-from-attributes token attributes)]
    (toggle-or-apply-token shape token)))

(defn apply-token-to-shape
  [{:keys [shape token attributes] :as _props}]
  (let [applied-tokens (apply-token-to-attributes {:shape shape
                                                   :token token
                                                   :attributes attributes})]
    (update shape :applied-tokens #(merge % applied-tokens))))

(defn maybe-apply-token-to-shape
  "When the passed `:token` is non-nil apply it to the `:applied-tokens` on a shape."
  [{:keys [shape token _attributes] :as props}]
  (if token
    (apply-token-to-shape props)
    shape))

(defn get-token-data-from-token-id
  [id]
  (let [workspace-data (deref refs/workspace-data)]
    (get (:tokens workspace-data) id)))

(defn update-create-token
  [token]
  (let [token (update token :id #(or % (uuid/next)))]
    (ptk/reify ::add-token
      ptk/WatchEvent
      (watch [it _ _]
        (let [prev-token (get-token-data-from-token-id (:id token))
              changes (if prev-token
                        (-> (pcb/empty-changes it)
                            (pcb/update-token token prev-token))
                        (-> (pcb/empty-changes it)
                            (pcb/add-token token)))]
          (rx/of (dch/commit-changes changes)))))))

(defn delete-token
  [id]
  (dm/assert! (uuid? id))
  (ptk/reify ::delete-token
    ptk/WatchEvent
    (watch [it state _]
      (let [data    (get state :workspace-data)
            changes (-> (pcb/empty-changes it)
                        (pcb/with-library-data data)
                        (pcb/delete-token id))]
        (rx/of (dch/commit-changes changes))))))

(defn duplicate-token
  [id]
  (let [new-token (-> (get-token-data-from-token-id id)
                      (dissoc :id)
                      (update :name #(str/concat % "-copy")))]
    (update-create-token new-token)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TEMP (Move to test)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(comment
  (def shape-1 {:r3 3})

  (def token-1 {:rx 1
                :ry 1})


  (def shape-after-token-1-is-applied {:rx 1
                                       :ry 1
                                       :r3 3})

  (def token-2 {:r3 1})


  (def shape-after-token-2-is-applied {:rx 1
                                       :ry 1
                                       :r3 1})

  (def token-3 {:r3 1})

  (def shape-after-token-3-is-applied {:rx 1
                                       :ry 1})

  (= (toggle-or-apply-token shape-1 token-1)
     shape-after-token-1-is-applied)
  (= (toggle-or-apply-token shape-after-token-1-is-applied token-2)
     shape-after-token-2-is-applied)
  (= (toggle-or-apply-token shape-after-token-2-is-applied token-3)
     shape-after-token-3-is-applied)
  nil)

(defn set-token-type-section-open
  [token-type open?]
  (ptk/reify ::set-token-type-section-open
    ptk/UpdateEvent
    (update [_ state]
      (assoc-in state [:workspace-tokens :open-status token-type] open?))))

;; Token Context Menu Functions -------------------------------------------------

(defn show-token-context-menu
  [{:keys [position token-id] :as params}]
  (dm/assert! (gpt/point? position))
  (ptk/reify ::show-token-context-menu
    ptk/UpdateEvent
    (update [_ state]
      (assoc-in state [:workspace-local :token-context-menu] params))))

(def hide-token-context-menu
  (ptk/reify ::hide-token-context-menu
    ptk/UpdateEvent
    (update [_ state]
      (assoc-in state [:workspace-local :token-context-menu] nil))))