mirror of
https://github.com/penpot/penpot.git
synced 2026-09-16 17:06:17 +00:00
f64b68b6cd
Compare the mirrored href against the path-relative current location so the no-op guard actually skips unchanged URLs. Read context ids through get-query-param so repeated keys resolve to the last value. Cover the navigated effect with stubbed-globals tests (write on change, skip when mirrored, strip stale context) and surface enable-link-preview in the configuration flags list. AI-assisted-by: muse-spark-1.3-contributor Signed-off-by: Andrey Antukh <niwi@niwi.nz>
286 lines
8.5 KiB
Clojure
286 lines
8.5 KiB
Clojure
;; 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.router
|
|
(:refer-clojure :exclude [resolve])
|
|
(:require
|
|
[app.common.data.macros :as dm]
|
|
[app.common.uri :as u]
|
|
[app.config :as cf]
|
|
[app.main.data.event :as ev]
|
|
[app.util.browser-history :as bhistory]
|
|
[app.util.dom :as dom]
|
|
[app.util.globals :as globals]
|
|
[app.util.timers :as ts]
|
|
[beicon.v2.core :as rx]
|
|
[cuerdas.core :as str]
|
|
[goog.events :as e]
|
|
[potok.v2.core :as ptk]
|
|
[reitit.core :as r]))
|
|
|
|
;; --- Router API
|
|
|
|
(defn map->Match
|
|
[data]
|
|
(r/map->Match data))
|
|
|
|
(defn resolve
|
|
([router id]
|
|
(resolve router id {}))
|
|
([router id params]
|
|
(when router
|
|
(when-let [match (r/match-by-name router id)]
|
|
(r/match->path match params)))))
|
|
|
|
(defn create
|
|
[routes]
|
|
(r/router routes))
|
|
|
|
(defn initialize-router
|
|
[routes]
|
|
(ptk/reify ::initialize-router
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc state :router (create routes)))))
|
|
|
|
(defn encode-url
|
|
[url]
|
|
(js/encodeURIComponent url))
|
|
|
|
(defn match
|
|
"Given routing tree and current path, return match with possibly
|
|
coerced parameters. Return nil if no match found."
|
|
[router path]
|
|
(let [uri (u/uri path)]
|
|
(when-let [match (r/match-by-path router (:path uri))]
|
|
(let [query-params (u/query-string->map (:query uri))
|
|
params {:path (:path-params match)
|
|
:query query-params}]
|
|
(-> match
|
|
(assoc :params params)
|
|
(assoc :query-params query-params))))))
|
|
|
|
;; --- Navigate (Event)
|
|
|
|
(defn get-query-param
|
|
"Safely extracts a scalar value for a query param key from a params
|
|
map. When the same key appears multiple times in a URL,
|
|
query-string->map returns a vector for that key; this function
|
|
always returns a single (last) element in that case, so downstream
|
|
consumers such as parse-long always receive a plain string or nil."
|
|
[params k]
|
|
(let [v (get params k)]
|
|
(if (sequential? v) (peek v) v)))
|
|
|
|
(defn match->context-params
|
|
"Extract the params that give sharing context to the current URL.
|
|
|
|
They are mirrored on the query string (before the fragment) because
|
|
the fragment is never sent to the server; this way shared links
|
|
carry enough context for rendering link preview metadata."
|
|
[match]
|
|
(let [path-params (dm/get-in match [:params :path])
|
|
query-params (get match :query-params)
|
|
file-id (or (get-query-param query-params :file-id)
|
|
(get-query-param path-params :file-id))
|
|
team-id (or (get-query-param query-params :team-id)
|
|
(get-query-param path-params :team-id))
|
|
project-id (or (get-query-param query-params :project-id)
|
|
(get-query-param path-params :project-id))]
|
|
(cond
|
|
(some? file-id) {:file-id file-id}
|
|
(some? project-id) {:team-id team-id :project-id project-id}
|
|
(some? team-id) {:team-id team-id})))
|
|
|
|
(defn navigated
|
|
[match send-event-info?]
|
|
(ptk/reify ::navigated
|
|
IDeref
|
|
(-deref [_] match)
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(when send-event-info?
|
|
(let [route (dm/get-in match [:data :name])
|
|
params (get match :query-params)]
|
|
(rx/of (ev/event
|
|
(assoc params
|
|
::ev/name "navigate"
|
|
:route (name route)))))))
|
|
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(-> state
|
|
(assoc :route match)
|
|
(dissoc :exception)))
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
(let [query (some-> (match->context-params match)
|
|
(u/map->query-string))
|
|
href (dm/str (.-pathname globals/location)
|
|
(if (some? query) (dm/str "?" query) "")
|
|
(.-hash globals/location))
|
|
current (dm/str (.-pathname globals/location)
|
|
(.-search globals/location)
|
|
(.-hash globals/location))]
|
|
;; The pre-fragment query string is owned by this mirroring: skip
|
|
;; the write when nothing changed to avoid URL churn and dropping
|
|
;; unrelated params set by other code. Both sides are path-relative.
|
|
(when (not= href current)
|
|
(.replaceState js/history nil "" href))))))
|
|
|
|
(defn navigate
|
|
[id params & {:keys [::replace ::new-window] :as options}]
|
|
(ptk/reify ::navigate
|
|
IDeref
|
|
(-deref [_]
|
|
{:id id
|
|
:params params
|
|
:options options})
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ state _]
|
|
(let [router (:router state)
|
|
history (:history state)
|
|
path (resolve router id params)]
|
|
|
|
(if ^boolean new-window
|
|
(let [name (or (::window-name options) "_blank")
|
|
uri (assoc cf/public-uri :fragment path)]
|
|
(dom/open-new-window uri name nil))
|
|
(ts/asap
|
|
#(if ^boolean replace
|
|
(bhistory/replace-token! history path)
|
|
(bhistory/set-token! history path))))))))
|
|
|
|
(defn assign-exception
|
|
[error]
|
|
(ptk/reify ::assign-exception
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(if (nil? error)
|
|
(dissoc state :exception)
|
|
(assoc state :exception error)))))
|
|
|
|
(defn nav
|
|
([id] (navigate id nil))
|
|
([id params] (navigate id params))
|
|
([id params & {:as options}]
|
|
(navigate id params options)))
|
|
|
|
(defn lookup-name
|
|
[state]
|
|
(dm/get-in state [:route :data :name]))
|
|
|
|
;; FIXME: rename to lookup-params
|
|
(defn get-params
|
|
[state]
|
|
(dm/get-in state [:route :params :query]))
|
|
|
|
(defn nav-back
|
|
[]
|
|
(ptk/reify ::nav-back
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
(ts/asap dom/browser-back))))
|
|
|
|
(defn nav-back-local
|
|
"Navigate back only if the previous page is in penpot app."
|
|
[]
|
|
(let [location (.-location js/document)
|
|
referrer (u/uri (.-referrer js/document))]
|
|
(when (or (nil? (:host referrer))
|
|
(= (.-hostname location) (:host referrer)))
|
|
(nav-back))))
|
|
|
|
(defn nav-root
|
|
"Navigate to the root page."
|
|
[]
|
|
(ptk/reify ::nav-root
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
(set! (.-href globals/location) "/"))))
|
|
|
|
(defn reload
|
|
[force?]
|
|
(ptk/reify ::reload
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
(ts/asap (partial dom/reload-current-window force?)))))
|
|
|
|
(defn nav-raw
|
|
[& {:keys [href uri]}]
|
|
(ptk/reify ::nav-raw
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
(cond
|
|
(string? uri)
|
|
(.replace globals/location uri)
|
|
|
|
(string? href)
|
|
(set! (.-href globals/location) href)))))
|
|
|
|
(defn get-current-href
|
|
[]
|
|
(.-href globals/location))
|
|
|
|
(defn get-current-path
|
|
[]
|
|
(let [hash (.-hash globals/location)]
|
|
(if (str/starts-with? hash "#")
|
|
(subs hash 1)
|
|
hash)))
|
|
|
|
|
|
;; --- History API
|
|
|
|
;; Check the urls to see if we need to send the navigated event.
|
|
;; If two paths are the same we only send the event when there is a
|
|
;; change in the parameters `file-id`, `page-id` or `team-id`
|
|
(defn- send-event-info?
|
|
[old-url new-url]
|
|
(let [params [:file-id :page-id :team-id]
|
|
new-uri (u/uri new-url)
|
|
new-path (:path new-uri)
|
|
new-params (-> new-uri :query u/query-string->map (select-keys params))
|
|
old-uri (u/uri old-url)
|
|
old-path (:path old-uri)
|
|
old-params (-> old-uri :query u/query-string->map (select-keys params))]
|
|
(or (not= old-path new-path)
|
|
(not= new-params old-params))))
|
|
|
|
(defn initialize-history
|
|
[on-change]
|
|
(ptk/reify ::initialize-history
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [history (bhistory/create)]
|
|
(bhistory/enable! history)
|
|
(assoc state :history history)))
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ state stream]
|
|
(let [stopper (rx/filter (ptk/type? ::initialize-history) stream)
|
|
history (:history state)
|
|
router (:router state)]
|
|
(ts/schedule #(on-change router (.getToken ^js history) true))
|
|
(->> (rx/concat
|
|
(rx/of nil nil)
|
|
(rx/create
|
|
(fn [subs]
|
|
(let [key (e/listen history "navigate" (fn [o] (rx/push! subs (.-token ^js o))))]
|
|
(fn []
|
|
(bhistory/disable! history)
|
|
(e/unlistenByKey key))))))
|
|
(rx/buffer 2 1)
|
|
(rx/take-until stopper)
|
|
(rx/subs!
|
|
(fn [[old-url new-url]]
|
|
(when (some? new-url)
|
|
(let [send? (or (nil? old-url) (send-event-info? old-url new-url))]
|
|
(on-change router new-url send?))))))))))
|