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 |}]