summaryrefslogtreecommitdiff
path: root/css/merge_lib/common.ml
blob: 48c1b1f7d8a3224f073fa4266026f316caa10538 (plain)
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)