Skip to content

Commit

Permalink
Add support for namespaced keys, update algor for matching, remove se…
Browse files Browse the repository at this point in the history
…cretary

- Router now supports namespaced keys in the URLs. Namespace separator (`/`) is serialized as `$` in the URL.
- Removed Secretary dependency and inlined the code for URL encode/decode
- Route matching algorithm is now changed to work better with default values.
- Route matching algorithm will now try exact matches first when matching URL with the route pattern
  • Loading branch information
retro committed Dec 7, 2019
1 parent e21a9af commit a10793b
Show file tree
Hide file tree
Showing 4 changed files with 312 additions and 113 deletions.
5 changes: 2 additions & 3 deletions project.clj
@@ -1,4 +1,4 @@
(defproject keechma/router "0.1.2"
(defproject keechma/router "0.1.3"
:description "Router - Pure functional router for ClojureScript applications."
:url "http://keechma.com/"
:license {:name "MIT"}
Expand All @@ -7,8 +7,7 @@

:dependencies [[org.clojure/clojure "1.9.0"]
[org.clojure/clojurescript "1.9.946"]
[lein-doo "0.1.6"]
[secretary "1.2.3"]]
[lein-doo "0.1.6"]]

:plugins [[lein-figwheel "0.5.8"]
[lein-cljsbuild "1.1.7" :exclusions [[org.clojure/clojure]]]
Expand Down
141 changes: 92 additions & 49 deletions src/router/core.cljs
@@ -1,20 +1,54 @@
(ns router.core
(:require [clojure.walk :refer [keywordize-keys]]
(:require [clojure.walk :refer [postwalk]]
[clojure.set :refer [superset? union]]
[secretary.core :refer [decode-query-params encode-query-params]]
[router.util :refer [decode-query-params encode-query-params]]
[clojure.string :as str]))

(def ^:private encode js/encodeURIComponent)
(def ^:private encode js/encodeURIComponent)

(defn ^:private process-url-namespace [v]
(str/replace-first v "$" "/"))

(defn ^:private preserve-ns-url-key [k]
(if (keyword? k)
(let [k-ns (namespace k)
k-name (name k)]
(if k-ns (str k-ns "$" k-name) (name k)))
k))

(defn ^:private keywordize-url-keys
[m]
(let [f (fn [[k v]]
(if (string? k)
[(keyword (process-url-namespace k)) v]
[k v]))]
;; only apply to maps
(postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))

(defn ^:private preserve-ns-url-keys
[m]
(let [f (fn [[k v]]
(if (keyword? k)
[(preserve-ns-url-key k) v]
[k v]))]
;; only apply to maps
(postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))


(defn ^:private placeholder->key [p]
(-> (subs p 1)
process-url-namespace
keyword))

(defn ^:private process-route-part [default-keys part]
(let [is-placeholder? (= ":" (first part))
key (when is-placeholder? (keyword (subs part 1)))
has-default? (contains? default-keys key)
min-matches (if has-default? "*" "+")
re-match (if is-placeholder? (str "(" "[^/]" min-matches ")") part)]
{:is-placeholder? is-placeholder?
(let [is-placeholder (= ":" (first part))
key (when is-placeholder (placeholder->key part))
has-default (contains? default-keys key)
min-matches (if has-default "*" "+")
re-match (if is-placeholder (str "(" "[^/]" min-matches ")") part)]
{:is-placeholder is-placeholder
:key key
:has-default has-default?
:has-default has-default
:re-match re-match}))

(defn ^:private route-regex [parts]
Expand All @@ -23,7 +57,9 @@
(re-pattern full-regex)))

(defn ^:private route-placeholders [parts]
(remove nil? (map (fn [p] (:key p)) parts)))
(->> parts
(map :key)
(remove nil?)))

(defn ^:private add-default-params [route]
(if (string? route) [route {}] route))
Expand All @@ -34,7 +70,8 @@
([side route]
(case side
:left (clojure.string/replace (clojure.string/trim (or route "")) #"^/+" "")
:right (clojure.string/replace (clojure.string/trim (or route "")) #"/+$" ""))))
:right (clojure.string/replace (clojure.string/trim (or route "")) #"/+$" "")
route)))

(defn ^:private process-route [[route defaults]]
(let [parts (clojure.string/split route #"/")
Expand All @@ -46,7 +83,13 @@
:defaults (or defaults {})}))

(defn ^:private remove-empty-matches [matches]
(apply dissoc matches (for [[k v] matches :when (or (= v "null") (empty? v))] k)))
(->> matches
(filter (fn [[k v]]
(and (not (nil? v))
(not (nil? k))
(not (empty? v))
(not= "null" v))))
(into {})))

(defn ^:private expand-route [route]
(let [strip-slashes (fn [[route defaults]] [(strip-slashes route) defaults])]
Expand All @@ -55,8 +98,11 @@
strip-slashes
process-route)))

(defn ^:private potential-route? [data-keys route]
(superset? data-keys (:placeholders route)))
(defn ^:private potential-route? [data {:keys [placeholders defaults] :as route}]
(or (and (not (empty? placeholders))
(superset? (set (keys data)) placeholders))
(and (not (empty? defaults))
(superset? (set defaults) (set data)))))

(defn ^:private intersect-maps [map1 map2]
(reduce-kv (fn [m k v]
Expand All @@ -66,17 +112,15 @@

(defn ^:private extract-query-param [default-keys placeholders m k v]
(if-not (or (contains? default-keys k) (contains? placeholders k))
(assoc m k v)
(assoc m k v)
m))

(defn ^:private add-url-segment [defaults data url k]
(let [val (get data k)
placeholder (str k)
is-default? (= (get defaults k) val)
;; Hack to enforce trailing slash when we have a default value
default-val (if (str/starts-with? url placeholder) "" "")
replacement (if is-default? default-val (encode val))]
(clojure.string/replace url placeholder replacement)))
placeholder (str ":" (preserve-ns-url-key k))
is-default (= (get defaults k) val)
replacement (if is-default "" (encode val))]
(str/replace url placeholder replacement)))

(defn ^:private build-url [route data]
(let [defaults (:defaults route)
Expand All @@ -86,33 +130,28 @@
base-url (reduce (partial add-url-segment defaults data) (:route route) placeholders)]
(if (empty? query-params)
(if (= "/" base-url) "" base-url)
(str base-url "?" (encode-query-params query-params)))))

(defn ^:private route-score [data route]
(let [matched []
default-matches (fn [matched]
(into matched
(keys (intersect-maps data (:defaults route)))))
placeholder-matches (fn [matched]
(into matched
(union (set (:placeholders route))
(set (keys data)))))]
(count (-> matched
default-matches
placeholder-matches
distinct))))
(str base-url "?" (encode-query-params (preserve-ns-url-keys query-params))))))

(defn ^:private route-score [data {:keys [defaults placeholders]}]
(reduce-kv
(fn [score k v]
(cond
(= v (get defaults k)) (+ score 1.1)
(contains? placeholders k) (inc score)
:else score))
0 data))

(defn ^:private match-path-with-route [route url]
(let [matches (first (re-seq (:regex route) url))]
(when-not (nil? matches)
(zipmap (:placeholders route) (rest matches)))))

(defn ^:private match-path [processed-routes path]
(let [route-count (count processed-routes)
(defn ^:private match-path [expanded-routes path]
(let [route-count (count expanded-routes)
max-index (dec route-count)]
(if (pos? route-count)
(when (pos? route-count)
(loop [index 0]
(let [route (get processed-routes index)
(let [route (get expanded-routes index)
matches (match-path-with-route route path)
end? (= max-index index)]
(cond
Expand Down Expand Up @@ -150,7 +189,7 @@
[expanded-routes url]
(let [[u q] (clojure.string/split url #"\?")
path (if (= u "/") u (strip-slashes :left u))
query (remove-empty-matches (keywordize-keys (decode-query-params (or q ""))))
query (remove-empty-matches (keywordize-url-keys (decode-query-params q)))
matched-path (match-path expanded-routes path)]
(if matched-path
(assoc matched-path :data (merge query (:data matched-path)))
Expand Down Expand Up @@ -180,10 +219,9 @@
```
"
[expanded-routes data]
(let [data-keys (set (keys data))
potential-routes (filter (partial potential-route? data-keys) expanded-routes)]
(let [potential-routes (filter (partial potential-route? data) expanded-routes)]
(if (empty? potential-routes)
(str "?" (encode-query-params data))
(str "?" (encode-query-params (preserve-ns-url-keys data)))
(let [sorted-routes (sort-by (fn [r] (- (route-score data r))) potential-routes)
best-match (first sorted-routes)]
(build-url best-match data)))))
Expand All @@ -210,7 +248,12 @@
```
"
[routes]
;; sort routes in desc order by count of placeholders
(into [] (sort-by (fn [r]
(- (count (:placeholders r))))
(map expand-route routes))))
(let [expanded-routes (map expand-route routes)
without-placeholders (filter #(not (seq (:placeholders %))) expanded-routes)
with-placeholders (filter #(seq (:placeholders %)) expanded-routes)]
;; We put routes without placeholders at the start of the list, so they would
;; be matched first - exact matches have precedence over matches with placeholders
;;
;; Routes that have placeholders are sorted so that the routes with the most
;; placeholders come first, because these have more specificity
(vec (concat without-placeholders (sort-by #(- (count (:placeholders %))) with-placeholders)))))
128 changes: 128 additions & 0 deletions src/router/util.cljs
@@ -0,0 +1,128 @@
(ns router.util
(:require [clojure.string :as str]))

;; this is taken from the Secretary project and slightly modified
;; https://github.com/clj-commons/secretary/blob/master/src/secretary/core.cljs

(def encode js/encodeURIComponent)

(defmulti
^{:private true
:doc "Given a key and a value return and encoded key-value pair."}
encode-pair
(fn [[k v]]
(cond
(or (sequential? v) (set? v))
::sequential
(or (map? v) (satisfies? IRecord v))
::map)))

(defn- key-index
([k] (str (name k) "[]"))
([k index]
(str (name k) "[" index "]")))

(defmethod encode-pair ::sequential [[k v]]
(let [encoded (map-indexed
(fn [i x]
(let [pair (if (coll? x)
[(key-index k i) x]
[(key-index k) x])]
(encode-pair pair)))
v)]
(str/join \& encoded)))

(defmethod encode-pair ::map [[k v]]
(let [encoded (map
(fn [[ik iv]]
(encode-pair [(key-index k (name ik)) iv]))
v)]
(str/join \& encoded)))

(defmethod encode-pair :default [[k v]]
(str (name k) \= (encode (str v))))

(defn encode-query-params
"Convert a map of query parameters into url encoded str."
[query-params]
(str/join \& (map encode-pair query-params)))

(defn encode-uri
"Like js/encodeURIComponent excepts ignore slashes."
[uri]
(->> (str/split uri #"/")
(map encode)
(str/join "/")))

;;----------------------------------------------------------------------
;; Parameter decoding

(def decode js/decodeURIComponent)

(defn- parse-path
"Parse a value from a serialized query-str key index. If the
index value is empty 0 is returned, if it's a digit it returns the
js/parseInt value, otherwise it returns the extracted index."
[path]
(let [index-re #"\[([^\]]*)\]*" ;; Capture the index value.
parts (re-seq index-re path)]
(map
(fn [[_ part]]
(cond
(empty? part) 0
(re-matches #"\d+" part) (js/parseInt part)
:else part))
parts)))

(defn- key-parse
"Return a key path for a serialized query-str entry.
Ex.
(key-parse \"foo[][a][][b]\")
;; => (\"foo\" 0 \"a\" 0 \"b\")
"
[k]
(let [re #"([^\[\]]+)((?:\[[^\]]*\])*)?"
[_ key path] (re-matches re k)
parsed-path (when path (parse-path path))]
(cons key parsed-path)))

(defn- assoc-in-query-params
"Like assoc-in but numbers in path create vectors instead of maps.
Ex.
(assoc-in-query-params {} [\"foo\" 0] 1)
;; => {\"foo\" [1]}
(assoc-in-query-params {} [\"foo\" 0 \"a\"] 1)
;; => {\"foo\" [{\"a\" 1}]}
"
[m path v]
(let [heads (fn [xs]
(map-indexed
(fn [i _]
(take (inc i) xs))
xs))
hs (heads path)
m (reduce
(fn [m h]
(if (and (or (number? (last h)))
(not (vector? (get-in m (butlast h)))))
(assoc-in m (butlast h) [])
m))
m
hs)]
(if (zero? (last path))
(update-in m (butlast path) conj v)
(assoc-in m path v))))

(defn decode-query-params
"Extract a map of query parameters from a query str."
[query-str]
(let [parts (str/split query-str #"&")
params (reduce
(fn [m part]
;; We only want two parts since the part on the right hand side
;; could potentially contain an =.
(let [[k v] (str/split part #"=" 2)]
(assoc-in-query-params m (key-parse (decode k)) (decode v))))
{}
parts)]
params))

0 comments on commit a10793b

Please sign in to comment.