1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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
|
