Skip to content

Commit

Permalink
feat: add parent and ancestor selectors
Browse files Browse the repository at this point in the history
  • Loading branch information
@Mertzenich @slipset
Mertzenich authored and slipset committed Oct 16, 2024
1 parent 93b40d1 commit 27ee318
Show file tree
Hide file tree
Showing 2 changed files with 243 additions and 100 deletions.
145 changes: 97 additions & 48 deletions src/cljc/hickory/select.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -465,6 +465,27 @@
(and (node-type :element)
(not selector)))

(defn compose-unary
"Takes a unary selection function and any number of selectors and returns
a selector which returns true when each selector and the unary function
applied to each subsequenct selector returns true.
Example:
(compose-unary has-child (tag :div) (class :foo) (attr :disabled))
Produces the equivalent of:
(and (tag :div)
(has-child (and (class :foo)
(has-child (and (attr :disabled))))))"
[unary-selector-fn & selectors]
(let [rev (reverse selectors)]
(loop [selectors (rest rev)
output (and (first rev))]
(cond
(empty? selectors) output
(= (count selectors) 1) (and (first selectors) (unary-selector-fn output))
:else (recur (rest selectors)
(and (first selectors) (unary-selector-fn output)))))))

(defn ordered-adjacent
"Takes a zipper movement function and any number of selectors as arguments
and returns a selector that returns true when the zip-loc given as the
Expand Down Expand Up @@ -507,6 +528,40 @@
[& selectors]
(apply ordered-adjacent zip/up (reverse selectors)))

(defn has-child
"Takes a selector as argument and returns a selector that returns true
when some direct child node of the zip-loc given as the argument satisfies
the selector.
Example: (has-child (tag :div))
will select only the inner span in
<div><span><div></div></span></div>"
[selector]
(fn [hzip-loc]
(let [subtree-start-loc (-> hzip-loc zip/down)
has-children? (not= nil subtree-start-loc)]
;; has-children? is needed to guard against zip/* receiving a nil arg in
;; a selector.
(if has-children?
(if (select-next-loc selector subtree-start-loc
zip/right
#(nil? %))
hzip-loc)))))

(defn parent
"Takes any number of selectors as arguments and returns a selector that
returns true when the zip-loc given as the argument is at the start of
a chain of direct child relationships specified by the selectors given
as arguments.
Example: (parent (tag :div) (class :foo) (attr :disabled))
will select the div in
<div><span class=\"foo\"><input disabled></input></span></div>
but not in
<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
[& selectors]
(apply compose-unary has-child selectors))

(defn follow-adjacent
"Takes any number of selectors as arguments and returns a selector that
returns true when the zip-loc given as the argument is at the end of
Expand Down Expand Up @@ -593,36 +648,6 @@
[& selectors]
(apply ordered zip/up (reverse selectors)))

(defn follow
"Takes any number of selectors as arguments and returns a selector that
returns true when the zip-loc given as the argument is at the end of
a chain of element sibling relationships specified by the selectors
given as arguments; intervening elements that do not satisfy a selector
are simply ignored and do not prevent a match.
Example: (follow (tag :div) (class :foo))
will select the span in both
<div>...</div><span class=\"foo\">...</span>
and
<div>...</div><b>...</b><span class=\"foo\">...</span>"
[& selectors]
(apply ordered #(left-of-node-type % :element) (reverse selectors)))

(defn precede
"Takes any number of selectors as arguments and returns a selector that
returns true when the zip-loc given as the argument is at the beginning of
a chain of element sibling relationships specified by the selectors
given as arguments; intervening elements that do not satisfy a selector
are simply ignored and do not prevent a match.
Example: (precede (tag :div) (class :foo))
will select the div in both
<div>...</div><span class=\"foo\">...</span>
and
<div>...</div><b>...</b><span class=\"foo\">...</span>"
[& selectors]
(apply ordered #(right-of-node-type % :element) selectors))

(defn has-descendant
"Takes a selector as argument and returns a selector that returns true
when some descendant node of the zip-loc given as the argument satisfies
Expand Down Expand Up @@ -652,23 +677,47 @@
#(= % subtree-end-loc))
hzip-loc))))))

(defn has-child
"Takes a selector as argument and returns a selector that returns true
when some direct child node of the zip-loc given as the argument satisfies
the selector.
(defn ancestor
"Takes any number of selectors as arguments and returns a selector that
returns true when the zip-loc given as the argument is at the start of
a chain of descendant relationships specified by the selectors given
as arguments; intervening elements that do not satisfy a selector are
simply ignored and do not prevent a match.
Example: (has-child (tag :div))
will select only the inner span in
<div><span><div></div></span></div>"
[selector]
(fn [hzip-loc]
(let [subtree-start-loc (-> hzip-loc zip/down)
has-children? (not= nil subtree-start-loc)]
;; has-children? is needed to guard against zip/* receiving a nil arg in
;; a selector.
(if has-children?
(if (select-next-loc selector subtree-start-loc
zip/right
#(nil? %))
hzip-loc)))))
Example: (ancestor (tag :div) (class :foo) (attr :disabled))
will select the div in both
<div><span class=\"foo\"><input disabled></input></span></div>
and
<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
[& selectors]
(apply compose-unary has-descendant selectors))

(defn follow
"Takes any number of selectors as arguments and returns a selector that
returns true when the zip-loc given as the argument is at the end of
a chain of element sibling relationships specified by the selectors
given as arguments; intervening elements that do not satisfy a selector
are simply ignored and do not prevent a match.
Example: (follow (tag :div) (class :foo))
will select the span in both
<div>...</div><span class=\"foo\">...</span>
and
<div>...</div><b>...</b><span class=\"foo\">...</span>"
[& selectors]
(apply ordered #(left-of-node-type % :element) (reverse selectors)))

(defn precede
"Takes any number of selectors as arguments and returns a selector that
returns true when the zip-loc given as the argument is at the beginning of
a chain of element sibling relationships specified by the selectors
given as arguments; intervening elements that do not satisfy a selector
are simply ignored and do not prevent a match.
Example: (precede (tag :div) (class :foo))
will select the div in both
<div>...</div><span class=\"foo\">...</span>
and
<div>...</div><b>...</b><span class=\"foo\">...</span>"
[& selectors]
(apply ordered #(right-of-node-type % :element) selectors))
198 changes: 146 additions & 52 deletions test/cljc/hickory/test/select.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -498,6 +498,79 @@
htree)]
(is (= [] selection))))))

(deftest has-child-test
(testing "has-child selector combinator"
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
(doseq [doc docs]
(let [htree (-> doc
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/has-child
(select/id :innermost))
htree)]
(is (and (= 1 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
;; Check that a descendant selector can peer up past the
;; node having its descendants examined.
(let [selection (select/select (select/has-child
(select/descendant (select/id :outermost)
(select/id :innermost)))
htree)]
(is (and (= 1 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
(let [selection (select/select (select/has-child (select/tag :a))
htree)]
(is (= [] selection))))))))

(deftest parent-test
(testing "parent selector combinator"
(let [htree (hickory/as-hickory (hickory/parse html1))]
(let [selection (select/select (select/parent (select/el-not select/any))
htree)]
(is (= [] selection)))
(let [selection (select/select (select/parent (select/tag :html)
(select/tag :div)
(select/tag :span))
htree)]
(is (= [] selection)))
(let [selection (select/select (select/parent (select/tag :body)
(select/tag :div)
(select/tag :span))
htree)]
(is (and (= 1 (count selection))
(every? true? (map #(= :body (:tag %)) selection)))))
(let [selection (select/select (select/parent (select/tag :div)
select/any)
htree)]
(is (and (= 1 (count selection))
(every? true? (map #(= :div (-> % :tag))
selection)))))
;; Find any element that is a parent of another element
(let [selection (select/select (select/parent select/any select/any)
htree)]
(is (and (= 4 (count selection))
(every? true? (mapv #(or (= :html (-> % :tag))
(= :body (-> % :tag))
(= :div (-> % :tag))
(= :span (-> % :tag)))
selection))))))
;; Check examples from the doc string.
(let [htree (-> "<div><span class=\"foo\"><input disabled></input></span></div>"
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/parent (select/tag :div)
(select/class :foo)
(select/attr :disabled))
htree)]
(is (= :div (-> selection first :tag)))))
(let [htree (-> "<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/parent (select/tag :div)
(select/class :foo)
(select/attr :disabled))
htree)]
(is (= [] selection))))))

(deftest follow-adjacent-test
(testing "follow-adjacent selector combinator"
(let [htree (hickory/as-hickory (hickory/parse html1))]
Expand Down Expand Up @@ -591,6 +664,79 @@
(is (and (= 1 (count selection))
(= :input (-> selection first :tag))))))))

(deftest has-descendant-test
(testing "has-descendant selector combinator"
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
(doseq [doc docs]
(let [htree (-> doc
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/and (select/tag :div)
(select/has-descendant
(select/id :innermost)))
htree)]
(is (and (= 2 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
;; Check that a descendant selector can peer up past the
;; node having its descendants examined.
(let [selection (select/select (select/and (select/tag :div)
(select/has-descendant
(select/descendant (select/id :outermost)
(select/tag :span))))
htree)]
(is (and (= 2 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
(let [selection (select/select (select/has-descendant (select/tag :a))
htree)]
(is (= [] selection))))))))

(deftest ancestor-test
(testing "ancestor selector combinator"
(let [htree (hickory/as-hickory (hickory/parse html1))]
(let [selection (select/select (select/ancestor (select/tag :h1))
htree)]
(is (and (= 1 (count selection))
(= :h1 (-> selection first :tag)))))
(let [selection (select/select (select/ancestor (select/class "cool")
(select/tag :div))
htree)]
(is (= 1 (count selection))
(= "deepestdiv" (-> selection first :attrs :id))))
(let [selection (select/select (select/ancestor (select/tag :div)
select/any)
htree)]
(is (= 1 (count selection))))
(let [selection (select/select (select/ancestor (select/tag :span))
htree)]
(is (= 2 (count selection))))
;; Find any element that is a parent of another element
(let [selection (select/select (select/parent select/any select/any)
htree)]
(is (and (= 4 (count selection))
(every? true? (mapv #(or (= :html (-> % :tag))
(= :body (-> % :tag))
(= :div (-> % :tag))
(= :span (-> % :tag)))
selection))))))
;; Check examples from doc string.
(let [htree (-> "<div><span class=\"foo\"><input disabled></input></span></div>"
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/ancestor (select/tag :div)
(select/class :foo)
(select/attr :disabled))
htree)]
(is (and (= 1 (count selection))
(= :div (-> selection first :tag))))))
(let [htree (-> "<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/ancestor (select/tag :div)
(select/class :foo)
(select/attr :disabled))
htree)]
(is (and (= 1 (count selection))
(= :div (-> selection first :tag))))))))

(deftest follow-test
(testing "follow selector combinator"
(let [htree (hickory/as-hickory (hickory/parse html1))]
Expand Down Expand Up @@ -636,58 +782,6 @@
htree)]
(is (= :div (-> selection first :tag)))))))

(deftest has-descendant-test
(testing "has-descendant selector combinator"
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
(doseq [doc docs]
(let [htree (-> doc
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/and (select/tag :div)
(select/has-descendant
(select/id :innermost)))
htree)]
(is (and (= 2 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
;; Check that a descendant selector can peer up past the
;; node having its descendants examined.
(let [selection (select/select (select/and (select/tag :div)
(select/has-descendant
(select/descendant (select/id :outermost)
(select/tag :span))))
htree)]
(is (and (= 2 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
(let [selection (select/select (select/has-descendant (select/tag :a))
htree)]
(is (= [] selection))))))))

(deftest has-child-test
(testing "has-child selector combinator"
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
(doseq [doc docs]
(let [htree (-> doc
hickory/parse hickory/as-hickory)]
(let [selection (select/select (select/has-child
(select/id :innermost))
htree)]
(is (and (= 1 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
;; Check that a descendant selector can peer up past the
;; node having its descendants examined.
(let [selection (select/select (select/has-child
(select/descendant (select/id :outermost)
(select/id :innermost)))
htree)]
(is (and (= 1 (count selection))
(every? true? (map #(= :div (-> % :tag)) selection)))))
(let [selection (select/select (select/has-child (select/tag :a))
htree)]
(is (= [] selection))))))))

(deftest graceful-boundaries-test
;; Testing some problematic expressions to make sure they gracefully
;; return empty results.
Expand Down

0 comments on commit 27ee318

Please sign in to comment.