1 files changed, 160 insertions, 0 deletions
diff --git a/lib/comparator.ml b/lib/comparator.ml
new file mode 100755
index 0000000..a7b1c09
--- /dev/null
+++ b/lib/comparator.ml
@@ -0,0 +1,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