Skip to content

Commit 27ee318

Browse files
Mertzenichslipset
Mertzenich
authored and
slipset
committed
feat: add parent and ancestor selectors
1 parent 93b40d1 commit 27ee318

File tree

2 files changed

+243
-100
lines changed

2 files changed

+243
-100
lines changed

‎src/cljc/hickory/select.cljc

+97-48
Original file line numberDiff line numberDiff line change
@@ -465,6 +465,27 @@
465465
(and (node-type :element)
466466
(not selector)))
467467

468+
(defn compose-unary
469+
"Takes a unary selection function and any number of selectors and returns
470+
a selector which returns true when each selector and the unary function
471+
applied to each subsequenct selector returns true.
472+
473+
Example:
474+
(compose-unary has-child (tag :div) (class :foo) (attr :disabled))
475+
Produces the equivalent of:
476+
(and (tag :div)
477+
(has-child (and (class :foo)
478+
(has-child (and (attr :disabled))))))"
479+
[unary-selector-fn & selectors]
480+
(let [rev (reverse selectors)]
481+
(loop [selectors (rest rev)
482+
output (and (first rev))]
483+
(cond
484+
(empty? selectors) output
485+
(= (count selectors) 1) (and (first selectors) (unary-selector-fn output))
486+
:else (recur (rest selectors)
487+
(and (first selectors) (unary-selector-fn output)))))))
488+
468489
(defn ordered-adjacent
469490
"Takes a zipper movement function and any number of selectors as arguments
470491
and returns a selector that returns true when the zip-loc given as the
@@ -507,6 +528,40 @@
507528
[& selectors]
508529
(apply ordered-adjacent zip/up (reverse selectors)))
509530

531+
(defn has-child
532+
"Takes a selector as argument and returns a selector that returns true
533+
when some direct child node of the zip-loc given as the argument satisfies
534+
the selector.
535+
536+
Example: (has-child (tag :div))
537+
will select only the inner span in
538+
<div><span><div></div></span></div>"
539+
[selector]
540+
(fn [hzip-loc]
541+
(let [subtree-start-loc (-> hzip-loc zip/down)
542+
has-children? (not= nil subtree-start-loc)]
543+
;; has-children? is needed to guard against zip/* receiving a nil arg in
544+
;; a selector.
545+
(if has-children?
546+
(if (select-next-loc selector subtree-start-loc
547+
zip/right
548+
#(nil? %))
549+
hzip-loc)))))
550+
551+
(defn parent
552+
"Takes any number of selectors as arguments and returns a selector that
553+
returns true when the zip-loc given as the argument is at the start of
554+
a chain of direct child relationships specified by the selectors given
555+
as arguments.
556+
557+
Example: (parent (tag :div) (class :foo) (attr :disabled))
558+
will select the div in
559+
<div><span class=\"foo\"><input disabled></input></span></div>
560+
but not in
561+
<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
562+
[& selectors]
563+
(apply compose-unary has-child selectors))
564+
510565
(defn follow-adjacent
511566
"Takes any number of selectors as arguments and returns a selector that
512567
returns true when the zip-loc given as the argument is at the end of
@@ -593,36 +648,6 @@
593648
[& selectors]
594649
(apply ordered zip/up (reverse selectors)))
595650

596-
(defn follow
597-
"Takes any number of selectors as arguments and returns a selector that
598-
returns true when the zip-loc given as the argument is at the end of
599-
a chain of element sibling relationships specified by the selectors
600-
given as arguments; intervening elements that do not satisfy a selector
601-
are simply ignored and do not prevent a match.
602-
603-
Example: (follow (tag :div) (class :foo))
604-
will select the span in both
605-
<div>...</div><span class=\"foo\">...</span>
606-
and
607-
<div>...</div><b>...</b><span class=\"foo\">...</span>"
608-
[& selectors]
609-
(apply ordered #(left-of-node-type % :element) (reverse selectors)))
610-
611-
(defn precede
612-
"Takes any number of selectors as arguments and returns a selector that
613-
returns true when the zip-loc given as the argument is at the beginning of
614-
a chain of element sibling relationships specified by the selectors
615-
given as arguments; intervening elements that do not satisfy a selector
616-
are simply ignored and do not prevent a match.
617-
618-
Example: (precede (tag :div) (class :foo))
619-
will select the div in both
620-
<div>...</div><span class=\"foo\">...</span>
621-
and
622-
<div>...</div><b>...</b><span class=\"foo\">...</span>"
623-
[& selectors]
624-
(apply ordered #(right-of-node-type % :element) selectors))
625-
626651
(defn has-descendant
627652
"Takes a selector as argument and returns a selector that returns true
628653
when some descendant node of the zip-loc given as the argument satisfies
@@ -652,23 +677,47 @@
652677
#(= % subtree-end-loc))
653678
hzip-loc))))))
654679

655-
(defn has-child
656-
"Takes a selector as argument and returns a selector that returns true
657-
when some direct child node of the zip-loc given as the argument satisfies
658-
the selector.
680+
(defn ancestor
681+
"Takes any number of selectors as arguments and returns a selector that
682+
returns true when the zip-loc given as the argument is at the start of
683+
a chain of descendant relationships specified by the selectors given
684+
as arguments; intervening elements that do not satisfy a selector are
685+
simply ignored and do not prevent a match.
659686
660-
Example: (has-child (tag :div))
661-
will select only the inner span in
662-
<div><span><div></div></span></div>"
663-
[selector]
664-
(fn [hzip-loc]
665-
(let [subtree-start-loc (-> hzip-loc zip/down)
666-
has-children? (not= nil subtree-start-loc)]
667-
;; has-children? is needed to guard against zip/* receiving a nil arg in
668-
;; a selector.
669-
(if has-children?
670-
(if (select-next-loc selector subtree-start-loc
671-
zip/right
672-
#(nil? %))
673-
hzip-loc)))))
687+
Example: (ancestor (tag :div) (class :foo) (attr :disabled))
688+
will select the div in both
689+
<div><span class=\"foo\"><input disabled></input></span></div>
690+
and
691+
<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
692+
[& selectors]
693+
(apply compose-unary has-descendant selectors))
694+
695+
(defn follow
696+
"Takes any number of selectors as arguments and returns a selector that
697+
returns true when the zip-loc given as the argument is at the end of
698+
a chain of element sibling relationships specified by the selectors
699+
given as arguments; intervening elements that do not satisfy a selector
700+
are simply ignored and do not prevent a match.
701+
702+
Example: (follow (tag :div) (class :foo))
703+
will select the span in both
704+
<div>...</div><span class=\"foo\">...</span>
705+
and
706+
<div>...</div><b>...</b><span class=\"foo\">...</span>"
707+
[& selectors]
708+
(apply ordered #(left-of-node-type % :element) (reverse selectors)))
674709

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

‎test/cljc/hickory/test/select.cljc

+146-52
Original file line numberDiff line numberDiff line change
@@ -498,6 +498,79 @@
498498
htree)]
499499
(is (= [] selection))))))
500500

501+
(deftest has-child-test
502+
(testing "has-child selector combinator"
503+
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
504+
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
505+
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
506+
(doseq [doc docs]
507+
(let [htree (-> doc
508+
hickory/parse hickory/as-hickory)]
509+
(let [selection (select/select (select/has-child
510+
(select/id :innermost))
511+
htree)]
512+
(is (and (= 1 (count selection))
513+
(every? true? (map #(= :div (-> % :tag)) selection)))))
514+
;; Check that a descendant selector can peer up past the
515+
;; node having its descendants examined.
516+
(let [selection (select/select (select/has-child
517+
(select/descendant (select/id :outermost)
518+
(select/id :innermost)))
519+
htree)]
520+
(is (and (= 1 (count selection))
521+
(every? true? (map #(= :div (-> % :tag)) selection)))))
522+
(let [selection (select/select (select/has-child (select/tag :a))
523+
htree)]
524+
(is (= [] selection))))))))
525+
526+
(deftest parent-test
527+
(testing "parent selector combinator"
528+
(let [htree (hickory/as-hickory (hickory/parse html1))]
529+
(let [selection (select/select (select/parent (select/el-not select/any))
530+
htree)]
531+
(is (= [] selection)))
532+
(let [selection (select/select (select/parent (select/tag :html)
533+
(select/tag :div)
534+
(select/tag :span))
535+
htree)]
536+
(is (= [] selection)))
537+
(let [selection (select/select (select/parent (select/tag :body)
538+
(select/tag :div)
539+
(select/tag :span))
540+
htree)]
541+
(is (and (= 1 (count selection))
542+
(every? true? (map #(= :body (:tag %)) selection)))))
543+
(let [selection (select/select (select/parent (select/tag :div)
544+
select/any)
545+
htree)]
546+
(is (and (= 1 (count selection))
547+
(every? true? (map #(= :div (-> % :tag))
548+
selection)))))
549+
;; Find any element that is a parent of another element
550+
(let [selection (select/select (select/parent select/any select/any)
551+
htree)]
552+
(is (and (= 4 (count selection))
553+
(every? true? (mapv #(or (= :html (-> % :tag))
554+
(= :body (-> % :tag))
555+
(= :div (-> % :tag))
556+
(= :span (-> % :tag)))
557+
selection))))))
558+
;; Check examples from the doc string.
559+
(let [htree (-> "<div><span class=\"foo\"><input disabled></input></span></div>"
560+
hickory/parse hickory/as-hickory)]
561+
(let [selection (select/select (select/parent (select/tag :div)
562+
(select/class :foo)
563+
(select/attr :disabled))
564+
htree)]
565+
(is (= :div (-> selection first :tag)))))
566+
(let [htree (-> "<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
567+
hickory/parse hickory/as-hickory)]
568+
(let [selection (select/select (select/parent (select/tag :div)
569+
(select/class :foo)
570+
(select/attr :disabled))
571+
htree)]
572+
(is (= [] selection))))))
573+
501574
(deftest follow-adjacent-test
502575
(testing "follow-adjacent selector combinator"
503576
(let [htree (hickory/as-hickory (hickory/parse html1))]
@@ -591,6 +664,79 @@
591664
(is (and (= 1 (count selection))
592665
(= :input (-> selection first :tag))))))))
593666

667+
(deftest has-descendant-test
668+
(testing "has-descendant selector combinator"
669+
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
670+
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
671+
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
672+
(doseq [doc docs]
673+
(let [htree (-> doc
674+
hickory/parse hickory/as-hickory)]
675+
(let [selection (select/select (select/and (select/tag :div)
676+
(select/has-descendant
677+
(select/id :innermost)))
678+
htree)]
679+
(is (and (= 2 (count selection))
680+
(every? true? (map #(= :div (-> % :tag)) selection)))))
681+
;; Check that a descendant selector can peer up past the
682+
;; node having its descendants examined.
683+
(let [selection (select/select (select/and (select/tag :div)
684+
(select/has-descendant
685+
(select/descendant (select/id :outermost)
686+
(select/tag :span))))
687+
htree)]
688+
(is (and (= 2 (count selection))
689+
(every? true? (map #(= :div (-> % :tag)) selection)))))
690+
(let [selection (select/select (select/has-descendant (select/tag :a))
691+
htree)]
692+
(is (= [] selection))))))))
693+
694+
(deftest ancestor-test
695+
(testing "ancestor selector combinator"
696+
(let [htree (hickory/as-hickory (hickory/parse html1))]
697+
(let [selection (select/select (select/ancestor (select/tag :h1))
698+
htree)]
699+
(is (and (= 1 (count selection))
700+
(= :h1 (-> selection first :tag)))))
701+
(let [selection (select/select (select/ancestor (select/class "cool")
702+
(select/tag :div))
703+
htree)]
704+
(is (= 1 (count selection))
705+
(= "deepestdiv" (-> selection first :attrs :id))))
706+
(let [selection (select/select (select/ancestor (select/tag :div)
707+
select/any)
708+
htree)]
709+
(is (= 1 (count selection))))
710+
(let [selection (select/select (select/ancestor (select/tag :span))
711+
htree)]
712+
(is (= 2 (count selection))))
713+
;; Find any element that is a parent of another element
714+
(let [selection (select/select (select/parent select/any select/any)
715+
htree)]
716+
(is (and (= 4 (count selection))
717+
(every? true? (mapv #(or (= :html (-> % :tag))
718+
(= :body (-> % :tag))
719+
(= :div (-> % :tag))
720+
(= :span (-> % :tag)))
721+
selection))))))
722+
;; Check examples from doc string.
723+
(let [htree (-> "<div><span class=\"foo\"><input disabled></input></span></div>"
724+
hickory/parse hickory/as-hickory)]
725+
(let [selection (select/select (select/ancestor (select/tag :div)
726+
(select/class :foo)
727+
(select/attr :disabled))
728+
htree)]
729+
(is (and (= 1 (count selection))
730+
(= :div (-> selection first :tag))))))
731+
(let [htree (-> "<div><span class=\"foo\"><b><input disabled></input></b></span></div>"
732+
hickory/parse hickory/as-hickory)]
733+
(let [selection (select/select (select/ancestor (select/tag :div)
734+
(select/class :foo)
735+
(select/attr :disabled))
736+
htree)]
737+
(is (and (= 1 (count selection))
738+
(= :div (-> selection first :tag))))))))
739+
594740
(deftest follow-test
595741
(testing "follow selector combinator"
596742
(let [htree (hickory/as-hickory (hickory/parse html1))]
@@ -636,58 +782,6 @@
636782
htree)]
637783
(is (= :div (-> selection first :tag)))))))
638784

639-
(deftest has-descendant-test
640-
(testing "has-descendant selector combinator"
641-
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
642-
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
643-
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
644-
(doseq [doc docs]
645-
(let [htree (-> doc
646-
hickory/parse hickory/as-hickory)]
647-
(let [selection (select/select (select/and (select/tag :div)
648-
(select/has-descendant
649-
(select/id :innermost)))
650-
htree)]
651-
(is (and (= 2 (count selection))
652-
(every? true? (map #(= :div (-> % :tag)) selection)))))
653-
;; Check that a descendant selector can peer up past the
654-
;; node having its descendants examined.
655-
(let [selection (select/select (select/and (select/tag :div)
656-
(select/has-descendant
657-
(select/descendant (select/id :outermost)
658-
(select/tag :span))))
659-
htree)]
660-
(is (and (= 2 (count selection))
661-
(every? true? (map #(= :div (-> % :tag)) selection)))))
662-
(let [selection (select/select (select/has-descendant (select/tag :a))
663-
htree)]
664-
(is (= [] selection))))))))
665-
666-
(deftest has-child-test
667-
(testing "has-child selector combinator"
668-
(let [docs ["<div id=\"outermost\"><div><span id=\"innermost\"></span></div></div>"
669-
"<div id=\"outermost\"><div><span id=\"innermost\"></span></div><span id=\"sib\"></span></div>"
670-
"<div id=\"outermost\"><span id=\"sib\"></span><div><span id=\"innermost\"></span></div></div>"]]
671-
(doseq [doc docs]
672-
(let [htree (-> doc
673-
hickory/parse hickory/as-hickory)]
674-
(let [selection (select/select (select/has-child
675-
(select/id :innermost))
676-
htree)]
677-
(is (and (= 1 (count selection))
678-
(every? true? (map #(= :div (-> % :tag)) selection)))))
679-
;; Check that a descendant selector can peer up past the
680-
;; node having its descendants examined.
681-
(let [selection (select/select (select/has-child
682-
(select/descendant (select/id :outermost)
683-
(select/id :innermost)))
684-
htree)]
685-
(is (and (= 1 (count selection))
686-
(every? true? (map #(= :div (-> % :tag)) selection)))))
687-
(let [selection (select/select (select/has-child (select/tag :a))
688-
htree)]
689-
(is (= [] selection))))))))
690-
691785
(deftest graceful-boundaries-test
692786
;; Testing some problematic expressions to make sure they gracefully
693787
;; return empty results.

0 commit comments

Comments
 (0)