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
|
open! Base
open! Import
let chop_if_exists ~ancestor ~from:path =
String.chop_prefix_if_exists path ~prefix:(ancestor ^ "/")
;;
let f
?(use_dot_patdiff = false)
?corrected_path
?(use_color = false)
?diff_command
?diff_path_prefix
~next_contents
~path
()
=
let prev_contents =
if Stdlib.Sys.file_exists path
then Stdio.In_channel.with_file path ~f:Stdio.In_channel.input_all
else ""
in
match String.( = ) prev_contents next_contents with
| true ->
(* It's possible for stale .corrected files to linger and ideally we would delete them
here, but this probably isn't worth fixing since it's mooted by dune, which puts
its build products in a separate directory. If we do add deletion at some point in
the future, we should make sure it doesn't cause problems for clients who call [f]
and then perform deletion on their own. *)
Ok ()
| false ->
let default_corrected_path = path ^ ".corrected" in
let corrected_path = Option.value corrected_path ~default:default_corrected_path in
Stdio.Out_channel.write_all corrected_path ~data:next_contents;
let extra_patdiff_args =
let default_configs =
match use_dot_patdiff && Option.is_none (Sys.getenv "TESTING_FRAMEWORK") with
| true -> []
| false -> [ "-default" ]
in
let cwd = Stdlib.Sys.getcwd () in
(* diff_path_prefix is useful to transform output paths to make it easier for the
consumer (e.g. editor) to locate the files with diffs. One particular example this
helps is the "test-this-file" rules generated by emacs/vscode in jenga/start/jbuild,
where the rule and the test are in different directories. *)
let prefix =
match diff_path_prefix with
| Some prefix -> String.rstrip ~drop:(Char.equal '/') prefix ^ "/"
| None -> ""
in
let alt_old = [ "-alt-old"; prefix ^ chop_if_exists ~ancestor:cwd ~from:path ] in
let alt_new =
[ "-alt-new"; prefix ^ chop_if_exists ~ancestor:cwd ~from:default_corrected_path ]
in
[ default_configs; alt_old; alt_new ] |> List.concat
in
Ppxlib_print_diff.print
?diff_command
~use_color
~extra_patdiff_args
~file1:path
~file2:corrected_path
();
Error (Error.of_string "Changes found.")
;;
|