(ns secretary.core
  (:require [clojure.string :as string]
            [clojure.walk :refer [keywordize-keys]])
  (:require-macros [secretary.core :refer [defroute]]))

;;----------------------------------------------------------------------
;; Protocols

(defprotocol IRouteMatches
  (route-matches [this route]))

(defprotocol IRouteValue
  (route-value [this]))

(defprotocol IRenderRoute
  (render-route
    [this]
    [this params]))

;;----------------------------------------------------------------------
;; Configuration

(def ^:dynamic *config*
  (atom {:prefix ""}))

(defn get-config
  "Gets a value for *config* at path."
  [path]
  (let [path (if (sequential? path) path [path])]
    (get-in @*config* path)))

(defn set-config!
  "Associates a value val for *config* at path."
  [path val]
  (let [path (if (sequential? path) path [path])]
    (swap! *config* assoc-in path val)))

;;----------------------------------------------------------------------
;; Parameter encoding

(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)]
    (string/join \& encoded)))

(defmethod encode-pair ::map [[k v]]
  (let [encoded (map
                 (fn [[ik iv]]
                   (encode-pair [(key-index k (name ik)) iv]))
                 v)]
    (string/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 string."
  [query-params]
  (string/join \& (map encode-pair query-params)))

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

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

(def decode js/decodeURIComponent)

(defn- parse-path
  "Parse a value from a serialized query-string 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-string 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 string."
  [query-string]
  (let [parts (string/split query-string #"&")
        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] (string/split part #"=" 2)]
                    (assoc-in-query-params m (key-parse (decode k)) (decode v))))
                {}
                parts)
        params (keywordize-keys params)]
    params))

;;----------------------------------------------------------------------
;; Route compilation

;; The implementation for route compilation was inspired by Clout and
;; modified to suit JavaScript and Secretary.
;; SEE: https://github.com/weavejester/clout

(defn- re-matches*
  "Like re-matches but result is a always vector. If re does not
  capture matches then it will return a vector of [m m] as if it had a
  single capture. Other wise it maintains consistent behavior with
  re-matches. "
  [re s]
  (let [ms (clojure.core/re-matches re s)]
    (when ms
      (if (sequential? ms) ms [ms ms]))))

(def ^:private re-escape-chars
  (set "\\.*+|?()[]{}$^"))

(defn- re-escape [s]
 (reduce
  (fn [s c]
    (if (re-escape-chars c)
      (str s \\ c)
      (str s c)))
  ""
  s))

(defn- lex*
  "Attempt to lex a single token from s with clauses. Each clause is a
  pair of [regexp action] where action is a function. regexp is
  expected to begin with ^ and contain a single capture. If the
  attempt is successful a vector of [s-without-token (action capture)]
  is returned. Otherwise the result is nil."
  [s clauses]
  (some
   (fn [[re action]]
     (when-let [[m c] (re-find re s)]
       [(subs s (count m)) (action c)]))
   clauses))

(defn- lex-route
  "Return a pair of [regex params]. regex is a compiled regular
  expression for matching routes. params is a list of route param
  names (:*, :id, etc.). "
  [s clauses]
  (loop [s s pattern "" params []]
    (if (seq s)
      (let [[s [r p]] (lex* s clauses)]
        (recur s (str pattern r) (conj params p)))
      [(re-pattern (str \^ pattern \$)) (remove nil? params)])))

(defn- compile-route
  "Given a route return an instance of IRouteMatches."
  [orig-route]
  (let [clauses [[#"^\*([^\s.:*/]*)" ;; Splats, named splates
                  (fn [v]
                    (let [r "(.*?)"
                          p (if (seq v)
                              (keyword v)
                              :*)]
                      [r p]))]
                 [#"^\:([^\s.:*/]+)" ;; Params
                  (fn [v]
                    (let [r "([^,;?/]+)"
                          p (keyword v)]
                      [r p]))]
                 [#"^([^:*]+)" ;; Literals
                  (fn [v]
                    (let [r (re-escape v)]
                      [r]))]]
       [re params] (lex-route orig-route clauses)]
   (reify
     IRouteValue
     (route-value [this] orig-route)

     IRouteMatches
     (route-matches [_ route]
       (when-let [[_ & ms] (re-matches* re route)]
         (->> (interleave params (map decode ms))
              (partition 2)
              (map (fn [[k v]] (MapEntry. k v nil)))
              (merge-with vector {})))))))

;;----------------------------------------------------------------------
;; Route rendering

(defn ^:internal render-route* [obj & args]
  (when (satisfies? IRenderRoute obj)
    (apply render-route obj args)))

;;----------------------------------------------------------------------
;; Routes adding/removing

(def ^:dynamic *routes*
  (atom []))

(defn add-route! [obj action]
  (let [obj (if (string? obj)
              (compile-route obj)
              obj)]
    (swap! *routes* conj [obj action])))

(defn remove-route! [obj]
  (swap! *routes*
         (fn [rs]
           (filterv
            (fn [[x _]]
              (not= x obj))
            rs))))

(defn reset-routes! []
  (reset! *routes* []))

;;----------------------------------------------------------------------
;; Route lookup and dispatch

(defn locate-route [route]
  (some
   (fn [[compiled-route action]]
     (when-let [params (route-matches compiled-route route)]
       {:action action :params params :route compiled-route}))
   @*routes*))

(defn locate-route-value
  "Returns original route value as set in defroute when passed a URI path."
  [uri]
  (-> uri locate-route :route route-value))

(defn- prefix
  []
  (str (get-config [:prefix])))

(defn- uri-without-prefix
  [uri]
  (string/replace uri (re-pattern (str "^" (prefix))) ""))

(defn- uri-with-leading-slash
  "Ensures that the uri has a leading slash"
  [uri]
  (if (= "/" (first uri))
    uri
    (str "/" uri)))

(defn dispatch!
  "Dispatch an action for a given route if it matches the URI path."
  [uri]
  (let [[uri-path query-string] (string/split (uri-without-prefix uri) #"\?")
        uri-path (uri-with-leading-slash uri-path)
        query-params (when query-string
                       {:query-params (decode-query-params query-string)})
        {:keys [action params]} (locate-route uri-path)
        action (or action identity)
        params (merge params query-params)]
    (action params)))

(defn invalid-params [params validations]
  (reduce (fn [m [key validation]]
            (let [value (get params key)]
              (if (re-matches validation value)
                m
                (assoc m key [value validation]))))
          {} (partition 2 validations)))

(defn- params-valid? [params validations]
  (empty? (invalid-params params validations)))

;;----------------------------------------------------------------------
;; Protocol implementations

(extend-protocol IRouteMatches
  string
  (route-matches [this route]
    (route-matches (compile-route this) route))

  js/RegExp
  (route-matches [this route]
    (when-let [[_ & ms] (re-matches* this route)]
      (vec ms)))

  cljs.core/PersistentVector
  (route-matches [[route-string & validations] route]
    (let [params (route-matches (compile-route route-string) route)]
      (when (params-valid? params validations)
        params))))

(extend-protocol IRouteValue
  string
  (route-value [this]
    (route-value (compile-route this)))

  js/RegExp
  (route-value [this] this)

  cljs.core/PersistentVector
  (route-value [[route-string & validations]]
    (vec (cons (route-value route-string) validations))))

(extend-protocol IRenderRoute
  string
  (render-route
    ([this]
       (render-route this {}))
    ([this params]
       (let [{:keys [query-params] :as m} params
             a (atom m)
             path (.replace this (js/RegExp. ":[^\\s.:*/]+|\\*[^\\s.:*/]*" "g")
                            (fn [$1]
                              (let [lookup (keyword (if (= $1 "*")
                                                      $1
                                                      (subs $1 1)))
                                    v (get @a lookup)
                                    replacement (if (sequential? v)
                                                  (do
                                                    (swap! a assoc lookup (next v))
                                                    (encode-uri (first v)))
                                                  (if v (encode-uri v) $1))]
                                replacement)))
             path (str (get-config [:prefix]) path)]
         (if-let [query-string (and query-params
                                    (encode-query-params query-params))]
           (str path "?" query-string)
           path))))

  cljs.core/PersistentVector
  (render-route
    ([this]
       (render-route this {}))
    ([[route-string & validations] params]
       (let [invalid (invalid-params params validations)]
         (if (empty? invalid)
           (render-route route-string params)
           (throw (ex-info "Could not build route: invalid params" invalid)))))))