Source file `make_corrected_file_kernel.ml`

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
let rstrip ~drop string =
  let rec loop pos =
    if pos = 0 || not (drop (String.get string (pos - 1))) then pos else loop (pos - 1)
  in
  StringLabels.sub string ~pos:0 ~len:(loop (String.length string))
;;

let chop_prefix_if_exists string ~prefix =
  if StringLabels.starts_with string ~prefix
  then
    StringLabels.sub
      string
      ~pos:(String.length prefix)
      ~len:(String.length string - String.length prefix)
  else string
;;

let ensure_trailing_slash path = rstrip ~drop:(Char.equal '/') path ^ "/"

let chop_if_exists ~ancestor ~from:path =
  chop_prefix_if_exists path ~prefix:(ensure_trailing_slash 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 In_channel.with_open_bin path In_channel.input_all
    else ""
  in
  match String.equal prev_contents next_contents with
  | true -> Ok ()
  | false ->
    let default_corrected_path = path ^ ".corrected" in
    let corrected_path = Option.value corrected_path ~default:default_corrected_path in
    Out_channel.with_open_bin corrected_path (fun oc ->
      Out_channel.output_string oc next_contents);
    let extra_patdiff_args =
      let default_configs =
        match use_dot_patdiff && Option.is_none (Sys.getenv_opt "TESTING_FRAMEWORK") with
        | true -> []
        | false -> [ "-default" ]
      in
      let cwd = Stdlib.Sys.getcwd () in
      let prefix =
        match diff_path_prefix with
        | Some prefix -> ensure_trailing_slash 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 `Changes_found
;;
Source file make_corrected_file_kernel.ml

Source file `make_corrected_file_kernel.ml`
