Fix contentRule

davesnx · Oct 17, 2023 · f0e262f · f0e262f
1 parent 314b841
commit f0e262f
Show file tree

Hide file tree

Showing 7 changed files with 37 additions and 31 deletions.
diff --git a/packages/css/js/Css_Js_Core.ml b/packages/css/js/Css_Js_Core.ml
@@ -12,10 +12,6 @@ type rule =
 let rec ruleToDict =
  fun [@bs] dict rule ->
   (match rule with
-  | D (name, value) when name = {js|content|js} ->
-    dict
-    |. Js.Dict.set name
-         (Js.Json.string (if value = {js||js} then {js|""|js} else value))
   | D (name, value) -> dict |. Js.Dict.set name (Js.Json.string value)
   | S (name, ruleset) -> dict |. Js.Dict.set name (toJson ruleset)
   | PseudoClass (name, ruleset) ->

diff --git a/packages/css/js/Css_Legacy_Core.ml b/packages/css/js/Css_Legacy_Core.ml
@@ -11,9 +11,6 @@ type rule =
 
 let rec ruleToDict dict rule =
   (match rule with
-  | D (name, value) when name = "content" ->
-    Js.Dict.set dict name
-      (Js.Json.string (if value = {js||js} then {js|""|js} else value))
   | D (name, value) -> Js.Dict.set dict name (Js.Json.string value)
   | S (name, ruleset) -> Js.Dict.set dict name (toJson ruleset)
   | PseudoClass (name, ruleset) ->

diff --git a/packages/css/native/shared/Css_AtomicTypes.ml b/packages/css/native/shared/Css_AtomicTypes.ml
@@ -2263,7 +2263,11 @@ module Content = struct
     | `noOpenQuote -> {js|no-open-quote|js}
     | `noCloseQuote -> {js|no-close-quote|js}
     | `attr name -> ({js|attr(|js} ^ name) ^ {js|)|js}
-    | `text value -> value
+    | `text "" -> {js|""|js}
+    | `text value ->
+      (match Js.String2.get value 0 with
+      | "\"" | "'" -> value
+      | _ -> "\"" ^ value ^ "\"")
 end
 
 module SVG = struct

diff --git a/packages/css/native/shared/Css_Js_Core.ml b/packages/css/native/shared/Css_Js_Core.ml
@@ -11,28 +11,14 @@ type rule =
 let rec ruleToDict =
  fun [@bs] dict rule ->
   (match rule with
-  | D (name, value) when name = {js|content|js} ->
-    let (_ : unit) =
-      Js.Dict.set dict name
-        (Js.Json.string (if value = {js||js} then {js|""|js} else value))
-    in
-    ()
-  | D (name, value) ->
-    let (_ : unit) = Js.Dict.set dict name (Js.Json.string value) in
-    ()
-  | S (name, ruleset) ->
-    let (_ : unit) = Js.Dict.set dict name (toJson ruleset) in
-    ()
+  | D (name, value) -> Js.Dict.set dict name (Js.Json.string value)
+  | S (name, ruleset) -> Js.Dict.set dict name (toJson ruleset)
   | PseudoClass (name, ruleset) ->
-    let (_ : unit) = dict |. Js.Dict.set ({js|:|js} ^ name) (toJson ruleset) in
-    ()
+    dict |. Js.Dict.set ({js|:|js} ^ name) (toJson ruleset)
   | PseudoClassParam (name, param, ruleset) ->
-    let (_ : unit) =
-      Js.Dict.set dict
-        ({js|:|js} ^ name ^ {js|(|js} ^ param ^ {js|)|js})
-        (toJson ruleset)
-    in
-    ());
+    Js.Dict.set dict
+      ({js|:|js} ^ name ^ {js|(|js} ^ param ^ {js|)|js})
+      (toJson ruleset));
   dict
 
 and toJson rules =

diff --git a/packages/css/native/shared/Css_Legacy_Core.ml b/packages/css/native/shared/Css_Legacy_Core.ml
@@ -11,9 +11,6 @@ type rule =
 
 let rec ruleToDict dict rule =
   (match rule with
-  | D (name, value) when name = "content" ->
-    Js.Dict.set dict name
-      (Js.Json.string (if value = {js||js} then {js|""|js} else value))
   | D (name, value) -> Js.Dict.set dict name (Js.Json.string value)
   | S (name, ruleset) -> Js.Dict.set dict name (toJson ruleset)
   | PseudoClass (name, ruleset) ->

diff --git a/packages/emotion/test/test.ml b/packages/emotion/test/test.ml
@@ -5,4 +5,5 @@ let () =
       Test_css_styles.tests;
       Test_css_autoprefixer.tests;
       Test_css_hash.tests;
+      Test_css_js_intf.tests;
     ]
diff --git a/packages/emotion/test/test_css_js_intf.ml b/packages/emotion/test/test_css_js_intf.ml
@@ -0,0 +1,25 @@
+(* TODO: Migrate all those tests
+   - https://github.com/giraud/bs-css/blob/master/bs-css/__tests__/Css_Js_test.res
+   - https://github.com/giraud/bs-css/blob/master/bs-css/__tests__/Selectors_test.res
+   - https://github.com/giraud/bs-css/blob/master/bs-css/__tests__/Svg_test.res
+*)
+
+let assert_string left right =
+  Alcotest.check Alcotest.string "should be equal" right left
+
+let case title fn = Alcotest.test_case title `Quick fn
+
+let tests =
+  ( "CssJs interface",
+    [
+      case "content" (fun () ->
+        let missing = CssJs.contentRule (`text "missing") in
+        let present = CssJs.contentRule (`text "\"present\"") in
+        let empty = CssJs.contentRule (`text "") in
+        let single = CssJs.contentRule (`text "'single'") in
+        let _ = CssJs.style [| missing; present; empty; single |] in
+        assert_string
+          (CssJs.render_style_tag ())
+          ".css-ktvasi { content: \"missing\"; content: \"present\"; content: \
+           \"\"; content: 'single'; }");
+    ] )