Repository: aantron/lambdasoup
Pull request #56 (2024-04-17 03:34:37)

Add :has selector
Pretty much what the title says.

I have added a few test cases all of which pass with flying colours.

Let me know if anything needs to be done.

One note though: `make test` didn't seem to run my changes. I tested that by adding a bad variable name, but the command did not err out. So I ended up testing with `dune exec ./test/performance/test.exe -w` after tweaking the file location (google.html) to match the test path.

jyssh: Please let me know if more needs to be done.

Patch:
diff --git a/src/soup.ml b/src/soup.ml
index 2347c6c..992edd1 100644
--- a/src/soup.ml
+++ b/src/soup.ml
@@ -485,6 +485,7 @@ struct
     | OnlyOfType
     | Empty
     | Content of string
+    | Has of simple_selector
     | Not of simple_selector
 
   and simple_selector =
@@ -595,6 +596,11 @@ struct
     | OnlyOfType -> element_count_with_name (name node) node = 1
     | Empty -> no_children node
     | Content s -> texts node |> String.concat "" |> has_substring s
+    | Has selector ->
+      descendants node
+      |> filter (fun descendant -> matches_simple_selector descendant selector)
+      |> count
+      |> fun count -> count > 0
     | Not selector -> not (matches_simple_selector node selector)
 
   and matches_simple_selector node = function
@@ -921,6 +927,9 @@ struct
       let s = parse_parenthesized_value parse_quoted_string stream in
       Content s
     | "empty" -> Empty
+    | "has" ->
+      let selector = parse_parenthesized_value parse_simple_selector stream in
+      Has selector
     | "not" ->
       let selector = parse_parenthesized_value parse_simple_selector stream in
       Not selector


Test patch:
diff --git a/test/performance/performance.ml b/test/performance/performance.ml
index a6b515e..f290bca 100644
--- a/test/performance/performance.ml
+++ b/test/performance/performance.ml
@@ -27,8 +27,24 @@ let () =
 
   let selector = "form[action*=search]" in
   assert (soup $ selector |> name = "form");
-  measure 1000 "select" (fun () -> soup $ selector |> ignore);
+  measure 1000 ("select " ^ selector) (fun () -> soup $ selector |> ignore);
+
+  let selector = ":has([id=mngb])" in
+  assert (soup $$ selector |> count = 2);
+  measure 1000 ("select_all " ^ selector)
+    (fun () -> soup $$ selector |> count |> ignore);
+
+  let selector = ":has([action*=search])" in
+  assert (soup $$ selector |> count = 3);
+  measure 1000 ("select_all " ^ selector)
+    (fun () -> soup $$ selector |> count |> ignore);
+
+  let selector = ":has([name=gbv])" in
+  assert (soup $$ selector |> count = 4);
+  measure 1000 ("select_all " ^ selector)
+    (fun () -> soup $$ selector |> count |> ignore);
 
   let selector = "*" in
   assert (soup $$ selector |> count > 10);
-  measure 1000 "select_all" (fun () -> soup $$ selector |> count |> ignore)
+  measure 1000 ("select_all " ^ selector)
+    (fun () -> soup $$ selector |> count |> ignore)
diff --git a/test/test.ml b/test/test.ml
index 378b9a5..c3abcb3 100644
--- a/test/test.ml
+++ b/test/test.ml
@@ -122,6 +122,11 @@ let suites = [
       test "p:empty" 1;
       test "ul li:not(:nth-child(1))" 2;
       test ":not(ul) > li" 2;
+      test ":has([id=one])" 3;
+      test "ul:has([id=one])" 1;
+      test "ol:has([id=one])" 0;
+      test "li:has([id=one])" 0;
+      test ":has(.odd)" 4;
       test
         ("html:root > body.lists[class~=lists] > ul > li#one:nth-child(1) " ^
          "+ li#two")
@@ -155,7 +160,9 @@ let suites = [
       test "[id=\"\\\"dquotes\\\"\"]" 1;
       test "[id=\"simple'quote\"]" 1;
       test "[id='simple\\'quote']" 1;
-      test "[id='back\\slash']" 1);
+      test "[id='back\\slash']" 1;
+      test "[id=\"bracket]\"]" 1;
+      test ":has([id=\"bracket]\"])" 2);
 
     ("parse-fail-quoted" >:: fun _ ->
       let soup = page "quoted" |> parse in