118 lines
3.7 KiB
OCaml
118 lines
3.7 KiB
OCaml
open Import
|
|
module Diff_promotion = Promote.Diff_promotion
|
|
|
|
let files_to_promote ~common files : Dune_rpc.Files_to_promote.t =
|
|
match files with
|
|
| [] -> All
|
|
| _ ->
|
|
let files =
|
|
List.map files ~f:(fun fn -> Path.Source.of_string (Common.prefix_target common fn))
|
|
in
|
|
let on_missing fn =
|
|
User_warning.emit
|
|
[ Pp.textf "Nothing to promote for %s." (Path.Source.to_string_maybe_quoted fn) ]
|
|
in
|
|
These (files, on_missing)
|
|
;;
|
|
|
|
let display_files files_to_promote =
|
|
let open Fiber.O in
|
|
Diff_promotion.load_db ()
|
|
|> Diff_promotion.filter_db files_to_promote
|
|
|> Fiber.parallel_map ~f:(fun file ->
|
|
Diff_promotion.diff_for_file file
|
|
>>| function
|
|
| Ok _ -> Some file
|
|
| Error _ -> None)
|
|
>>| List.filter_opt
|
|
>>| List.sort ~compare:(fun file file' -> Diff_promotion.File.compare file file')
|
|
>>| List.iter ~f:(fun (file : Diff_promotion.File.t) ->
|
|
Console.printf "%s" (Diff_promotion.File.source file |> Path.Source.to_string))
|
|
;;
|
|
|
|
module Apply = struct
|
|
let info =
|
|
let doc = "Promote files from the last run" in
|
|
let man =
|
|
[ `S Cmdliner.Manpage.s_description
|
|
; `P
|
|
{|Considering all actions of the form $(b,(diff a b)) that failed
|
|
in the last run of dune, $(b,dune promotion apply) does the following:
|
|
|
|
If $(b,a) is present in the source tree but $(b,b) isn't, $(b,b) is
|
|
copied over to $(b,a) in the source tree. The idea behind this is that
|
|
you might use $(b,(diff file.expected file.generated)) and then call
|
|
$(b,dune promote) to promote the generated file.
|
|
|}
|
|
; `Blocks Common.help_secs
|
|
]
|
|
in
|
|
Cmd.info ~doc ~man "apply"
|
|
;;
|
|
|
|
let term =
|
|
let+ builder = Common.Builder.term
|
|
and+ files = Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") in
|
|
let common, config = Common.init builder in
|
|
let files_to_promote = files_to_promote ~common files in
|
|
match Dune_util.Global_lock.lock ~timeout:None with
|
|
| Ok () ->
|
|
Scheduler.go_with_rpc_server ~common ~config (fun () ->
|
|
let open Fiber.O in
|
|
let+ () = Fiber.return () in
|
|
Diff_promotion.promote_files_registered_in_last_run files_to_promote)
|
|
| Error lock_held_by ->
|
|
Rpc_common.run_via_rpc
|
|
~builder
|
|
~common
|
|
~config
|
|
lock_held_by
|
|
(Rpc_common.fire_request
|
|
~name:"promote_many"
|
|
~wait:true
|
|
Dune_rpc_private.Procedures.Public.promote_many)
|
|
files_to_promote
|
|
;;
|
|
|
|
let command = Cmd.v info term
|
|
end
|
|
|
|
module Diff = struct
|
|
let info = Cmd.info ~doc:"List promotions to be applied" "diff"
|
|
|
|
let term =
|
|
let+ builder = Common.Builder.term
|
|
and+ files = Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") in
|
|
let common, config = Common.init builder in
|
|
let files_to_promote = files_to_promote ~common files in
|
|
Scheduler.go_with_rpc_server ~common ~config (fun () ->
|
|
Diff_promotion.display files_to_promote)
|
|
;;
|
|
|
|
let command = Cmd.v info term
|
|
end
|
|
|
|
module Files = struct
|
|
let info = Cmd.info ~doc:"List promotions files" "list"
|
|
|
|
let term =
|
|
let+ builder = Common.Builder.term
|
|
and+ files = Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE") in
|
|
let common, config = Common.init builder in
|
|
let files_to_promote = files_to_promote ~common files in
|
|
Scheduler.go_with_rpc_server ~common ~config (fun () ->
|
|
display_files files_to_promote)
|
|
;;
|
|
|
|
let command = Cmd.v info term
|
|
end
|
|
|
|
let info =
|
|
Cmd.info ~doc:"Control how changes are propagated back to source code." "promotion"
|
|
;;
|
|
|
|
let group = Cmd.group info [ Files.command; Apply.command; Diff.command ]
|
|
|
|
let promote =
|
|
command_alias ~orig_name:"promotion apply" Apply.command Apply.term "promote"
|
|
;;
|