open Import
module Lock_dir = Dune_pkg.Lock_dir
module Solver_env = Dune_pkg.Solver_env
module Package_variable_name = Dune_lang.Package_variable_name
module Variable_value = Dune_pkg.Variable_value

let solver_env
      ~solver_env_from_current_system
      ~solver_env_from_context
      ~unset_solver_vars_from_context
  =
  let solver_env =
    [ solver_env_from_current_system; solver_env_from_context ]
    |> List.filter_opt
    |> List.fold_left ~init:Solver_env.with_defaults ~f:Solver_env.extend
  in
  match unset_solver_vars_from_context with
  | None -> solver_env
  | Some unset_solver_vars -> Solver_env.unset_multi solver_env unset_solver_vars
;;

let poll_solver_env_from_current_system () =
  Dune_pkg.Sys_poll.make ~path:(Env_path.path Stdune.Env.initial)
  |> Dune_pkg.Sys_poll.solver_env_from_current_system
;;

let get_lock_dir_from_context ~lock_dir_path =
  Memo.run
  @@
  let open Memo.O in
  let+ workspace = Workspace.workspace () in
  Workspace.find_lock_dir workspace lock_dir_path
;;

let get_solver_env_from_context ~lock_dir_path =
  let open Fiber.O in
  let+ lock_dir = get_lock_dir_from_context ~lock_dir_path in
  Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.solver_env)
;;

let get_unset_solver_vars_from_context ~lock_dir_path =
  let open Fiber.O in
  let+ lock_dir = get_lock_dir_from_context ~lock_dir_path in
  Option.bind lock_dir ~f:(fun lock_dir -> lock_dir.unset_solver_vars)
;;

let solver_env_from_system_and_context ~lock_dir_path =
  let open Fiber.O in
  let+ solver_env_from_current_system =
    poll_solver_env_from_current_system () >>| Option.some
  and+ solver_env_from_context = get_solver_env_from_context ~lock_dir_path
  and+ unset_solver_vars_from_context =
    get_unset_solver_vars_from_context ~lock_dir_path
  in
  solver_env
    ~solver_env_from_current_system
    ~solver_env_from_context
    ~unset_solver_vars_from_context
;;

module Version_preference = struct
  include Dune_pkg.Version_preference

  let term =
    let all_strings = List.map all_by_string ~f:fst in
    let doc =
      sprintf
        "Whether to prefer the newest compatible version of a package or the oldest \
         compatible version of packages while solving dependencies. This overrides any \
         setting in the current workspace. The default is %s."
        (to_string default)
    in
    let docv = String.concat ~sep:"|" all_strings |> sprintf "(%s)" in
    Arg.(
      value
      & opt (some (enum all_by_string)) None
      & info [ "version-preference" ] ~doc ~docv)
  ;;

  let choose ~from_arg ~from_context =
    match from_arg, from_context with
    | Some from_arg, _ -> from_arg
    | None, Some from_context -> from_context
    | None, None -> default
  ;;
end

let repositories_of_workspace (workspace : Workspace.t) =
  List.map workspace.repos ~f:(fun repo ->
    Dune_pkg.Pkg_workspace.Repository.name repo, repo)
  |> Dune_pkg.Pkg_workspace.Repository.Name.Map.of_list_exn
;;

let constraints_of_workspace (workspace : Workspace.t) ~lock_dir_path =
  match Workspace.find_lock_dir workspace lock_dir_path with
  | None -> []
  | Some lock_dir -> lock_dir.constraints
;;

let depopts_of_workspace (workspace : Workspace.t) ~lock_dir_path =
  match Workspace.find_lock_dir workspace lock_dir_path with
  | None -> []
  | Some lock_dir -> lock_dir.depopts |> List.map ~f:snd
;;

let repositories_of_lock_dir workspace ~lock_dir_path =
  match Workspace.find_lock_dir workspace lock_dir_path with
  | Some lock_dir -> lock_dir.repositories
  | None ->
    List.map workspace.repos ~f:(fun repo ->
      let name = Dune_pkg.Pkg_workspace.Repository.name repo in
      let loc = Loc.none in
      loc, name)
;;

let unset_solver_vars_of_workspace workspace ~lock_dir_path =
  let open Option.O in
  let* lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
  lock_dir.unset_solver_vars
;;

let get_repos repos ~repositories =
  let module Repository = Dune_pkg.Pkg_workspace.Repository in
  repositories
  |> Fiber.parallel_map ~f:(fun (loc, name) ->
    match Repository.Name.Map.find repos name with
    | None ->
      User_error.raise
        ~loc
        [ Pp.textf "Repository '%s' is not a known repository"
          @@ Repository.Name.to_string name
        ]
    | Some repo ->
      let loc, opam_url = Repository.opam_url repo in
      let module Opam_repo = Dune_pkg.Opam_repo in
      (match Dune_pkg.OpamUrl.classify opam_url loc with
       | `Git -> Opam_repo.of_git_repo loc opam_url
       | `Path path -> Fiber.return @@ Opam_repo.of_opam_repo_dir_path loc path
       | `Archive ->
         User_error.raise
           ~loc
           [ Pp.textf "Repositories stored in archives (%s) are currently unsupported"
             @@ OpamUrl.to_string opam_url
           ]))
;;

let find_local_packages =
  let open Memo.O in
  Dune_rules.Dune_load.packages ()
  >>| Package.Name.Map.map ~f:Dune_pkg.Local_package.of_package
;;

let pp_package { Lock_dir.Pkg.info = { Lock_dir.Pkg_info.name; version; avoid; _ }; _ } =
  let warn =
    if avoid
    then Pp.tag User_message.Style.Warning (Pp.text " (this version should be avoided)")
    else Pp.nop
  in
  let open Pp.O in
  Pp.verbatim
    (Package_name.to_string name ^ "." ^ Dune_pkg.Package_version.to_string version)
  ++ warn
;;

let pp_packages packages = Pp.enumerate packages ~f:pp_package

module Lock_dirs_arg = struct
  type t =
    | All
    | Selected of Path.Source.t list

  let all = All

  let term =
    Common.one_of
      (let+ arg =
         Arg.(
           value
           & pos_all string []
           & info
               []
               ~docv:"LOCKDIRS"
               ~doc:
                 "Lock directories to check for outdated packages. Defaults to dune.lock.")
       in
       Selected (List.map arg ~f:Path.Source.of_string))
      (let+ _all =
         Arg.(
           value
           & flag
           & info
               [ "all" ]
               ~doc:"Check all lock directories in the workspace for outdated packages.")
       in
       All)
  ;;

  let lock_dirs_of_workspace t (workspace : Workspace.t) =
    let workspace_lock_dirs =
      Lock_dir.default_path
      :: List.map workspace.lock_dirs ~f:(fun (lock_dir : Workspace.Lock_dir.t) ->
        lock_dir.path)
      |> Path.Source.Set.of_list
      |> Path.Source.Set.to_list
    in
    match t with
    | All -> workspace_lock_dirs
    | Selected [] -> [ Lock_dir.default_path ]
    | Selected chosen_lock_dirs ->
      let workspace_lock_dirs_set = Path.Source.Set.of_list workspace_lock_dirs in
      let chosen_lock_dirs_set = Path.Source.Set.of_list chosen_lock_dirs in
      if Path.Source.Set.is_subset chosen_lock_dirs_set ~of_:workspace_lock_dirs_set
      then chosen_lock_dirs
      else (
        let unknown_lock_dirs =
          Path.Source.Set.diff chosen_lock_dirs_set workspace_lock_dirs_set
          |> Path.Source.Set.to_list
        in
        let f x = Path.pp (Path.source x) in
        User_error.raise
          [ Pp.text
              "The following directories are not lock directories in this workspace:"
          ; Pp.enumerate unknown_lock_dirs ~f
          ; Pp.text "This workspace contains the following lock directories:"
          ; Pp.enumerate workspace_lock_dirs ~f
          ])
  ;;
end