From 38e42723a916b7d5c2a15e514b3f3e6dcab398dd Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 8 Aug 2020 21:04:28 +0200
Subject: Propose already defined colors in the form

---
 src/Lib/Dom/HA.ml | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'src/Lib/Dom/HA.ml')

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)
-- 
cgit v1.2.3