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))
;;

let show_corrected_contents files_to_promote =
  let open Fiber.O in
  let files = Diff_promotion.load_db () |> Diff_promotion.filter_db files_to_promote in
  let+ () = Fiber.return () in
  List.iter files ~f:(fun file ->
    let correction_file = Diff_promotion.File.correction_file file in
    if Path.exists correction_file
    then (
      let contents = Io.read_file correction_file in
      Console.printf "%s" contents)
    else
      User_warning.emit
        [ Pp.textf
            "Corrected file does not exist for %s."
            (Diff_promotion.File.source file |> Path.Source.to_string_maybe_quoted)
        ])
;;

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 =
      (* CR-someday Alizter: document this option *)
      Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE" ~doc:None)
    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_without_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 ->
      Scheduler.go_without_rpc_server ~common ~config (fun () ->
        let open Fiber.O in
        Rpc.Rpc_common.fire_request
          ~name:"promote_many"
          ~wait:true
          ~lock_held_by
          builder
          Dune_rpc_private.Procedures.Public.promote_many
          files_to_promote
        >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:true)
  ;;

  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 =
      (* CR-someday Alizter: document this option *)
      Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE" ~doc:None)
    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 =
      (* CR-someday Alizter: document this option *)
      Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE" ~doc:None)
    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

module Show = struct
  let info = Cmd.info ~doc:"Display contents of a corrected file" "show"

  let term =
    let+ builder = Common.Builder.term
    and+ files =
      Arg.(value & pos_all Cmdliner.Arg.file [] & info [] ~docv:"FILE" ~doc:None)
    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 () ->
      show_corrected_contents 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; Show.command ]

let promote =
  command_alias ~orig_name:"promotion apply" Apply.command Apply.term "promote"
;;
