summaryrefslogtreecommitdiff
path: root/css/merge_lib/comparator.ml
blob: a7b1c0901840e0ed2f9f1279eade15eb47016836 (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
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
153
154
155
156
157
158
159
160
open Css.Types
open StdLabels

(** The module Comparator helps to compare two stylesheet together. *)

(** Compare two list in a safe way *)
let compare_list
  : ('a -> 'a -> int) -> 'a list -> 'a list -> int
  = fun cmp l1 l2 ->
    let length = List.compare_lengths l1 l2  in
    if length <> 0 then
      length
    else
      List.fold_left2
        ~f:(fun res v1 v2 ->
            if res <> 0 then res
            else cmp v1 v2
          )
        ~init:0
        l1 l2

(** Compare each component without the loccation information *)
let rec component_value
  : Component_value.t with_loc -> Component_value.t with_loc -> int
  = fun v1 v2 ->
    let open Component_value in
    match (fst v1), (fst v2) with
    | Paren_block b1, Paren_block b2
    | Bracket_block b1, Bracket_block b2 ->
      compare_list
        component_value
        b1 b2
    | Percentage v1, Percentage v2
    | Ident v1, Ident v2
    | String v1, String v2
    | Uri v1, Uri v2
    | Operator v1, Operator v2
    | Delim v1, Delim v2
    | Hash v1, Hash v2
    | Number v1, Number v2
    | Unicode_range v1, Unicode_range v2 ->
      String.compare v1 v2
    | Float_dimension v1, Float_dimension v2 ->
      Stdlib.compare v1 v2
    | Dimension v1, Dimension v2 ->
      Stdlib.compare v1 v2

    | Function (n1, v1), Function (n2, v2) ->
      let name1 = fst (n1)
      and name2 = fst (n2) in
      let cmp = String.compare name1 name2 in
      if cmp <> 0 then cmp
      else
        compare_list
          component_value
          (fst v1) (fst v2)
    | v1, v2 -> Stdlib.compare v1 v2

let rec brace_block
  : Brace_block.t -> Brace_block.t -> int
  = fun v1 v2 ->
    match v1, v2 with
    | Declaration_list l1, Declaration_list l2 -> declaration_list l1 l2
    | Stylesheet s1, Stylesheet s2 -> style_sheet s1 s2
    | _, _ ->  Stdlib.compare v1 v2

and at_rule
  : At_rule.t -> At_rule.t -> int
  = fun v1 v2 ->
    let cmp = String.compare (fst v1.name) (fst v2.name) in
    if cmp <> 0 then cmp
    else
      let cmp =
        compare_list
          component_value
          (fst v1.prelude) (fst v2.prelude)
      in
      if cmp <> 0 then cmp
      else
        brace_block v1.block v2.block

and declaration
  : Declaration.t -> Declaration.t -> int
  = fun v1 v2 ->
    let cmp = String.compare (fst v1.name) (fst v2.name) in
    if cmp <> 0 then cmp
    else
      let cmp = Stdlib.compare (fst v1.important)  (fst v2.important) in
      if cmp <> 0 then cmp
      else
        compare_list
          component_value
          (fst v1.value) (fst v2.value)

and declaration_kind
  : Declaration_list.kind -> Declaration_list.kind -> int
  = fun v1 v2 ->
    match v1, v2 with
    | Declaration v1, Declaration v2 -> declaration v1 v2
    | At_rule v1, At_rule v2 -> at_rule v1 v2
    | _, _ -> Stdlib.compare v1 v2

and declaration_list
  : Declaration_list.t -> Declaration_list.t -> int
  = fun v1 v2 ->
    compare_list
      declaration_kind
      (fst v1) (fst v2)

and style_rule
  : Style_rule.t -> Style_rule.t -> int
  = fun v1 v2 ->
    let cmp = declaration_list v1.block v2.block in
    if cmp <> 0 then
      cmp
    else
      compare_list
        component_value
        (fst v1.prelude) (fst v2.prelude)

and rule
  : Rule.t -> Rule.t -> int
  = fun v1 v2 ->
    begin match v1, v2 with
      | Style_rule v1, Style_rule v2 -> style_rule v1 v2
      | At_rule v1, At_rule v2 -> at_rule v1 v2
      | _, _ -> Stdlib.compare v1 v2
    end

and style_sheet
  : Stylesheet.t -> Stylesheet.t -> int
  = fun v1 v2 ->
    compare_list rule (fst v1) (fst v2)

(** Compare two rules by name only *)
let at_rule'
  : At_rule.t -> At_rule.t -> int
  = fun v1 v2 ->
    let cmp = String.compare (fst v1.name) (fst v2.name) in
    if cmp <> 0 then
      cmp
    else
      compare_list
        component_value
        (fst v1.prelude) (fst v2.prelude)

(** Compare two declarations by name only *)
let declaration'
  : Declaration.t -> Declaration.t -> int
  = fun v1 v2 ->
    String.compare (fst v1.name) (fst v2.name)

(** Compare two declaration_kind by name only *)
let declaration_kind'
  : Declaration_list.kind -> Declaration_list.kind -> int
  = fun v1 v2 ->
    match v1, v2 with
    | Declaration v1, Declaration v2 -> declaration' v1 v2
    | At_rule v1, At_rule v2 -> at_rule' v1 v2
    | _, _ -> Stdlib.compare v1 v2