Skip to content

Implement route history further. Add support for html5 history. #14

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 2 commits into
base: routing-refactor
Choose a base branch
from
Draft

Implement route history further. Add support for html5 history. #14

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
818db81
Implement route history further. Add support for html5 history.
Mar 20, 2025
34941d9
refactor URI encoding functions and enhance query parameter handling
Mar 21, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
58 changes: 42 additions & 16 deletions src/main/com/fulcrologic/statecharts/integration/fulcro/rad_integration.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@
[com.fulcrologic.fulcro.raw.components :as rc]
[com.fulcrologic.fulcro.ui-state-machines :as uism :refer [defstatemachine]]
[com.fulcrologic.rad.attributes :as attr]
[com.fulcrologic.rad.container :as container]
[com.fulcrologic.rad.form :as form]
[com.fulcrologic.rad.form-options :as fo]
[com.fulcrologic.rad.options-util :refer [?!]]
Expand All @@ -27,27 +28,52 @@

(deftype RadCompatibleRouteHistory [sc-registry sc-hist]
srhist/RouteHistory
(push-route! [_ route] (srhist/push-route! sc-hist route))
(replace-route! [_ route] (srhist/replace-route! sc-hist route))
(recent-history [_] (srhist/recent-history sc-hist))
(-push-route! [history route] (srhist/push-route! route))
(-replace-route! [history route] (srhist/replace-route! route))
(-back! [history] (srhist/back!))
(-current-route [history] (srhist/current-route))
(-recent-history [history] (srhist/recent-history))
rhist/RouteHistory ; route is a vector of strings
(-push-route! [_ route params]
;; Find the route that matches the path
(let [{:route/keys [target]} (uir/state-for-path (scp/get-statechart sc-registry ::uir/chart) route)]
(srhist/push-route! sc-hist {:target target :params params :route-params params})))
(srhist/-push-route! sc-hist {:target target :params params :route-params params})))
(-replace-route! [_ route params]
(let [{:route/keys [target]} (uir/state-for-path (scp/get-statechart sc-registry ::uir/chart) route)]
;; TASK: Double-check that this is the format
(srhist/replace-route! sc-hist {:target target :params params :route-params params})))
(-back! [_] (some->> (srhist/recent-history sc-hist) (second) (srhist/replace-route! sc-hist)))
(srhist/-replace-route! sc-hist {:target target :params params :route-params params})))
(-back! [_] (srhist/-back! sc-hist))
(-undo! [_ new-route params] "not necessary with statecharts")
(-add-route-listener! [_ listener-key f] "not necessary with statecharts")
(-remove-route-listener! [_ listener-key] "not necessary with statecharts")
(-current-route [_]
;; TASK: Reformat this to RAD expected
;; {:route [...]
;; :params {}}
(first (srhist/recent-history sc-hist))))
(-current-route [_] (srhist/-current-route sc-hist)))

(defn target->route
"Find the latest route by the given target. Returns nil if not found."
[target]
(reduce (fn [acc [_ {:keys [id] :as route}]]
(if (= id target)
route
acc))
nil
(srhist/recent-history)))

(defn container-state
"Creates a state whose :route/target is a RAD container. The container will be started on entry, and the :route-params
for the report will be a merge of the current statechart session data with the event data (which has precedence). If
you set `container/param-keys` to a collection of keywords, then the route params will be selected from just those keys.

See `rstate` for generate options for a routed state."
[{:route/keys [target path]
:container/keys [param-keys] :as props}] ; TASK: Ugly duplication of param keys...Yuck. Don't want it. Use report component or don't prune keys
(uir/rstate (merge {} props)
(entry-fn [{:fulcro/keys [app]} data _ event-data]
(log/debug "Starting container")
;; TASK: Restore params (from route history system)
;; Thinking of using (target->route) to get the route params. Not sure this is the correct path.
(container/start-container! app (comp/registry-key->class (:route/target props)) {:route-params (cond-> (merge data event-data)
(seq param-keys) (select-keys param-keys))})
nil)))

(defn report-state
"Creates a state whose :route/target is a RAD report. The report will be started on entry, and the :route-params
Expand All @@ -61,8 +87,8 @@
(entry-fn [{:fulcro/keys [app]} data _ event-data]
(log/debug "Starting report")
;; TASK: Restore params (from route history system)
(report/start-report! app (comp/registry-key->class (:route/target props)) {:route-params (cond-> (merge data event-data)
(seq param-keys) (select-keys param-keys))})
(report/start-report! app (comp/registry-key->class target) {:route-params (cond-> (merge data event-data)
(seq param-keys) (select-keys param-keys))})
nil)))

(defn leave-form
Expand Down Expand Up @@ -334,16 +360,16 @@
The busy detection of UI routing will automatically detect busy for RAD forms.

Leaving this state will ensure the form is abandoned. So, route override will undo the unsaved changes."
[props]
[{:route/keys [target path] :as props}]
(uir/rstate props
(entry-fn [{:fulcro/keys [app]} data _ event-data]
(log/debug "Starting form" event-data)
(let [{:keys [id params]} event-data]
(start-form! app id (comp/registry-key->class (:route/target props)) params))
(start-form! app id (comp/registry-key->class target) params))
nil)
(exit-fn [{:fulcro/keys [app]} {:route/keys [idents]} & _]
;; Make sure if we abandoned the form that we undo the changes
(when-let [form-ident (get idents (rc/class->registry-key (:route/target props)))]
(when-let [form-ident (get idents (rc/class->registry-key target))]
(form/abandon-form! app form-ident)
[(ops/delete [:route/idents form-ident])]))))

Expand Down
85 changes: 80 additions & 5 deletions src/main/com/fulcrologic/statecharts/integration/fulcro/route_history.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,13 @@
(ns com.fulcrologic.statecharts.integration.fulcro.route-history
"ALPHA. This namespace's API is subject to change."
#?(:clj (:import (java.net URLDecoder URLEncoder)
(java.nio.charset StandardCharsets))))
(java.nio.charset StandardCharsets)))
(:require
[clojure.spec.alpha :as s]
[com.fulcrologic.guardrails.core :refer [>defn => ?]]
[taoensso.timbre :as log]))

(defonce history (volatile! nil))

(defprotocol RouteHistory
"A Route History is mainly a storage device. It records a history stack along with optional additional parameters
Expand All @@ -14,7 +20,76 @@
these events, since it is the browser, not your app, that is technically initiating the change). Such an implementation
*must* honor the add/remove calls to hook up a listener to these external events.
"
(push-route! [history route] "Pushes the given route with params onto the current history stack.")
(replace-route! [history route] "Replaces the top entry in the history stack.")
(recent-history [history] "Returns a vector of the recent routes (current route is first, older routes in age order)")
(current-route [history] "Returns a map containing {:route [vector of strings] :params map-of-data}."))
(-push-route! [history route] "Pushes the given route with params onto the current history stack.")
(-replace-route! [history route] "Replaces the top entry in the history stack.")
(-back! [history] "Moves the history back one in the history stack.")
(-current-route [history] "Returns a map containing {:route [vector of strings] :params map-of-data}.")
(-recent-history [history] "Returns a list of recent routes."))

(s/def ::RouteHistory #(satisfies? RouteHistory %))
(s/def :route/path (s/coll-of string? :kind vector?))
(s/def :route/params map?)
(s/def ::route (s/map-of #{:id :route/path :route/params :uid} any?))

(>defn active-history
"Returns the active (installed) RouteHistory implementation, or nil if none is installed."
[]
[=> (? ::RouteHistory)]
(try
(some-> history deref)
(catch #?(:cljs :default :clj Exception) e
(log/error e "Unable to execute history operation."))))

(>defn history-support?
"Returns true if history support is enabled on the given app (you can also pass a component)."
[]
[=> boolean?]
(boolean (active-history)))

(>defn install-route-history!
[history-impl]
[::RouteHistory => any?]
(vreset! history history-impl))

(defn push-route!
"Push the given route onto the route history (if history is installed). A route is a vector of the route segments
that locate a given target."
[route]
(try
(some-> (active-history) (-push-route! route))
(catch #?(:cljs :default :clj Exception) e
(log/error e "Unable to execute history operation."))))

(defn replace-route!
"Replace the top of the current route stack "
[route]
(try
(some-> (active-history) (-replace-route! route))
(catch #?(:cljs :default :clj Exception) e
(log/error e "Unable to execute history operation."))))

(defn back!
"Go to the last position in history (if history is installed)."
[]
(try
(some-> (active-history) (-back!))
(catch #?(:cljs :default :clj Exception) e
(log/error e "Unable to execute history operation."))))

(>defn current-route
"Returns a map of {:route [\"a\" \"b\"] :params {}}. The params are the extra state/params, and the route is purely strings."
[]
[=> (? ::route)]
(try
(some-> (active-history) (-current-route))
(catch #?(:cljs :default :clj Exception) e
(log/error e "Unable to execute history operation."))))

(defn recent-history
"Returns a list of recent routes."
[]
[=> (s/map-of :int ::route)]
(try
(some-> (active-history) (-recent-history))
(catch #?(:cljs :default :clj Exception) e
(log/error e "Unable to execute history operation."))))
109 changes: 60 additions & 49 deletions src/main/com/fulcrologic/statecharts/integration/fulcro/route_history_browser.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,38 +2,47 @@
"ALPHA. This namespace's API is subject to change."
(:require
#?(:cljs [goog.object :as gobj])
[com.fulcrologic.guardrails.core :refer [>defn => ?]]
[com.fulcrologic.fulcro.algorithms.do-not-use :refer [base64-encode base64-decode]]
[clojure.string :as str]
[clojure.spec.alpha :as s]
[com.fulcrologic.fulcro.algorithms.transit :refer [transit-clj->str transit-str->clj]]
[com.fulcrologic.statecharts.integration.fulcro.route-history :as rh]
[com.fulcrologic.statecharts.integration.fulcro.route-history :as srhist]
[com.fulcrologic.statecharts.integration.fulcro :as scf]
[com.fulcrologic.statecharts.integration.fulcro.route-url :as ru]
[com.fulcrologic.statecharts.integration.fulcro.ui-routes :as uir]
[taoensso.timbre :as log])
#?(:clj (:import (java.net URLDecoder URLEncoder)
(java.nio.charset StandardCharsets))))

(defn decode-uri-component
(def uir-session-id :com.fulcrologic.statecharts.integration.fulcro.ui-routes/session)

(>defn decode-uri-component
"Decode the given string as a transit and URI encoded CLJ(s) value."
[v]
[(? string?) => (? string?)]
(when (string? v)
#?(:clj (URLDecoder/decode ^String v (.toString StandardCharsets/UTF_8))
:cljs (js/decodeURIComponent v))))

(defn encode-uri-component
(>defn encode-uri-component
"Encode a key/value pair of CLJ(s) data such that it can be safely placed in browser query params. If `v` is
a plain string, then it will not be transit-encoded."
[v]
[string? => string?]
#?(:clj (URLEncoder/encode ^String v (.toString StandardCharsets/UTF_8))
:cljs (js/encodeURIComponent v)))

(defn query-params
(>defn query-params
[raw-search-string]
[string? => map?]
(try
(let [param-string (str/replace raw-search-string #"^[?]" "")]
(reduce
(fn [result assignment]
(let [[k v] (str/split assignment #"=")]
(cond
(and k v (= k "_rp_")) (merge result (transit-str->clj (base64-decode (decode-uri-component v))))
(and k v (= k "_sc_")) (merge result (transit-str->clj (base64-decode (decode-uri-component v))))
(and k v) (assoc result (keyword (decode-uri-component k)) (decode-uri-component v))
:else result)))
{}
Expand All @@ -42,12 +51,13 @@
(log/error e "Cannot decode query param string")
{})))

(defn query-string
(>defn query-string
"Convert a map to an encoded string that is acceptable on a URL.
The param-map allows any data type acceptable to transit. The additional key-values must all be strings
(and will be coerced to string if not). "
[param-map & {:as string-key-values}]
(str "?_rp_="
[map? (s/* string?) => string?]
(str "?_sc_="
(encode-uri-component (base64-encode (transit-clj->str param-map)))
"&"
(str/join "&"
Expand All @@ -56,61 +66,61 @@

(defn route->url
"Construct URL from route and params"
[route params hash-based?]
(let [q (query-string (or params {}))]
(if hash-based?
(str q "#/" (str/join "/" (map str route)))
(str "/" (str/join "/" (map str route)) q))))
[{:keys [id]
:route/keys [path params]}]
;; TODO: Confirm if we want to keep a traveling history of params
(let [old-url (js/URL. (.. js/document -location -href))
search-params (.-searchParams old-url)
old-params (query-params (.toString search-params))
new-params (apply update old-params id (constantly params) {})
q (query-string (or new-params {}))]
;q (query-string (or params {}))]
(str "/" (str/join "/" (map str path)) q)))

(defn url->route
"Convert the current browser URL into a route path and parameter map. Returns:

```
{:route [\"path\" \"segment\"]
:params {:param value}}
"Convert the current browser URL into a route map. Returns:
```

You can save this value and later use it with `apply-route!`.

Parameter hash-based? specifies whether to expect hash based routing. If no
parameter is provided the mode is autodetected from presence of hash segment in URL.
"
([] (url->route #?(:clj false
:cljs (some? (seq (.. js/document -location -hash)))) nil))
([hash-based?] (url->route hash-based? nil))
([hash-based? prefix]
#?(:cljs
(let [path (if hash-based?
(str/replace (.. js/document -location -hash) #"^[#]" "")
(.. js/document -location -pathname))
pcnt (count prefix)
prefixed? (> pcnt 0)
path (if (and prefixed? (str/starts-with? path prefix))
(subs path pcnt)
path)
route (vec (drop 1 (str/split path #"/")))
params (or (some-> (.. js/document -location -search) (query-params)) {})]
{:route route
:params params}))))
{:id id
:route/path [\"path\" \"segment\"]
:route/params {:param value}}
```"
[app]
(let [id->params (or (some-> (.. js/document -location -search) (query-params)) {})
path-string (.. js/document -location -pathname)
path (if (seq path-string)
(filterv #(not= "" %) (str/split path-string #"/"))
[])
statechart (scf/lookup-statechart app ::uir/chart)
{:keys [id] :as state} (uir/state-for-path statechart path)]
{:id id
:route/path path
:route/params (get id->params id {})}))

(defrecord HTML5History [hash-based? current-uid prefix uid->history default-route
fulcro-app route->url url->route]
rh/RouteHistory
(push-route! [this {:keys [uid] :as r}]
srhist/RouteHistory
(-push-route! [this {:keys [uid] :as r}]
#?(:cljs
(let [url (str prefix (route->url r hash-based?))]
(let [url (route->url r)]
(when-not uid
(swap! current-uid inc)
(swap! uid->history assoc @current-uid (assoc r :uid @current-uid)))
(.pushState js/history #js {"uid" @current-uid} "" url))))
(replace-route! [this {:keys [uid] :as r}]
(-replace-route! [this {:keys [uid] :as r}]
#?(:cljs
(let [url (str prefix (route->url r hash-based?))
(let [url (route->url r)
uid (or uid @current-uid)]
(swap! uid->history assoc uid (assoc r :uid uid))
(.replaceState js/history #js {"uid" @current-uid} "" url))))
(current-route [this] (second (last (rh/recent-history this))))
(recent-history [_] @uid->history))
(-back! [this]
#?(:cljs
(cond
(> (count @uid->history) 1) (do
(log/debug "Back to prior route" (some-> @uid->history last second))
(.back js/history))
:else (log/error "No prior route. Ignoring BACK request."))))
(-current-route [this] (url->route fulcro-app))
(-recent-history [this] @uid->history))

(defn new-html5-history
"Create a new instance of a RouteHistory object that is properly configured against the browser's HTML5 History API.
Expand Down Expand Up @@ -144,9 +154,10 @@
(when (gobj/getValueByKeys evt "state")
(let [event-uid (gobj/getValueByKeys evt "state" "uid")]
(log/debug "Got pop state event." evt)
(scf/send! app :com.fulcrologic.statecharts.integration.fulcro.ui-routes/session
(swap! (:current-uid history) (constantly event-uid))
Copy link
Author

@yoodame yoodame Mar 21, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ensures current-uid is synced with the browser popstate event-uid.

(scf/send! app uir-session-id
:event/external-route-change {:route/uid event-uid}))))]
(.addEventListener js/window "popstate" pop-state-listener)
history)
(catch :default e
(log/error e "Unable to create HTML5 history.")))))
(log/error e "Unable to create HTML5 history.")))))
4 changes: 0 additions & 4 deletions src/main/com/fulcrologic/statecharts/integration/fulcro/route_url.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,8 +50,4 @@
(set! (.-search url) (.toString search-params))
(.toString url))))

(defn push-url! [href] #?(:cljs (.pushState (.-history js/window) nil "" href)))

(defn replace-url! [href] #?(:cljs (.replaceState (.-history js/window) nil "" href)))


Loading