penpot/frontend/src/app/main/refs.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 SUBSIDIARY SL

(ns app.main.refs
  "A collection of derived refs."
  (:require
   [app.common.data :as d]
   [app.common.data.macros :as dm]
   [app.common.files.helpers :as cph]
   [app.common.files.tokens :as cfo]
   [app.common.types.shape-tree :as ctt]
   [app.common.types.shape.layout :as ctl]
   [app.common.types.tokens-lib :as ctob]
   [app.common.types.tokens-status :as ctos]
   [app.config :as cf]
   [app.main.data.helpers :as dsh]
   [app.main.data.workspace.tokens.selected-set :as dwts]
   [app.main.store :as st]
   [app.main.streams :as ms]
   [beicon.v2.core :as rx]
   [clojure.string :as str]
   [okulary.core :as l]))

;; ---- Global refs

(def route
  (l/derived (l/key :route) st/state))

(def router
  (l/derived (l/key :router) st/state))

(def profile
  (l/derived (l/key :profile) st/state))

(def custom-shortcuts
  (l/derived (fn [state] (get-in state [:profile :props :custom-shortcuts])) st/state))

(def current-page-id
  (l/derived (l/key :current-page-id) st/state))

(def branch-context
  ;; the state entry is {:file-id .. :loaded? .. :info <row-or-nil>};
  ;; consumers only care about the branch row itself
  (l/derived #(get-in % [:workspace-branch-context :info]) st/state))

(def pull-requests
  (l/derived :workspace-pull-requests st/state))

(def pull-request-preview
  ;; active review context: {:pr-id .. :status .. :info <pr-row>}; the
  ;; open file is the live branch, opened normally — this only drives
  ;; the review banner/actions. nil when no review is active.
  (l/derived #(get % :workspace-pr-preview) st/state))

(def pending-reviews
  ;; dashboard: open pull requests awaiting the current profile's review
  (l/derived #(get % :dashboard-pending-reviews) st/state))

(def fetch-failures
  ;; dashboard: fetches that timed out or failed, keyed by fetch event;
  ;; non-empty while the placeholder waits for data it will not get
  (l/derived #(get % :dashboard-fetch-failures) st/state))

(def team
  (l/derived dsh/lookup-team st/state))

(def project
  (l/derived (fn [state]
               (let [project-id (:current-project-id state)
                     projects   (:projects state)]
                 (get projects project-id)))
             st/state))

(defn- open-closed-branch?
  "True when the open file is a merged or an archived branch. A merged
  branch has its work in main, and an archived one is set aside until it
  is restored or turned into an ordinary file: both open read-only."
  [state]
  (let [ctx (:workspace-branch-context state)]
    (and (contains? #{"merged" "archived"} (get-in ctx [:info :status]))
         (= (:file-id ctx) (:current-file-id state)))))

(def permissions
  "The team permissions, without edition on a merged or archived branch."
  (l/derived (fn [state]
               (cond-> (:permissions (dsh/lookup-team state))
                 (open-closed-branch? state)
                 (assoc :can-edit false)))
             st/state))

(def teams
  (l/derived (l/key :teams) st/state))

(def exception
  (l/derived :exception st/state))

(def threads
  (l/derived :comment-threads st/state))

(def share-links
  (l/derived :share-links st/state))

(def export
  (l/derived :export st/state))

(def persistence
  (l/derived :persistence st/state))

(def projects
  (l/derived :projects st/state))

(def files
  (l/derived :files st/state))

(def file
  (l/derived (fn [state]
               (let [file-id (:current-file-id state)
                     files   (:files state)]
                 (get files file-id)))
             st/state))

(def shared-files
  "A derived state that points to the current list of shared
  files (without the content, only summary)"
  (l/derived :shared-files st/state))

(defn select-libraries
  "Find between all the given files, those who are libraries of the file-id.
   Also include the file-id file itself.
   Return a map of id -> library."
  [files file-id]
  (persistent!
   (reduce-kv (fn [result id file]
                (if (or (= id file-id)
                        (= (:library-of file) file-id))
                  (assoc! result id file)
                  result))
              (transient {})
              files)))

;; NOTE: for performance reasons, prefer derefing refs/files and then
;; use with-memo mechanism with `select-libraries` this will avoid
;; executing the select-libraries reduce-kv on each state change and
;; only execute it when files are changed. This ref exists for
;; backward compatibility with the code, but it is considered
;; DEPRECATED and all new code should not use it and old code should
;; be gradually migrated to more efficient approach
(def libraries
  "A derived state that contains the currently loaded shared
  libraries with all its content; including the current file"
  (l/derived (fn [state]
               (let [files   (get state :files)
                     file-id (get state :current-file-id)]
                 (select-libraries files file-id)))
             st/state))

(defn extract-selected-files
  [files selected]
  (let [get-file #(get files %)
        sim-file #(select-keys % [:id :name :project-id :is-shared])
        xform    (comp (keep get-file)
                       (map sim-file))]
    (->> (sequence xform selected)
         (d/index-by :id))))

(def selected-files
  (l/derived (fn [state]
               (let [selected (get state :selected-files)
                     files    (get state :files)]
                 (extract-selected-files files selected)))
             st/state))

(def selected-project
  (l/derived :selected-project st/state))

(def dashboard-local
  (l/derived :dashboard-local st/state))

(def render-state
  (l/derived :render-state st/state))

(def render-context-lost?
  (l/derived :lost render-state))

(def workspace-local
  (l/derived :workspace-local st/state))

(def stroke-per-side
  "Per-stroke expansion state of the design tab per-side controls, keyed by
  `[ids index]`. This is ephemeral UI state: it survives shape and page
  switches during the session but resets on reload."
  (l/derived (fn [state] (get-in state [:workspace-local :stroke-per-side])) st/state))

(def workspace-global
  (l/derived :workspace-global st/state))

(def mcp
  (l/derived :mcp st/state))

(def workspace-drawing
  (l/derived :workspace-drawing st/state))

(def workspace-tokens
  "All tokens related ephimeral state"
  (l/derived :workspace-tokens st/state))

(def workspace-selrect
  (let [a (atom nil)]
    (rx/sub! ms/workspace-selrect #(reset! a %))
    a))

;; WARNING: Don't use directly from components, this is a proxy to
;; improve performance of selected-shapes and
(def ^:private selected-shapes-data
  (l/derived
   (fn [state]
     (let [objects  (dsh/lookup-page-objects state)
           selected (dm/get-in state [:workspace-local :selected])]
       {:objects objects :selected selected}))
   st/state
   (fn [v1 v2]
     (and (identical? (:objects v1) (:objects v2))
          (= (:selected v1) (:selected v2))))))

(def selected-shapes
  (l/derived
   (fn [{:keys [objects selected]}]
     (dsh/process-selected objects selected))
   selected-shapes-data =))

(defn make-selected-ref
  [id]
  (l/derived #(contains? % id) selected-shapes))

(def export-in-progress?
  (l/derived :export-in-progress? export))

(def export-error?
  (l/derived :export-error? export))

(def export-progress
  (l/derived :export-progress export))

(def exports
  (l/derived :exports export))

(def export-detail-visibililty
  (l/derived :export-detail-visibililty export))

(def export-widget-visibililty
  (l/derived :export-widget-visibililty export))

(def export-health
  (l/derived :export-health export))

(def selected-zoom
  (l/derived :zoom workspace-local))

(def selected-drawing-tool
  (l/derived :tool workspace-drawing))

(def current-drawing-shape
  (l/derived :object workspace-drawing))

(def selected-edition
  (l/derived :edition workspace-local))

(def workspace-edit-path
  (l/derived :edit-path workspace-local))

(def current-transform
  (l/derived :transform workspace-local))

(def options-mode
  (l/derived :options-mode workspace-local))

(def options-mode-global
  (l/derived :options-mode workspace-global))

(def default-font
  (l/derived :default-font workspace-global))

(def inspect-expanded
  (l/derived :inspect-expanded workspace-local))

(def workspace-vport
  (l/derived :vport workspace-local))

(def vbox
  (l/derived :vbox workspace-local))

(def current-hover
  (l/derived :hover workspace-local))

(def context-menu
  (l/derived :context-menu workspace-local))

(def token-context-menu
  (l/derived :token-context-menu workspace-local))

;; page item that it is being edited
(def editing-page-item
  (l/derived :page-item workspace-local))

;; set of pages selected in the sitemap (multi-selection)
(def selected-pages
  (l/derived :selected-pages workspace-local))

(def current-hover-ids
  (l/derived :hover-ids context-menu))

(def workspace-layout
  (l/derived :workspace-layout st/state))

(def snap-pixel?
  (l/derived #(contains? % :snap-pixel-grid) workspace-layout))

(def rulers?
  (l/derived #(contains? % :rulers) workspace-layout))

;; FIXME: rename to current-file-data
(def workspace-data
  "Currently working file data on workspace"
  (l/derived dsh/lookup-file-data st/state))

(def workspace-file-colors
  (l/derived (fn [{:keys [id] :as data}]
               (some-> (:colors data) (update-vals #(assoc % :file-id id))))
             workspace-data
             =))

(def recent-colors
  "Recent colors for the currently selected file"
  (l/derived (fn [state]
               (when-let [file-id (:current-file-id state)]
                 (dm/get-in state [:recent-colors file-id])))
             st/state))

(def recent-fonts
  "Recent fonts for the currently selected file"
  (l/derived (fn [state]
               (when-let [file-id (:current-file-id state)]
                 (dm/get-in state [:recent-fonts file-id])))
             st/state))

(def workspace-file-typography
  (l/derived :typographies workspace-data))

(def workspace-presence
  (l/derived :workspace-presence st/state))

(def workspace-page
  "Ref to currently active page on workspace"
  (l/derived dsh/lookup-page st/state))

(def workspace-page-flows
  (l/derived #(-> % :flows not-empty) workspace-page))

(def workspace-page-guides
  (l/derived :guides workspace-page))

(defn workspace-page-object-by-id
  [page-id shape-id]
  (l/derived #(dsh/lookup-shape % page-id shape-id) st/state =))

(def workspace-page-objects
  (l/derived dsh/lookup-page-objects st/state identical?))

(def workspace-read-only?
  (l/derived :read-only? workspace-global))

(def workspace-paddings-selected
  (l/derived :paddings-selected workspace-global))

(def workspace-gap-selected
  (l/derived :gap-selected workspace-global))

(def workspace-margins-selected
  (l/derived :margins-selected workspace-global))

(defn object-by-id
  [id]
  (l/derived #(get % id) workspace-page-objects))

(defn objects-by-id
  [ids]
  (l/derived #(into [] (keep (d/getf %)) ids) workspace-page-objects =))

(defn parents-by-ids
  [ids]
  (l/derived
   (fn [objects]
     (let [parent-ids (into #{} (keep #(get-in objects [% :parent-id])) ids)]
       (into [] (keep #(get objects %)) parent-ids)))
   workspace-page-objects =))

(defn shape-parents
  [id]
  (l/derived
   (fn [objects]
     (into []
           (keep (d/getf objects))
           (cph/get-parent-ids objects id)))
   workspace-page-objects =))

(defn children-objects
  [id]
  (l/derived
   (fn [objects]
     (->> (dm/get-in objects [id :shapes])
          (into [] (keep (d/getf objects)))))
   workspace-page-objects =))

(defn all-children-objects
  [id]
  (l/derived
   (fn [objects]
     (let [children-ids (cph/get-children-ids objects id)]
       (into [] (keep (d/getf objects)) children-ids)))
   workspace-page-objects =))

(def workspace-frames
  (l/derived ctt/get-frames workspace-page-objects =))

(def workspace-editor
  (l/derived :workspace-editor st/state))

(def workspace-editor-state
  (l/derived :workspace-editor-state st/state))

(def workspace-v2-editor-state
  (l/derived :workspace-v2-editor-state st/state))

(def workspace-modifiers
  (l/derived :workspace-modifiers st/state))

(def workspace-wasm-editor-styles
  (l/derived :workspace-wasm-editor-styles st/state))

(def workspace-wasm-modifiers
  (let [a (atom nil)]
    (rx/sub! ms/wasm-modifiers #(reset! a %))
    a))

(def ^:private workspace-modifiers-with-objects
  (l/derived
   (fn [state]
     {:modifiers (get state :workspace-modifiers)
      :objects   (dsh/lookup-page-objects state)})
   st/state
   (fn [a b]
     (and (identical? (:modifiers a) (:modifiers b))
          (identical? (:objects a) (:objects b))))))

(def workspace-frame-modifiers
  (l/derived
   (fn [{:keys [modifiers objects]}]
     (reduce (fn [result [id modifiers]]
               (let [shape (get objects id)
                     frame-id (:frame-id shape)]
                 (cond
                   (cph/frame-shape? shape)
                   (assoc-in result [id id] modifiers)

                   (some? frame-id)
                   (assoc-in result [frame-id id] modifiers)

                   :else
                   result)))
             {}
             modifiers))
   workspace-modifiers-with-objects))

(defn workspace-modifiers-by-frame-id
  [frame-id]
  (l/derived #(get % frame-id) workspace-frame-modifiers =))

(def workspace-clipboard-style
  (l/derived :clipboard-style workspace-global))

(defn select-bool-children [id]
  (l/derived #(dsh/select-bool-children % id) st/state =))

(defn is-child-selected?
  [id]
  (l/derived
   (fn [{:keys [selected objects]}]
     (let [children (cph/get-children-ids objects id)]
       (some #(contains? selected %) children)))
   selected-shapes-data
   =))

(def workspace-focus-selected
  (l/derived :workspace-focus-selected st/state))

(defn workspace-get-flex-child
  [ids]
  (l/derived
   (fn [state]
     (let [objects  (dsh/lookup-page-objects state)]
       (into []
             (comp (map (d/getf objects))
                   (filter (partial ctl/flex-layout-immediate-child? objects)))
             ids)))
   st/state =))

;; ---- Token refs

(def tokens-lib
  (l/derived dsh/lookup-tokens-lib st/state))

(def tokens-status
  (l/derived dsh/lookup-tokens-status st/state))

(def workspace-token-theme-groups
  (l/derived (d/nilf ctob/get-theme-groups) tokens-lib))

(defn workspace-token-theme
  [id]
  (l/derived
   (fn [lib]
     (when lib
       (ctob/get-theme lib id)))
   tokens-lib))

(def workspace-token-theme-tree-no-hidden
  (l/derived (fn [lib]
               (or
                (some-> lib
                        (ctob/delete-theme ctob/hidden-theme-id)
                        (ctob/get-theme-tree))
                []))
             tokens-lib))

(def workspace-token-themes
  (l/derived #(or (some-> % ctob/get-themes) []) tokens-lib))

(def workspace-token-themes-no-hidden
  (l/derived #(remove ctob/hidden-theme? %) workspace-token-themes))

(def selected-token-set-id
  (l/derived (l/key :selected-token-set-id) workspace-tokens))

(def workspace-ordered-token-sets
  (l/derived #(or (some-> % ctob/get-sets) []) tokens-lib))

(def workspace-token-sets-tree
  (l/derived (d/nilf ctob/get-set-tree) tokens-lib))

(def workspace-active-theme-ids
  (l/derived (d/nilf ctos/get-active-theme-ids) tokens-status))

(def workspace-all-tokens-map
  (l/derived (d/nilf ctob/get-all-tokens-map) tokens-lib))

;; TODOstatus ver una forma eficiente de hacer un derived de lib y status a la vez
(defn token-sets-at-path-all-active
  [group-path]
  (l/derived
   (fn [status]
     (when status
       (cfo/sets-at-path-all-active? status @(l/derived identity tokens-lib) group-path)))
   tokens-status))

;; FIXME: deprecated, it should not be implemented with ref (still used in form)
(def workspace-active-theme-sets-tokens
  (l/derived (fn [[status lib]]
               (if (and status lib)
                 (cfo/get-tokens-in-active-sets status lib)
                 {}))
             [tokens-status tokens-lib]))

(def workspace-token-in-selected-set
  (fn [token-id]
    (l/derived
     #(dwts/get-token-in-selected-set % token-id)
     st/state)))

(def workspace-all-tokens-in-selected-set
  (l/derived #(or (dwts/get-all-tokens-in-selected-set %) {}) st/state))

(def plugins-permissions-peek
  (l/derived (fn [state]
               (dm/get-in state [:plugins-permissions-peek :data]))
             st/state))

;; ---- Viewer refs

(defn get-viewer-objects
  [state page-id]
  (dm/get-in state [:viewer :pages page-id :objects]))

(defn lookup-viewer-objects-by-id
  [page-id]
  (l/derived #(get-viewer-objects % page-id) st/state =))

(def viewer-data
  (l/derived (l/key :viewer) st/state))

(def viewer-file
  (l/derived :file viewer-data))

(def viewer-thumbnails
  (l/derived :thumbnails viewer-file))

(def viewer-project
  (l/derived :project viewer-data))

(def viewer-state
  (l/derived :viewer st/state))

(def viewer-local
  (l/derived :viewer-local st/state))

(def viewer-overlays
  (l/derived :viewer-overlays st/state))

(def comment-threads
  (l/derived :comment-threads st/state))

(def comments-local
  (l/derived :comments-local st/state))

(def profiles
  (l/derived :profiles st/state))

(def viewer-fullscreen?
  (l/derived (fn [state]
               (dm/get-in state [:viewer-local :fullscreen?]))
             st/state))

(def viewer-zoom-type
  (l/derived (fn [state]
               (dm/get-in state [:viewer-local :zoom-type]))
             st/state))

(defn- resolved-uri?
  "Returns true if the uri is already a fully resolved URI (blob or data)."
  [uri]
  (and (string? uri)
       (or (str/starts-with? uri "blob:")
           (str/starts-with? uri "data:"))))

(defn workspace-thumbnail-by-id
  [object-id]
  (l/derived
   (fn [state]
     (when-let [entry (dm/get-in state [:thumbnails object-id])]
       (cond-> entry
         (and (:uri entry)
              (not (resolved-uri? (:uri entry))))
         (update :uri cf/resolve-media))))
   st/state))

(def workspace-text-modifier
  (l/derived :workspace-text-modifier st/state))

(defn workspace-text-modifier-by-id [id]
  (l/derived #(get % id) workspace-text-modifier =))

(defn is-layout-child?
  [ids]
  (l/derived
   (fn [objects]
     (->> ids
          (map (d/getf objects))
          (some (partial ctl/any-layout-immediate-child? objects))))
   workspace-page-objects))

(defn all-layout-child?
  [ids]
  (l/derived
   (fn [objects]
     (->> ids
          (map (d/getf objects))
          (every? (partial ctl/any-layout-immediate-child? objects))))
   workspace-page-objects =))

(defn flex-layout-child?
  [ids]
  (l/derived
   (fn [objects]
     (->> ids
          (map (d/getf objects))
          (every? (partial ctl/flex-layout-immediate-child? objects))))
   workspace-page-objects =))

(defn grid-layout-child?
  [ids]
  (l/derived
   (fn [objects]
     (->> ids
          (map (d/getf objects))
          (every? (partial ctl/grid-layout-immediate-child? objects))))
   workspace-page-objects =))

(def colorpicker
  (l/derived :colorpicker st/state))

(def workspace-grid-edition
  (l/derived :workspace-grid-edition st/state))

(defn workspace-grid-edition-id
  [id]
  (l/derived #(get % id) workspace-grid-edition))

(def workspace-preview-blend
  (l/derived :workspace-preview-blend st/state))

(defn workspace-preview-blend-by-id [id]
  (l/derived (l/key id) workspace-preview-blend =))

(def specialized-panel
  (l/derived :specialized-panel st/state))

(def updating-library
  (l/derived :updating-library st/state))

(def progress
  (l/derived :progress st/state))

(def access-tokens
  (l/derived :access-tokens st/state))

(def access-token-created
  (l/derived :access-token-created st/state))