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
|
open StdLabels
open Css.Types
let location_none = Css.Location.none
(** Update the declaration list with this new property if the same property
name is already present.
If not return [None] *)
let merge_declations
: Declaration_list.t -> Declaration_list.kind -> Declaration_list.t option
= fun decls1 decl2 ->
let declarations, loc = decls1 in
let updated, list' =
List.fold_left_map declarations
~init:false
~f:(fun res kind ->
if Comparator.declaration_kind' kind decl2 = 0 then
true, decl2
else
res, kind)
in
match updated with
| false -> None
| _ -> Some
( list'
, loc )
(** Add all the declarations from [decl2] into the list [decl1]
and return the list, and all the new declarations to add *)
let add_all_declarations
: Declaration_list.t -> Declaration_list.t -> Declaration_list.t * Declaration_list.t
= fun decls1 (decls2, loc2) ->
let decls1, remain' = List.fold_left decls2
~init:(decls1, [])
~f:(fun (decls1, remain) new_declaration ->
match merge_declations decls1 new_declaration with
(* TODO : Handle empty property as None *)
| None -> decls1, (Some new_declaration::remain)
| Some decls1 -> decls1, remain
) in
(* Remove all the unused properties *)
let remain' = List.filter_map ~f:(fun x -> x) remain' in
( decls1
, (remain', loc2) )
let update_declarations
: (Declaration_list.t * Css.Location.t) -> (Declaration_list.t * Css.Location.t) list -> (Declaration_list.t * Css.Location.t) list
= fun (block, loc) existing ->
let remain, tl = List.fold_left
existing
~init:(block, [])
~f:(fun (block, prev) (declarations, location) ->
let update, remain = add_all_declarations declarations block in
remain, (update, location)::prev) in
match fst remain with
| [] -> tl
| other -> (((other, loc), loc)::tl)
|
