Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[Fix #40] add parent and ancestor selectors #90

Merged
merged 1 commit into from
Oct 16, 2024
Merged

[Fix #40] add parent and ancestor selectors #90

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
145 changes: 97 additions & 48 deletions src/cljc/hickory/select.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -463,6 +463,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 @@ -505,6 +526,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 @@ -591,36 +646,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 @@ -650,23 +675,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
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -492,6 +492,79 @@ cool\">Span</span>
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 @@ -585,6 +658,79 @@ cool\">Span</span>
(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 @@ -630,58 +776,6 @@ cool\">Span</span>
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
Loading