melse.tngl.sh
a code review tool
refactor: introduce typed IDs for change, commit, and user
+85
-76
+1
lib/backend/change_id.ml
+1
lib/backend/change_id.ml
+5
lib/backend/change_id.mli
+5
lib/backend/change_id.mli
+5
lib/backend/commit_id.mli
+5
lib/backend/commit_id.mli
+7
-9
lib/tui/code_review_view.ml
+7
-9
lib/tui/code_review_view.ml
···
135
135
Bonsai.Edge.Poll.effect_on_change
136
136
Bonsai.Edge.Poll.Starting.empty
137
137
diff_poll_input
138
-
~equal_input:[%equal: string option * string]
138
+
~equal_input:[%equal: string option * Change_id.t]
139
139
~effect:
140
140
(Bonsai.return
141
141
@@ fun (path_opt, change_id) ->
···
144
144
| Some path ->
145
145
let open Effect.Let_syntax in
146
146
let%bind diff =
147
-
Effect.of_lwt_thunk (fun () -> Jj.fetch_file_diff ~change_id ~path)
147
+
Effect.of_lwt_thunk (fun () -> Jj.fetch_file_diff change_id ~path)
148
148
in
149
149
return (Some diff))
150
150
graph
···
181
181
182
182
let component
183
183
~(dimensions : Dimensions.t Bonsai.t)
184
-
~(change_id : string Bonsai.t)
185
-
~(commit_id : _ Bonsai.t)
184
+
~(change_id : Change_id.t Bonsai.t)
186
185
~(on_exit : unit Effect.t Bonsai.t)
187
186
~(on_approve : unit Effect.t Bonsai.t)
188
187
~(reviewed_files : String.Set.t Bonsai.t)
189
188
~(set_reviewed_files : (String.Set.t -> unit Effect.t) Bonsai.t)
190
189
(graph @ local)
191
190
=
192
-
ignore commit_id;
193
191
(* Fetch diff_stat internally *)
194
192
let diff_stat =
195
193
Bonsai.Edge.Poll.effect_on_change
196
194
Bonsai.Edge.Poll.Starting.empty
197
195
change_id
198
-
~equal_input:[%equal: string]
196
+
~equal_input:[%equal: Change_id.t]
199
197
~effect:
200
198
(Bonsai.return
201
-
@@ fun change_id ->
202
-
Effect.of_lwt_thunk (fun () -> Jj.fetch_diff_stat ~change_id))
199
+
@@ fun change_id -> Effect.of_lwt_thunk (fun () -> Jj.fetch_diff_stat change_id)
200
+
)
203
201
graph
204
202
in
205
203
let file_paths =
···
220
218
Bonsai.Edge.on_change
221
219
change_id
222
220
~trigger:`After_display
223
-
~equal:[%equal: string]
221
+
~equal:[%equal: Change_id.t]
224
222
~callback:
225
223
(let%arr set_selected_file_idx and set_showing_approval_prompt in
226
224
fun _id ->
+1
-2
lib/tui/diff_view.ml
+1
-2
lib/tui/diff_view.ml
···
61
61
| None -> Ui_effect.return None
62
62
| Some (change : Jj.Change.t) ->
63
63
let%bind stat =
64
-
Effect.of_lwt_thunk (fun () ->
65
-
Jj.fetch_diff_stat ~change_id:change.change_id)
64
+
Effect.of_lwt_thunk (fun () -> Jj.fetch_diff_stat change.change_id)
66
65
in
67
66
return (Some stat))
68
67
graph
+20
-27
lib/tui/graph_layout.ml
+20
-27
lib/tui/graph_layout.ml
···
1
1
open! Core
2
+
open! Import
2
3
3
4
module Row = struct
4
5
type t =
···
17
18
else (
18
19
(* Build lookup: change_id -> Change.t *)
19
20
let by_id =
20
-
List.fold
21
-
changes
22
-
~init:(Map.empty (module String))
23
-
~f:(fun acc c -> Map.set acc ~key:c.change_id ~data:c)
21
+
List.fold changes ~init:Change_id.Map.empty ~f:(fun acc c ->
22
+
Map.set acc ~key:c.change_id ~data:c)
24
23
in
25
24
(* Build children map: parent_id -> child change_ids *)
26
25
let children_map =
27
-
List.fold
28
-
changes
29
-
~init:(Map.empty (module String))
30
-
~f:(fun acc c ->
31
-
List.fold c.parents ~init:acc ~f:(fun acc pid ->
32
-
if Map.mem by_id pid
33
-
then
34
-
Map.update acc pid ~f:(function
35
-
| None -> [ c.change_id ]
36
-
| Some kids -> c.change_id :: kids)
37
-
else acc))
26
+
List.fold changes ~init:Change_id.Map.empty ~f:(fun acc c ->
27
+
List.fold c.parents ~init:acc ~f:(fun acc pid ->
28
+
if Map.mem by_id pid
29
+
then
30
+
Map.update acc pid ~f:(function
31
+
| None -> [ c.change_id ]
32
+
| Some kids -> c.change_id :: kids)
33
+
else acc))
38
34
in
39
35
(* Find the spine: walk from working copy via first parents to root *)
40
36
let spine_set =
41
37
let wc = List.find changes ~f:(fun c -> c.current_working_copy) in
42
38
match wc with
43
-
| None -> Set.empty (module String)
39
+
| None -> Change_id.Set.empty
44
40
| Some wc ->
45
41
let rec walk acc id =
46
42
let acc = Set.add acc id in
···
52
48
| Some pid ->
53
49
if Set.mem acc pid || not (Map.mem by_id pid) then acc else walk acc pid)
54
50
in
55
-
walk (Set.empty (module String)) wc.change_id
51
+
walk Change_id.Set.empty wc.change_id
56
52
in
57
53
(* DFS-based topological sort that defers side branches.
58
54
Strategy: walk spine first. When we reach a commit that has non-spine
59
55
children, recursively emit those children just before the commit itself
60
56
becomes reachable. This keeps side branches close to their merge point. *)
61
-
let emitted = Hashtbl.create (module String) in
57
+
let emitted = Change_id.Table.create () in
62
58
let result = Queue.create () in
63
59
(* Collect all heads (commits with no children in the visible set) *)
64
60
let has_children =
65
-
List.fold
66
-
changes
67
-
~init:(Set.empty (module String))
68
-
~f:(fun acc c ->
69
-
List.fold c.parents ~init:acc ~f:(fun acc pid ->
70
-
if Map.mem by_id pid then Set.add acc pid else acc))
61
+
List.fold changes ~init:Change_id.Set.empty ~f:(fun acc c ->
62
+
List.fold c.parents ~init:acc ~f:(fun acc pid ->
63
+
if Map.mem by_id pid then Set.add acc pid else acc))
71
64
in
72
65
let heads =
73
66
List.filter changes ~f:(fun c -> not (Set.mem has_children c.change_id))
···
101
94
Map.find children_map pid
102
95
|> Option.value ~default:[]
103
96
|> List.filter ~f:(fun cid ->
104
-
(not (String.equal cid id)) && not (Hashtbl.mem emitted cid))
97
+
(not (Change_id.equal cid id)) && not (Hashtbl.mem emitted cid))
105
98
in
106
99
let spine_siblings, other_siblings =
107
100
List.partition_tf siblings ~f:(fun cid -> Set.mem spine_set cid)
···
125
118
Map.find children_map pid
126
119
|> Option.value ~default:[]
127
120
|> List.filter ~f:(fun cid ->
128
-
(not (String.equal cid id)) && not (Hashtbl.mem emitted cid))
121
+
(not (Change_id.equal cid id)) && not (Hashtbl.mem emitted cid))
129
122
in
130
123
List.iter siblings ~f:(fun cid -> emit_branch cid));
131
124
emit id)
···
146
139
let rec aux i =
147
140
if i >= !num_active
148
141
then None
149
-
else if [%equal: string option] lanes.(i) (Some id)
142
+
else if [%equal: Change_id.t option] lanes.(i) (Some id)
150
143
then Some i
151
144
else aux (i + 1)
152
145
in
+14
-21
lib/tui/log_screen.ml
+14
-21
lib/tui/log_screen.ml
···
6
6
module Focus = struct
7
7
type t =
8
8
| Log
9
-
| Edit_description of { change_id : string }
10
-
| Request_review of { change_id : string }
9
+
| Edit_description of Change_id.t
10
+
| Request_review of Change_id.t
11
11
end
12
12
13
13
type t =
···
37
37
and enter_review = t.enter_review in
38
38
fun (event : Event.t) ->
39
39
match focus with
40
-
| Request_review { change_id } ->
40
+
| Request_review change_id ->
41
41
(match event with
42
42
| Key_press { key = Escape; mods = [] } ->
43
43
let open Effect.Let_syntax in
···
53
53
Effect.of_lwt_thunk (fun () ->
54
54
Lens_backend.Store.request
55
55
t.store
56
-
(Lens_backend.Change_id.of_string change_id)
56
+
change_id
57
57
(Lens_backend.User_id.of_string reviewer_email))
58
58
in
59
59
let%bind () = textbox.set "" in
···
61
61
let%bind () = refresh_log_reviews in
62
62
set_focus Log
63
63
| event -> textbox.handler event)
64
-
| Edit_description { change_id } ->
64
+
| Edit_description change_id ->
65
65
let open Effect.Let_syntax in
66
66
let%bind action = editor_handler event in
67
67
(match action with
68
68
| None -> return ()
69
69
| Some Exit_without_saving -> set_focus Log
70
70
| Some (Save_and_exit message) ->
71
-
let%bind () = Effect.of_lwt_thunk (fun () -> Jj.describe ~change_id ~message) in
71
+
let%bind () = Effect.of_lwt_thunk (fun () -> Jj.describe change_id ~message) in
72
72
let%bind () = refresh_log_changes in
73
73
set_focus Log)
74
74
| Log ->
···
85
85
| Some (row : Graph_layout.Row.t) ->
86
86
let open Effect.Let_syntax in
87
87
let%bind () = editor_set_text row.change.description in
88
-
set_focus (Edit_description { change_id = row.change.change_id }))
88
+
set_focus (Edit_description row.change.change_id))
89
89
| Key_press { key = ASCII 'r'; mods = [] } ->
90
90
(match selected_row with
91
91
| None -> Effect.Ignore
92
92
| Some (row : Graph_layout.Row.t) ->
93
93
let open Effect.Let_syntax in
94
94
let%bind () = textbox.set "" in
95
-
set_focus (Request_review { change_id = row.change.change_id }))
95
+
set_focus (Request_review row.change.change_id))
96
96
| Key_press { key = Enter; mods = [] } ->
97
97
(match selected_row with
98
98
| None -> Effect.Ignore
···
110
110
| Some (idx, change) ->
111
111
let%bind () = set_selected_idx (Fn.const idx) in
112
112
let%bind () = editor_set_text "" in
113
-
set_focus (Edit_description { change_id = change.change_id })
113
+
set_focus (Edit_description change.change_id)
114
114
| None -> Effect.Ignore)
115
115
| _ -> Effect.Ignore))
116
116
;;
···
154
154
let%arr selected_row = log_view.selected_row in
155
155
Option.map selected_row ~f:Graph_layout.Row.change
156
156
in
157
-
let bottom_view =
158
-
Diff_view.component ~dimensions:bottom_dims ~selected_change graph
159
-
in
157
+
let bottom_view = Diff_view.component ~dimensions:bottom_dims ~selected_change graph in
160
158
let review_view = Review_view.component ~selected_change ~store graph in
161
159
let textbox_focused =
162
160
let%arr focus in
···
284
282
~right_padding:1
285
283
~top_padding:0
286
284
~bottom_padding:0
287
-
~title:
288
-
(View.text ~attrs:[ Attr.fg (c Mauve); Attr.bold ] " Request Review ")
285
+
~title:(View.text ~attrs:[ Attr.fg (c Mauve); Attr.bold ] " Request Review ")
289
286
~attrs:[ Attr.fg (c Overlay1); Attr.bg (c Mantle) ]
290
287
padded_tb
291
288
in
···
313
310
~right_padding:1
314
311
~top_padding:0
315
312
~bottom_padding:0
316
-
~title:
317
-
(View.text ~attrs:[ Attr.fg (c Mauve); Attr.bold ] " Edit Description ")
313
+
~title:(View.text ~attrs:[ Attr.fg (c Mauve); Attr.bold ] " Edit Description ")
318
314
~attrs:[ Attr.fg (c Overlay1); Attr.bg (c Mantle) ]
319
315
padded_editor
320
316
in
···
331
327
(let%arr set_cursor and focus in
332
328
fun pos ->
333
329
match focus with
334
-
| Log | Request_review _ ->
335
-
Effect.Many [ Effect.hide_cursor; set_cursor None ]
330
+
| Log | Request_review _ -> Effect.Many [ Effect.hide_cursor; set_cursor None ]
336
331
| Edit_description _ ->
337
332
(match pos with
338
333
| Some pos ->
339
334
Effect.Many
340
-
[ Effect.show_cursor
341
-
; set_cursor (Some { position = pos; kind = Bar })
342
-
]
335
+
[ Effect.show_cursor; set_cursor (Some { position = pos; kind = Bar }) ]
343
336
| None -> Effect.Ignore))
344
337
graph;
345
338
let log_handler = handler t in
+25
-12
lib/tui/log_view.ml
+25
-12
lib/tui/log_view.ml
···
42
42
|> List.intersperse ~sep:space
43
43
in
44
44
let id_len = 8 in
45
-
let change_id_short = String.prefix change.change_id id_len in
45
+
let change_id_short = Change_id.prefix change.change_id id_len in
46
46
let change_prefix =
47
47
text
48
48
[ Attr.fg (c Mauve); Attr.bold ]
···
56
56
if change.current_working_copy then Catppuccin.Teal else Catppuccin.Subtext0
57
57
in
58
58
let timestamp = text [ Attr.fg (c timestamp_color) ] (" " ^ change.timestamp) in
59
-
let commit_id_short = String.prefix change.commit_id id_len in
59
+
let commit_id_short = Commit_id.prefix change.commit_id id_len in
60
60
let commit_prefix =
61
61
text
62
62
[ Attr.fg (c Blue); Attr.bold ]
···
72
72
in
73
73
let review_badge =
74
74
if review_count > 0
75
-
then text [ Attr.fg (c Blue) ] (sprintf " [%d review%s]" review_count (if review_count = 1 then "" else "s"))
75
+
then
76
+
text
77
+
[ Attr.fg (c Blue) ]
78
+
(sprintf " [%d review%s]" review_count (if review_count = 1 then "" else "s"))
76
79
else View.none
77
80
in
78
81
let line1 =
···
159
162
Lwt.all
160
163
(List.map changes ~f:(fun (c : Jj.Change.t) ->
161
164
let open Lwt.Syntax in
162
-
let* reqs =
163
-
Lens_backend.Store.pending_requests
164
-
store
165
-
(Lens_backend.Change_id.of_string c.change_id)
166
-
in
165
+
let* reqs = Lens_backend.Store.pending_requests store c.change_id in
167
166
Lwt.return (c.change_id, List.length reqs)))))
168
167
graph
169
168
in
···
192
191
let change_views =
193
192
List.mapi rows ~f:(fun i (row : Graph_layout.Row.t) ->
194
193
let review_count =
195
-
List.Assoc.find review_counts ~equal:String.equal row.change.change_id
194
+
List.Assoc.find review_counts ~equal:Change_id.equal row.change.change_id
196
195
|> Option.value ~default:0
197
196
in
198
197
render_change_line
199
198
~flavor
200
199
~row
201
200
~change_prefix_len:
202
-
(Jj.Change.unique_prefix_length row.change changes ~f:Jj.Change.change_id)
201
+
(Jj.Change.unique_prefix_length
202
+
(module Change_id)
203
+
row.change
204
+
changes
205
+
~f:Jj.Change.change_id)
203
206
~commit_prefix_len:
204
-
(Jj.Change.unique_prefix_length row.change changes ~f:Jj.Change.commit_id)
207
+
(Jj.Change.unique_prefix_length
208
+
(module Commit_id)
209
+
row.change
210
+
changes
211
+
~f:Jj.Change.commit_id)
205
212
~selected:(i = selected_idx)
206
213
~review_count)
207
214
in
···
234
241
graph;
235
242
view
236
243
in
237
-
{ selected_row; set_selected_idx; view; refresh_changes; refresh_reviews; handler = less_keybindings }
244
+
{ selected_row
245
+
; set_selected_idx
246
+
; view
247
+
; refresh_changes
248
+
; refresh_reviews
249
+
; handler = less_keybindings
250
+
}
238
251
;;
+7
-5
lib/tui/review_view.ml
+7
-5
lib/tui/review_view.ml
···
7
7
; refresh : unit Effect.t Bonsai.t
8
8
}
9
9
10
-
let render_reviews ~(flavor : Catppuccin.Flavor.t) (requests : Lens_backend.Store.Request.t list) =
10
+
let render_reviews
11
+
~(flavor : Catppuccin.Flavor.t)
12
+
(requests : Lens_backend.Store.Request.t list)
13
+
=
11
14
let c color = Catppuccin.color ~flavor color in
12
15
match requests with
13
16
| [] -> View.text ~attrs:[ Attr.fg (c Subtext0) ] "No pending reviews"
···
43
46
let open Effect.Let_syntax in
44
47
let%bind reqs =
45
48
Effect.of_lwt_thunk (fun () ->
46
-
Lens_backend.Store.pending_requests
47
-
store
48
-
(Lens_backend.Change_id.of_string change.change_id))
49
+
Lens_backend.Store.pending_requests store change.change_id)
49
50
in
50
51
return (Some reqs))
51
52
graph
···
55
56
| None -> Bonsai.return View.none
56
57
| Some None -> Bonsai.return View.none
57
58
| Some (Some requests) ->
58
-
let%arr requests and flavor = Catppuccin.flavor graph in
59
+
let%arr requests
60
+
and flavor = Catppuccin.flavor graph in
59
61
render_reviews ~flavor requests
60
62
in
61
63
let refresh =