dependencies
| (this space intentionally left almost blank) | ||||||||||||||||||
Accessors are separated by dots like {{ foo.bar.0 }} -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 "<") - \> (.append sb ">") - \" (.append sb """) - \' (.append sb "'") - (.append sb c)) - (recur (inc idx)))))) - s)) | ||||||||||||||||||
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))) - 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 - [x] - (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 - [ks] - (mapv (fn [^String s] - (try (Long/valueOf s) - (catch NumberFormatException _ - (keyword s)))) - ks)) | ||||||||||||||||||
Split accessors like foo.bar.baz by the dot. - But if there is a double dot '..' then it will leave it - | (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))) | ||||||||||||||||||
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 - [args] - ;; TODO - figure out what kind of extra args filters can take - (map (fn [^String s] - (strip-doublequotes s)) - args)) | ||||||||||||||||||
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 - [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))) | ||||||||||||||||||
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 - [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)))))) | ||||||||||||||||||
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 - (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))))))))) | ||||||||||||||||||
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.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."))))))) | ||||||||||||||||||
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
- (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])) | ||||||||||||||||||
development middleware for rendering a friendly error page when a parsing error occurs - | (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))))))) | ||||||||||||||||||
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 - (:gen-class)) | ||||||||||||||||||
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] - INode - (render-node [this context-map] - (handler context-map)) - clojure.lang.IMeta - (meta [this] - (meta handler))) | ||||||||||||||||||
Implements dumb text content injection at runtime. - | |||||||||||||||||||
| - | (deftype TextNode [text] - INode - (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]] - selmer.node) - (: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 "/")) - 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)))))) | ||||||||||||||||||
set custom location, where templates are being searched for. path - may be a java.net.URL instance or a string. If it's a string, we - first try to convert it to a java.net.URL instance and if it doesn't - work it's interpreted as a path in the local filesystem. - | (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)))) | ||||||||||||||||||
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] - `(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)) | ||||||||||||||||||
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 (java.io.StringReader. 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))))
- (validation-error
- (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]
- (with-meta
- (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]
- (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))))) | ||||||||||||||||||
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)) - 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!)))))) | ||||||||||||||||||
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 (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])) | ||||||||||||||||||
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) - (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))))) | ||||||||||||||||||
Accepts | (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 "//" "/")))) | ||||||||||||||||||
Returns function that renders HTML | (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>"))))) | ||||||||||||||||||
Returns function that renders HTML | (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)))) | ||||||||||||||||||
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]
- [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))))) | ||||||||||||||||||
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 | (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))) | ||||||||||||||||||
parse any included templates and splice them in replacing the include tags - | (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)))) | ||||||||||||||||||
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)
- (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) | ||||||||||||||||||
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 - 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)))) | ||||||||||||||||||
dependencies
| (this space intentionally left almost blank) | |||||||||
Accessors are separated by dots like {{ foo.bar.0 }} +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 [*escape-variables* parse-accessor]] + [clojure.string :as str])) | |||||||||
HTML-escapes the given string. Escapes the same characters as django's escape. + +More Utils + | (defn escape-html* + [^String s] + ;; This method is "Java in Clojure" for serious speedups. + ;; Stolen from davidsantiago/quoin and modified. + (if *escape-variables* + (let [slength (count s) + sb (StringBuilder. slength)] + (loop [idx 0] + (if (>= idx slength) + (.toString sb) + (let [c (char (.charAt s idx))] + (case c + \& (.append sb "&") + \< (.append sb "<") + \> (.append sb ">") + \" (.append sb """) + \' (.append sb "'") + (.append sb c)) + (recur (inc idx)))))) + s)) | |||||||||
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))) + 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. + +If it is marked as :safe, the value will be returned as-is, otherwise it +will be converted to a string even if it is not escaped. + | (defn escape-html + [x] + (if (and (vector? x) + (= :safe (first x))) + (second x) + (let [s (str x)] + (escape-html* s)))) | |||||||||
Compile filters + | ||||||||||
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 + [args] + ;; TODO - figure out what kind of extra args filters can take + (map (fn [^String s] + (strip-doublequotes s)) + args)) | |||||||||
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 + [context-map] + (fn [^String arg] + (if (and (> (count arg) 1) (.startsWith arg "@")) + (let [accessor (parse-accessor (subs arg 1))] + (get-in context-map accessor arg)) + 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
+ [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)))
+ (throw (ex-info (str "No filter defined with the name '" filter-name "'")
+ {:filter-name filter}))))) | |||||||||
| + | (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
+ (throw (ex-info (str "On filter body '" s "' and filter '" filter-str "' this error occurred:" (.getMessage e))
+ {:filters filters
+ :filter-str filter-str
+ :body s}
+ e)))))
+ val
+ (map vector filter-strs filters))) | |||||||||
Returns the value of | (defn get-accessor + [m k] + (let [v (get m k)] + (if (nil? v) + (when (keyword? k) + (if-let [n (namespace k)] + (get m (str n "/" (name k))) + (get m (name k)))) + v))) | |||||||||
| + | (defn split-value [s] + (->> s + ;; Ignore pipes and allow escaped doublequotes inside doublequotes + (re-seq #"\w*(?:[^|\"]|\"[^\"]*\")+") + (map str/trim))) | |||||||||
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] (split-value s) + accessor (parse-accessor 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 runtime-test [context-map] + (let [val (reduce get-accessor context-map accessor)] + (when (or (not (nil? 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))))))))) | |||||||||
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] + [selmer.util :as u]) + (:import + java.util.Locale + [java.time Instant + LocalTime + LocalDate + LocalDateTime + ZonedDateTime + ZoneId] + [java.time.format DateTimeFormatter FormatStyle] + java.text.NumberFormat)) | |||||||||
JSON generation function. Resolved in the (arbitrary) order of cheshire, clojure.data.json, jsonista. Falls back on function that throws at runtime. It is important for GraalVM native-image that we resolve this at compile time (top level). + | (def generate-json
+ (try (require 'cheshire.core)
+ @(resolve 'cheshire.core/generate-string)
+ (catch Exception _
+ (try (require 'clojure.data.json)
+ @(resolve 'clojure.data.json/write-str)
+ (catch Exception _
+ (try (require 'jsonista.core)
+ @(resolve 'jsonista.core/write-value-as-string)
+ (catch Exception e
+ (fn [_]
+ (throw (ex-info "Supported JSON libraries: cheshire, clojure.data.json or
+ jsonista. Provide one of these on the classpath to enable
+ the json filter." {} e)))))))))) | |||||||||
| + | (def valid-date-formats
+ {"shortTime" (DateTimeFormatter/ofLocalizedTime FormatStyle/SHORT)
+ "shortDate" (DateTimeFormatter/ofLocalizedDate FormatStyle/SHORT)
+ "shortDateTime" (DateTimeFormatter/ofLocalizedDateTime FormatStyle/SHORT)
+ "mediumDate" (DateTimeFormatter/ofLocalizedDate FormatStyle/MEDIUM)
+ "mediumTime" (DateTimeFormatter/ofLocalizedTime FormatStyle/MEDIUM)
+ "mediumDateTime" (DateTimeFormatter/ofLocalizedDateTime FormatStyle/MEDIUM)
+ "longDate" (DateTimeFormatter/ofLocalizedDate FormatStyle/LONG)
+ "longTime" (DateTimeFormatter/ofLocalizedTime FormatStyle/LONG)
+ "longDateTime" (DateTimeFormatter/ofLocalizedDateTime FormatStyle/LONG)
+ "fullDate" (DateTimeFormatter/ofLocalizedDate FormatStyle/FULL)
+ "fullTime" (DateTimeFormatter/ofLocalizedTime FormatStyle/FULL)
+ "fullDateTime" (DateTimeFormatter/ofLocalizedDateTime FormatStyle/FULL)}) | |||||||||
| + | (defn fix-date [d] + (cond (or (instance? LocalTime d) + (instance? LocalDate d) + (instance? LocalDateTime d) + (instance? ZonedDateTime d)) + d + (instance? java.sql.Time d) + (-> (.getTime ^java.sql.Time d) + (Instant/ofEpochMilli) + (LocalDateTime/ofInstant (ZoneId/systemDefault))) + (instance? java.sql.Timestamp d) + (-> (.getTime ^java.sql.Timestamp d) + (Instant/ofEpochMilli) + (LocalDateTime/ofInstant (ZoneId/systemDefault))) + (instance? java.sql.Date d) + (.toLocalDate ^java.sql.Date d) + (instance? java.util.Date d) + (-> (.toInstant ^java.util.Date d) + (.atZone (ZoneId/systemDefault)) + (.toLocalDateTime)) + (instance? java.time.Instant d) + (-> (.atZone ^java.time.Instant d (ZoneId/systemDefault)) + (.toLocalDateTime)) + :else + (throw (IllegalArgumentException. (str d " is not a valid date format."))))) | |||||||||
Parses a number to Long or Double. Throws NumberFormatException if value cannot be converted to Long or Double. + | (defn parse-number + [value] + (if (number? value) + value + (let [value (str value)] + (try + (Long/parseLong value) + (catch NumberFormatException _ + (Double/parseDouble value)))))) | |||||||||
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
+ (throw (ex-info msg {:arg x}))))) | |||||||||
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)
+ (throw (ex-info msg {:arg x}))))) | |||||||||
| + | (defonce filters
+ (atom
+ {;;; Useful for doing crazy stuff like {{ foo|length-is:3|join:"/" }}
+ ;;; Without blowing up I guess
+ :str
+ str
+ ;;; Like the subs, only adds rest if s is modified
+ :subs
+ (fn [s start end & rest]
+ (let [start (parse-number start)
+ end (parse-number end)
+ result (subs s start end)]
+ (if (and rest (not= (count s) (count result)))
+ (str result (apply str rest))
+ result)))
+ :abbr-left
+ (fn [s] (assoc (if (map? s) s {:s s}) :abbr-position :left))
+ :abbr-middle
+ (fn [s] (assoc (if (map? s) s {:s s}) :abbr-position :middle))
+ :abbr-right
+ (fn [s] (assoc (if (map? s) s {:s s}) :abbr-position :right))
+ :abbr-ellipsis
+ (fn [s ellipsis] (assoc (if (map? s) s {:s s}) :abbr-ellipsis ellipsis))
+ :abbreviate
+ (fn abbreviate
+ ([s max-width] (abbreviate s max-width max-width))
+ ([s max-width abbreviated-width]
+ (let [max-width (parse-number max-width)
+ abbreviated-width (parse-number abbreviated-width)
+ ellipsis (:abbr-ellipsis s "...")
+ position (:abbr-position s :right)
+ ellipsis-length (count ellipsis)
+ effective-width (- abbreviated-width ellipsis-length)
+ s (:s s s) ; Extract string from map if it's not already a string
+ width (count s)]
+ (if (< max-width abbreviated-width)
+ (throw (IllegalArgumentException.
+ (format "Maximum width %d can't be shorter than abbreviated width %d"
+ max-width abbreviated-width))))
+ (if (< abbreviated-width ellipsis-length)
+ (throw (IllegalArgumentException.
+ (format "Length %d of ellipsis '%s' can't be bigger than abbreviated width %d"
+ ellipsis-length ellipsis abbreviated-width))))
+ (if (> width max-width)
+ (case position
+ :right (str (subs s 0 effective-width) ellipsis)
+ :left (str ellipsis (subs s (- width effective-width)))
+ :middle (str (subs s 0 (/ effective-width 2)) ellipsis
+ (subs s (- width (/ effective-width 2)))))
+ s))))
+ ;;; 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 parse-number args))
+ (catch NumberFormatException _
+ (apply str args)))))
+ :multiply
+ (fn [x y]
+ (* (parse-number x) (parse-number y)))
+ :divide
+ (fn [x y]
+ (let [val (/ (parse-number x) (parse-number y))]
+ (if (ratio? val)
+ (double val)
+ val)))
+ :round
+ (fn [x]
+ (Math/round ^Double (parse-number x)))
+ ;;; 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. Supports a wide range of
+ ;;; date types (incl. java.util.Date, java.time.Instant, java.sql.Date)
+ ;;; The format can be a key from valid-date-formats or a manually defined format
+ ;;; Look in
+ ;;; https://docs.oracle.com/en/java/javase/21/docs/api//java.base/java/time/format/DateTimeFormatter.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 (DateTimeFormatter/ofPattern fmt)) locale)]
+ (.format fmt fixed-date))))
+ ;;; Default if x is falsey
+ :default
+ (fn [x default]
+ (or 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 (parse-number n) coll)))
+ :drop
+ (fn [coll n]
+ (throw-when-expecting-seqable coll)
+ (vec (drop (parse-number n) coll)))
+ :drop-last
+ (fn [coll n]
+ (throw-when-expecting-seqable coll)
+ (vec (drop-last (parse-number 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)]
+ (u/hex hash s)))
+ :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] (generate-json 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)]
+ [:safe (= n (count coll))]))
+ :count-is
+ (fn [coll n]
+ (when-not (nil? coll)
+ (throw-when-expecting-seqable coll))
+ (let [n (Long/valueOf ^String n)]
+ [:safe (= 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))
+ :range
+ (fn [end & [start step]]
+ (let [->long (fn [s] (if (number? s) s (Long/parseLong s)))]
+ (cond
+ step (range (->long start) (->long end) (->long step))
+ start (range (->long start) (->long end))
+ :else (range (->long end)))))
+ ;;; 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))
+ :between?
+ (fn [val x y]
+ (let [val (parse-number val)
+ x (parse-number x)
+ y (parse-number y)]
+ [:safe (if (<= x y)
+ (<= x val y)
+ (<= y val x))]))
+ :replace
+ (fn [s s-search s-replace]
+ (clojure.string/replace ^String s ^String s-search ^String s-replace))
+ ;;; 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 )))))
+ :email
+ ;; the `email` filter takes one positional argument:
+ ;; * validate? if present and equal to "false", do not throw exception if email appears
+ ;; invalid. Default behaviour is do throw an exception.
+ (fn [email & [validate?]]
+ (if (or (and validate? (false? (Boolean/parseBoolean validate?)))
+ (re-matches #"^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\.[A-Za-z]{2,6}$" email))
+ [:safe (str "<a href='mailto:" email "'>" email "</a>")]
+ (throw (Exception. (str email " does not appear to be a valid email address")))))
+ :phone
+ ;; The `phone` filter takes two optional positional arguments:
+ ;; * national-prefix The ITU-T E.123 international subscriber dialing prefix to prepend
+ ;; in place of a leading zero. Default is do not prepend.
+ ;; * validate? if present and equal to "false", do not throw exception if number appears
+ ;; invalid. Default behaviour is do throw an exception.
+ ;; Both arguments are optional, when a single argument is supplied and parses as a boolean
+ ;; it is inferred as `validate?` otherwise as `national-prefix`
+ (fn [phone & [arg1 arg2]]
+ (let [[national-prefix validate?] (cond
+ ;both national-prefix and validate? flags are supplied
+ (and arg1 arg2) [arg1 (case arg2 "false" false "true" true)]
+ ;neither national-prefix or validate? flags are supplied
+ (and (nil? arg1) (nil? arg2)) [nil true]
+ ;one of the flags is supplied, if it parses as a boolean assume it's validate?
+ (= arg1 "false") [nil false]
+ (= arg1 "true") [nil true]
+ :else [arg1 true])
+ number (if
+ national-prefix
+ (s/replace
+ phone
+ #"^0"
+ (str "+" national-prefix "-"))
+ phone)]
+ (if (or (false? validate?)
+ (re-matches #"[0-9 +-]*" number))
+ [:safe (str "<a href='tel:" (s/replace number #"\s+" "-") "'>" phone "</a>")]
+ (throw (Exception. (str number " does not appear to be a valid phone number"))))))
+ :name
+ name
+ :get
+ get})) | |||||||||
| + | (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 handle-template-parsing-error [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)))) | |||||||||
development middleware for rendering a friendly error page when a parsing error occurs + | (defn wrap-error-page + [handler] + (fn + ([request] + (try + (handler request) + (catch clojure.lang.ExceptionInfo ex + (handle-template-parsing-error ex)))) + ([request respond raise] + (try + (handler request respond raise) + (catch clojure.lang.ExceptionInfo ex + (respond (handle-template-parsing-error 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 + (:gen-class)) | |||||||||
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] + INode + (render-node [this context-map] + (handler context-map)) + clojure.lang.IMeta + (meta [this] + (meta handler))) | |||||||||
Implements dumb text content injection at runtime. + | ||||||||||
| + | (deftype TextNode [text] + INode + (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 + [clojure.set :as set] + [clojure.string :as string] + [selmer.template-parser :refer [preprocess-template]] + [selmer.filters :refer [filters]] + [selmer.filter-parser :refer [compile-filter-body literal? + split-value parse-literal]] + [selmer.tags :refer :all] + [selmer.util :refer :all] + [selmer.validator :refer [validation-error]] + selmer.node) + (:import [selmer.node TextNode FunctionNode])) | |||||||||
Ahead decl because some fns call into each other. + | ||||||||||
| + | (declare parse parse-input parse-str 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 clear-cache! []
+ (reset! templates {})) | |||||||||
| + | (defn cache-on! [] + (reset! cache? true)) | |||||||||
| + | (defn cache-off! [] + (clear-cache!) + (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 "/")) + s + (str s "/"))) | |||||||||
| + | (defn- make-resource-path + [path] + (cond + (nil? path) + nil + (instance? java.net.URL path) + (append-slash (str path)) + :else + (if (or (looks-like-absolute-file-path? path) + (.startsWith ^java.lang.String path "file:/")) + (append-slash + (try + (str (java.net.URL. path)) + (catch java.net.MalformedURLException err + (str "file:///" path)))) + (append-slash path)))) | |||||||||
set custom location, where templates are being searched for. path +may be a java.net.URL instance or a string. If it's a string, we +first try to convert it to a java.net.URL instance and if it doesn't +work it's interpreted as a path in the local filesystem. + | (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)))) | |||||||||
| + | (def add-filter! selmer.filters/add-filter!) | |||||||||
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] + `(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)) | |||||||||
render-template renders at runtime, accepts +post-parsing vectors of INode elements. + | ||||||||||
vector of ^selmer.node.INodes and a context map. + | (defn render-template + [template 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))) | |||||||||
render takes the string, the context-map and possibly also opts. + | (defn render + [s context-map & [opts]] + (render-template (parse parse-str 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. + | ||||||||||
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 + | (defn render-file
+ [filename-or-url context-map & [{:keys [cache custom-resource-path url-stream-handler]
+ :or {cache @cache?
+ custom-resource-path *custom-resource-path*
+ url-stream-handler *url-stream-handler*}
+ :as opts}]]
+ (binding [*custom-resource-path* (make-resource-path custom-resource-path)
+ *url-stream-handler* url-stream-handler]
+ (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)))) | |||||||||
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]} rdr]
+ (if-let [handler (tag-name @expr-tags)]
+ (handler args tag-content render-template rdr)
+ (throw (ex-info (str "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. + | ||||||||||
Compile-time parser of var tag filters. + | (defn filter-tag
+ [{:keys [tag-value]}]
+ (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]
+ (with-meta
+ (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))))) | |||||||||
Turns the argument into a list if it isn't a list already. + | (defn ensure-list + [list-maybe] + (if (sequential? list-maybe) + list-maybe + (if (nil? list-maybe) + [] + [list-maybe]))) | |||||||||
Assocs in the passed tag to the tags map. + | (defn update-tags
+ [tag tags content args ^StringBuilder buf]
+ (let [content {:args args
+ :content (conj content (TextNode. (.toString buf)))}]
+ (if-let [tag-already-there (tags tag)]
+ ; if the tag is already in there, it's elif which can be duplicated.
+ ; in this case, we want to make a list and put it in there, as we need all the elif tags later.
+ (assoc tags tag (conj (ensure-list tag-already-there)
+ content))
+ (assoc tags tag content)))) | |||||||||
| + | (defn skip-short-comment-tag [rdr]
+ (loop [ch1 (read-char rdr)
+ ch2 (read-char rdr)]
+ (cond
+ (nil? ch2)
+ (throw (ex-info "short-form comment tag was not closed" {}))
+ (and (= *short-comment-second* ch1) (= *tag-close* ch2))
+ nil
+ :else
+ (recur ch2 (read-char rdr))))) | |||||||||
Parses the content of a tag. + Returns a map of tag-name -> args & content, which can then be interpreted by the calling function. + | (defn tag-content
+ [rdr start-tag & end-tags]
+ (let [buf (StringBuilder.)]
+ (loop [ch (read-char rdr)
+ tags {}
+ content []
+ cur-tag start-tag ; for example, if
+ end-tags end-tags ; for example, [elif, else, endif]
+ cur-args nil]
+ (cond
+ (and (nil? ch) (not-empty end-tags))
+ (throw (ex-info (str "No closing tag found for " start-tag)
+ {:args start-tag}))
+ ; We're done with this tag so return.
+ (nil? ch)
+ tags
+ ; Skip any short form comments
+ (open-short-comment? ch rdr)
+ (do (skip-short-comment-tag rdr)
+ (recur (read-char rdr) tags content cur-tag end-tags cur-args))
+ ; A tag was found inside this tag
+ (open-tag? ch rdr)
+ (let [{:keys [tag-name args] :as tag} (read-tag-info rdr)]
+ ; Determine if the tag belongs to the opening tag on this level
+ (if-let [open-tag (and tag-name (some #{tag-name} end-tags))]
+ ; This tag is part of the already open tag, like how else or endif belongs to the if tag.
+ ; Since we have reached the end of this cluse we empty the contents of the buffer into the tags list.
+ (let [tags (update-tags cur-tag tags content cur-args buf)
+ ; special case to allow an arbitrary number of elif tags
+ end-tags (if (= open-tag :elif)
+ end-tags
+ ; but non-elif tags can only used once, so remove from the possible options
+ (next (drop-while #(not= tag-name %) end-tags)))]
+ ; clear the buffer - it's been written inside update-tags
+ (.setLength buf 0)
+ (recur (when-not (empty? end-tags) (read-char rdr))
+ tags
+ []
+ open-tag
+ end-tags
+ args))
+ ; The detected tag is not part of the open tag.
+ ; Recursively reading the new tag and adding it to content.
+ (let [content (append-node content tag buf rdr)]
+ (.setLength buf 0)
+ (recur (read-char rdr) tags content cur-tag end-tags cur-args))))
+ ; Just a normal letter
+ :else
+ (do
+ (.append buf ch)
+ (recur (read-char rdr) tags content cur-tag end-tags cur-args)))))) | |||||||||
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)) + 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) (contains? #{*tag-second* *filter-open*} (peek-rdr rdr)))
+ (recur (add-node template buf rdr) (read-char rdr))
+ ;; Short comment tags are dropped
+ (open-short-comment? ch rdr)
+ (do
+ (skip-short-comment-tag rdr)
+ (recur template (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!)))))) | |||||||||
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 (java.io.StringReader.) (parse-input params))) | |||||||||
File-aware parse wrapper for string. + | ||||||||||
| + | (defn parse-str [input params] + (-> (char-array input) 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.*")
+ *tags* (atom [])]
+ (with-meta
+ (parse-fn input params)
+ {:all-tags @*tags*}))) | |||||||||
takes in vals like: "person.name|capitalize" +and produces [:person :name] + | (defn- parse-variable-paths + [arg] + (some-> arg split-value first parse-accessor)) | |||||||||
List of variables in a template file + | (defn ^:private parse-variables [tags]
+ (loop [vars #{}
+ nested-keys #{}
+ tags tags]
+ (if-let [{:keys [tag-type tag-name tag-value args] :as tag} (first tags)]
+ (cond
+ (= :filter tag-type) (let [v (parse-variable-paths tag-value)
+ should-add-var? (when (vector? v)
+ (not (contains? nested-keys (first v))))
+ updated-vars (cond-> vars
+ should-add-var? (conj v))]
+ (recur
+ updated-vars
+ nested-keys
+ (rest tags)))
+ (= :for tag-name) (let [[ids [_ items]] (aggregate-args args)]
+ (recur
+ (conj vars (parse-variable-paths items))
+ (conj (set (map keyword ids)) :forloop)
+ (rest tags)))
+ (= :with tag-name) (let [[id value] (string/split (first args) #"=")]
+ (recur
+ (conj vars (parse-variable-paths value))
+ #{(keyword id)}
+ (rest tags)))
+ (contains? #{:endfor :endwith} tag-name) (recur vars #{} (rest tags))
+ :else
+ (let [special-syms #{nil :not :all :any :< :> := :<= :>=}
+ should-remove? (fn [[var-head :as var]]
+ (or
+ (special-syms var-head)
+ (nested-keys var-head)))]
+ (recur (set/union
+ vars
+ (->> args
+ (filter (complement literal?))
+ (map parse-variable-paths)
+ (remove should-remove?)
+ set))
+ nested-keys
+ (rest tags))))
+ vars))) | |||||||||
| + | (defn known-variable-paths [input & [opts]]
+ (->> (or opts {})
+ (parse parse-input (java.io.StringReader. input))
+ meta
+ :all-tags
+ parse-variables)) | |||||||||
| + | (defn known-variables [input & [opts]]
+ (->> (or opts {})
+ (parse parse-input (java.io.StringReader. input))
+ meta
+ :all-tags
+ parse-variables
+ (map first)
+ (into #{}))) | |||||||||
Puts &env into a map. + | (defmacro ^:no-doc env-map + [] + `(zipmap (mapv keyword (quote ~(keys &env))) (vector ~@(keys &env)))) | |||||||||
| + | (defn ^:no-doc resolve-var-from-kw [ns env kw]
+ (if (namespace kw)
+ (when-let [v (ns-resolve ns (symbol (str (namespace kw) "/" (name kw))))] {kw @v})
+ (or
+ ;; check local env first
+ (when-let [[_ v] (find env kw)] {kw v})
+ (when-let [v (ns-resolve ns (symbol (name kw)))] {kw @v})))) | |||||||||
Resolves the variables from your template string from the local-env, or the +namespace and puts them into your template for you. + +e.g. (let [a 1] (<< "{{a}} + {{a}} = 2")) ;;=> "1 + 1 = 2" + | (defmacro << + [s] + `(->> (known-variables ~s) + (mapv #(resolve-var-from-kw ~*ns* (env-map) %)) + (apply merge) + (render ~s))) | |||||||||
Resolves an arg as passed to an add-tag! handler using the provided +context-map. + +A custom tag handler will receive a seq of args as its first argument. +With this function, you can selectively resolve one or more of those args +so that if they contain literals, the literal value is returned, and if they +contain templates of any sort, which can itself have variables, filters or +tags in it, they will be returned resolved, applied and rendered. + +Example: + (resolve-arg {{header-name|upper}} {:header-name "My Page"}) + => "MY PAGE" + | (defn resolve-arg + [arg context-map] + (if (literal? arg) + (parse-literal arg) + (render arg context-map))) | |||||||||
| + | (ns selmer.tags + (:require + clojure.java.io + [clojure.string :as str] + selmer.node + [selmer.filter-parser :refer [literal? parse-literal safe-filter compile-filter-body get-accessor escape-html*]] + [selmer.filters :refer [filters]] + [selmer.util :refer :all]) + (:import [selmer.node TextNode])) | |||||||||
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 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-accessor ids)
+ [items & filter-names] (when items (.split ^String items "\\|"))
+ ;; prevent literals cascading through filters:
+ for-items (cond->> items
+ (literal? items)
+ (str "for-"))
+ filters (compile-filters for-items filter-names)
+ item-keys (parse-accessor items)]
+ (fn [context-map]
+ (let [buf (StringBuilder.)
+ unfiltered-items (if (literal? items)
+ (parse-literal items)
+ (reduce get-accessor context-map item-keys))]
+ (if (and (nil? unfiltered-items) (not empty-content))
+ ;item was not in the context map and it didn't have an {% empty %} fallback
+ (.append buf (*missing-value-formatter* {:tag-name :for :args item-keys} context-map))
+ ;item was in context map, keep going
+ (let [items (apply-filters unfiltered-items filters context-map for-items)
+ length (count items)]
+ (if (and empty-content (empty? items))
+ (.append buf (render empty-content context-map))
+ (let [item-mappings (map #(create-value-mappings context-map ids %) items)]
+ (doseq [[counter [value previous]]
+ (map-indexed vector
+ (map vector item-mappings (cons nil item-mappings)))]
+ (let [loop-info
+ {:length length
+ :counter0 counter
+ :counter (inc counter)
+ :revcounter (- length (inc counter))
+ :revcounter0 (- length counter)
+ :first (= counter 0)
+ :last (= counter (dec length))
+ :parentloop (:forloop context-map)
+ :previous previous}]
+ (->> (assoc value :forloop 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 match-comparator [op]
+ (condp = op ">" > "<" < "=" == ">=" >= "<=" <=
+ (throw (ex-info (str "Unrecognized operator in 'if' statement: " op)
+ {:args op})))) | |||||||||
| + | (defn- num? [v] + (and v (re-matches #"-?[0-9]*\.?[0-9]+" v))) | |||||||||
| + | (defn- parse-double-value [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-value %1) (parse-double-value %2)) p1 p2] + (num? p1) + [#(comparator (parse-double-value p1) (parse-double-value %)) nil p2] + (num? p2) + [#(comparator (parse-double-value %) (parse-double-value p2)) p1 nil]))) | |||||||||
| + | (defn numeric-expression-evaluation [[comparator context-key1 context-key2]] + ; Parse the filter bodies first and close over them. + ; This makes them cached. + (let [l (when context-key1 (compile-filter-body context-key1)) + r (when context-key2 (compile-filter-body context-key2))] + (fn [context-map] + (let [value1 (when context-key1 (not-empty (l context-map))) + value2 (when context-key2 (not-empty (r context-map)))] + (cond + (and value1 value2) + (comparator value1 value2) + value1 + (comparator value1) + value2 + (comparator value2)))))) | |||||||||
| + | (defn if-any-all-fn [op params] + ; op is either the function "some" or "any" + (let [filters (map compile-filter-body params)] + (fn if-any-all-runtime-test [context-map] + ; We want to short-circuit here, in case + ; the first arg is true for ANY, or false for ALL. + (op (fn [f] (-> context-map (f) (if-result))) + filters)))) | |||||||||
| + | (defn parse-eq-arg [^String arg-string] + (cond + (= \" (first arg-string)) + (.substring arg-string 1 (dec (.length arg-string))) + (= \: (first arg-string)) + arg-string + (num? arg-string) + arg-string + :else + (compile-filter-body arg-string))) | |||||||||
Compiles an if form into a function that takes a context-map, and returns true or false. + | (defn if-condition-fn
+ [params]
+ (let [negate (= "not" (first params))
+ params (if negate (rest params)
+ params)
+ eval-fn (cond
+ ; just a normal, single argument if.
+ (= (count params) 1)
+ (compile-filter-body (first params))
+ ; the any/all version, like {% if any a b c %}
+ (#{"any" "all"} (first params))
+ (let [op (first params)
+ params (rest params)]
+ (if-any-all-fn (if (= "any" op) some every?) params))
+ ; Do an equals comparison, for instance with a string comparison
+ (and (= 3 (count params)) (= (second params) "="))
+ (let [[p1 _ p3] params]
+ (fn [context-map]
+ (let [lookup-if-needed (fn [arg] (if (fn? arg)
+ (arg context-map)
+ arg))
+ a (lookup-if-needed (parse-eq-arg p1))
+ b (lookup-if-needed (parse-eq-arg p3))]
+ (if (and (num? a) (num? b))
+ ; Special case for when both are numbers -
+ ; since we want 2 = 2.0 to be true and in clojure (= 2 2.0) => false
+ (== (parse-double-value a)
+ (parse-double-value b))
+ (= a b)))))
+ ; it has to be a numeric expression like 1 > 2
+ (= 3 (count params))
+ (let [[p1 p2 p3] params]
+ (numeric-expression-evaluation (parse-numeric-params p1 p2 p3))))]
+ (if negate
+ (fn if-cond-fn-negated [context-map] (not (if-result (eval-fn context-map))))
+ (fn if-cond-fn [context-map] (if-result (eval-fn context-map)))))) | |||||||||
| + | (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 if-handler [params tag-content render rdr]
+ ; The main idea of this function is to generate a list of test conditions and corresponding content,
+ ; then going though them in order until a test is successful, and then returning the contents belonging to
+ ; that test.
+ ; tag-content is key here as it's in charge of parsing the template.
+ ; The rest just renders out based on what it generates
+ (let [{if-tags :if elif-tags-list :elif else-tags :else} (tag-content rdr :if :elif :else :endif)
+ ; Conditions is a list of tests with their corresponding content.
+ ; First comes the if clause
+ conditions (->> [{:args params :content (:content if-tags)}
+ ; then any elifs
+ elif-tags-list
+ ; then the else clause. The "test" of the else clause just always returns true.
+ (when else-tags (assoc else-tags :args ["\"true\]))]
+ ; Remove a hole created if there is no else clause.
+ (filter identity)
+ ; Unnest the elifs
+ (flatten)
+ ; Compile the args into a test function
+ (map (fn [{args :args content :content}]
+ {:test (if-condition-fn args)
+ :content content})))]
+ ; Returns anonymous fn that will expect runtime context-map. (Separate from compile-time).
+ (fn render-if [context-map]
+ (let [content-to-use (:content (ffind (fn [{test :test}] (test context-map))
+ conditions))]
+ (render content-to-use context-map))))) | |||||||||
| + | (defn parse-eq-args [args] + (for [^String arg args] + (parse-eq-arg 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] + (if (= \\ (first val)) + (if (str/includes? val ".") + (parse-double-value (subs val 1)) + (Integer/parseInt (subs val 1))) + (let [accessor (parse-accessor 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))
+ (throw (ex-info (str "invalid arguments passed to 'with' tag: " args)
+ {:args args})))
+ (for [[id value] (partition 2 args)]
+ [(map keyword (str/split id #"\.")) (compile-filter-body value false)])) | |||||||||
Like compile-args but namespaces keys under selmer/ to avoid conflicts with user context. + | (defn- compile-args-namespaced
+ [args]
+ (when-not (even? (count args))
+ (throw (ex-info (str "invalid arguments passed to tag: " args)
+ {:args args})))
+ (for [[id value] (partition 2 args)]
+ [(map #(keyword "selmer" %) (str/split 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 + tokenize-tag-args + (compile-args))] + (fn [context-map] + (render content + (reduce + (fn [context-map [k v]] + (assoc-in context-map k (v context-map))) + context-map args))))) | |||||||||
Accepts | (defn- build-uri-for-script-or-style-tag
+ [^String uri {context :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])))
+ uri-str (str context uri)]
+ (if-let [[_ initial-slashes the-rest] (re-matches #"^(/+)(.*)" uri-str)]
+ (let [^String rest-part (or the-rest "")]
+ (str initial-slashes (.replace rest-part "//" "/")))
+ uri-str))) | |||||||||
Returns function that renders HTML Note: Using non-namespaced keys | (defn script-handler
+ [[^String uri & args] _ _ _]
+ (let [args
+ (->> args
+ (mapcat #(.split ^String % "="))
+ (remove #{"="})
+ (compile-args-namespaced))]
+ (fn [context-map]
+ (let [args
+ (reduce
+ (fn [context-map [k v]]
+ (assoc-in context-map k (v context-map)))
+ context-map
+ args)
+ async-attr (when (if (contains? args :selmer/async)
+ (:selmer/async args)
+ (deprecated-key-lookup args :selmer/async :async))
+ "async ")
+ defer-attr (when (if (contains? args :selmer/defer)
+ (:selmer/defer args)
+ (deprecated-key-lookup args :selmer/defer :defer))
+ "defer ")
+ type-attr (or (:selmer/type args) "application/javascript")
+ src-attr-val (build-uri-for-script-or-style-tag uri context-map)]
+ (str "<script " async-attr defer-attr "src=\"" src-attr-val "\" type=\"" type-attr "\"></script>"))))) | |||||||||
Returns function that renders HTML | (defn style-handler + [[^String uri] _ _ _] + (fn [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 pretty-print
+ ([m]
+ (let [sb (StringBuilder.)]
+ (pretty-print sb 1 m)
+ (str sb)))
+ ([^StringBuilder sb indent v]
+ (letfn [(spaces [n] (apply str (repeat n " ")))
+ (primitive-coll? [coll] (and (< (count coll) 100) (every? (complement coll?) coll)))
+ (append-k [^StringBuilder sb indent k]
+ (.append sb (str (spaces indent) (pr-str k) " ")))
+ (append-v [^StringBuilder sb indent v]
+ (if (coll? v)
+ (if (primitive-coll? v)
+ (.append sb (pr-str v))
+ (do
+ (.append sb (str "\n" (spaces indent)))
+ (pretty-print sb (inc indent) v)))
+ (.append sb (pr-str v))))
+ (render-coll [coll open close offset]
+ (if (primitive-coll? coll)
+ (.append sb (pr-str coll))
+ (let [[x & xs] coll
+ new-indent (+ offset indent)]
+ (.append ^StringBuilder sb open)
+ (when x
+ (if (coll? x)
+ (pretty-print sb new-indent x)
+ (.append sb (pr-str x)))
+ (doseq [x xs]
+ (.append sb (str "\n" (spaces indent)))
+ (if (coll? x)
+ (pretty-print sb new-indent x)
+ (.append sb (str (pr-str x))))))
+ (.append sb close))))]
+ (cond
+ (map? v)
+ (let [[[k v] & m] v]
+ (.append sb "{")
+ (when k
+ (append-k sb 0 k)
+ (append-v sb indent v))
+ (when (seq? m)
+ (let [indent indent]
+ (.append sb "\n")
+ (doseq [x (interpose "\n" m)]
+ (if (string? x)
+ (.append sb x)
+ (let [[k v] x]
+ (append-k sb indent k)
+ (append-v sb indent v))))))
+ (.append sb "}"))
+ (coll? v)
+ (render-coll v "[" "]" 1)
+ :else
+ (append-v sb indent v))))) | |||||||||
| + | (defn basic-edn->html [ctx-map] + (str "<pre>" + "Include yogthos/json-html for prettier debugging.\n" + (escape-html* (pretty-print ctx-map)) + "</pre>")) | |||||||||
Resolves to json-html.core/edn->html if available, falls back to more basic rendering otherwise. +NOTE: It's important for GraalVM native-image that we resolve vars +at compile time (top-level) rather than at run-time (in a function +body). + | (def prettify-edn + (try + (require 'json-html.core) + (let [edn->html @(resolve 'json-html.core/edn->html)] + (fn [ctx-map] + (str + "<style>" + (-> "json.human.css" clojure.java.io/resource slurp) + "</style>" + (edn->html ctx-map)))) + (catch java.lang.Exception _ + basic-edn->html))) | |||||||||
| + | (defn debug-handler [_ _ _ _] + (fn [context-map] + (prettify-edn 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 [:elif :else :endif]
+ :elif [:elif :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]
+ [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))))) | |||||||||
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 | (ns selmer.template-parser + (:require + [clojure.java.io :refer [reader] :as io] + [selmer.filter-parser :refer [split-value]] + [selmer.util :refer :all] + [clojure.string :as s :refer [split trim]] + [selmer.validator :as validator]) + (:import java.io.StringReader)) | |||||||||
| + | (declare consume-block preprocess-template wrap-in-expression-tag) | |||||||||
| + | (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))) | |||||||||
+Public utilities. + + These general-purpose helpers are part of the documented include/extends machinery no longer relies on all of them.+ | ||||||||||
| + | (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 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- parse-include-tag [tag-str]
+ (let [params
+ (tokenize-tag-args
+ (get-tag-params "include"
+ (.replace ^String tag-str "\\" "/")))
+ [source & include-args] params
+ include-args
+ (if (= "with" (first include-args))
+ (rest include-args)
+ include-args)]
+ {:source (.replaceAll ^String source "\ )
+ :bindings (partition 2 include-args)})) | |||||||||
| + | (defn- wrap-in-with-tag [template bindings] + (let [include-binding-temp-name + (fn [id] + ;; Namespace the temp binding under the `selmer` keyword namespace + ;; (mirroring `compile-args-namespaced`) so it can't collide with—or + ;; throw on—a user-supplied `:selmer` context key. Dots are flattened + ;; so the name resolves to a single namespaced keyword rather than a + ;; nested accessor path. + (str "selmer/include-" (clojure.string/replace id "." "_"))) + self-referential-include-binding? + (fn [id value] + (= id (-> value split-value first))) + outer-with-binding-arg + (fn [[id value]] + (str (include-binding-temp-name id) + "=" value)) + ;; Precedence note: the inner `with` decides whether the binding or the + ;; caller's context wins for the bound name. + ;; - self-referential (e.g. `x=x|upper`): the computed value wins, + ;; otherwise the filter would be a no-op whenever the caller has `x`. + ;; - everything else (e.g. `x=heading`): the binding is treated as a + ;; default, preserving Selmer's historic include-with semantics where + ;; a caller-provided value for the bound name wins. + inner-with-binding-arg + (fn [[id value]] + (if (self-referential-include-binding? id value) + (str id "=" + (include-binding-temp-name id) + "|default:@" + id) + (str id "=" id + "|default:@" + (include-binding-temp-name id)))) + outer-args + (->> bindings + (map outer-with-binding-arg) + (clojure.string/join \space)) + inner-args + (->> bindings + (map inner-with-binding-arg) + (clojure.string/join \space))] + (str (wrap-in-expression-tag + (str "with " outer-args)) + (wrap-in-expression-tag + (str "with " inner-args)) + template + (wrap-in-expression-tag "endwith") + (wrap-in-expression-tag "endwith")))) | |||||||||
| + | (defn- process-includes [tag-str blocks]
+ (let [{:keys [source bindings]}
+ (parse-include-tag tag-str)
+ template
+ (preprocess-template source blocks)]
+ (if (seq bindings)
+ (wrap-in-with-tag template bindings)
+ template))) | |||||||||
| + | (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) + includes? (re-matches *include-pattern* tag-str) + block? (re-matches *block-pattern* tag-str) + block-name (when block? (get-tag-params "block" tag-str)) + super-tag? (re-matches *block-super-pattern* tag-str) + existing-block (when block-name (get-in blocks [block-name :content]))] + (when buf + (cond + includes? + (.append buf (process-includes tag-str blocks)) + ;;check if we wish to write the closing tag for the block. If we're + ;;injecting block.super, then we want to omit it + (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- unparse-defaults [defaults] + (when defaults + (trim + (reduce-kv + (fn [s k v] + (str s k "=\ v "\" ")) + defaults)))) | |||||||||
| + | (defn to-expression-string [tag-name args defaults] + (let [tag-name' (name tag-name) + args' (clojure.string/join \space args) + defaults' (when (= tag-name' "include") ;; forwards any defined defaults down to the children to be evaluated in context + (unparse-defaults defaults)) + joined (str tag-name' + (when (seq args) + (str \space args')) + (when defaults' + (str \space "with" \space defaults')))] + (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'))
+ identifier+defaults (map #(try-add-default % defaults) args)]
+ (to-expression-string tag-name identifier+defaults defaults))) | |||||||||
| + | (defn get-template-path [template] + (resource-path template)) | |||||||||
| + | (defn read-template [template blocks]
+ (let [path (if (instance? (Class/forName "[C") template)
+ template
+ (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))
+ path))
+ 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
+ (re-matches *include-pattern* tag-str)
+ (do (.append buf (process-includes tag-str blocks))
+ (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
+ (when (nil? parent) (.append buf ch))
+ (recur blocks (read-char rdr) parent)))))]
+ (if parent
+ (recur parent blocks)
+ (.toString buf)))) | |||||||||
| + | (defn preprocess-template [template & [blocks]] + (read-template template blocks)) | |||||||||
| + | (ns selmer.util + (:require + [clojure.java.io :as io] + [clojure.string :as string]) + (:import java.io.StringReader + java.util.regex.Pattern + java.security.MessageDigest)) | |||||||||
| + | (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 *url-stream-handler* nil) | |||||||||
| + | (defn set-url-stream-handler! + [path] + (alter-var-root #'*url-stream-handler* (constantly path)) + (when (thread-bound? #'*url-stream-handler*) + (set! *url-stream-handler* 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 (string/join content))) | |||||||||
| + | (defn read-char [^java.io.Reader 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 ^:dynamic *tags* nil) | |||||||||
| + | (defn check-tag-args [args]
+ (if (even? (count (filter #{\"} args)))
+ args (throw (ex-info (str "malformed tag arguments in " args) {:args args})))) | |||||||||
| + | (defn read-tag-info [rdr]
+ (let [buf (StringBuilder.)
+ tag-type (if (= *filter-open* (read-char rdr)) :filter :expr)
+ filter? (identical? :filter tag-type )]
+ (loop [ch1 (read-char rdr)
+ ch2 (read-char rdr)]
+ (when-not (or (nil? ch1)
+ (and (if filter? (= *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 (if filter?
+ #"(?:[^\"]|\"[^\"]*\")+"
+ #"(?:[^\s\"]|\"[^\"]*\")+"))
+ (remove empty?)
+ (map (fn [^String s] (.trim s))))
+ tag-info (merge {:tag-type tag-type}
+ (if (= :filter tag-type)
+ {:tag-value (first content)}
+ {:tag-name (keyword (first content))
+ :args (next content)}))]
+ (when *tags*
+ (swap! *tags* conj tag-info))
+ tag-info))) | |||||||||
| + | (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 [] + (let [ch (read-char rdr)] + (cond + (or (= *tag-close* ch) + (= *filter-close* ch)) + (.append buf ch) + (nil? ch) + (throw (java.io.EOFException. (str "Expected closing delimiter: " buf))) + :else (do (.append buf ch) + (recur))))) + (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 tokenize-tag-args [args] + (let [input (if (sequential? args) + (string/join " " args) + args) + rdr (StringReader. input) + buf (StringBuilder.)] + (loop [items [] + ^Character ch (read-char rdr) + open? false] + (cond + (nil? ch) + (let [value (.trim (.toString buf))] + (cond-> items (not (empty? value)) (conj value))) + (= ch \") + (do + (.append buf ch) + (recur items (read-char rdr) (not open?))) + (and (not open?) (or (Character/isWhitespace ^Character ch) (= ch \=))) + (let [value (.trim (.toString buf))] + (.setLength buf 0) + (recur (cond-> items (not (empty? value)) (conj value)) + (read-char rdr) + open?)) + :else + (do + (.append buf ch) + (recur items (read-char rdr) open?)))))) | |||||||||
Do we seem to be running on Windows? + | (defn on-windows? + [] + (-> (System/getProperty "os.name") + clojure.string/lower-case + (clojure.string/includes? "windows"))) | |||||||||
Does the resource path seem to be an absolute file path, considering +the system file separator, and (when running on Windows) the +possibility of a drive letter prefix? + | (defn looks-like-absolute-file-path? + [^java.lang.String path] + (or (.startsWith path java.io.File/separator) + (and (on-windows?) (re-matches #"[a-zA-Z]:.*" path)))) | |||||||||
Var to override the implementation of io/resource. Used by babashka. + | (def ^:dynamic *resource-fn* + io/resource) | |||||||||
| + | (defn resource-path [template] + (if (instance? java.net.URL template) + template + (if-let [path *custom-resource-path*] + (let [f (str path template)] + (cond + (looks-like-absolute-file-path? f) (.toURL (.toURI (io/file f))) + (.startsWith f "file:/") (java.net.URL. f) + (.startsWith f "jar:file:/") (java.net.URL. f) + *url-stream-handler* + (java.net.URL. nil f + ^java.net.URLStreamHandler *url-stream-handler*) + :else (*resource-fn* f))) + (cond + *url-stream-handler* (java.net.URL. nil ^String template + ^java.net.URLStreamHandler *url-stream-handler*) + :else (*resource-fn* template))))) | |||||||||
| + | (defn resource-last-modified [^java.net.URL resource] + (let [path (.getPath resource)] + (try + (.lastModified (io/file 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) | |||||||||
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))) | |||||||||
| + | (defn- parse-long-value [^String s] + (when (re-matches #"\d+" s) + (Long/valueOf s))) | |||||||||
Turns strings into keywords and strings like "0" into Longs +so it can access vectors as well as maps. + | (defn fix-accessor + [ks] + (mapv (fn [^String s] + (or (parse-long-value s) (keyword s))) + ks)) | |||||||||
Split accessors like foo.bar.baz by the dot. + But if there is a double dot '..' then it will leave it + | (defn parse-accessor + [^String accessor] + (->> (string/split accessor #"(?<!\.)\.(?!\.)") + (map (fn [s] (string/replace s ".." "."))) + (fix-accessor))) | |||||||||
finds and returns the first element in a collection where function f evaluates to true. + | (defn ffind + [f coll] + (some + (fn [e] (and (f e) e)) + coll)) | |||||||||
| + | (defn hex [algo ^String s] + (let [algo (case algo + "md5" "MD5" + "sha" "SHA" + "sha256" "SHA-256" + "sha384" "SHA-384" + "sha512" "SHA-512" + (throw (IllegalArgumentException. (str "'" algo "' is not a valid hash algorithm.")))) + algo (MessageDigest/getInstance algo) + bs (.digest algo (.getBytes s))] + (format "%032x" (BigInteger. 1 bs)))) | |||||||||
Deprecation warning infrastructure + | (def ^:dynamic *warn-on-deprecated-keys* true) | |||||||||
| + | (defonce ^:private warned-keys (atom #{})) | |||||||||
| + | (def ^:private tools-logging-log* + (try + (require 'clojure.tools.logging) + (require 'clojure.tools.logging.impl) + (let [get-logger (resolve 'clojure.tools.logging.impl/get-logger) + factory @(resolve 'clojure.tools.logging/*logger-factory*) + logger (get-logger factory "selmer.util") + log* (resolve 'clojure.tools.logging/log*)] + (fn [message] + (log* logger :warn nil message))) + (catch Exception _ + nil))) | |||||||||
Default handler that tries clojure.tools.logging first, falls back to stderr. + | (defn- default-deprecation-warning-handler + [message] + (if tools-logging-log* + (tools-logging-log* message) + (binding [*out* *err*] + (println "DEPRECATION WARNING:" message)))) | |||||||||
| + | (def ^:dynamic *deprecation-warning-handler* default-deprecation-warning-handler) | |||||||||
Looks up a key in context-map, preferring the namespaced version (e.g. :selmer/async) + but falling back to the non-namespaced version (e.g. :async) with a deprecation warning. + The warning is only emitted once per key per JVM session. + | (defn deprecated-key-lookup + [context-map namespaced-key non-namespaced-key] + (if (contains? context-map namespaced-key) + (get context-map namespaced-key) + (when (contains? context-map non-namespaced-key) + (when (and *warn-on-deprecated-keys* + (not (contains? @warned-keys non-namespaced-key))) + (swap! warned-keys conj non-namespaced-key) + (*deprecation-warning-handler* + (str "Using " non-namespaced-key " in context is deprecated. " + "Please use " namespaced-key " instead."))) + (get context-map non-namespaced-key)))) | |||||||||
| + | (ns selmer.validator + (:require + [selmer.tags :refer :all] + [selmer.filters :refer :all] + [selmer.util :refer :all] + [clojure.string :as str] + [clojure.set :refer [difference]] + [clojure.java.io :as io])) | |||||||||
| + | (def error-template + (slurp (io/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 str/trim 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 validate-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 (io/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 (validate-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)))) | |||||||||