terminal user interface to jujutsu. Focused on speed and clarity
fix preview mode bugs (I think this broke the update loop somehow)
+546
-65
+33
jj_tui/bin/global_vars.ml
+33
jj_tui/bin/global_vars.ml
···
16
16
| `Add_after
17
17
]
18
18
19
+
type rebase_preview_source_mode =
20
+
[ `Revisions
21
+
| `Source
22
+
| `Branch
23
+
]
24
+
19
25
type ui_state_t = {
20
26
view :
21
27
[ `Main (**Normal Mode*)
···
46
52
; selected_revisions : string maybe_unique list Lwd.var
47
53
; rebase_preview_active : bool Lwd.var
48
54
; rebase_preview_mode : rebase_preview_mode Lwd.var
55
+
; rebase_preview_source_mode : rebase_preview_source_mode Lwd.var
49
56
; rebase_preview_targets : string list Lwd.var
50
57
; rebase_preview_sources : string list Lwd.var
51
58
; rebase_preview_invalid : string option Lwd.var
···
82
89
val get_rebase_preview_active : unit -> bool
83
90
val get_rebase_preview_mode : unit -> rebase_preview_mode
84
91
val get_rebase_preview_mode_lwd : unit -> rebase_preview_mode Lwd.t
92
+
val get_rebase_preview_source_mode : unit -> rebase_preview_source_mode
93
+
val get_rebase_preview_source_mode_lwd : unit -> rebase_preview_source_mode Lwd.t
94
+
val set_rebase_preview_source_mode : rebase_preview_source_mode -> unit
85
95
val get_rebase_preview_targets : unit -> string list
86
96
val get_rebase_preview_sources : unit -> string list
87
97
val set_rebase_preview_active : bool -> unit
···
90
100
val set_rebase_preview_invalid : string option -> unit
91
101
val clear_rebase_preview : unit -> unit
92
102
val cycle_rebase_preview_mode : unit -> unit
103
+
val cycle_rebase_preview_source_mode : unit -> unit
93
104
val rebase_preview_label : unit -> string
94
105
val config : Config.t Lwd.var
95
106
val show_popup : (Nottui.ui Lwd.t * string) option -> unit
···
110
121
; selected_revisions = Lwd.var [ Unique "@" ]
111
122
; rebase_preview_active = Lwd.var false
112
123
; rebase_preview_mode = Lwd.var `Insert_after
124
+
; rebase_preview_source_mode = Lwd.var `Revisions
113
125
; rebase_preview_targets = Lwd.var []
114
126
; rebase_preview_sources = Lwd.var []
115
127
; rebase_preview_invalid = Lwd.var None
···
179
191
180
192
let get_rebase_preview_mode_lwd () = Lwd.get ui_state.rebase_preview_mode
181
193
194
+
let get_rebase_preview_source_mode () = Lwd.peek ui_state.rebase_preview_source_mode
195
+
196
+
let get_rebase_preview_source_mode_lwd () = Lwd.get ui_state.rebase_preview_source_mode
197
+
198
+
let set_rebase_preview_source_mode mode =
199
+
Lwd.set ui_state.rebase_preview_source_mode mode
200
+
;;
201
+
182
202
let get_rebase_preview_targets () = Lwd.peek ui_state.rebase_preview_targets
183
203
184
204
let get_rebase_preview_sources () = Lwd.peek ui_state.rebase_preview_sources
···
215
235
`Insert_before
216
236
in
217
237
Lwd.set ui_state.rebase_preview_mode next
238
+
;;
239
+
240
+
let cycle_rebase_preview_source_mode () =
241
+
let next =
242
+
match Lwd.peek ui_state.rebase_preview_source_mode with
243
+
| `Revisions ->
244
+
`Source
245
+
| `Source ->
246
+
`Branch
247
+
| `Branch ->
248
+
`Revisions
249
+
in
250
+
Lwd.set ui_state.rebase_preview_source_mode next
218
251
;;
219
252
220
253
let rebase_preview_label () =
+69
-1
jj_tui/bin/graph_commands.ml
+69
-1
jj_tui/bin/graph_commands.ml
···
316
316
(fun () ->
317
317
Fun
318
318
(fun _ ->
319
+
let build_rebase_args () =
320
+
let sources = Vars.get_rebase_preview_sources () in
321
+
let targets = Vars.get_rebase_preview_targets () in
322
+
if sources = [] || targets = []
323
+
then None
324
+
else (
325
+
let source_flag =
326
+
match Vars.get_rebase_preview_source_mode () with
327
+
| `Revisions ->
328
+
"-r"
329
+
| `Source ->
330
+
"-s"
331
+
| `Branch ->
332
+
"-b"
333
+
in
334
+
let dest_flag =
335
+
match Vars.get_rebase_preview_mode () with
336
+
| `Insert_before ->
337
+
"-B"
338
+
| `Insert_after ->
339
+
"-A"
340
+
| `Add_after ->
341
+
"-o"
342
+
in
343
+
let source_args =
344
+
sources |> List.concat_map (fun rev -> [ source_flag; rev ])
345
+
in
346
+
let target_args =
347
+
targets |> List.concat_map (fun rev -> [ dest_flag; rev ])
348
+
in
349
+
Some ([ "rebase" ] @ source_args @ target_args))
350
+
in
351
+
let preview_input key =
352
+
match key with
353
+
| `ASCII 'y', [] ->
354
+
(match build_rebase_args () with
355
+
| None ->
356
+
`Handled
357
+
| Some args ->
358
+
Vars.clear_rebase_preview ();
359
+
ui_state.input $= `Normal;
360
+
jj args |> ignore;
361
+
Global_funcs.update_status ~cause_snapshot:false ();
362
+
`Handled)
363
+
| `ASCII 'd', [] ->
364
+
Vars.cycle_rebase_preview_mode ();
365
+
Vars.set_rebase_preview_invalid None;
366
+
Vars.ui_state.trigger_update $= ();
367
+
`Handled
368
+
| `ASCII 's', [] ->
369
+
Vars.cycle_rebase_preview_source_mode ();
370
+
Vars.set_rebase_preview_invalid None;
371
+
Vars.ui_state.trigger_update $= ();
372
+
`Handled
373
+
| _ ->
374
+
`Unhandled
375
+
in
319
376
if Vars.get_rebase_preview_active ()
320
377
then (
321
378
Vars.clear_rebase_preview ();
···
330
387
in
331
388
Vars.set_rebase_preview_targets targets;
332
389
Vars.set_rebase_preview_invalid None;
333
-
ui_state.input $= `Mode_no_popup (fun _ -> `Unhandled);
390
+
ui_state.input $= `Mode_no_popup preview_input;
334
391
Vars.ui_state.trigger_update $= ())))
392
+
}
393
+
; {
394
+
id = "rebase_preview_cycle_source_mode"
395
+
; sorting_key = 19.6
396
+
; description = "Cycle rebase preview source mode (revisions/source/branch)"
397
+
; make_cmd =
398
+
(fun () ->
399
+
Fun
400
+
(fun _ ->
401
+
Vars.cycle_rebase_preview_source_mode ();
402
+
Vars.ui_state.trigger_update $= ()))
335
403
}
336
404
; {
337
405
id = "rebase_single"
+31
-5
jj_tui/bin/graph_view.ml
+31
-5
jj_tui/bin/graph_view.ml
···
135
135
let mode_indicator =
136
136
let$ active = Lwd.get Vars.ui_state.rebase_preview_active
137
137
and$ mode = Lwd.get Vars.ui_state.rebase_preview_mode
138
+
and$ source_mode = Lwd.get Vars.ui_state.rebase_preview_source_mode
138
139
and$ invalid = Lwd.get Vars.ui_state.rebase_preview_invalid in
139
140
if not active
140
141
then Ui.empty
···
148
149
| `Add_after ->
149
150
"add-after"
150
151
in
151
-
let base = "Preview: " ^ mode_str in
152
+
let source_str =
153
+
match source_mode with
154
+
| `Revisions ->
155
+
"revisions"
156
+
| `Source ->
157
+
"source"
158
+
| `Branch ->
159
+
"branch"
160
+
in
161
+
let base =
162
+
Printf.sprintf "Preview: dest=%s source=%s" mode_str source_str
163
+
in
152
164
let label =
153
165
match invalid with
154
166
| None ->
···
180
192
in
181
193
let nodes, invalid =
182
194
if Vars.get_rebase_preview_active ()
183
-
then
195
+
then (
196
+
let expanded_sources =
197
+
Render_jj_graph.expand_preview_sources
198
+
~mode:(Vars.get_rebase_preview_source_mode ())
199
+
~sources:(Vars.get_rebase_preview_sources ())
200
+
~targets:(Vars.get_rebase_preview_targets ())
201
+
nodes
202
+
in
184
203
Render_jj_graph.apply_rebase_preview
185
204
~mode:(Vars.get_rebase_preview_mode ())
186
-
~sources:(Vars.get_rebase_preview_sources ())
205
+
~sources:expanded_sources
187
206
~targets:(Vars.get_rebase_preview_targets ())
188
-
nodes
207
+
nodes)
189
208
else nodes, None
190
209
in
191
210
let current_invalid = Lwd.peek Vars.ui_state.rebase_preview_invalid in
···
263
282
in
264
283
(* run commands when there is keybaord input*)
265
284
let handleKeys = function
285
+
| `Escape, [] when Vars.get_rebase_preview_active () ->
286
+
Vars.clear_rebase_preview ();
287
+
Vars.ui_state.trigger_update $= ();
288
+
Vars.ui_state.input $= `Normal;
289
+
`Handled
266
290
| `Enter, [] ->
267
291
Focus.request_reversable summary_focus;
268
292
`Handled
269
293
| k ->
270
-
handleInputs (get_command_mapping ()) k
294
+
if Vars.get_rebase_preview_active ()
295
+
then `Unhandled
296
+
else handleInputs (get_command_mapping ()) k
271
297
| _ ->
272
298
`Unhandled
273
299
in
+4
-1
jj_tui/bin/jj_ui.ml
+4
-1
jj_tui/bin/jj_ui.ml
···
107
107
| `Mode_no_popup _, _, _ ->
108
108
(match event with
109
109
| `Escape, [] ->
110
-
if Vars.get_rebase_preview_active () then Vars.clear_rebase_preview ();
110
+
if Vars.get_rebase_preview_active ()
111
+
then (
112
+
Vars.clear_rebase_preview ();
113
+
Vars.ui_state.trigger_update $= ());
111
114
ui_state.input $= `Normal;
112
115
`Handled
113
116
| _ ->
+1
jj_tui/lib/key_map.ml
+1
jj_tui/lib/key_map.ml
+408
-58
jj_tui/lib/render_jj_graph.ml
+408
-58
jj_tui/lib/render_jj_graph.ml
···
133
133
| `Add_after
134
134
]
135
135
136
+
type preview_source_mode =
137
+
[ `Revisions
138
+
| `Source
139
+
| `Branch
140
+
]
141
+
136
142
module StringSet = Set.Make (String)
137
143
138
144
let node_matches_rev (n : node) rev = n.change_id = rev || n.commit_id = rev
···
168
174
children
169
175
;;
170
176
177
+
let descendants_of ~children_map ~sources =
178
+
let visited = Hashtbl.create (List.length sources * 2) in
179
+
let queue = Queue.create () in
180
+
List.iter
181
+
(fun id ->
182
+
if not (Hashtbl.mem visited id)
183
+
then (
184
+
Hashtbl.add visited id ();
185
+
Queue.add id queue))
186
+
sources;
187
+
while not (Queue.is_empty queue) do
188
+
let current = Queue.take queue in
189
+
let children = Option.value (Hashtbl.find_opt children_map current) ~default:[] in
190
+
List.iter
191
+
(fun child ->
192
+
if not (Hashtbl.mem visited child)
193
+
then (
194
+
Hashtbl.add visited child ();
195
+
Queue.add child queue))
196
+
children
197
+
done;
198
+
visited |> Hashtbl.to_seq_keys |> List.of_seq
199
+
;;
200
+
201
+
171
202
let build_ancestors parent_map =
172
203
let cache = Hashtbl.create (Hashtbl.length parent_map) in
173
204
let rec ancestors id =
···
190
221
ancestors
191
222
;;
192
223
224
+
let expand_preview_sources
225
+
~(mode : preview_source_mode)
226
+
~(sources : string list)
227
+
~(targets : string list)
228
+
(nodes : node list) : string list
229
+
=
230
+
if sources = [] then []
231
+
else (
232
+
let parent_map = build_parent_map nodes in
233
+
let children_map = build_children_map parent_map in
234
+
let ancestors_of = build_ancestors parent_map in
235
+
let sources = resolve_revs nodes sources in
236
+
let targets = resolve_revs nodes targets in
237
+
let descendants = descendants_of ~children_map ~sources in
238
+
let expanded =
239
+
match mode with
240
+
| `Revisions ->
241
+
sources
242
+
| `Source ->
243
+
descendants
244
+
| `Branch ->
245
+
let ancestors_of_targets =
246
+
targets
247
+
|> List.fold_left
248
+
(fun acc target_id ->
249
+
let ancestors = ancestors_of target_id |> StringSet.elements in
250
+
StringSet.union acc (StringSet.of_list (target_id :: ancestors)))
251
+
StringSet.empty
252
+
in
253
+
let ancestors_of_sources =
254
+
sources
255
+
|> List.fold_left
256
+
(fun acc source_id ->
257
+
let ancestors = ancestors_of source_id |> StringSet.elements in
258
+
StringSet.union acc (StringSet.of_list (source_id :: ancestors)))
259
+
StringSet.empty
260
+
in
261
+
let base_set =
262
+
StringSet.diff ancestors_of_sources ancestors_of_targets |> StringSet.elements
263
+
in
264
+
let branch_descendants = descendants_of ~children_map ~sources:base_set in
265
+
StringSet.(union (of_list base_set) (of_list branch_descendants) |> elements)
266
+
in
267
+
let expanded_set = StringSet.of_list expanded in
268
+
nodes
269
+
|> List.filter (fun n -> StringSet.mem n.commit_id expanded_set)
270
+
|> List.map (fun n -> n.commit_id))
271
+
;;
272
+
193
273
let preview_description sources =
194
274
match sources with
195
275
| [ rev ] ->
···
198
278
Printf.sprintf "preview: %d commits" (List.length sources)
199
279
;;
200
280
281
+
let apply_rebase_preview_multi
282
+
~(mode : preview_mode)
283
+
~(sources : string list)
284
+
~(targets : string list)
285
+
(nodes : node list) : node list * string option
286
+
=
287
+
let parent_map_all = build_parent_map nodes in
288
+
let children_map_all = build_children_map parent_map_all in
289
+
let ancestors_of = build_ancestors parent_map_all in
290
+
let source_ids = resolve_revs nodes sources in
291
+
let target_ids = resolve_revs nodes targets in
292
+
let source_set = StringSet.of_list source_ids in
293
+
let invalid = ref None in
294
+
let invalid_target target_id =
295
+
List.exists
296
+
(fun source_id ->
297
+
if source_id = target_id
298
+
then true
299
+
else (
300
+
let source_ancestors = ancestors_of source_id in
301
+
let target_ancestors = ancestors_of target_id in
302
+
match mode with
303
+
| `Insert_before ->
304
+
StringSet.mem target_id source_ancestors
305
+
| `Insert_after | `Add_after ->
306
+
StringSet.mem source_id target_ancestors))
307
+
source_ids
308
+
in
309
+
List.iter (fun target_id ->
310
+
if invalid_target target_id
311
+
then invalid := Some "Preview blocked: cycle detected") target_ids;
312
+
if !invalid <> None
313
+
then nodes, !invalid
314
+
else (
315
+
let nodes_filtered =
316
+
nodes |> List.filter (fun n -> not (StringSet.mem n.commit_id source_set))
317
+
in
318
+
let parent_map = Hashtbl.create (List.length nodes_filtered) in
319
+
List.iter
320
+
(fun n ->
321
+
let parents =
322
+
n.parents
323
+
|> List.map (fun p -> p.commit_id)
324
+
|> List.filter (fun id -> not (StringSet.mem id source_set))
325
+
in
326
+
Hashtbl.replace parent_map n.commit_id parents)
327
+
nodes_filtered;
328
+
let children_map = build_children_map parent_map in
329
+
let base_nodes = Hashtbl.create (List.length nodes_filtered) in
330
+
List.iter (fun n -> Hashtbl.replace base_nodes n.commit_id n) nodes_filtered;
331
+
let heads =
332
+
source_ids
333
+
|> List.filter (fun id ->
334
+
let children =
335
+
Option.value (Hashtbl.find_opt children_map_all id) ~default:[]
336
+
in
337
+
not (List.exists (fun child -> StringSet.mem child source_set) children))
338
+
in
339
+
let source_order =
340
+
nodes
341
+
|> List.filter (fun n -> StringSet.mem n.commit_id source_set)
342
+
|> List.map (fun n -> n.commit_id)
343
+
in
344
+
let preview_map = Hashtbl.create (List.length source_ids) in
345
+
List.iter
346
+
(fun source_id ->
347
+
let preview_id = Printf.sprintf "preview:%s" source_id in
348
+
let source_node = List.find (fun n -> n.commit_id = source_id) nodes in
349
+
let preview_node =
350
+
{
351
+
source_node with
352
+
commit_id = preview_id
353
+
; change_id = preview_id
354
+
; description = "preview: " ^ source_node.description
355
+
; is_preview = true
356
+
}
357
+
in
358
+
Hashtbl.replace base_nodes preview_id preview_node;
359
+
Hashtbl.replace preview_map source_id preview_id)
360
+
source_ids;
361
+
let preview_parent_ids source_id =
362
+
let source_node = List.find (fun n -> n.commit_id = source_id) nodes in
363
+
source_node.parents
364
+
|> List.map (fun p -> p.commit_id)
365
+
|> List.filter (fun id -> StringSet.mem id source_set)
366
+
|> List.filter_map (fun id -> Hashtbl.find_opt preview_map id)
367
+
in
368
+
List.iter
369
+
(fun source_id ->
370
+
let preview_id = Hashtbl.find preview_map source_id in
371
+
let parent_ids = preview_parent_ids source_id in
372
+
Hashtbl.replace parent_map preview_id parent_ids)
373
+
source_ids;
374
+
let root_ids =
375
+
source_ids
376
+
|> List.filter (fun id ->
377
+
let source_node = List.find (fun n -> n.commit_id = id) nodes in
378
+
not (List.exists (fun p -> StringSet.mem p.commit_id source_set) source_node.parents))
379
+
in
380
+
let root_preview_ids = root_ids |> List.map (fun id -> Hashtbl.find preview_map id) in
381
+
let head_preview_ids = heads |> List.map (fun id -> Hashtbl.find preview_map id) in
382
+
let target_parent_union =
383
+
target_ids
384
+
|> List.concat_map (fun target_id ->
385
+
Option.value (Hashtbl.find_opt parent_map target_id) ~default:[])
386
+
|> List.sort_uniq String.compare
387
+
in
388
+
(match mode with
389
+
| `Insert_before ->
390
+
List.iter
391
+
(fun preview_id -> Hashtbl.replace parent_map preview_id target_parent_union)
392
+
root_preview_ids;
393
+
List.iter
394
+
(fun target_id -> Hashtbl.replace parent_map target_id head_preview_ids)
395
+
target_ids
396
+
| `Insert_after ->
397
+
List.iter
398
+
(fun preview_id -> Hashtbl.replace parent_map preview_id target_ids)
399
+
root_preview_ids;
400
+
List.iter
401
+
(fun target_id ->
402
+
let children =
403
+
Option.value (Hashtbl.find_opt children_map target_id) ~default:[]
404
+
in
405
+
List.iter
406
+
(fun child_id ->
407
+
let child_parents =
408
+
Option.value (Hashtbl.find_opt parent_map child_id) ~default:[]
409
+
in
410
+
let without_target =
411
+
List.filter (fun id -> id <> target_id) child_parents
412
+
in
413
+
Hashtbl.replace parent_map child_id (without_target @ head_preview_ids))
414
+
children)
415
+
target_ids
416
+
| `Add_after ->
417
+
List.iter
418
+
(fun preview_id -> Hashtbl.replace parent_map preview_id target_ids)
419
+
root_preview_ids);
420
+
let preview_before = match mode with `Insert_after | `Add_after -> true | _ -> false in
421
+
let preview_after = match mode with `Insert_before -> true | _ -> false in
422
+
let first_target_id =
423
+
List.find_map
424
+
(fun n -> if List.mem n.commit_id target_ids then Some n.commit_id else None)
425
+
nodes_filtered
426
+
|> Option.value ~default:(List.hd target_ids)
427
+
in
428
+
let last_target_id =
429
+
nodes_filtered
430
+
|> List.fold_left
431
+
(fun acc n ->
432
+
if List.mem n.commit_id target_ids then Some n.commit_id else acc)
433
+
None
434
+
|> Option.value ~default:(List.hd target_ids)
435
+
in
436
+
let insertion_target_id =
437
+
if preview_after then last_target_id else first_target_id
438
+
in
439
+
let inserted = ref false in
440
+
let ordered_ids_rev =
441
+
List.fold_left
442
+
(fun acc n ->
443
+
let id = n.commit_id in
444
+
if (not !inserted) && id = insertion_target_id
445
+
then (
446
+
inserted := true;
447
+
let preview_ids =
448
+
source_order |> List.map (fun source_id -> Hashtbl.find preview_map source_id)
449
+
in
450
+
if preview_before
451
+
then id :: (List.rev_append preview_ids acc)
452
+
else if preview_after
453
+
then (List.rev_append preview_ids (id :: acc))
454
+
else id :: acc)
455
+
else id :: acc)
456
+
[]
457
+
nodes_filtered
458
+
in
459
+
let ordered_ids = List.rev ordered_ids_rev in
460
+
let final_nodes = Hashtbl.create (List.length ordered_ids) in
461
+
let rec build_node id =
462
+
match Hashtbl.find_opt final_nodes id with
463
+
| Some node ->
464
+
node
465
+
| None ->
466
+
let base = Hashtbl.find base_nodes id in
467
+
let parent_ids = Option.value (Hashtbl.find_opt parent_map id) ~default:[] in
468
+
let parents = List.map build_node parent_ids in
469
+
let node = { base with parents } in
470
+
Hashtbl.replace final_nodes id node;
471
+
node
472
+
in
473
+
let nodes = List.map build_node ordered_ids in
474
+
nodes, !invalid)
475
+
;;
476
+
201
477
let apply_rebase_preview
202
478
~(mode : preview_mode)
203
479
~(sources : string list)
···
211
487
if source_ids = [] || target_ids = []
212
488
then nodes, None
213
489
else (
490
+
if List.length source_ids > 1
491
+
then apply_rebase_preview_multi ~mode ~sources ~targets nodes
492
+
else (
214
493
let parent_map_all = build_parent_map nodes in
215
494
let ancestors_of = build_ancestors parent_map_all in
216
495
let removed_set = StringSet.of_list source_ids in
···
234
513
Hashtbl.create (List.length nodes_filtered + List.length target_ids)
235
514
in
236
515
List.iter (fun n -> Hashtbl.replace base_nodes n.commit_id n) nodes_filtered;
237
-
let add_preview_for_target target_id =
238
-
if not (Hashtbl.mem parent_map target_id)
239
-
then ()
240
-
else (
241
-
let invalid_target =
242
-
List.exists
243
-
(fun source_id ->
244
-
if source_id = target_id
245
-
then true
246
-
else (
247
-
let source_ancestors = ancestors_of source_id in
248
-
let target_ancestors = ancestors_of target_id in
249
-
match mode with
250
-
| `Insert_before ->
251
-
StringSet.mem target_id source_ancestors
252
-
| `Insert_after | `Add_after ->
253
-
StringSet.mem source_id target_ancestors))
254
-
source_ids
255
-
in
256
-
if invalid_target
257
-
then invalid := Some "Preview blocked: cycle detected"
258
-
else (
259
-
let preview_id = Printf.sprintf "preview:%s" target_id in
260
-
if not (Hashtbl.mem preview_by_target target_id)
261
-
then (
262
-
let label = "preview" in
263
-
let description = preview_description sources in
264
-
let preview_node =
265
-
make_preview_node ~label ~description ~target_commit_id:target_id ()
266
-
in
267
-
Hashtbl.replace base_nodes preview_id preview_node;
268
-
Hashtbl.replace preview_by_target target_id preview_id;
516
+
let invalid_target target_id =
517
+
List.exists
518
+
(fun source_id ->
519
+
if source_id = target_id
520
+
then true
521
+
else (
522
+
let source_ancestors = ancestors_of source_id in
523
+
let target_ancestors = ancestors_of target_id in
524
+
match mode with
525
+
| `Insert_before ->
526
+
StringSet.mem target_id source_ancestors
527
+
| `Insert_after | `Add_after ->
528
+
StringSet.mem source_id target_ancestors))
529
+
source_ids
530
+
in
531
+
List.iter
532
+
(fun target_id ->
533
+
if invalid_target target_id
534
+
then invalid := Some "Preview blocked: cycle detected")
535
+
target_ids;
536
+
if !invalid <> None
537
+
then nodes_filtered, !invalid
538
+
else (
539
+
let () =
540
+
if List.length target_ids > 1
541
+
then (
542
+
let preview_id = "preview:multi" in
543
+
let description = preview_description sources in
544
+
let preview_node = make_preview_node ~label:"preview" ~description () in
545
+
Hashtbl.replace base_nodes preview_id preview_node;
546
+
let target_parent_union =
547
+
target_ids
548
+
|> List.concat_map (fun target_id ->
549
+
Option.value (Hashtbl.find_opt parent_map target_id) ~default:[])
550
+
|> List.sort_uniq String.compare
551
+
in
552
+
(match mode with
553
+
| `Insert_before ->
554
+
Hashtbl.replace parent_map preview_id target_parent_union;
555
+
List.iter
556
+
(fun target_id -> Hashtbl.replace parent_map target_id [ preview_id ])
557
+
target_ids
558
+
| `Insert_after ->
559
+
Hashtbl.replace parent_map preview_id target_ids;
560
+
List.iter
561
+
(fun target_id ->
562
+
let children =
563
+
Option.value (Hashtbl.find_opt children_map target_id) ~default:[]
564
+
in
565
+
List.iter
566
+
(fun child_id ->
567
+
let child_parents =
568
+
Option.value (Hashtbl.find_opt parent_map child_id) ~default:[]
569
+
in
570
+
let without_target =
571
+
List.filter (fun id -> id <> target_id) child_parents
572
+
in
573
+
Hashtbl.replace parent_map child_id (without_target @ [ preview_id ]))
574
+
children)
575
+
target_ids
576
+
| `Add_after ->
577
+
Hashtbl.replace parent_map preview_id target_ids);
578
+
let first_target_id =
579
+
List.find_map
580
+
(fun n ->
581
+
if List.mem n.commit_id target_ids then Some n.commit_id else None)
582
+
nodes_filtered
583
+
|> Option.value ~default:(List.hd target_ids)
584
+
in
585
+
let last_target_id =
586
+
nodes_filtered
587
+
|> List.fold_left
588
+
(fun acc n ->
589
+
if List.mem n.commit_id target_ids then Some n.commit_id else acc)
590
+
None
591
+
|> Option.value ~default:(List.hd target_ids)
592
+
in
593
+
let insertion_target_id =
269
594
match mode with
270
595
| `Insert_before ->
271
-
let parents = Option.value (Hashtbl.find_opt parent_map target_id) ~default:[] in
272
-
Hashtbl.replace parent_map preview_id parents;
273
-
Hashtbl.replace parent_map target_id [ preview_id ]
274
-
| `Insert_after ->
275
-
Hashtbl.replace parent_map preview_id [ target_id ];
276
-
let children =
277
-
Option.value (Hashtbl.find_opt children_map target_id) ~default:[]
278
-
in
279
-
List.iter
280
-
(fun child_id ->
281
-
let child_parents =
282
-
Option.value (Hashtbl.find_opt parent_map child_id) ~default:[]
283
-
in
284
-
let updated =
285
-
List.map
286
-
(fun parent_id ->
287
-
if parent_id = target_id then preview_id else parent_id)
288
-
child_parents
289
-
in
290
-
Hashtbl.replace parent_map child_id updated)
291
-
children
292
-
| `Add_after ->
293
-
Hashtbl.replace parent_map preview_id [ target_id ])))
294
-
in
295
-
List.iter add_preview_for_target target_ids;
596
+
last_target_id
597
+
| `Insert_after | `Add_after ->
598
+
first_target_id
599
+
in
600
+
Hashtbl.replace preview_by_target insertion_target_id preview_id)
601
+
else (
602
+
let add_preview_for_target target_id =
603
+
if not (Hashtbl.mem parent_map target_id)
604
+
then ()
605
+
else (
606
+
let preview_id = Printf.sprintf "preview:%s" target_id in
607
+
if not (Hashtbl.mem preview_by_target target_id)
608
+
then (
609
+
let label = "preview" in
610
+
let description = preview_description sources in
611
+
let preview_node =
612
+
make_preview_node ~label ~description ~target_commit_id:target_id ()
613
+
in
614
+
Hashtbl.replace base_nodes preview_id preview_node;
615
+
Hashtbl.replace preview_by_target target_id preview_id;
616
+
match mode with
617
+
| `Insert_before ->
618
+
let parents =
619
+
Option.value (Hashtbl.find_opt parent_map target_id) ~default:[]
620
+
in
621
+
Hashtbl.replace parent_map preview_id parents;
622
+
Hashtbl.replace parent_map target_id [ preview_id ]
623
+
| `Insert_after ->
624
+
Hashtbl.replace parent_map preview_id [ target_id ];
625
+
let children =
626
+
Option.value (Hashtbl.find_opt children_map target_id) ~default:[]
627
+
in
628
+
List.iter
629
+
(fun child_id ->
630
+
let child_parents =
631
+
Option.value (Hashtbl.find_opt parent_map child_id) ~default:[]
632
+
in
633
+
let updated =
634
+
List.map
635
+
(fun parent_id ->
636
+
if parent_id = target_id then preview_id else parent_id)
637
+
child_parents
638
+
in
639
+
Hashtbl.replace parent_map child_id updated)
640
+
children
641
+
| `Add_after ->
642
+
Hashtbl.replace parent_map preview_id [ target_id ]))
643
+
in
644
+
List.iter add_preview_for_target target_ids)
645
+
in
296
646
(* Order must follow topological log order: children appear before parents. *)
297
647
let preview_before = match mode with `Insert_after | `Add_after -> true | _ -> false in
298
648
let preview_after = match mode with `Insert_before -> true | _ -> false in
···
327
677
node
328
678
in
329
679
let nodes = List.map build_node ordered_ids in
330
-
nodes, !invalid))
680
+
nodes, !invalid))))
331
681
;;
332
682
333
683
(** Insert a preview node after the specified commit.