simple-router.clj

(ns simple-router)

(defn- update-handlers
  ;; utility fn to update all values keyed by `::handlers` in routes using `f`
  [routes f]
  (reduce-kv (fn [routes k v]
               (if (= k ::handlers)
                 (assoc routes k (update-vals v f))
                 (assoc routes k (update-handlers v f))))
             {}
             routes))

(defn route
  "Create a route map from segments and handlers. A segment can be a keyword
   or a string. Keywords are interpreted as path parameters. Strings are interpreted
   as path literals.
   
   (route [\"users\" :id] {:get get-user :post create-user})
   "
  [segments dispatch-map]
  (let [bindings (filter keyword? segments)]
    (reduce (fn [acc segment]
              (if (= segment ::handlers)
                {::handlers (update-vals dispatch-map (fn [f] {::dispatch f
                                                               ::bindings bindings}))}
                (let [segment (if (keyword? segment) ::match segment)]
                  {segment acc})))
            {}
            (cons ::handlers (reverse segments)))))

(defn prefix-routes
  "prefix all routes with the given prefix-segments. Prefix segments can be keywords or strings.
   For more information about segments see `route`.
   ```
   (prefix-routes [\"api\" \"v1\"] 
     (route [\"users\" :id] {:get get-user :post create-user})
     (route [\"posts\" :id] {:get get-post :post create-post}))
   ```
   "
  [prefix-segments routes]
  (let [bindings (filter keyword? prefix-segments)]
    (reduce (fn [acc segment]
              (if-not (= segment ::routes)
                (let [k (if (keyword? segment) ::match segment)]
                  {k acc})
                (update-handlers routes
                                 (fn [handler]
                                   (update handler ::bindings
                                           #(let [updated-bindings (concat bindings %)]
                                              (assert (= (count (set updated-bindings))
                                                         (count updated-bindings))
                                                      "duplicate bindings")
                                              updated-bindings))))))
            {}
            (cons ::routes (reverse prefix-segments)))))

(defn merge-routes
  "Merge routes, throwing an exception if there are duplicate paths.
   This operation is associative and commutative, which means that the order of
   the arguments does not matter.  
   ```
    (merge-routes
      (route [\"users\" :id] {:get get-user :post create-user})
      (route [\"posts\" :id] {:get get-post :post create-post}))    
   ```
   "
  [& routes]
  (letfn [(merge-routes*
            [routes-a routes-b]
            (reduce (fn [{:keys [::handlers] :as a'} [k v]]
                      (if (= k ::handlers)
                       ;; ensure that there are no duplicate handlers for a given method
                        (let [a-methods (keys handlers)
                              b-methods (keys v)]
                          (when (some (set a-methods) b-methods)
                            (throw (ex-info "duplicate path" {})))
                          (assoc a' k (merge handlers v)))
                        (assoc a' k (merge-routes* (get a' k) v))))
                    routes-a routes-b))]
    (reduce merge-routes* routes)))

(defn with-middleware
  "Add middleware to all handlers in routes. Returns a single route map.
   Middleware will only be invoked once a match has been found for a given request.
   ```
    (with-middleware wrap-authorization
      (route [\"users\" :id] {:get get-user :post create-user})
      (route [\"posts\" :id] {:get get-post :post create-post}))
   ```"
  ;; because the middleware-fn is added to each handler, the resulting route will
  ;; still be mergable with other routes that have middleware added to them.
  ;; this is because the middleware-fn is added directly to the handlers and not to
  ;; the route itself. if the middleware was added _in place_ to the route, then 
  ;; the resulting route would not be mergable with other routes that have middleware
  ;; at the same level as order of middleware often matters.
  [middleware-fn & routes]
  (-> (apply merge-routes routes)
      (update-handlers #(-> %
                            (update ::dispatch middleware-fn)
                            (update ::middleware (fnil conj []) middleware-fn)))))

;;  --------------------------------------------------------------------------------------

(defn- match-segments [routes segments]
  (reduce (fn [[routes binding-values] segment]
            (let [children (get routes segment)]
              (if children
                [children binding-values]
                (if-let [match-children (get routes ::match)]
                  [match-children (conj binding-values segment)]
                  (reduced nil))))) [routes []] segments))

(defn match-uri [routes uri method]
  (let [[{:keys [::handlers] :as result} binding-vals]
        (->> (str/split uri #"/")
             (remove str/blank?)
             (match-segments routes))]
    (when-some [{:keys [::bindings ::dispatch]} (get handlers method)]
      {::dispatch dispatch
       ::bindings (zipmap bindings binding-vals)})))

(defn run-router!
  ([routes {:keys [uri request-method] :as req}]
   (run-router! routes uri request-method req))
  ([routes uri method req]
   (when-some [{:keys [::dispatch ::bindings]} (match-uri routes uri method)]
     (dispatch (assoc req :uri-params bindings)))))