:base-path option to allow deployment on non-root paths

.gitignore

@@ -13,3 +13,7 @@ pom.xml.asc
 .nrepl-port
 /.idea/*
 *.iml
+/.cpcache/
+/.clj-kondo/.cache/
+/.lsp/.cache/
+/.calva/output-window/

src/kee_frame/core.cljc

@@ -2,14 +2,13 @@
   (:require [kee-frame.legacy :as legacy]
             [kee-frame.state :as state]
             [kee-frame.router :as router]
-            [re-frame.core :as rf :refer [console]]
             [kee-frame.log :as log]
             [kee-frame.spec :as spec]
             [re-frame.interop :as interop]
             [clojure.spec.alpha :as s]
             [expound.alpha :as e]))
 
-(def valid-option-key? #{:router :hash-routing? :routes :process-route :debug? :debug-config
+(def valid-option-key? #{:router :hash-routing? :base-path :routes :process-route :debug? :debug-config
                          :chain-links :app-db-spec :root-component :initial-db :log-spec-error
                          :screen :scroll :route-change-event :not-found :log :global-interceptors})
 

src/kee_frame/router.cljc

@@ -1,6 +1,5 @@
 (ns ^:no-doc kee-frame.router
-  (:require [kee-frame.interop :as interop]
-            [re-frame.core :as rf :refer [console]]
+  (:require [re-frame.core :as rf :refer [console]]
             [re-chain.core :as chain]
             [kee-frame.event-logger :as event-logger]
             [kee-frame.api :as api :refer [dispatch-current! navigate! url->data data->url]]
@@ -13,7 +12,6 @@
             [clojure.string :as str]
             [clojure.spec.alpha :as s]
             [expound.alpha :as e]
-            [re-frame.core :as f]
             [clojure.set :as set]))
 
 (def default-chain-links [{:effect-present? (fn [effects] (:http-xhrio effects))
@@ -56,34 +54,44 @@
 (defn valid? [{:keys [path-params required]}]
   (set/subset? required (set (keys path-params))))
 
-(defn match-data [routes route hash?]
+(defn match-data [routes route hash? base-path]
   (let [[_ path-params] route
         {:keys [path] :as match} (apply reitit/match-by-name routes route)]
     (when (valid? match)
-      (str (when hash? "/#") path
+      (str base-path (when hash? "/#") path
            (when-some [q (:query-string path-params)] (str "?" q))
            (when-some [h (:hash path-params)] (str "#" h))))))
 
-(defn match-url [routes url]
-  (let [[path+query fragment] (-> url (str/replace #"^/#/" "/") (str/split #"#" 2))
+(defn- remove-base-path [url base-path]
+  ;; i don't want to think about how to quote the regex
+  ;; also we would pay for compilation on every check
+  (if (str/starts-with? url base-path)
+    (subs url (count base-path))
+    url))
+
+(defn match-url [routes base-path url]
+  (let [[path+query fragment] (-> url
+                                  (remove-base-path base-path)
+                                  (str/replace #"^/#/" "/")
+                                  (str/split #"#" 2))
         [path query] (str/split path+query #"\?" 2)]
     (some-> (reitit/match-by-path routes path)
             (assoc :query-string query :hash fragment))))
 
-(defrecord ReititRouter [routes hash? not-found]
+(defrecord ReititRouter [routes hash? base-path not-found]
   api/Router
   (data->url [_ data]
     (assert-route-data data)
-    (or (match-data routes data hash?)
+    (or (match-data routes data hash? base-path)
         (url-not-found routes data)))
   (url->data [_ url]
-    (or (match-url routes url)
-        (some->> not-found (match-url routes))
+    (or (match-url routes base-path url)
+        (some->> not-found (match-url routes base-path))
         (route-match-not-found routes url))))
 
-(defn bootstrap-routes [{:keys [routes router hash-routing? scroll route-change-event not-found]}]
+(defn bootstrap-routes [{:keys [routes router hash-routing? base-path scroll route-change-event not-found]}]
   (let [initialized? (boolean @state/navigator)
-        router (or router (->ReititRouter (reitit/router routes) hash-routing? not-found))]
+        router (or router (->ReititRouter (reitit/router routes) hash-routing? base-path not-found))]
     (reset! state/router router)
     (rf/reg-fx :navigate-to goto)
 
@@ -118,14 +126,15 @@
     (console :warn "Kee-frame option :debug-config has been removed. Configure timbre logger through :log option instead. Example: {:level :debug :ns-blacklist [\"kee-frame.event-logger\"]}")))
 
 (defn start! [{:keys [routes initial-db router app-db-spec root-component chain-links
-                      screen scroll global-interceptors log-spec-error]
-               :or   {scroll true}
+                      screen scroll global-interceptors log-spec-error base-path]
+               :or   {scroll true base-path ""}
                :as   config}]
   (deprecations config)
   (when app-db-spec
-    (f/reg-global-interceptor (spec/spec-interceptor app-db-spec log-spec-error)))
+    (rf/reg-global-interceptor (spec/spec-interceptor app-db-spec log-spec-error)))
   (doseq [i global-interceptors]
-    (f/reg-global-interceptor i))
+    (rf/reg-global-interceptor i))
+
   (chain/configure! (concat default-chain-links
                             chain-links))
 
@@ -135,7 +144,7 @@
                     {:routes routes
                      :router router})))
   (when (or routes router)
-    (bootstrap-routes config))
+    (bootstrap-routes (assoc config :scroll scroll :base-path base-path)))
 
   (when initial-db
     (rf/dispatch-sync [:init initial-db]))

test/kee_frame/router_test.cljc

@@ -4,34 +4,47 @@
             [kee-frame.api :as api]
             [reitit.core :as reitit]))
 
-(defn router [routes hash?] (router/->ReititRouter (reitit/router routes) hash? nil))
+(defn router [routes hash? base-path] (router/->ReititRouter (reitit/router routes) hash? base-path nil))
 
-(deftest can-produce-hash-urls
+(defn produce-urls-helper [hash? base-path]
   (let [r (router [["/" :root]
-                   ["/item/:id" :item]] true)]
+                   ["/item/:id" :item]] hash? base-path)
+        hash-path (if hash? "/#" "")]
     (testing "Root"
-      (is (= "/#/" (api/data->url r [:root]))))
+      (is (= (str base-path hash-path "/") (api/data->url r [:root]))))
 
     (testing "Item"
-      (is (= "/#/item/1" (api/data->url r [:item {:id 1}]))))
+      (is (= (str base-path hash-path "/item/1") (api/data->url r [:item {:id 1}]))))
 
     (testing "Item with missing id throws"
       (is (thrown?
            #?(:clj clojure.lang.ExceptionInfo
               :cljs js/Error)
            (api/data->url r [:item]))))))
 
-(deftest can-parse-hash-urls
+(defn parse-urls-helper [hash? base-path]
   (let [r (router [["/" :root]
-                   ["/item/:id" :item]] true)]
+                   ["/item/:id" :item]] true base-path)
+        hash-path (if hash? "/#" "")]
 
     (testing "Root"
-      (is (= :root (-> (api/url->data r "/")
+      (is (= :root (-> (api/url->data r (str base-path hash-path "/"))
                        :data
                        :name))))
 
     (testing "Item with path params and query string"
-      (let [{:keys [data path-params query-string]} (api/url->data r "/item/1?query=string")]
+      (let [{:keys [data path-params query-string]} 
+            (api/url->data r (str base-path hash-path "/item/1?query=string"))]
         (is (= "query=string" query-string))
         (is (= :item (:name data)))
         (is (= "1" (:id path-params)))))))
+
+(deftest can-produce-urls
+  (doseq [hash?      [true false]
+          base-path  ["" "/prefix"]]
+    (produce-urls-helper hash? base-path)))
+
+(deftest can-parse-urls
+  (doseq [hash?      [true false]
+          base-path  ["" "/prefix"]]
+    (parse-urls-helper hash? base-path)))