predicate.clj

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