Skip to content

Instantly share code, notes, and snippets.

@bendlas
Created February 13, 2013 07:00
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save bendlas/4942791 to your computer and use it in GitHub Desktop.
Save bendlas/4942791 to your computer and use it in GitHub Desktop.
This file is not part of the cljs port as of yet, but a tidbit from my enlive cleanup effort It shows how to implement CSS3 operations in terms of zippers, in that form it should be trivial to adapt to the DOM it's basically the predicates library from enlive, but lifted to a zipper level, so that it can work generically
(ns workbench.enlive.predicate
(:require
[clojure.zip :as z]
[workbench.enlive.engine
:refer [compile-step]]
[workbench.enlive.select
:refer [zip-select]]))
;; ## Builtin predicates
;;
;; A lot of predefined predicates and predicate combiners, for your
;; convenience.
(def root #(-> % z/up nil?))
(def void #(when (z/branch? %)
(every? void (z/children %))))
;; ### CSS like nth-*
;;
;; Every nth-* style predicate, gets two constants a b and matches
;; every a*n+b branches.
;;
;; When compared with the original enlive implementation, there are
;; additional *-node-* here, which not only count branch nodes, but
;; also leaf nodes.
;; These are mnemonics for the right or left siblings of a loc
(def ^:private <<< #(iterate-while z/left %))
(def ^:private >>> #(iterate-while z/right %))
;; Utils
(defn- congruent? [a b n]
(if (zero? a)
(= n b)
(let [n-b (- n b)]
(and (zero? (rem n-b a))
(<= 0 (quot n-b a))))))
(defn- nth-of [dir attr a b]
(fn [loc]
(when-let [val (attr loc)]
(congruent? a b (count (filter #(= val (attr %))
(dir loc)))))))
;; These helper macros generate toplevel functions that take a and b
;; and return a predicate. When the macro is used without specifying a
;; _location_ attribute, the generated fn additionally takes a _node_
;; attribute.
(defmacro ^:private defnth
([v dir]
(let [fname (symbol (str "nth-" (name v)))]
`(defn ~fname
([node-attr# b#] (~fname node-attr# 0 b#))
([node-attr# a# b#] (nth-of ~dir
(pred node-attr#)
a# b#)))))
([v dir attr]
(let [fname (symbol (str "nth-" (name v)))]
`(defn ~fname
([b#] (~fname 0 b#))
([a# b#] (nth-of ~dir ~attr a# b#))))))
;; The defnbr is an oddball. We need it to define functions that take
;; a user attribute, but still only want to operate on branches.
(defmacro ^:private defnbr
([v dir]
(let [fname (symbol (str "nth-" (name v)))]
`(defn ~fname
([node-attr# b#] (~fname node-attr# 0 b#))
([node-attr# a# b#] (nth-of ~dir
(branch-pred node-attr#)
a# b#))))))
;; Now we can conveniently define all the permutations of
;; [only|nth|last]-[node|branch]-of-[attr|tag] and some more.
(defnth child <<< z/branch?)
(defnth child-node <<< any-node)
(defnth last-child >>> z/branch?)
(defnth last-child-node >>> any-node)
(defnbr of-attr <<<)
(defnth node-of-attr <<<)
(defnbr last-of-attr >>>)
(defnth last-node-of-attr >>>)
(defnth of-tag <<< (branch-zip-pred loc-tag))
(defnth last-of-tag >>> (branch-zip-pred loc-tag))
;; ### Predefined positions
(def first-child (nth-child 1))
(def last-child (nth-last-child 1))
(def first-of-tag (nth-of-tag 1))
(def last-of-tag (nth-last-of-tag 1))
(def only-child (intersection [first-child last-child]))
(def only-of-tag (intersection [first-of-tag last-of-tag]))
(def odd (nth-child 2 1))
(def even (nth-child 2 0))
;; Node variants
(def first-child-node (nth-child-node 1))
(def last-child-node (nth-last-child-node 1))
(def only-node (intersection [first-child-node last-child-node]))
(def odd-node (nth-child-node 2 1))
(def even-node (nth-child-node 2 0))
;; These only work if nodes are selectable
(defnth node-of-tag <<< loc-tag)
(defnth last-node-of-tag >>> loc-tag)
(def first-node-of-tag (nth-node-of-tag 1))
(def last-node-of-tag (nth-last-node-of-tag 1))
(def only-node-of-tag (intersection [first-node-of-tag last-node-of-tag]))
;; ## Other CSS style predicates
;; locs-predicate applies f to loc to get a sequence of successor locs
;; and sees selector matches any of those
(defn- locs-predicate [f selector]
(branch-zip-pred
#(-> (f %)
(zip-select selector)
seq boolean)))
(defn has
"Selector predicate, matches elements which contain at least one element that
matches the specified selector. See jQuery's :has"
[selector]
(locs-predicate children-locs selector))
(defn but-node
"Selector predicate, matches nodes which are rejected by the specified selector-step. See CSS :not"
[selector-step]
(complement (compile-step selector-step)))
(defn but
"Selector predicate, matches branches which are rejected by the specified selector-step. See CSS :not"
[selector-step]
(intersection [any (but-node selector-step)]))
(defn left
"Selector predicate, matches nodes whose immediate left sibling element is
matched by the specified selector-step."
[selector-step]
(locs-predicate #(take 1 (left-branches %)) [:> selector-step]))
(defn lefts
"Selector predicate, matches nodes whose one left sibling element is matched by
the specified selector-step."
[selector-step]
(locs-predicate left-branches [:> selector-step]))
(defn right
"Selector predicate, matches nodes whose immediate right sibling element is
matched by the specified selector-step."
[selector-step]
(locs-predicate #(take 1 (right-branches %)) [:> selector-step]))
(defn rights
"Selector predicate, matches nodes whose one left sibling element is matched by
the specified selector-step."
[selector-step]
(locs-predicate right-branches [:> selector-step]))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment