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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
(* Copyright © 2021 <Sébastien Dailly>
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the “Software”), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is furnished to do
so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.*)
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 * 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 * 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
|
