patrick.sirref.org
+66
src/lib/shelter/diff.ml
+66
src/lib/shelter/diff.ml
···
5
5
| Removed of string
6
6
[@@deriving repr]
7
7
8
+
let path = function
9
+
| Modified p -> p
10
+
| Created p -> p
11
+
| Renamed (p, _) -> p
12
+
| Removed p -> p
13
+
8
14
type t = diff list [@@deriving repr]
9
15
10
16
let truncate_path s =
···
37
43
|> List.filter (function [] -> false | _ -> true)
38
44
in
39
45
List.filter_map parse_row tsv
46
+
47
+
type tree = Leaf of diff | Dir of string * tree list
48
+
49
+
let rec insert modified path_components tree =
50
+
match (path_components, tree) with
51
+
| [], _ -> tree
52
+
| [ file ], nodes ->
53
+
if List.exists (function Leaf f -> path f = file | _ -> false) nodes
54
+
then nodes
55
+
else
56
+
let diff =
57
+
match modified with
58
+
| Modified _ -> Modified file
59
+
| Created _ -> Created file
60
+
| Renamed (_, to_) -> Renamed (file, to_)
61
+
| Removed _ -> Removed file
62
+
in
63
+
Leaf diff :: nodes
64
+
| dir :: rest, nodes ->
65
+
let rec insert_into_dir acc = function
66
+
| [] -> Dir (dir, insert modified rest []) :: List.rev acc
67
+
| Dir (name, children) :: tl when name = dir ->
68
+
List.rev_append acc (Dir (name, insert modified rest children) :: tl)
69
+
| x :: tl -> insert_into_dir (x :: acc) tl
70
+
in
71
+
insert_into_dir [] nodes
72
+
73
+
let to_tree (diffs : diff list) =
74
+
let paths =
75
+
List.map (fun v -> (v, String.split_on_char '/' (path v))) diffs
76
+
in
77
+
List.fold_left (fun acc (m, p) -> insert m p acc) [] paths
78
+
79
+
let leaves =
80
+
let rec loop acc acc2 = function
81
+
| Leaf (Modified v) -> Modified (Filename.concat acc v) :: acc2
82
+
| Leaf (Created v) -> Created (Filename.concat acc v) :: acc2
83
+
| Leaf (Removed v) -> Removed (Filename.concat acc v) :: acc2
84
+
| Leaf (Renamed (r1, r2)) -> Renamed (Filename.concat acc r1, r2) :: acc2
85
+
| Dir (p, cs) ->
86
+
List.fold_left (fun lvs v -> loop (Filename.concat acc p) lvs v) acc2 cs
87
+
in
88
+
loop "" []
89
+
90
+
let pp_diff fmt = function
91
+
| Modified v -> Fmt.(styled (`Fg `Yellow) string) fmt ("~ /" ^ v)
92
+
| Created v -> Fmt.(styled (`Fg `Green) string) fmt ("+ /" ^ v)
93
+
| Removed v -> Fmt.(styled (`Fg `Red) string) fmt ("- /" ^ v)
94
+
| Renamed (v, _) -> Fmt.(styled (`Fg `Magenta) string) fmt ("| /" ^ v)
95
+
96
+
let pp fmt diffs =
97
+
let tree = to_tree diffs in
98
+
let lvs =
99
+
List.fold_left (fun acc v -> leaves v @ acc) [] tree
100
+
|> List.filter (fun v ->
101
+
not
102
+
(String.starts_with ~prefix:"shelter" (path v)
103
+
|| String.starts_with ~prefix:"tmp" (path v)))
104
+
in
105
+
Fmt.pf fmt "%a" Fmt.(list ~sep:Format.pp_force_newline pp_diff) lvs
+1
-3
src/lib/shelter/shelter_main.ml
+1
-3
src/lib/shelter/shelter_main.ml
···
166
166
167
167
(* Fork a new session from an existing one *)
168
168
let display_history (s : entry H.t) =
169
-
let pp_diff fmt d =
170
-
if d = [] then () else Fmt.pf fmt "\n %a" (Repr.pp Diff.t) d
171
-
in
169
+
let pp_diff fmt d = if d = [] then () else Fmt.pf fmt "\n%a%!" Diff.pp d in
172
170
let pp_entry fmt (e : entry) =
173
171
Fmt.pf fmt "%-10s %s%a"
174
172
Fmt.(str "%a" (styled (`Fg `Yellow) uint64_ns_span) e.post.time)