Django style templates for Clojure



(this space intentionally left almost blank)

Accessors are separated by dots like {{ }} which gets translated into (get-in context-map [:foo :bar 0]). So you can nest vectors and maps in your context-map.

Filters can be applied by separating then from the accessor with pipes: {{ foo|lower|capitalize }}. They are applied one after the other from left to right. Arguments can be passed to a filter separated by colons: {{ foo|pluralize:y:ies }}. If an argument includes spaces you can enclose it with doublequotes or colons: {{ foo|join:", " }}.

You can escape doublequotes inside doublequotes. And you can put colons inside doublequotes which will be ignored for the purpose of separating arguments.

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

More Utils

(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))))))

Removes doublequotes from the start and end of a string if any.

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

Must have the form [:safe safe-string] to prevent escaping. Alternatively, you can call selmer.util/turn-off-escaping! to turn it off completely.

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

Turns strings into keywords and strings like "0" into Longs so it can access vectors as well as maps.

Compile filters

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

Split accessors like by the dot. But if there is a double dot '..' then it will leave it

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

Map any sort of needed fixes to the arguments before passing them to the filters. Only strips enclosing doublequotes for now.

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

Given a context map, return a function that accepts a filter argument and if it begins with @, return the value from the context map instead of treating it as a literal.

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

Turns a filter string like "pluralize:y:ies" into a function that expects a value obtained from a context map or from a previously applied filter.

(defn filter-str->fn
  (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]
    (and (.startsWith val "\) (.endsWith val "\))
    (re-matches #"[0-9]+" val)))
(defn- parse-literal [^String val]
  (if (.startsWith val "\)
    (subs val 1 (dec (count val)))
(defn- apply-filters [val s filter-strs filters context-map]
    (fn [acc [filter-str filter]]
      (try (filter acc context-map)
           (catch Exception e
               "On filter body '" s "' and filter '" filter-str "' this error occurred:" (.getMessage e)))))
    (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))))))

Turns a string like foo|filter1:x|filter2:y into a fn that expects a context-map and will apply the filters one after the other to the value from the map. It will escape the end result unless the last filter is "safe" or when it's called with escape? equal to true, which is the default behavior.

(defn compile-filter-body
  ([s] (compile-filter-body s true))
  ([s escape?]
   (let [[val & filter-strs] (->> s
                                  ;; 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]
           (parse-literal val)
       (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
               ;; Escape by default unless the last filter is 'safe' or safe-filter is set in the context-map
                 (safe-filter context-map) x
                 escape? (escape-html x)
                 :else x)))))))))

To create a filter use the function add-filter! which takes a name and a fn. The first argument to the fn is always the value obtained from the context map. The rest of the arguments are optional and are always strings.

(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.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)
        (try (DateTime. d)
             (catch Exception _
               (throw (IllegalArgumentException. (str d " is not a valid date format.")))))))

Throws an exception with the given msg when (seq x) will fail (excluding nil)

Used in filters when we are expecting a collection but instead got nil or a number or something else just as useless. Some clojure functions silently do the wrong thing when given invalid arguments. This aims to prevent that.

(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))))

Similar to the above only with numbers

(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
           {;;; Useful for doing crazy stuff like {{ foo|length-is:3|join:"/" }}
            ;;; Without blowing up I guess
            ;;; Try to add the arguments as numbers
            ;;; If it fails concatenate them as strings
            (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
            (fn [s]
              (->> s
                   (mapcat (fn [c]
                             (if (or (= \" c) (= \' c))
                               [\\ c]
                   (apply str)))
            ;;; Center a string given a width
            (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))]
                  (apply str (repeat l \space))
                  (apply str (repeat r \space)))))
            (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)))
            (fn [n fmt & [locale]]
              (throw-when-expecting-number n)
              (let [locale (if locale (java.util.Locale. locale)
                (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
            ;;; for formatting help.
            ;;; You can also format time with this.
            ;;; An optional locale for formatting can be given as second parameter
            (fn [d fmt & [locale]]
              (when d
                (let [fixed-date             (fix-date d)
                      locale                 (if locale (java.util.Locale. locale)
                      ^DateTimeFormatter fmt (.withLocale
                                               (or ^DateTimeFormatter (valid-date-formats fmt)
                                                   ^DateTimeFormatter (DateTimeFormat/forPattern fmt)) locale)]
                  (.print fmt fixed-date))))
            ;;; Default if x is falsey
            (fn [x default]
              (if x
            ;;; Default if coll is empty
            (fn [coll default]
                  (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
            (fn [n & [decimal-places]]
              (throw-when-expecting-number n)
              (let [n (double n)]
                (format (str "%." (if decimal-places decimal-places "1") "f")
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (first coll))
            (fn [coll n]
              (throw-when-expecting-seqable coll)
              (vec (take (Long/valueOf ^String n) coll)))
            (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
            (fn [n i]
              (let [nv (vec (str n))
                    i  (Long/valueOf ^String i)
                    i  (- (count nv) i)]
                (if (or (< i 0) (>= i (count nv)))
                  (let [d (nv i)]
                    (if (= \. d)
                      (nv (dec i))
            (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."))))))
            (fn [coll & [sep]]
              (throw-when-expecting-seqable coll)
              (if sep (s/join sep coll) (s/join coll)))
            (fn [x] (json/generate-string x))
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (if (vector? coll)
                (coll (dec (count coll)))
                (last coll)))
            ;;; Exception to the rule: nil counts to 0
            (fn [coll]
              (if (nil? coll)
                  (throw-when-expecting-seqable coll)
                  (count coll))))
            ;;; Exception to the rule: nil counts to 0
            (fn [coll]
              (if (nil? coll)
                  (throw-when-expecting-seqable coll)
                  (count coll))))
            ;;; Return true when the count of the coll matches the argument
            (fn [coll n]
              (when-not (nil? coll)
                (throw-when-expecting-seqable coll))
              (let [n (Long/valueOf ^String n)]
                (= n (count coll))))
            (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
            (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>"))))
            (fn [s]
              (let [s (str s)]
                (s/replace s #"\n" "<br />")))
            ;;; Display text with line numbers
            (fn [s]
              (let [s (str s)]
                (->> (s/split s #"\n")
                       (fn [i line]
                         (str (inc i) ". " line)))
                     (s/join "\n"))))
            (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
            (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 }}
            (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)
            ;;; Do not escape html
            (fn [s] [:safe s])
            (fn [s] ( s))
            (fn [s] (s/lower-case (str s)))
            (fn [s] (s/upper-case (str s)))
            (fn [s] (s/capitalize (str s)))
            ;; Capitalize every word
            (fn [s] (->> (s/split (str s) #" ")
                         (map s/capitalize)
                         (s/join " ")))
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (sort coll))
            ;;; Sort by a keyword
            (fn [coll k]
              (throw-when-expecting-seqable coll)
              (sort-by (keyword k) coll))
            (fn [coll k]
              (throw-when-expecting-seqable coll)
              (sort-by (keyword k) (comp - compare) coll))
            (fn [coll]
              (throw-when-expecting-seqable coll)
              (sort (comp - compare) coll))
            ;;; Remove tags
            ;;; Use like {{ value|remove-tags:b:span }}
            (fn [s & tags]
              (if-not tags
                (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 )))))
(defn get-filter
  (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!
  (swap! filters dissoc (keyword name)))
(ns selmer.middleware
  (:require [selmer.parser :as parser]))

development middleware for rendering a friendly error page when a parsing error occurs

(defn wrap-error-page
  (fn [request]
      (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)))))))

Node protocol for the objects that get accum'd in the post-parse vector. Same vector that will be processed by the runtime context-aware renderer. Currently only TextNodes and FunctionNodes. Anything that requires action upon context map data at runtime is handled by a generated anonymous function.

(ns selmer.node

Generic INode protocol

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

Implements fn handler for the context map. fn handlers can access any data in the context map.

(deftype FunctionNode [handler]
  (render-node [this context-map]
    (handler context-map))
  (meta [this]
    (meta handler)))

Implements dumb text content injection at runtime.

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

Parsing and handling of compile-time vs. run-time. Avoiding unnecessary work by pre-processing the template structure and content and reacting to the runtime context map with a prepared data structure instead of a raw template. Anything other than a raw tag value injection is a runtime dispatch fn. Compile-time here means the first time we see a template at runtime, not the implementation's compile-time.

(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]]
  (:import [selmer.node INode TextNode FunctionNode]))

Ahead decl because some fns call into each other.

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

Memoization atom for templates. If you pass a filepath instead of a string, we'll use the last-modified timestamp to cache the template. Works fine for active local development and production.

(defonce templates (atom {}))

Can be overridden by closure/argument 'cache

(defonce cache? (atom true))
(defn cache-on! []
  (reset! cache? true))
(defn cache-off! []
  (reset! cache? false))

append '/' to the given string unless it already ends with a slash

(defn- append-slash
  [^String s]
  (if (or (nil? s)
          (.endsWith s "/"))
    (str s "/")))
(defn- make-resource-path
    (nil? path)
    (instance? path)
      (append-slash (str path))
         (str ( path))
         (catch err
           (str "file:///" path))))))

set custom location, where templates are being searched for. path may be a instance or a string. If it's a string, we first try to convert it to a instance and if it doesn't work it's interpreted as a path in the local filesystem.

(defn set-resource-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))))

tag name, fn handler, and maybe tags

add-tag! is a hella nifty macro. Example use: (add-tag! :joined (fn [args context-map] (clojure.string/join "," args)))

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

render-template renders at runtime, accepts post-parsing vectors of INode elements.

(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 ( s) opts) context-map))

Primary fn you interact with as a user, you pass a path that exists somewhere in your class-path, typically something like resources/templates/template_name.html. You also pass a context map and potentially opts. Smart (last-modified timestamp) auto-memoization of compiler output.

(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))))
       (str "resource-path for " filename-or-url " returned nil, typically means the file doesn't exist in your classpath.")
       nil nil nil))))

For a given tag, get the fn handler for the tag type, pass it the arguments, tag-content, render-template fn, and reader.

(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?")))

Same as a vanilla data tag with a value, but composes the filter fns. Like, {{ data-var | upper | safe }} (-> {:data-var "woohoo"} upper safe) => "WOOHOO" Happens at compile-time.

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

Generally either a filter tag, if tag, ifequal, or for. filter-tags are conflated with vanilla tag

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

Parses and detects tags which turn into FunctionNode call-sites or TextNode content. open-tag? fn returns true or false based on character lookahead to see if it's {{ or {%

(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]
        (and (nil? ch) (not-empty end-tags))
        (exception "No closing tag found for " start-tag)
        (nil? ch)
        (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))))
          (.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)]
      (nil? ch2)
      (exception "short-form comment tag was not closed")
      (and (= *short-comment-second* ch1) (= *tag-close* ch2))
      :else (recur ch2 (read-char rdr)))))

Compile-time parsing of tags. Accumulates a transient vector before returning the persistent vector of INodes (TextNode, FunctionNode)

(defn add-node [template buf rdr]
  (let [template (if-let [text (not-empty (.toString ^StringBuilder buf))]
                   (conj! template (TextNode. text))
    (.setLength ^StringBuilder buf 0)
    (conj! template (FunctionNode. (parse-tag (read-tag-info rdr) rdr)))))
(defn parse* [input]
  (with-open [rdr ( input)]
      (let [buf      (StringBuilder.)]
        (loop [template (transient [])
               ch (read-char rdr)]
          (if ch
              ;; 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
                (.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!))))))

Primary compile-time parse routine. Work we don't want happening after first template render. Vector output from parse* gets memoized by render-file.

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

File-aware parse wrapper.

(defn parse-file [file params]
  (-> file preprocess-template ( (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]))

A tag can modify the context map for its body It has full control of its body which means that it has to take care of its compilation.

(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)
      (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]
    (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]
      (and condition first-block)
      (:content first-block)
      (and (not condition) first-block)
      (:content second-block)
      (:content second-block)
      :else [(TextNode. )])
(defn if-result [value]
  (condp = value
    nil false
    "false" false
    false false
(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)]
      (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]
    (let [[value1 value2]
            (and context-key1 context-key2)
            [(not-empty ((compile-filter-body context-key1) context-map))
             (not-empty ((compile-filter-body context-key2) context-map))]
            [(not-empty ((compile-filter-body context-key1) context-map))]
            [(not-empty ((compile-filter-body context-key2) context-map))])
          result (cond
                   (and value1 value2)
                   (comparator value1 value2)
                   (comparator value1)
                   (comparator value2))]
      (or (:content (if (if negate? (not result) result) if-tags else-tags))
          [(TextNode. )]))
(defn if-numeric-handler [[p1 p2 p3 p4 :as params] if-tags else-tags render]
    (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)
    #(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]
        (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)]
      (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)
      (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]
      (= \" (first arg))
      (.substring arg 1 (dec (.length arg)))
      (= \: (first arg))
      (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
               (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)))))
                 (.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 #{"="})
    (fn [context-map]
      (render content
                (fn [context-map [k v]]
                  (assoc context-map k (v context-map)))
                context-map args)))))

Accepts uri passed in as first argument to {% script %} or {% style %} tag and context map. Returns string - new URI built with value of selmer/context context parameter in mind. uri can be a string literal or name of context parameter (filters also supported).

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

Returns function that renders HTML <SCRIPT/> tag. Accepts uri that would be used to build value for 'src' attribute of generated tag and variable number of optional arguments. Value for 'src' attribute is built accounting value of selmer/context context parameter and uri can be a string literal or name of context parameter (filters also supported). Optional arguments are: * async - when evaluates to logical true then 'async' attribute would be added to generated tag.

(defn script-handler
  [[^String uri & args] _ _ _]
  (let [args
        (->> args
             (mapcat #(.split ^String % "="))
             (remove #{"="})
    (fn [{:keys [selmer/context] :as context-map}]
      (let [args
             (fn [context-map [k v]]
               (assoc context-map k (v context-map)))
            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>")))))

Returns function that renders HTML <LINK/> tag. Accepts uri that would be used to build value for 'href' attribute of generated tag. Value for 'href' attribute is built accounting value of selmer/context context parameter and uri can be a string literal or name of context parameter (filters also supported).

(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))
(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]
      (-> "json.human.css" slurp)
      (edn->html context-map))))

expr-tags are {% if ... %}, {% ifequal ... %}, {% for ... %}, and {% block blockname %}

(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]}))

helpers for custom tag definition

(defn render-tags [context-map tags]
  (into {}
        (for [[tag content] tags]
           (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]
          [(->> content (render-tags context-map) (handler args context-map) (TextNode.))]
      (fn [context-map]
        (handler args context-map)))))

Where we preprocess the inheritance and mixin components of the templates. These are presumed to be static and we only aggregate them on the first template render. The compile-time tag parsing routines happen on a flat string composed from the result of extends inheritance and include mixins.

(ns selmer.template-parser
  (:require [ :refer [reader]]
            [selmer.util :refer :all]
            [clojure.string :as s :refer [split trim]]
            [selmer.validator :as validator])
(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)
         (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)))

parse any included templates and splice them in replacing the include tags

(defn insert-includes
  ;; 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))
                 (.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?
             (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))
                    (consume-block rdr)
                      (StringReader. existing-block) buf (dissoc blocks block-name))
                  (inc blocks-to-close)
                  (re-matches *endblock-pattern* tag-str)
                  (dec blocks-to-close)
                  :else blocks-to-close))
              (or has-super? super-tag?)))
            (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)]
      ;;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
      (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
      (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
                 (->buf [buf] (consume-block rdr buf blocks true))))
        (.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)
(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
        (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]
                (nil? ch) [parent blocks]
                (open-tag? ch rdr)
                (let [tag-str (read-tag-content rdr)]
                    (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)
                      (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)
                      (.append buf tag-str)
                      (recur blocks (read-char rdr) parent))))
                  (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
(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!
  (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]
(defmacro without-escaping [& body]
  `(binding [*escape-variables* false]
(defn pattern [& content]
  (re-pattern (clojure.string/join content)))
(defn read-char [^ rdr]
  (let [ch (.read rdr)]
    (if-not (== -1 ch) (char ch))))

Works best for small collections seemingly.

(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))))

default tag characters

(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* \#)

tag regex patterns

(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)
                       (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 [^ rdr]
  (.mark rdr 1)
  (let [result (read-char rdr)]
    (.reset rdr)
(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]
        (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?))
          (.append buf ch)
          (recur items (read-char rdr) open?))))))
(defn get-resource [resource]
  (-> (Thread/currentThread)
      (.getResource resource)))
(defn resource-path [template]
  (if (instance? template)
    (if-let [path *custom-resource-path*]
      ( (str path template))
      (get-resource template))))
(defn resource-last-modified [^ resource]
  (let [path (.getPath resource)]
      (.lastModified ( ^String path))
      (catch NullPointerException _ -1))))
(defn check-template-exists [^ resource]
  (when-not resource
    (exception "template: \ (.getPath ^ resource) "\" not found")))
(def default-missing-value-formatter (constantly ))
(def ^:dynamic *missing-value-formatter* default-missing-value-formatter)
(def ^:dynamic *filter-missing-values* true)

Takes a function of two arguments which is called on a missing value. The function should return the value to be output in place of an empty string (which is the default from 'default-missing-value-formatter').

Call with named argument :filter-missing-values true to force filtering of missing values (although for most use cases this will not make sense).

Arguments to missing-value-fn: tag - map with data for the tag being evaluated. Contains the key :tag-type with the value :filter or :expr (for filter or expression tag types. For :filter: tag-value - the contents of the filter tag as a string. For :expr: tag-name - the name of the expression. args - the args provided to the expression. context-map - the context-map provided to the render function.

(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
       [clojure.set :only [difference]]
       [ :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]
     (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]
     (ex-info long-error
              {:type           :selmer-validation-error
               :error          short-error
               :error-template error-template
               :line           line
               :template       template
               (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
   (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)))
       (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))
   (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)))))
(defn read-tag [rdr line template]
    (-> (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)))
(defn validate [template]
  (when @validate?
    (check-template-exists template)
    (if-let [orphan-tags (not-empty (validate-tags template))]
        (->> orphan-tags
             (map (fn [{:keys [tag-name line] :as tag}] (str (format-tag tag) " on line " line)))
             (interpose ", ")
             (clojure.string/join "The template contains orphan tags: "))
        "The template contains orphan tags."