let build_sublist_of_targets ~client ~list_name ~all_log ~go_verb ~filter =
Ketrew_client.all_targets client
>>| List.filter ~f:(fun target -> filter target)
>>| sort_target_list
>>= fun all_targets ->
let to_process = ref [] in
let all_valid_targets () =
List.filter all_targets ~f:(fun target ->
not (List.exists !to_process ~f:(fun id -> id = Target.id target)))
in
let target_menu () =
List.map (all_valid_targets ()) ~f:(fun t ->
menu_item
~log:Log.(s "Add: " % Document.target_for_menu t)
(`Add (Target.id t)))
in
let rec loop () =
let all_valid_ids = all_valid_targets () |> List.map ~f:Target.id in
let always_there =
let go =
if !to_process = [] then []
else
let log = Log.(s "Go; " % if_color bold_red go_verb % s " the "
% (match !to_process with
| [one] -> s "target"
| more -> i (List.length more) % s " targets")) in
[menu_item ~char:'G' ~log `Done]
in
go @ [ menu_item ~char:'q' ~log:Log.(s "Cancel") `Cancel ]
@ (if all_valid_ids = [] then []
else [ menu_item ~char:'A' ~log:all_log `All; ])
in
let sentence =
if all_valid_ids = [] then Log.(s "Nothing to " % go_verb)
else Log.(s "Add targets to “" % s list_name % s "”") in
menu ~sentence ~always_there (target_menu ())
>>= function
| `Add id -> to_process := id :: !to_process; loop ()
| `All -> to_process := all_valid_ids @ !to_process; loop ()
| `Cancel -> return `Cancel
| `Done -> return (`Go !to_process)
in
loop ()