From f01591d2ca787b34c59b1bce746aa55f7b41d62d Mon Sep 17 00:00:00 2001
From: Ali Caglayan <alizter@gmail.com>
Date: Tue, 22 Aug 2023 15:00:13 +0100
Subject: [PATCH] add comparison function for Pp.Ast.t

Signed-off-by: Ali Caglayan <alizter@gmail.com>
---
 src/pp.ml     | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++
 src/pp.mli    |  5 ++++
 test/tests.ml | 63 ++++++++++++++++++++++++++++------------------
 3 files changed, 113 insertions(+), 24 deletions(-)

diff --git a/src/pp.ml b/src/pp.ml
index 886b05d..37edc8c 100644
--- a/src/pp.ml
+++ b/src/pp.ml
@@ -222,3 +222,72 @@ module O = struct
 end
 
 let of_fmt f x = Format (fun ppf -> f ppf x)
+
+let compare compare_tag =
+  let compare_both (type a b) (f : a -> a -> int) (g : b -> b -> int) (a, b)
+      (c, d) =
+    let r = f a c in
+    if r <> 0 then
+      r
+    else
+      g b d
+  in
+  let rec compare x y =
+    match (x, y) with
+    | Nop, Nop -> 0
+    | Nop, _ -> -1
+    | _, Nop -> 1
+    | Seq (a, b), Seq (c, d) -> compare_both compare compare (a, b) (c, d)
+    | Seq _, _ -> -1
+    | _, Seq _ -> 1
+    | Concat (a, b), Concat (c, d) ->
+      compare_both compare (List.compare ~cmp:compare) (a, b) (c, d)
+    | Concat _, _ -> -1
+    | _, Concat _ -> 1
+    | Box (a, b), Box (c, d) -> compare_both Int.compare compare (a, b) (c, d)
+    | Box _, _ -> -1
+    | _, Box _ -> 1
+    | Vbox (a, b), Vbox (c, d) -> compare_both Int.compare compare (a, b) (c, d)
+    | Vbox _, _ -> -1
+    | _, Vbox _ -> 1
+    | Hbox a, Hbox b -> compare a b
+    | Hbox _, _ -> -1
+    | _, Hbox _ -> 1
+    | Hvbox (a, b), Hvbox (c, d) ->
+      compare_both Int.compare compare (a, b) (c, d)
+    | Hvbox _, _ -> -1
+    | _, Hvbox _ -> 1
+    | Hovbox (a, b), Hovbox (c, d) ->
+      compare_both Int.compare compare (a, b) (c, d)
+    | Hovbox _, _ -> -1
+    | _, Hovbox _ -> 1
+    | Verbatim a, Verbatim b -> String.compare a b
+    | Verbatim _, _ -> -1
+    | _, Verbatim _ -> 1
+    | Char a, Char b -> Char.compare a b
+    | Char _, _ -> -1
+    | _, Char _ -> 1
+    | Break (a, b), Break (c, d) ->
+      let compare (x, y, z) (a, b, c) =
+        compare_both String.compare
+          (compare_both Int.compare String.compare)
+          (x, (y, z))
+          (a, (b, c))
+      in
+      compare_both compare compare (a, b) (c, d)
+    | Break _, _ -> -1
+    | _, Break _ -> 1
+    | Newline, Newline -> 0
+    | Newline, _ -> -1
+    | _, Newline -> 1
+    | Text a, Text b -> String.compare a b
+    | Text _, _ -> -1
+    | _, Text _ -> 1
+    | Tag (a, b), Tag (c, d) -> compare_both compare_tag compare (a, b) (c, d)
+    | Format _, Format _ ->
+      raise
+        (Invalid_argument "[Pp.of_fmt] values not supported in [Pp.compare]")
+    | Format _, _ -> -1
+    | _, Format _ -> 1
+  in
+  compare
diff --git a/src/pp.mli b/src/pp.mli
index 5bb5255..925ca3e 100644
--- a/src/pp.mli
+++ b/src/pp.mli
@@ -211,3 +211,8 @@ val of_ast : 'a Ast.t -> 'a t
 (** [to_ast t] will try to convert [t] to [Ast.t]. When [t] contains values
     constructed with [of_fmt], this function will fail and return [Error ()] *)
 val to_ast : 'a t -> ('a Ast.t, unit) result
+
+(** {1 Comparison} *)
+
+(** [compare cmp x y] compares [x] and [y] using [cmp] to compare tags. *)
+val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
diff --git a/test/tests.ml b/test/tests.ml
index 937bb37..9ec07c4 100644
--- a/test/tests.ml
+++ b/test/tests.ml
@@ -153,31 +153,33 @@ let%expect_test _ =
     .....x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x
            x x x x x x x x x x x x x x |}]
 
+let error_example_1 =
+  Pp.vbox
+    (Pp.box (Pp.text "Error: something went wrong!")
+    ++ Pp.cut
+    ++ Pp.box (Pp.text "Here are a few things you can do:")
+    ++ Pp.cut
+    ++ Pp.enumerate
+         ~f:(fun x -> x)
+         [ Pp.text
+             "read the documentation, double check the way you are using this \
+              software to make sure you are not doing something wrong, and \
+              hopefully fix the problem on your side and move on"
+         ; Pp.text
+             "strace furiously the program to try and understand why exactly \
+              it is trying to do what it is doing"
+         ; Pp.text "report an issue upstream"
+         ; Pp.text "if all else fails"
+           ++ Pp.cut
+           ++ Pp.enumerate ~f:Pp.text
+                [ "scream loudly at your computer"
+                ; "take a break from your keyboard"
+                ; "clear your head and try again"
+                ]
+         ])
+
 let%expect_test _ =
-  print
-    (Pp.vbox
-       (Pp.box (Pp.text "Error: something went wrong!")
-       ++ Pp.cut
-       ++ Pp.box (Pp.text "Here are a few things you can do:")
-       ++ Pp.cut
-       ++ Pp.enumerate
-            ~f:(fun x -> x)
-            [ Pp.text
-                "read the documentation, double check the way you are using \
-                 this software to make sure you are not doing something wrong, \
-                 and hopefully fix the problem on your side and move on"
-            ; Pp.text
-                "strace furiously the program to try and understand why \
-                 exactly it is trying to do what it is doing"
-            ; Pp.text "report an issue upstream"
-            ; Pp.text "if all else fails"
-              ++ Pp.cut
-              ++ Pp.enumerate ~f:Pp.text
-                   [ "scream loudly at your computer"
-                   ; "take a break from your keyboard"
-                   ; "clear your head and try again"
-                   ]
-            ]));
+  print error_example_1;
   [%expect
     {|
     Error: something went wrong!
@@ -219,3 +221,16 @@ let%expect_test _ =
     (1,
     2)
     foo |}]
+
+let%expect_test "comparison" =
+  let x = error_example_1
+  and y = Pp.hovbox ~indent:2 (xs 200) in
+  let print x = Printf.printf "comparison result: %d\n" x in
+  print (Pp.compare (fun _ _ -> 0) x y);
+  print (Pp.compare (fun _ _ -> 0) x x);
+  print (Pp.compare (fun _ _ -> 0) y x);
+  [%expect
+    {|
+    comparison result: -1
+    comparison result: 0
+    comparison result: 1 |}]