Source file compare_core.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
73
74
75
76
77
78
79
80
81
82
83
84
85
open! Core
open! Import
include Compare_core_intf
module Make (Patdiff_core_arg : Patdiff_core.S) = struct
let compare_lines (config : Configuration.t) ~prev ~next =
let context = config.context in
let keep_ws = config.keep_ws in
let split_long_lines = config.split_long_lines in
let line_big_enough = config.line_big_enough in
let hunks = Patdiff_core_arg.diff ~context ~line_big_enough ~keep_ws ~prev ~next in
let hunks =
match config.float_tolerance with
| None -> hunks
| Some tolerance -> Float_tolerance.apply hunks tolerance ~context
in
if config.unrefined
then
Patience_diff.Hunks.unified hunks
else (
let rules = config.rules in
let output = config.output in
let produce_unified_lines = config.produce_unified_lines in
let interleave = config.interleave in
let word_big_enough = config.word_big_enough in
Patdiff_core_arg.refine
~rules
~output
~keep_ws
~produce_unified_lines
~split_long_lines
~interleave
hunks
~word_big_enough)
;;
let diff_strings
?
(config : Configuration.t)
~(prev : Diff_input.t)
~(next : Diff_input.t)
=
let lines { Diff_input.name = _; text } = String.split_lines text |> Array.of_list in
let hunks =
Comparison_result.create
config
~prev
~next
~compare_assuming_text:(fun config ~prev ~next ->
compare_lines config ~prev:(lines prev) ~next:(lines next))
in
if Comparison_result.has_no_diff hunks
then `Same
else
`Different
(match hunks with
| Binary_same -> assert false
| Binary_different { prev_is_binary; next_is_binary } ->
File_helpers.binary_different_message
~config
~prev_file:(Fake prev.name)
~prev_is_binary
~next_file:(Fake next.name)
~next_is_binary
| Hunks hunks ->
Patdiff_core_arg.output_to_string
hunks
?print_global_header
~file_names:(Fake prev.name, Fake next.name)
~output:config.output
~rules:config.rules
~location_style:config.location_style)
;;
module Private = struct
let compare_lines = compare_lines
end
end
module Without_unix = Make (Patdiff_core.Without_unix)