Propose already defined colors in the form

1 files changed, 18 insertions, 0 deletions

diff --git a/src/Lib/Dom/HA.ml b/src/Lib/Dom/HA.ml
index a7a45ce..53fb84d 100644
--- a/src/Lib/Dom/HA.ml
+++ b/src/Lib/Dom/HA.ml
@@ -1,3 +1,21 @@
+let concat xs ys =
+  let partition_class =
+    Js.Array.reduce
+      (fun (class_acc, rest_acc) z ->
+        match z with
+        | H.TextAttr ("class", c) -> (class_acc ^ " " ^ c, rest_acc)
+        | _ -> (class_acc, Js.Array.concat [| z |] rest_acc)
+      )
+      ("", [| |])
+  in
+  let (xs_class, xs_rest) = partition_class xs in
+  let (ys_class, ys_rest) = partition_class ys in
+  let rest = Js.Array.concat xs_rest ys_rest in
+  if xs_class == "" && ys_class == "" then
+    rest
+  else
+    Js.Array.concat [| H.TextAttr ("class", xs_class ^ " " ^ ys_class) |] rest
+
 (* Attribute creation *)
 
 let id v = H.TextAttr ("id", v)