(ns selmer.filter-parser
  (:require [selmer.filters :refer [get-filter]]
            [selmer.util :refer [exception *escape-variables*]]
            [clojure.string :as s]))

(defn escape-html*
  [^String s]
  "HTML-escapes the given string. Escapes the same characters as django's escape."
  ;; This method is "Java in Clojure" for serious speedups.
  ;; Stolen from davidsantiago/quoin and modified.
  (if *escape-variables*
    (let [sb (StringBuilder.)
          slength (count s)]
      (loop [idx 0]
        (if (>= idx slength)
          (.toString sb)
          (let [c (char (.charAt s idx))]
            (case c
              \& (.append sb "&")
              \< (.append sb "&lt;")
              \> (.append sb "&gt;")
              \" (.append sb "&quot;")
              \' (.append sb "&#39;")
              (.append sb c))
            (recur (inc idx))))))
    s))

(defn strip-doublequotes
  [^String s]
  (if (and (> (count s) 1)
           (= \" (first s) (.charAt s (dec (count s)))))
    (.substring s 1 (dec (count s)))
    s))

(defn escape-html
  [x]
  (if (and (vector? x)
           (= :safe (first x)))
    (second x)
    (let [s (str x)]
      (escape-html* s))))

(defn fix-accessor
  [ks]
  (mapv (fn [^String s]
          (try (Long/valueOf s)
               (catch NumberFormatException _
                 (keyword s))))
        ks))

(defn split-filter-val
  [s]
  (let [ks (clojure.string/split s #"(?<!\.)\.(?!\.)")
        kss (map
              (fn [s] (clojure.string/replace s ".." ".")) ks)] ;we remove the double dot here
    (fix-accessor kss)))

(defn fix-filter-args
  [args]
  ;; TODO - figure out what kind of extra args filters can take
  (map (fn [^String s]
         (strip-doublequotes s))
       args))

(defn lookup-args
  [context-map]
  (fn [^String arg]
    (if (and (> (count arg) 1) (.startsWith arg "@"))
      (let [accessor (split-filter-val (subs arg 1))]
        (get-in context-map accessor arg))
      arg)))

(defn filter-str->fn
  [s]
  (let [[filter-name & args]
        ;; Ignore colons inside doublequotes
        (re-seq #"(?:[^:\"]|\"[^\"]*\")+" s)
        args (fix-filter-args args)
        filter (get-filter filter-name)]
    (if filter
      (fn [x context-map]
        (apply filter x (map (lookup-args context-map) args)))
      (exception "No filter defined with the name '" filter-name "'"))))

(def safe-filter ::selmer-safe-filter)

(defn- literal? [^String val]
  (or
    (and (.startsWith val "\) (.endsWith val "\))
    (re-matches #"[0-9]+" val)))

(defn- parse-literal [^String val]
  (if (.startsWith val "\)
    (subs val 1 (dec (count val)))
    val))

(defn- apply-filters [val s filter-strs filters context-map]
  (reduce
    (fn [acc [filter-str filter]]
      (try (filter acc context-map)
           (catch Exception e
             (exception
               "On filter body '" s "' and filter '" filter-str "' this error occurred:" (.getMessage e)))))
    val
    (map vector filter-strs filters)))

(defn get-accessor [m k]
  "Returns the value of `k` from map `m`, either as a keyword or string lookup."
  (or (get m k)
      (when (keyword? k)
        (if-let [n (namespace k)]
          (get m (str n "/" (name k)))
          (get m (name k))))))

(defn compile-filter-body
  ([s] (compile-filter-body s true))
  ([s escape?]
   (let [[val & filter-strs] (->> s
                                  (s/trim)
                                  ;; Ignore pipes and allow escaped doublequotes inside doublequotes
                                  (re-seq #"(?:[^|\"]|\"[^\"]*\")+"))
         accessor (split-filter-val val)
         filters (map filter-str->fn filter-strs)]
     (if (literal? val)
       (fn [context-map]
         (apply-filters
           (parse-literal val)
           s
           filter-strs
           filters
           context-map))
       (fn [context-map]
         (let [val (reduce get-accessor context-map accessor)]
           (when (or val (and selmer.util/*filter-missing-values* (seq filters)))
             (let [x (apply-filters
                       val
                       s
                       filter-strs
                       filters
                       context-map)]
               ;; Escape by default unless the last filter is 'safe' or safe-filter is set in the context-map
               (cond
                 (safe-filter context-map) x
                 escape? (escape-html x)
                 :else x)))))))))

(ns selmer.filters
  (:require [clojure.string :as s]
            [cheshire.core :as json :only [generate-string]]
            [selmer.util :refer [exception]])
  (:import java.util.Locale
           org.joda.time.DateTime
           java.text.NumberFormat
           [org.joda.time.format DateTimeFormat DateTimeFormatter]
           [org.apache.commons.codec.digest DigestUtils]))

(def valid-date-formats
  {"shortDate"      (DateTimeFormat/shortDate)
   "shortTime"      (DateTimeFormat/shortTime)
   "shortDateTime"  (DateTimeFormat/shortDateTime)
   "mediumDate"     (DateTimeFormat/mediumDate)
   "mediumTime"     (DateTimeFormat/mediumTime)
   "mediumDateTime" (DateTimeFormat/mediumDateTime)
   "longDate"       (DateTimeFormat/longDate)
   "longTime"       (DateTimeFormat/longTime)
   "longDateTime"   (DateTimeFormat/longDateTime)
   "fullDate"       (DateTimeFormat/fullDate)
   "fullTime"       (DateTimeFormat/fullTime)
   "fullDateTime"   (DateTimeFormat/fullDateTime)
   })

(defn ^DateTime fix-date [d]
  (cond (instance? DateTime d) d
        (instance? java.util.Date d) (DateTime. d)
        :else
        (try (DateTime. d)
             (catch Exception _
               (throw (IllegalArgumentException. (str d " is not a valid date format.")))))))

(defn throw-when-expecting-seqable
  [x & [msg]]
  (let [is-seqable  (and (not (nil? x))
                         (or (seq? x)
                             (instance? clojure.lang.Seqable x)
                             (string? x)
                             (instance? Iterable x)
                             (-> ^Object x .getClass .isArray)
                             (instance? java.util.Map x)))
        ^String msg (if msg msg (str "Expected '" (if (nil? x) "nil" (str x)) "' to be a collection of some sort."))]
    (when-not is-seqable
      (exception msg))))

(defn throw-when-expecting-number
  [x & [msg]]
  (let [^String msg (if msg msg (str "Expected '" (if (nil? x) "nil" (str x)) "' to be a number."))]
    (when-not (number? x)
      (exception msg))))

(defonce filters
         (atom
           {;;; Useful for doing crazy stuff like {{ foo|length-is:3|join:"/" }}
            ;;; Without blowing up I guess
            :str
            str
            ;;; Try to add the arguments as numbers
            ;;; If it fails concatenate them as strings
            :add
            (fn [x y & rest]
              (let [args (conj rest y (str x))]
                (try (apply +
                            (map #(Long/valueOf ^String %) args))
                     (catch NumberFormatException _
                       (apply str args)))))
            ;;; Add backslashes to quotes
            :addslashes
            (fn [s]
              (->> s
                   (str)
                   (mapcat (fn [c]
                             (if (or (= \" c) (= \' c))
                               [\\ c]
                               [c])))
                   (apply str)))
            ;;; Center a string given a width
            :center
            (fn [s w]
              (let [s (str s)
                    w (Long/valueOf (s/trim w))
                    c (count s)
                    l (Math/ceil (/ (- w c) 2))
                    r (Math/floor (/ (- w c) 2))]
                (str
                  (apply str (repeat l \space))
                  s
                  (apply str (repeat r \space)))))
            :currency-format
            (fn [n & [locale country]]
              (throw-when-expecting-number n)
              (let [n               (double n)
                    locale          (cond
                                      (and locale country) (Locale. locale country)
                                      locale (Locale. locale)
                                      :else (Locale/getDefault))
                    currency-format (java.text.NumberFormat/getCurrencyInstance locale)]
                (.format ^NumberFormat currency-format n)))
            :number-format
            (fn [n fmt & [locale]]
              (throw-when-expecting-number n)
              (let [locale (if locale (java.util.Locale. locale)
                                      (Locale/getDefault))]
                (String/format locale fmt (into-array Object [n]))))
            ;;; Formats a date with default locale, expects an instance of DateTime (Joda Time) or Date.
            ;;; The format can be a key from valid-date-formats or a manually defined format
            ;;; Look in
            ;;; http://joda-time.sourceforge.net/apidocs/org/joda/time/format/DateTimeFormat.html
            ;;; for formatting help.
            ;;; You can also format time with this.
            ;;; An optional locale for formatting can be given as second parameter
            :date
            (fn [d fmt & [locale]]
              (when d
                (let [fixed-date             (fix-date d)
                      locale                 (if locale (java.util.Locale. locale)
                                                        (Locale/getDefault))
                      ^DateTimeFormatter fmt (.withLocale
                                               (or ^DateTimeFormatter (valid-date-formats fmt)
                                                   ^DateTimeFormatter (DateTimeFormat/forPattern fmt)) locale)]
                  (.print fmt fixed-date))))
            ;;; Default if x is falsey
            :default
            (fn [x default]
              (if x
                x
                default))
            ;;; Default if coll is empty
            :default-if-empty
            (fn [coll default]
              (try
                (cond
                  (nil? coll) default
                  (empty? coll) default
                  :else coll)
                (catch Exception _
                  (throw-when-expecting-seqable coll))))
            ;;; With no decimal places it rounds to 1 decimal place
            :double-format
            (fn [n & [decimal-places]]
              (throw-when-expecting-number n)
              (let [n (double n)]
                (format (str "%." (if decimal-places decimal-places "1") "f")
                        n)))
            :first
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (first coll))
            :take
            (fn [coll n]
              (throw-when-expecting-seqable coll)
              (vec (take (Long/valueOf ^String n) coll)))
            :drop
            (fn [coll n]
              (throw-when-expecting-seqable coll)
              (vec (drop (Long/valueOf ^String n) coll)))
            ;;; Get the ith digit of a number
            ;;; 1 is the rightmost digit
            ;;; Returns the number if the index is out of bounds
            :get-digit
            (fn [n i]
              (let [nv (vec (str n))
                    i  (Long/valueOf ^String i)
                    i  (- (count nv) i)]
                (if (or (< i 0) (>= i (count nv)))
                  n
                  (let [d (nv i)]
                    (if (= \. d)
                      (nv (dec i))
                      d)))))
            :hash
            (fn [s hash]
              (let [s (str s)]
                (case hash
                  "md5" (DigestUtils/md5Hex s)
                  "sha" (DigestUtils/shaHex s)
                  "sha256" (DigestUtils/sha256Hex s)
                  "sha384" (DigestUtils/sha384Hex s)
                  "sha512" (DigestUtils/sha512Hex s)
                  (throw (IllegalArgumentException. (str "'" hash "' is not a valid hash algorithm."))))))
            :join
            (fn [coll & [sep]]
              (throw-when-expecting-seqable coll)
              (if sep (s/join sep coll) (s/join coll)))
            :empty?
            empty?
            :not-empty
            not-empty
            :json
            (fn [x] (json/generate-string x))
            :last
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (if (vector? coll)
                (coll (dec (count coll)))
                (last coll)))
            ;;; Exception to the rule: nil counts to 0
            :length
            (fn [coll]
              (if (nil? coll)
                0
                (do
                  (throw-when-expecting-seqable coll)
                  (count coll))))
            ;;; Exception to the rule: nil counts to 0
            :count
            (fn [coll]
              (if (nil? coll)
                0
                (do
                  (throw-when-expecting-seqable coll)
                  (count coll))))
            ;;; Return true when the count of the coll matches the argument
            :length-is
            (fn [coll n]
              (when-not (nil? coll)
                (throw-when-expecting-seqable coll))
              (let [n (Long/valueOf ^String n)]
                (= n (count coll))))
            :count-is
            (fn [coll n]
              (when-not (nil? coll)
                (throw-when-expecting-seqable coll))
              (let [n (Long/valueOf ^String n)]
                (= n (count coll))))
            ;;; Single newlines become <br />, double newlines mean new paragraph
            :linebreaks
            (fn [s]
              (let [s  (str s)
                    br (s/replace s #"\n" "<br />")
                    p  (s/replace br #"<br /><br />" "</p><p>")
                    c  (s/replace p #"<p>$" )]
                (if (re-seq #"</p>$" c)
                  (str "<p>" c)
                  (str "<p>" c "</p>"))))
            :linebreaks-br
            (fn [s]
              (let [s (str s)]
                (s/replace s #"\n" "<br />")))
            ;;; Display text with line numbers
            :linenumbers
            (fn [s]
              (let [s (str s)]
                (->> (s/split s #"\n")
                     (map-indexed
                       (fn [i line]
                         (str (inc i) ". " line)))
                     (s/join "\n"))))
            :rand-nth
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (rand-nth coll))
            ;;; Turns the to-remove string into a set of chars
            ;;; That are removed from the context string
            :remove
            (fn [s to-remove]
              (let [s         (str s)
                    to-remove (set to-remove)]
                (apply str (remove to-remove s))))
            ;;; Use like the following:
            ;;; You have {{ num-cherries }} cherr{{ num-cherries|pluralize:y:ies }}
            ;;; You have {{ num-walruses }} walrus{{ num-walruses|pluralize:es }}
            ;;; You have {{ num-messages }} message{{ num-messages|pluralize }}
            :pluralize
            (fn [n-or-coll & opts]
              (let [n        (if (number? n-or-coll) n-or-coll
                                                     (do (throw-when-expecting-seqable n-or-coll)
                                                         (count n-or-coll)))
                    plural   (case (count opts)
                               0 "s"
                               1 (first opts)
                               2 (second opts))
                    singular (case (count opts)
                               (list 0 1)
                               2 (first opts))]
                (if (== 1 n)
                  singular
                  plural)))
            ;;; Do not escape html
            :safe
            (fn [s] [:safe s])
            :urlescape
            (fn [s] (java.net.URLEncoder/encode s))
            :lower
            (fn [s] (s/lower-case (str s)))
            :upper
            (fn [s] (s/upper-case (str s)))
            :capitalize
            (fn [s] (s/capitalize (str s)))
            ;; Capitalize every word
            :title
            (fn [s] (->> (s/split (str s) #" ")
                         (map s/capitalize)
                         (s/join " ")))
            :sort
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (sort coll))
            ;;; Sort by a keyword
            :sort-by
            (fn [coll k]
              (throw-when-expecting-seqable coll)
              (sort-by (keyword k) coll))
            :sort-by-reversed
            (fn [coll k]
              (throw-when-expecting-seqable coll)
              (sort-by (keyword k) (comp - compare) coll))
            :sort-reversed
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (sort (comp - compare) coll))
            ;;; Remove tags
            ;;; Use like {{ value|remove-tags:b:span }}
            :remove-tags
            (fn [s & tags]
              (if-not tags
                s
                (let [s       (str s)
                      tags    (str "(" (s/join "|" tags) ")")
                      opening (re-pattern (str "(?i)<" tags "(/?>|(\\s+[^>]*>))"))
                      closing (re-pattern (str "(?i)</" tags ">"))]
                  (-> s
                      (s/replace opening )
                      (s/replace closing )))))
            :name
            name}))

(defn get-filter
  [name]
  (get @filters (keyword name)))

(defn call-filter
  [name & args]
  (apply (get-filter name) args))

(defn add-filter!
  [name f]
  (swap! filters assoc (keyword name) f))

(defn remove-filter!
  [name]
  (swap! filters dissoc (keyword name)))

(ns selmer.middleware
  (:require [selmer.parser :as parser]))

(defn wrap-error-page
  [handler]
  (fn [request]
    (try
      (handler request)
      (catch clojure.lang.ExceptionInfo ex
        (let [{:keys [type error-template] :as data} (ex-data ex)]
          (if (= :selmer-validation-error type)
            {:status 500
             :headers {"Content-Type" "text/html; charset=utf-8"}
             :body (parser/render error-template data)}
            (throw ex)))))))

(ns selmer.node
  (:gen-class))

(defprotocol INode
  (render-node [this context-map] "Renders the context"))

(deftype FunctionNode [handler]
  INode
  (render-node [this context-map]
    (handler context-map))
  clojure.lang.IMeta
  (meta [this]
    (meta handler)))

(deftype TextNode [text]
  INode
  (render-node [this context-map]
    (str text))
  (toString [_]
    (str text)))

(ns selmer.parser
  (:require [selmer.template-parser :refer [preprocess-template]]
            [selmer.filters :refer [filters]]
            [selmer.filter-parser :refer [compile-filter-body]]
            [selmer.tags :refer :all]
            [selmer.util :refer :all]
            [selmer.validator :refer [validation-error]]
            selmer.node)
  (:import [selmer.node INode TextNode FunctionNode]))

(declare parse parse-input parse-file tag-content)

(defonce templates (atom {}))

(defonce cache? (atom true))

(defn cache-on! []
  (reset! cache? true))

(defn cache-off! []
  (reset! cache? false))

(defn- append-slash
  [^String s]
  (if (or (nil? s)
          (.endsWith s "/"))
    s
    (str s "/")))

(defn- make-resource-path
  [path]
  (cond
    (nil? path)
      nil
    (instance? java.net.URL path)
      (append-slash (str path))
    :else
      (append-slash
       (try
         (str (java.net.URL. path))
         (catch java.net.MalformedURLException err
           (str "file:///" path))))))

(defn set-resource-path!
  [path]
  (set-custom-resource-path! (make-resource-path path)))

(defn update-tag [tag-map tag tags]
  (assoc tag-map tag (concat (get tag-map tag) tags)))

(defn set-closing-tags! [& tags]
  (loop [[tag & tags] tags]
    (when tag
      (swap! selmer.tags/closing-tags update-tag tag tags)
      (recur tags))))

(defmacro add-tag!
  [k handler & tags]
  `(do
     (set-closing-tags! ~k ~@tags)
     (swap! selmer.tags/expr-tags assoc ~k (tag-handler ~handler ~k ~@tags))))

(defn remove-tag!
  [k]
  (swap! expr-tags dissoc k)
  (swap! closing-tags dissoc k))

(defn render-template [template context-map]
  " vector of ^selmer.node.INodes and a context map."
  (let [buf (StringBuilder.)]
    (doseq [^selmer.node.INode element template]
        (if-let [value (.render-node element context-map)]
          (.append buf value)
          (.append buf (*missing-value-formatter* (:tag (meta element)) context-map))))
    (.toString buf)))

(defn render [s context-map & [opts]]
  " render takes the string, the context-map and possibly also opts. "
  (render-template (parse parse-input (java.io.StringReader. s) opts) context-map))

(defn render-file [filename-or-url context-map & [{:keys [cache custom-resource-path]
                                            :or  {cache @cache?
                                                  custom-resource-path *custom-resource-path*}
                                            :as opts}]]
  " Parses files if there isn't a memoized post-parse vector ready to go,
  renders post-parse vector with passed context-map regardless. Double-checks
  last-modified on files. Uses classpath for filename-or-url path "
  (binding [*custom-resource-path* (make-resource-path custom-resource-path)]
    (if-let [resource (resource-path filename-or-url)]
      (let [{:keys [template last-modified]} (get @templates resource)
            ;;for some resources, such as ones inside a jar, it's
            ;;not possible to check the last modified timestamp
            last-modified-time (if (or (nil? last-modified) (pos? last-modified))
                                 (resource-last-modified resource) -1)]
        (check-template-exists resource)
        (if (and cache last-modified (= last-modified last-modified-time))
          (render-template template context-map)
          (let [template (parse parse-file filename-or-url opts)]
            (swap! templates assoc resource {:template template
                                             :last-modified last-modified-time})
            (render-template template context-map))))
      (validation-error
       (str "resource-path for " filename-or-url " returned nil, typically means the file doesn't exist in your classpath.")
       nil nil nil))))

(defn expr-tag [{:keys [tag-name args] :as tag} rdr]
  (if-let [handler (tag-name @expr-tags)]
    (handler args tag-content render-template rdr)
    (exception "unrecognized tag: " tag-name " - did you forget to close a tag?")))

(defn filter-tag [{:keys [tag-value]}]
  " Compile-time parser of var tag filters. "
  (compile-filter-body tag-value))

(defn parse-tag [{:keys [tag-type] :as tag} rdr]
  (with-meta
    (if (= :filter tag-type)
      (filter-tag tag)
      (expr-tag tag rdr))
    {:tag tag}))

(defn append-node [content tag ^StringBuilder buf rdr]
  (-> content
    (conj (TextNode. (.toString buf)))
    (conj (FunctionNode. (parse-tag tag rdr)))))

(defn update-tags [tag tags content args ^StringBuilder buf]
  (assoc tags tag
         {:args args
          :content (conj content (TextNode. (.toString buf)))}))

(defn tag-content [rdr start-tag & end-tags]
  (let [buf (StringBuilder.)]
    (loop [ch       (read-char rdr)
           tags     {}
           content  []
           cur-tag  start-tag
           end-tags end-tags]
      (cond
        (and (nil? ch) (not-empty end-tags))
        (exception "No closing tag found for " start-tag)
        (nil? ch)
        tags
        (open-tag? ch rdr)
        (let [{:keys [tag-name args] :as tag} (read-tag-info rdr)]
          (if-let [open-tag  (and tag-name (some #{tag-name} end-tags))]
              (let [tags     (update-tags cur-tag tags content args buf)
                    end-tags (next (drop-while #(not= tag-name %) end-tags))]
                (.setLength buf 0)
                (recur (when-not (empty? end-tags) (read-char rdr)) tags [] open-tag end-tags))
              (let [content (append-node content tag buf rdr)]
                (.setLength buf 0)
                (recur (read-char rdr) tags content cur-tag end-tags))))
        :else
        (do
          (.append buf ch)
          (recur (read-char rdr) tags content cur-tag end-tags))))))

(defn skip-short-comment-tag [template rdr]
  (loop [ch1 (read-char rdr)
         ch2 (read-char rdr)]
    (cond
      (nil? ch2)
      (exception "short-form comment tag was not closed")
      (and (= *short-comment-second* ch1) (= *tag-close* ch2))
      template
      :else (recur ch2 (read-char rdr)))))

(defn add-node [template buf rdr]
  (let [template (if-let [text (not-empty (.toString ^StringBuilder buf))]
                   (conj! template (TextNode. text))
                   template)]
    (.setLength ^StringBuilder buf 0)
    (conj! template (FunctionNode. (parse-tag (read-tag-info rdr) rdr)))))

(defn parse* [input]
  (with-open [rdr (clojure.java.io/reader input)]
      (let [buf      (StringBuilder.)]
        (loop [template (transient [])
               ch (read-char rdr)]
          (if ch
            (cond
              ;; We hit a tag so we append the buffer content to the template
              ;; and empty the buffer, then we proceed to parse the tag
              (and (open-tag? ch rdr) (some #{(peek-rdr rdr)} [*tag-second* *filter-open*]))
              (recur (add-node template buf rdr) (read-char rdr))
              ;; Short comment tags are dropped
              (open-short-comment? ch rdr)
              (recur (skip-short-comment-tag template rdr) (read-char rdr))
              ;; Default case, here we append the character and
              ;; read the next char
              :else
              (do
                (.append buf ch)
                (recur template (read-char rdr))))
            ;; Add the leftover content of the buffer and return the template
            (->> buf (.toString) (TextNode.) (conj! template) persistent!))))))

(defn parse-input [input & [{:keys [custom-tags custom-filters]}]]
  (swap! expr-tags merge custom-tags)
  (swap! filters merge custom-filters)
  (parse* input))

(defn parse-file [file params]
  (-> file preprocess-template (java.io.StringReader.) (parse-input params)))

(defn parse [parse-fn input & [{:keys [tag-open tag-close filter-open filter-close tag-second short-comment-second]
                                :or   {tag-open             *tag-open*
                                       tag-close            *tag-close*
                                       filter-open          *filter-open*
                                       filter-close         *filter-close*
                                       tag-second           *tag-second*
                                       short-comment-second *short-comment-second*}
                                :as   params}]]
  (binding [*tag-open*             tag-open
            *tag-close*            tag-close
            *filter-open*          filter-open
            *filter-close*         filter-close
            *tag-second*           tag-second
            *short-comment-second* short-comment-second
            *tag-second-pattern*   (pattern tag-second)
            *filter-open-pattern*  (pattern "\\" tag-open "\\" filter-open "\\s*")
            *filter-close-pattern* (pattern "\\s*\\" filter-close "\\" tag-close)
            *filter-pattern*       (pattern "\\" tag-open "\\" filter-open "\\s*.*\\s*\\" filter-close "\\" tag-close)
            *tag-open-pattern*     (pattern "\\" tag-open "\\" tag-second "\\s*")
            *tag-close-pattern*    (pattern "\\s*\\" tag-second "\\"  tag-close)
            *tag-pattern*          (pattern "\\" tag-open "\\" tag-second "\\s*.*\\s*\\" tag-second "\\" tag-close)
            *include-pattern*      (pattern "\\" tag-open "\\" tag-second "\\s*include.*")
            *extends-pattern*      (pattern "\\" tag-open "\\" tag-second "\\s*extends.*")
            *block-pattern*        (pattern "\\" tag-open "\\" tag-second "\\s*block.*")
            *block-super-pattern*  (pattern "\\" tag-open "\\" filter-open "\\s*block.super\\s*\\" filter-close "\\" tag-close)
            *endblock-pattern*     (pattern "\\" tag-open "\\" tag-second "\\s*endblock.*")]
    (parse-fn input params)))

(ns selmer.tags
  (:require selmer.node
            [selmer.filter-parser :refer [split-filter-val safe-filter compile-filter-body fix-accessor get-accessor]]
            [selmer.filters :refer [filters]]
            [selmer.util :refer :all]
            [json-html.core :refer [edn->html]])
  (:import [selmer.node INode TextNode FunctionNode]))

(defn parse-arg [^String arg]
  (fix-accessor (.split arg "\\.")))

(defn create-value-mappings [context-map ids value]
  (if (= 1 (count ids))
    (assoc-in context-map (first ids) value)
    (reduce
      (fn [m [path value]] (assoc-in m path value))
      context-map (map vector ids value))))

(defn aggregate-args [args]
  (->> args
       (map #(.split ^String % ","))
       (apply concat)
       (split-with (partial not= "in"))))

(defn compile-filters [items filter-names]
  (map #(compile-filter-body (str items "|" %) false) filter-names))

(defn apply-filters [item filters context-map items]
  (reduce
    (fn [value filter]
      (filter (assoc context-map
                     (keyword items) value
                     (name items) value)))
    item filters))

(defn for-handler [args tag-content render rdr]
  (let [content       (tag-content rdr :for :empty :endfor)
        for-content   (get-in content [:for :content])
        empty-content (get-in content [:empty :content])
        [ids [_ items]] (aggregate-args args)
        ids           (map parse-arg ids)
        [items & filter-names] (if items (.split ^String items "\\|"))
        filters       (compile-filters items filter-names)
        item-keys     (parse-arg items)]
    (fn [context-map]
      (let [buf    (StringBuilder.)
            items  (-> (reduce get-accessor context-map item-keys)
                       (apply-filters filters context-map items))
            length (count items)]
        (if (and empty-content (empty? items))
          (.append buf (render empty-content context-map))
          (doseq [[counter value] (map-indexed vector items)]
            (let [loop-info
                  {:length      length
                   :counter0    counter
                   :counter     (inc counter)
                   :revcounter  (- length (inc counter))
                   :revcounter0 (- length counter)
                   :first       (= counter 0)
                   :last        (= counter (dec length))}]
              (->> (assoc (create-value-mappings context-map ids value)
                     :forloop loop-info
                     :parentloop loop-info)
                   (render for-content)
                   (.append buf)))))
        (.toString buf)))))

(defn render-if [render context-map condition first-block second-block]
  (render
    (cond
      (and condition first-block)
      (:content first-block)
      (and (not condition) first-block)
      (:content second-block)
      condition
      (:content second-block)
      :else [(TextNode. )])
    context-map))

(defn if-result [value]
  (condp = value
    nil false
     false
    "false" false
    false false
    true))

(defn if-default-handler [[condition1 condition2] if-tags else-tags render]
  " Handler of if-condition tags. Expects conditions, enclosed
  tag-content, render boolean. Returns anonymous fn that will expect
  runtime context-map. (Separate from compile-time) "
  (let [not?      (and condition1 condition2 (= condition1 "not"))
        condition (compile-filter-body (or condition2 condition1))]
    (fn [context-map]
      (let [condition (if-result (condition context-map))]
        (render-if render context-map (if not? (not condition) condition) if-tags else-tags)))))

(defn match-comparator [op]
  (condp = op ">" > "<" < "=" == ">=" >= "<=" <=
              (exception "Unrecognized operator in 'if' statement: " op)))

(defn- num? [v]
  (re-matches #"[0-9]*\.?[0-9]+" v))

(defn- parse-double [v]
  (java.lang.Double/parseDouble v))

(defn parse-numeric-params [p1 op p2]
  (let [comparator (match-comparator op)]
    (cond
      (and (not (num? p1)) (not (num? p2)))
      [#(comparator (parse-double %1) (parse-double %2)) p1 p2]
      (num? p1)
      [#(comparator (parse-double p1) (parse-double %)) nil p2]
      (num? p2)
      [#(comparator (parse-double %) (parse-double p2)) p1 nil])))

(defn render-if-numeric [render negate? [comparator context-key1 context-key2] context-map if-tags else-tags]
  (render
    (let [[value1 value2]
          (cond
            (and context-key1 context-key2)
            [(not-empty ((compile-filter-body context-key1) context-map))
             (not-empty ((compile-filter-body context-key2) context-map))]
            context-key1
            [(not-empty ((compile-filter-body context-key1) context-map))]
            context-key2
            [(not-empty ((compile-filter-body context-key2) context-map))])
          result (cond
                   (and value1 value2)
                   (comparator value1 value2)
                   value1
                   (comparator value1)
                   value2
                   (comparator value2))]
      (or (:content (if (if negate? (not result) result) if-tags else-tags))
          [(TextNode. )]))
    context-map))

(defn if-numeric-handler [[p1 p2 p3 p4 :as params] if-tags else-tags render]
  (cond
    (and p4 (not= p1 "not"))
    (exception "invalid params for if-tag: " params)
    (= "not" p1)
    #(render-if-numeric render true (parse-numeric-params p2 p3 p4) % if-tags else-tags)
    :else
    #(render-if-numeric render false (parse-numeric-params p1 p2 p3) % if-tags else-tags)))

(defn render-if-any-all [not? op params if-tags else-tags render]
  (let [filters (map compile-filter-body params)]
    (fn [context-map]
      (render-if
        render
        context-map
        (let [test (op #{true} (map #(if-result (% context-map)) filters))]
          (if not? (not test) test))
        if-tags else-tags))))

(defn if-handler [params tag-content render rdr]
  (let [{if-tags :if else-tags :else} (tag-content rdr :if :else :endif)]
    (cond
      (some #{"any" "all"} (take 2 params))
      (let [[not? op] (if (= "not" (first params))
                        [true (second params)]
                        [false (first params)])
            params (if not? (drop 2 params) (rest params))]
        (render-if-any-all not? (if (= "any" op) some every?) params if-tags else-tags render))
      (< (count params) 3)
      (if-default-handler params if-tags else-tags render)
      :else
      (if-numeric-handler params if-tags else-tags render))))

(defn compare-tag [args comparator render success failure]
  (fn [context-map]
    (let [condition (apply comparator (map #(if (fn? %) (% context-map) %) args))]
      (render-if render context-map condition success failure))))

(defn parse-eq-args [args]
  (for [^String arg args]
    (cond
      (= \" (first arg))
      (.substring arg 1 (dec (.length arg)))
      (= \: (first arg))
      arg
      :else
      (compile-filter-body arg))))

(defn ifequal-handler [args tag-content render rdr]
  (let [{:keys [ifequal else]} (tag-content rdr :ifequal :else :endifequal)
        args (parse-eq-args args)]
    (compare-tag args = render ifequal else)))

(defn ifunequal-handler [args tag-content render rdr]
  (let [{:keys [ifunequal else]} (tag-content rdr :ifunequal :else :endifunequal)
        args (parse-eq-args args)]
    (compare-tag args not= render ifunequal else)))

(defn block-handler [args tag-content render rdr]
  (let [content (get-in (tag-content rdr :block :endblock) [:block :content])]
    (fn [context-map] (render content context-map))))

(defn sum-handler [args _ _ _]
  (fn [context-map]
    (reduce + (map (fn [val]
                     (let [accessor (split-filter-val val)]
                       (get-in context-map accessor))) args))))

(defn now-handler [args _ _ _]
  (fn [context-map]
    ((:date @filters) (java.util.Date.) (clojure.string/join " " args))))

(defn comment-handler [args tag-content render rdr]
  (let [content (tag-content rdr :comment :endcomment)]
    (fn [_]
      (render (filter (partial instance? selmer.node.TextNode) content) {}))))

(defn first-of-handler [args _ _ _]
  (let [args (map compile-filter-body args)]
    (fn [context-map]
      (let [first-true (->> args (map #(% context-map)) (remove empty?) (drop-while false?) first)]
        (or first-true )))))

(defn read-verbatim [rdr]
  (->buf [buf]
         (loop [ch (read-char rdr)]
           (when ch
             (cond
               (open-tag? ch rdr)
               (let [tag (read-tag-content rdr)]
                 (if-not (re-matches #"\{\%\s*endverbatim\s*\%\}" tag)
                   (do (.append buf tag)
                       (recur (read-char rdr)))))
               :else
               (do
                 (.append buf ch)
                 (recur (read-char rdr))))))))

(defn verbatim-handler [args _ render rdr]
  (let [content (read-verbatim rdr)]
    (fn [context-map] content)))

(defn compile-args [args]
  (when-not (even? (count args))
    (exception "invalid arguments passed to 'with' tag: " args))
  (for [[id value] (partition 2 args)]
    [(keyword id) (compile-filter-body value false)]))

(defn with-handler [args tag-content render rdr]
  (let [content (get-in (tag-content rdr :with :endwith) [:with :content])
        args    (->> args
                     (mapcat #(.split ^String % "="))
                     (remove #{"="})
                     (compile-args))]
    (fn [context-map]
      (render content
              (reduce
                (fn [context-map [k v]]
                  (assoc context-map k (v context-map)))
                context-map args)))))

(defn- build-uri-for-script-or-style-tag
  [^String uri {:keys [selmer/context] :as context-map}]
  (let [literal? (and (.startsWith uri "\"") (.endsWith uri "\""))
        uri
        (if literal?
          (.replace uri "\"" "")     ; case of {% style "/css/foo.css" %}
          (-> uri                    ; case of {% style context-param|some-filter:arg1:arg2 %}
              (compile-filter-body)
              (apply [context-map])))]
    (-> selmer/context (str uri) (.replace "//" "/"))))

(defn script-handler
  [[^String uri & args] _ _ _]
  (let [args
        (->> args
             (mapcat #(.split ^String % "="))
             (remove #{"="})
             (compile-args))]
    (fn [{:keys [selmer/context] :as context-map}]
      (let [args
            (reduce
             (fn [context-map [k v]]
               (assoc context-map k (v context-map)))
             context-map
             args)
            async-attr (when (:async args) "async ")
            src-attr-val (build-uri-for-script-or-style-tag uri context-map)]
        (str "<script " async-attr "src=\"" src-attr-val "\" type=\"text/javascript\"></script>")))))

(defn style-handler
  [[^String uri] _ _ _]
  (fn [{:keys [selmer/context] :as context-map}]
    (let [href-attr-val (build-uri-for-script-or-style-tag uri context-map)]
      (str "<link href=\"" href-attr-val "\" rel=\"stylesheet\" type=\"text/css\" />"))))

(defn cycle-handler [args _ _ _]
  (let [fields (vec args)
        length (dec (count fields))
        i      (int-array [0])]
    (fn [_]
      (let [cur-i (aget i 0)
            val   (fields cur-i)]
        (aset i 0 (if (< cur-i length) (inc cur-i) 0))
        val))))

(defn safe-handler [args tag-content render rdr]
  (let [content (get-in (tag-content rdr :safe :endsafe) [:safe :content])]
    (fn [context-map]
      (render content (assoc context-map safe-filter true)))))

(defn debug-handler [_ _ _ _]
  (fn [context-map]
    (str
      "<style>"
      (-> "json.human.css" clojure.java.io/resource slurp)
      "</style>"
      (edn->html context-map))))

(defonce expr-tags
         (atom {:if        if-handler
                :ifequal   ifequal-handler
                :ifunequal ifunequal-handler
                :sum       sum-handler
                :for       for-handler
                :block     block-handler
                :cycle     cycle-handler
                :now       now-handler
                :comment   comment-handler
                :firstof   first-of-handler
                :verbatim  verbatim-handler
                :with      with-handler
                :script    script-handler
                :style     style-handler
                :safe      safe-handler
                :debug     debug-handler
                :extends   nil
                :include   nil}))

(defonce closing-tags
         (atom {:if        [:else :endif]
                :else      [:endif :endifequal :endifunequal]
                :ifequal   [:else :endifequal]
                :ifunequal [:else :endifunequal]
                :block     [:endblock]
                :for       [:empty :endfor]
                :empty     [:endfor]
                :comment   [:endcomment]
                :safe      [:endsafe]
                :verbatim  [:endverbatim]
                :with      [:endwith]}))

(defn render-tags [context-map tags]
  (into {}
        (for [[tag content] tags]
          [tag
           (update-in content [:content]
                      (fn [^selmer.node.INode node]
                        (clojure.string/join (map #(.render-node ^selmer.node.INode % context-map) node))))])))

(defn tag-handler [handler & tags]
  (fn [args tag-content render rdr]
    (if-let [content (if (> (count tags) 1) (apply (partial tag-content rdr) tags))]
      (fn [context-map]
        (render
          [(->> content (render-tags context-map) (handler args context-map) (TextNode.))]
          context-map))
      (fn [context-map]
        (handler args context-map)))))

(ns selmer.template-parser
  (:require [clojure.java.io :refer [reader]]
            [selmer.util :refer :all]
            [clojure.string :as s :refer [split trim]]
            [selmer.validator :as validator])
  (:import java.io.StringReader))

(declare consume-block preprocess-template)

(defn get-tag-params [tag-id block-str]
  (let [tag-id (re-pattern (str "^.+?" tag-id "\\s*"))]
    (-> block-str (s/replace tag-id ) (split *tag-second-pattern*) first trim)))

(defn parse-defaults [defaults]
  (when defaults
    (->> defaults
         (interpose " ")
         (apply str)
         split-by-args
         (partition 2)
         (map vec)
         (into {}))))

(defn split-include-tag [^String tag-str]
  (seq (.split ^String (get-tag-params "include" (.replace tag-str "\\" "/")) " ")))

(defn string->reader [string]
  (reader (StringReader. string)))

(defn insert-includes
  [template]
  ;; We really need to split out the "gather all parent templates recursively"
  ;; and separate that from the buffer appending so we can gather the template
  ;; hierarchy for smarter cache invalidation - will eliminate almost all
  ;; existing reasons for cache-off!
  (->buf [buf]
         (with-open [rdr (reader (StringReader. template))]
           (loop [ch (read-char rdr)]
             (when ch
               (if (and (= *tag-open* ch) (= *tag-second* (peek-rdr rdr)))
                 (let [tag-str (read-tag-content rdr)]
                   (.append buf
                            (if (re-matches *include-pattern* tag-str)
                              (let [params   (split-include-tag tag-str)
                                    source   (.replaceAll ^String (first params) "\"" "")
                                    defaults (parse-defaults (nnext params))]
                                (preprocess-template source {} defaults))
                              tag-str)))
                 (.append buf ch))
               (recur (read-char rdr)))))))

(defn get-parent [tag-str]
  (let [template (get-tag-params "extends" tag-str)]
    (.substring ^String template 1 (dec (.length ^String template)))))

(defn write-tag? [buf super-tag? existing-block blocks-to-close omit-close-tag?]
  (and buf
       (or super-tag?
           (and
             (not existing-block)
             (> blocks-to-close (if omit-close-tag? 1 0))))))

(defn consume-block [rdr & [^StringBuilder buf blocks omit-close-tag?]]
  (loop [blocks-to-close 1
         has-super? false]
    (if (and (pos? blocks-to-close) (peek-rdr rdr))
      (let [ch (read-char rdr)]
        (if (open-tag? ch rdr)
          (let [tag-str        (read-tag-content rdr)
                block?         (re-matches *block-pattern* tag-str)
                block-name     (if block? (get-tag-params "block" tag-str))
                super-tag?     (re-matches *block-super-pattern* tag-str)
                existing-block (if block-name (get-in blocks [block-name :content]))]
            ;;check if we wish to write the closing tag for the block. If we're
            ;;injecting block.super, then we want to omit it
            (when (write-tag? buf super-tag? existing-block blocks-to-close omit-close-tag?)
              (.append buf tag-str))
            (recur
              (long
                (cond
                  existing-block
                  (do
                    (consume-block rdr)
                    (consume-block
                      (StringReader. existing-block) buf (dissoc blocks block-name))
                    blocks-to-close)
                  block?
                  (inc blocks-to-close)
                  (re-matches *endblock-pattern* tag-str)
                  (dec blocks-to-close)
                  :else blocks-to-close))
              (or has-super? super-tag?)))
          (do
            (when buf (.append buf ch))
            (recur blocks-to-close has-super?))))
      (boolean has-super?))))

(defn rewrite-super [block parent-content]
  (clojure.string/replace block *block-super-pattern* parent-content))

(defn read-block [rdr block-tag blocks]
  (let [block-name     (get-tag-params "block" block-tag)
        existing-block (get blocks block-name)]
    (cond
      ;;we have a child block with a {{block.super}} tag, we'll need to
      ;;grab the contents of the parent and inject them in the child
      (:super existing-block)
      (let [child-content  (:content existing-block)
            parent-content (StringBuilder.)
            has-super?     (consume-block rdr parent-content blocks true)]
        (assoc blocks block-name
               {:super has-super?
                :content (rewrite-super child-content (.toString parent-content))}))
      ;;we've got a child block without a super tag, the parent will be replaced
      existing-block
      (do (consume-block rdr) blocks)
      ;;this is the first occurance of the block and we simply add it to the
      ;;map of blocks we've already seen
      :else
      (let [buf        (doto (StringBuilder.) (.append block-tag))
            has-super? (consume-block rdr buf blocks)]
        (assoc blocks block-name
               {:super has-super?
                :content (.toString buf)})))))

(defn process-block [rdr buf block-tag blocks]
  (let [block-name (get-tag-params "block" block-tag)]
    (if-let [child-content (get-in blocks [block-name :content])]
      (.append ^StringBuilder buf
               (rewrite-super
                 child-content
                 (->buf [buf] (consume-block rdr buf blocks true))))
      (do
        (.append ^StringBuilder buf block-tag)
        (consume-block rdr buf blocks)))))

(defn wrap-in-expression-tag [string]
  (str *tag-open* *tag-second* string *tag-second* *tag-close*))

(defn wrap-in-variable-tag [string]
  (str *tag-open* *filter-open* string *filter-close* *tag-close*))

(defn trim-regex [string & regexes]
  (reduce #(clojure.string/replace %1 %2 ) string regexes))

(defn trim-variable-tag [string]
  (trim-regex string *filter-open-pattern* *filter-close-pattern*))

(defn trim-expression-tag [string]
  (trim-regex string *tag-open-pattern* *tag-close-pattern*))

(defn to-expression-string [tag-name args]
  (let [tag-name' (name tag-name)
        args' (clojure.string/join \space args)
        joined (if (seq args) (str tag-name' \space args') tag-name')]
    (wrap-in-expression-tag joined)))

(defn add-default [identifier default]
  (str identifier "|default:" \" default \"))

(defn try-add-default [identifier defaults]
  (if-let [default (get defaults identifier)]
    (add-default identifier default)
    identifier))

(defn add-defaults-to-variable-tag [tag-str defaults]
  (let [tag-name (trim-variable-tag tag-str)]
    (wrap-in-variable-tag (try-add-default tag-name defaults))))

(defn add-defaults-to-expression-tag [tag-str defaults]
  (let [tag-str' (->> (trim-expression-tag tag-str)
                      ;; NOTE: we add a character here since read-tag-info
                      ;; consumes the first character before parsing.
                      (str *tag-second*))
        {:keys [tag-name args]} (read-tag-info (string->reader tag-str')) ]
    (to-expression-string tag-name (map #(try-add-default % defaults) args))))

(defn get-template-path [template]
  (resource-path template))

(defn read-template [template blocks defaults]
  (let [path (resource-path template)]
    (when-not path
      (validator/validation-error
        (str "resource-path for " template " returned nil, typically means the file doesn't exist in your classpath.")
        nil nil nil))
    (validator/validate path)
    (check-template-exists (get-template-path template))
    (let [buf (StringBuilder.)
          [parent blocks]
          (with-open [rdr (reader path)]
            (loop [blocks (or blocks {})
                   ch     (read-char rdr)
                   parent nil]
              (cond
                (nil? ch) [parent blocks]
                (open-tag? ch rdr)
                (let [tag-str (read-tag-content rdr)]
                  (cond
                    (and defaults
                         (re-matches *filter-pattern* tag-str))
                    (do (.append buf (add-defaults-to-variable-tag tag-str defaults))
                        (recur blocks (read-char rdr) parent))
                    (and defaults
                         (re-matches *tag-pattern* tag-str))
                    (do (.append buf (add-defaults-to-expression-tag tag-str defaults))
                        (recur blocks (read-char rdr) parent))
                    ;;if the template extends another it's not the root
                    ;;this template is allowed to only contain blocks
                    (re-matches *extends-pattern* tag-str)
                    (recur blocks (read-char rdr) (get-parent tag-str))
                    ;;if we have a parent then we simply want to add the
                    ;;block to the block map if it hasn't been added already
                    (and parent (re-matches *block-pattern* tag-str))
                    (recur (read-block rdr tag-str blocks) (read-char rdr) parent)
                    ;;if the template has blocks, but no parent it's the root
                    ;;we either replace the block with an existing one from a child
                    ;;template or read the block from this template
                    (re-matches *block-pattern* tag-str)
                    (do
                      (process-block rdr buf tag-str blocks)
                      (recur blocks (read-char rdr) parent))
                    ;;if we are in the root template we'll accumulate the content
                    ;;into a buffer, this will be the resulting template string
                    (nil? parent)
                    (do
                      (.append buf tag-str)
                      (recur blocks (read-char rdr) parent))))
                :else
                (do
                  (if (nil? parent) (.append buf ch))
                  (recur blocks (read-char rdr) parent)))))]
      (if parent (recur parent blocks defaults) (.toString buf)))))

(defn preprocess-template [template & [blocks defaults]]
  (insert-includes (read-template template blocks defaults)))

(ns selmer.util
  (:import java.io.StringReader
           java.util.regex.Pattern))

(defmacro exception [& [param & more :as params]]
  (if (class? param)
    `(throw (new ~param (str ~@more)))
    `(throw (Exception. (str ~@params)))))

(def ^:dynamic *custom-resource-path* nil)

(defn set-custom-resource-path!
  [path]
  (alter-var-root #'*custom-resource-path* (constantly path))
  (when (thread-bound? #'*custom-resource-path*)
    (set! *custom-resource-path* path)))

(def ^:dynamic *escape-variables* true)

(defn turn-off-escaping! []
  (alter-var-root #'*escape-variables*
                  (constantly false)))

(defn turn-on-escaping! []
  (alter-var-root #'*escape-variables*
                  (constantly true)))

(defmacro with-escaping [& body]
  `(binding [*escape-variables* true]
     ~@body))

(defmacro without-escaping [& body]
  `(binding [*escape-variables* false]
     ~@body))

(defn pattern [& content]
  (re-pattern (clojure.string/join content)))

(defn read-char [^java.io.Reader rdr]
  (let [ch (.read rdr)]
    (if-not (== -1 ch) (char ch))))

(defn assoc-in*
  [m ks v]
  (let [k (first ks)]
    (if (zero? (count ks))
      (assoc m k (assoc-in* (get m k) (next ks) v))
      (assoc m k v))))

(def ^:dynamic ^Character *tag-open* \{)
(def ^:dynamic ^Character *tag-close* \})
(def ^:dynamic ^Character *filter-open* \{)
(def ^:dynamic ^Character *filter-close* \})
(def ^:dynamic ^Character *tag-second* \%)
(def ^:dynamic ^Character *short-comment-second* \#)

(def ^:dynamic ^Pattern *tag-second-pattern* nil)
(def ^:dynamic ^Pattern *filter-open-pattern* nil)
(def ^:dynamic ^Pattern *filter-close-pattern* nil)
(def ^:dynamic ^Pattern *filter-pattern* nil)
(def ^:dynamic ^Pattern *tag-open-pattern* nil)
(def ^:dynamic ^Pattern *tag-close-pattern* nil)
(def ^:dynamic ^Pattern *tag-pattern* nil)
(def ^:dynamic ^Pattern *include-pattern* nil)
(def ^:dynamic ^Pattern *extends-pattern* nil)
(def ^:dynamic ^Pattern *block-pattern* nil)
(def ^:dynamic ^Pattern *block-super-pattern* nil)
(def ^:dynamic ^Pattern *endblock-pattern* nil)

(def match-unquoted " *(?=(?:[^\"]*\"[^\"]*\")*[^\"]*$)")

(defn check-tag-args [args]
  (if (even? (count (filter #{\"} args)))
    args (exception "malformed tag arguments in " args)))

(defn read-tag-info [rdr]
  (let [buf      (StringBuilder.)
        tag-type (if (= *filter-open* (read-char rdr)) :filter :expr)]
    (loop [ch1 (read-char rdr)
           ch2 (read-char rdr)]
      (when-not (or (nil? ch1)
                    (and (or (= *filter-close* ch1) (= *tag-second* ch1))
                         (= *tag-close* ch2)))
        (.append buf ch1)
        (recur ch2 (read-char rdr))))
    (let [content (->> (.toString buf)
                       (check-tag-args)
                       (re-seq #"(?:[^\s\"]|\"[^\"]*\")+")
                       (remove empty?)
                       (map (fn [^String s] (.trim s))))]
      (merge {:tag-type tag-type}
             (if (= :filter tag-type)
               {:tag-value (first content)}
               {:tag-name (keyword (first content))
                :args     (next content)})))))

(defn peek-rdr [^java.io.Reader rdr]
  (.mark rdr 1)
  (let [result (read-char rdr)]
    (.reset rdr)
    result))

(defmacro ->buf [[buf] & body]
  `(let [~buf (StringBuilder.)]
     (do ~@body)
     (.toString ~buf)))

(defn read-tag-content [rdr]
  (->buf [buf]
         (let [next-ch (peek-rdr rdr)
               filter? (not= *tag-second* next-ch)]
           (.append buf *tag-open*)
           (when next-ch
             (loop [ch (read-char rdr)]
               (.append buf ch)
               (when (and (not= *tag-close* ch) (not= *filter-close* ch))
                 (recur (read-char rdr))))
             (when filter?
               (.append buf (read-char rdr)))))))

(defn open-tag? [ch rdr]
  (and (= *tag-open* ch)
       (let [next-ch (peek-rdr rdr)]
         (or (= *filter-open* next-ch)
             (= *tag-second* next-ch)))))

(defn open-short-comment? [ch rdr]
  (and (= *tag-open* ch)
       (let [next-ch (peek-rdr rdr)]
         (= *short-comment-second* next-ch))))

(defn split-by-args [s]
  (let [rdr (StringReader. s)
        buf (StringBuilder.)]
    (loop [items []
           ch    (read-char rdr)
           open? false]
      (cond
        (nil? ch) items
        (and open? (= ch \"))
        (let [value (.trim (.toString buf))]
          (.setLength buf 0)
          (recur (conj items value) (read-char rdr) false))
        (= ch \")
        (recur items (read-char rdr) true)
        (and (not open?) (= ch \=))
        (let [id (.trim (.toString buf))]
          (.setLength buf 0)
          (recur (conj items id) (read-char rdr) open?))
        :else
        (do
          (.append buf ch)
          (recur items (read-char rdr) open?))))))

(defn get-resource [resource]
  (-> (Thread/currentThread)
      (.getContextClassLoader)
      (.getResource resource)))

(defn resource-path [template]
  (if (instance? java.net.URL template)
    template
    (if-let [path *custom-resource-path*]
      (java.net.URL. (str path template))
      (get-resource template))))

(defn resource-last-modified [^java.net.URL resource]
  (let [path (.getPath resource)]
    (try
      (.lastModified (java.io.File. ^String path))
      (catch NullPointerException _ -1))))

(defn check-template-exists [^java.net.URL resource]
  (when-not resource
    (exception "template: \ (.getPath ^java.net.URL resource) "\" not found")))

(def default-missing-value-formatter (constantly ))

(def ^:dynamic *missing-value-formatter* default-missing-value-formatter)
(def ^:dynamic *filter-missing-values* true)

(defn set-missing-value-formatter!
  [missing-value-fn & {:keys [filter-missing-values] :or {filter-missing-values false}}]
  (alter-var-root #'*missing-value-formatter* (constantly missing-value-fn))
  (alter-var-root #'*filter-missing-values* (constantly filter-missing-values)))

(ns selmer.validator
 (:use selmer.tags
       selmer.filters
       selmer.util
       [clojure.set :only [difference]]
       [clojure.java.io :only [reader]]))

(def error-template
  (slurp (get-resource "selmer-error-template.html")))

(def validate? (atom true))

(defn validate-on! [] (reset! validate? true))

(defn validate-off! [] (reset! validate? false))

(defn format-tag [{:keys [tag-name tag-value tag-type args]}]
  (condp = tag-type
    :expr (str *tag-open* *tag-second* " " (name tag-name) " " (if args (str (clojure.string/join args) " ")) *tag-second* *tag-close*)
    :filter (str *tag-open* *filter-open* (name tag-value) *filter-close* *tag-close*)
    (str tag-name " " tag-value " " tag-type " " args)))

(defn validation-error
  ([error tag line template]
   (validation-error
     (str error
          (if tag (str " " (format-tag tag)))
          (if line (str " on line " line))
          (if template (str " for template " template)))
     error line [{:tag tag :line line}] template))
  ([long-error short-error line error-tags template]
   (throw
     (ex-info long-error
              {:type           :selmer-validation-error
               :error          short-error
               :error-template error-template
               :line           line
               :template       template
               :validation-errors
               (for [error error-tags]
                 (update-in error [:tag] format-tag))}))))

(defn validate-filters [template line {:keys [tag-value] :as tag}]
  (let [tag-filters (map
                  #(-> ^String % (.split ":") first keyword)
                  (-> tag-value name (.split "\\|") rest))]
    (if-not (empty? (difference (set tag-filters) (set (keys @filters))))
      (validation-error (str "Unrecognized filter " tag-value " found inside the tag") tag line template))))

(defn close-tags []
  (apply concat (vals @closing-tags)))

(defn valide-tag [template line tags {:keys [tag-name args tag-value tag-type] :as tag}]
 (condp = tag-type
   :expr
   (let [last-tag (last tags)
         end-tags (get @closing-tags (:tag-name last-tag))]
     (doseq [arg args] (validate-filters template line (assoc tag :tag-value arg)))
     (cond
       (nil? tag-name)
       (validation-error "No tag name supplied for the tag" tag line template)
       (not-any? #{tag-name} (concat (close-tags) (keys @expr-tags)))
       (validation-error "Unrecognized tag found" tag line template)
       ;; check if we have closing tag
       ;; handle the case where it's an intermediate tag
       ;; throw an exception if it doesn't belong to the last open tag
       (some #{tag-name} (close-tags))
       (let [tags (vec (butlast tags))]
         (if (some #{tag-name} end-tags)
           (if (not-empty (get @closing-tags tag-name))
             (conj tags (assoc tag :line line)) tags)
           (validation-error "No closing tag found for the tag" last-tag (:line last-tag) template)))
       (not-empty (get @closing-tags tag-name))
       (conj tags (assoc tag :line line))
       (some #{tag-name} (close-tags))
       (validation-error "Found an orphan closing tag" tag line template)
       :else tags))
   :filter
   (do (validate-filters template line tag) tags)))

(defn skip-verbatim-tags [tag-info rdr line template]
  (if (= :verbatim (:tag-name tag-info))
    (loop [ch (read-char rdr)]
      (if ch
        (if-not (and
                 (open-tag? ch rdr)
                 (= :endverbatim (:tag-name (read-tag-info rdr))))
          (recur (read-char rdr)))))
    tag-info))

(defn read-tag [rdr line template]
  (try
    (-> (read-tag-info rdr) (skip-verbatim-tags rdr line template))
    (catch Exception ex
      (validation-error (str "Error parsing the tag: " (.getMessage ex)) nil line template))))

(defn validate-tags [template]
  (with-open [rdr (reader template)]
    (loop [tags [], ch (read-char rdr), line 1]
      (if ch
        (if (open-tag? ch rdr)
          (if-let [tag-info (read-tag rdr line template)]
            (recur (valide-tag template line tags tag-info) (read-char rdr) line)
            (recur tags (read-char rdr) line))
          (recur tags (read-char rdr) (if (= \newline ch) (inc line) line)))
        tags))))

(defn validate [template]
  (when @validate?
    (check-template-exists template)
    (if-let [orphan-tags (not-empty (validate-tags template))]
      (validation-error
        (->> orphan-tags
             (map (fn [{:keys [tag-name line] :as tag}] (str (format-tag tag) " on line " line)))
             (interpose ", ")
             doall
             (clojure.string/join "The template contains orphan tags: "))
        "The template contains orphan tags."
        nil
        orphan-tags
        template))))