From 86ec559f913c389e8dc055b494630f21a45e039b Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Thu, 4 Feb 2021 21:14:01 +0100
Subject: css_merge application

---
 css/merge_lib/merge_style.ml | 132 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 132 insertions(+)
 create mode 100755 css/merge_lib/merge_style.ml

(limited to 'css/merge_lib/merge_style.ml')

diff --git a/css/merge_lib/merge_style.ml b/css/merge_lib/merge_style.ml
new file mode 100755
index 0000000..6d8851b
--- /dev/null
+++ b/css/merge_lib/merge_style.ml
@@ -0,0 +1,132 @@
+open StdLabels
+open Css.Types
+
+let delim_coma = ( Component_value.Delim ","
+                 , Common.location_none )
+
+module MapRule = Map.Make(struct
+    type t  = Component_value.t list
+    let compare =
+      Comparator.compare_list (fun l1 l2 ->
+          Comparator.component_value
+            (l1, Common.location_none)
+            (l2, Common.location_none)
+        )
+  end)
+
+(** The type of the map contains both :
+
+    - The declaration inside the selector
+    - The selector Location
+
+*)
+type t = (Declaration_list.t * Css.Location.t) list MapRule.t
+
+type acc = Component_value.t list * Component_value.t list list
+
+(** Group all the selectors together, using a given delimiter *)
+let group_selector
+  : string -> Component_value.t with_loc list with_loc -> Component_value.t list list
+  = fun delim elems ->
+
+    let add_element
+      : acc -> Component_value.t with_loc -> acc
+      = fun (acc, prev) elem ->
+        match (fst elem) with
+        | Delim s when String.equal s delim -> [], (List.rev acc)::prev
+        | other -> other::acc, prev
+    in
+    let last, prev = List.fold_left
+        (fst elems)
+        ~init:([], [])
+        ~f:add_element in
+    (List.rev last)::prev
+
+(** Add a new style in the map. *)
+let add_style
+  : Style_rule.t -> t -> t
+  = fun {prelude; block; loc} map ->
+    List.fold_left (group_selector "," prelude)
+      ~init:map
+      ~f:(fun map group ->
+          MapRule.update group
+            (function
+              | None ->
+                (* There is no declaration yet, just add this one *)
+                Some [(block, loc)]
+              | Some tl ->
+
+                (* The declaration is already present.
+
+                   For each of them, we check if the declaration is overriden
+                   by the new one, and update the list.
+
+                   The news declarations are added in a new block (a second
+                   pass may be necessary to join all the remaining elements
+                   together.
+                *)
+                Some (Common.update_declarations (block, loc) tl))
+            map)
+
+module ReversedMapRule = Map.Make(struct
+    type t  = Declaration_list.t * Css.Location.t
+
+    (* Use a custom comparaison without the location *)
+    let compare l1 l2 =
+      Comparator.declaration_list
+        (fst l1)
+        (fst l2)
+  end)
+type splitted_rules' = (Component_value.t list list) ReversedMapRule.t
+
+(** Extract all the styles, and return them as a Rule.t sequence *)
+let extract_style
+  : t -> Rule.t Seq.t
+  = fun map ->
+    (* First, iterate all the values and match the identical one together *)
+
+    let table:splitted_rules' =
+      MapRule.fold
+        (fun k values map' ->
+
+           (* Each element may be present multiple times in the declaration. We
+              have te extract each of them *)
+           List.fold_left values
+             ~init:map'
+             ~f:(fun map' (v, loc) ->
+
+                 ReversedMapRule.update (v, loc)
+                   (function
+                     | None -> Some [k]
+                     | Some tl -> Some (k::tl))
+                   map' ))
+        map
+        ReversedMapRule.empty in
+
+    (* The rebuild the rules *)
+    ReversedMapRule.to_seq table
+    |> Seq.map (fun ((block, loc), k) ->
+
+        let selectors =
+          List.fold_left k
+            ~init:[]
+            ~f:(fun acc v ->
+                let selectors = List.map
+                    v
+                    ~f:(fun x -> x , Common.location_none) in
+                let tail = List.append selectors acc in
+                delim_coma::tail) in
+
+        let prelude =
+          match selectors with
+          | (Component_value.Delim ",", _)::tl ->
+            (* Remove the first delimiter element *)
+            ( tl
+            , Common.location_none)
+          | _->
+            ( selectors
+            , Common.location_none )
+        in
+        Rule.Style_rule (Style_rule.{prelude; block; loc}))
+
+let empty = MapRule.empty
-- 
cgit v1.2.3