(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) 2012-2014 Johannes 'josch' Schauer <j.schauer@email.de> *)
(*  Copyright (C) 2012      Pietro Abate <pietro.abate@pps.jussieu.fr>    *)
(*                                                                        *)
(*  This library is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Lesser General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version.  A special linking    *)
(*  exception to the GNU Lesser General Public License applies to this    *)
(*  library, see the COPYING file for more information.                   *)
(**************************************************************************)

open ExtLib
open Common
open Debian
open Algo
open DoseparseNoRpm

include Util.Logging(struct let label = __FILE__ end) ;;

module Options = struct
  open OptParse
  let description = (
    "remove all conflicts and calculate an optimal self-contained universe"
  )
  let usage = "%prog Packages... Sources"
  let options = OptParser.make ~description ~usage
  include BootstrapCommon.MakeOptions(struct let options = options end)

  let addarchall = StdOpt.store_true ()
  let noindep = StdOpt.store_false ()
  let allowsrcmismatch = StdOpt.store_true ()

  open OptParser

  let prog_group = add_group options "Program specific options" in

  add options ~group:prog_group ~long_name:"all" ~help:"also add source packages for Architecture:all packages" addarchall;
  add options ~group:prog_group ~long_name:"keep-indep" ~help:"Do not drop Build-Depends-Indep dependencies" noindep;
  add options ~group:prog_group
    ~long_name:"allowsrcmismatch"
    ~help:("If a binary package is "^
           "without a source package but there is a source package of same name but "^
           "different version, match this binary package to that source package.") allowsrcmismatch;

  include StdOptions.InputOptions;;
  let default = List.filter (fun e -> not (List.mem e ["checkonly";"latest";"fg";"bg"])) StdOptions.InputOptions.default_options in
  StdOptions.InputOptions.add_options ~default options;;

  include StdOptions.DistribOptions;;
  let default = List.filter (fun e -> not (List.mem e ["deb-ignore-essential"; "inputtype"])) StdOptions.DistribOptions.default_options in
  StdOptions.DistribOptions.add_options ~default options;;
end

let main () =
  let posargs = OptParse.OptParser.parse_argv Options.options in
  StdDebug.enable_debug (OptParse.Opt.get Options.verbose);
  StdDebug.all_quiet (OptParse.Opt.get Options.quiet);

  let options = Options.set_deb_options () in
  let buildarch = Option.get options.Debian.Debcudf.native in
  let hostarch = match options.Debian.Debcudf.host with None -> "" | Some s -> s in
  let foreignarchs = options.Debian.Debcudf.foreign in
  let addarchall = OptParse.Opt.get Options.addarchall in
  let noindep = OptParse.Opt.get Options.noindep in
  let allowsrcmismatch = OptParse.Opt.get Options.allowsrcmismatch in

  let binlist, (fgsrclist, bgsrclist), _ = BootstrapCommon.parse_packages ~noindep Options.parse_cmdline buildarch hostarch foreignarchs posargs in
  let srclist = fgsrclist @ bgsrclist in
  let tables = Debian.Debcudf.init_tables (srclist@binlist) in
  let sl = List.map (Debian.Debcudf.tocudf ~options tables) srclist in
  let bl = List.map (Debian.Debcudf.tocudf ~options tables) binlist in

  let bl =
    if OptParse.Opt.get Options.latest then
      CudfAdd.latest bl
    else
      bl
  in

  (* create a hashtable mapping cudf package name,version,arch tuples to
   * Packages.package format822 stanzas *)
  let cudftobin_table = Hashtbl.create 30000 in
  List.iter2 (fun cudfpkg -> fun binpkg ->
      let arch =
        try Some (Cudf.lookup_package_property cudfpkg "architecture")
        with Not_found -> None
      in
      let id = (cudfpkg.Cudf.package, cudfpkg.Cudf.version, arch) in
      Hashtbl.add cudftobin_table id binpkg
    ) bl binlist;

  let universe = Cudf.load_universe (bl@sl) in

  info "creating conflict free universe..."; (* pun intended *)

  let newsl = List.map (fun srcpkg ->
      let issource = ("issource",`Int 1) in
      { srcpkg with Cudf.conflicts = [];
                    Cudf.pkg_extra = issource :: srcpkg.Cudf.pkg_extra;
                    (* FIXME: source package provides have to be versioned - this should be fixed in dose3:
                            *https://gforge.inria.fr/tracker/?func=detail&group_id=4395&atid=13808&aid=17556 *)
                    Cudf.provides = [(srcpkg.Cudf.package, Some (`Eq, srcpkg.Cudf.version))] }
    ) sl in

  let essential = [] in
  let newbl = List.map (fun binpkg ->
      if (not addarchall) && (BootstrapCommon.pkg_is_arch_all binpkg) then
        (* do not connect arch:all packages to source packages *)
        { binpkg with Cudf.conflicts = []; }
      else begin
        (* get the source package for the non-arch:all binary package *)
        let srcpkg = try BootstrapCommon.get_src_package ~allowmismatch:allowsrcmismatch universe binpkg
          with Sources.NotfoundSrc ->
            failwith (Printf.sprintf "cannot find source for binary package %s" (CudfAdd.string_of_package binpkg))
        in
        (* connect to source package as "builds-from" *)
        let srcdep = (srcpkg.Cudf.package,Some(`Eq,srcpkg.Cudf.version)) in
        { binpkg with Cudf.conflicts = [];
                      Cudf.depends = [srcdep] :: binpkg.Cudf.depends }
      end
    ) bl in

  let newuniverse = Cudf.load_universe(newsl@newbl) in
  info "solving...";

  let preamble = Debcudf.preamble in
  let preamble = CudfAdd.add_properties preamble [("issource",(`Int (Some 0)))] in
  (* any source package that builds part of the minimal builds system will draw in everything else *)
  let essential = List.map
      (fun pkg -> (pkg.Cudf.package, Some (`Eq, pkg.Cudf.version)))
      (CudfAdd.latest (Cudf.get_packages ?filter:(Some (fun pkg ->
           pkg.keep = `Keep_package )) universe))
  in
  let request = { Cudf.default_request
                  with Cudf.request_id = "";
                       Cudf.install = essential } in
  let criteria = "-sum(solution,issource)" in
  let cmd = "aspcud $in $out $pref" in
  let r = Depsolver.check_request ~cmd ~criteria (preamble,newuniverse,request) in

  info "writing output...";
  let oc =
    if OptParse.Opt.is_set Options.outfile then
      open_out (OptParse.Opt.get Options.outfile)
    else
      stdout
  in
  begin match r with
    |Algo.Depsolver.Error s -> fatal "%s" s
    |Algo.Depsolver.Unsat _ -> fatal "(UNSAT) No Solutions according to the given preferences"
    |Algo.Depsolver.Sat (_,soluniv) ->
      (* print out all selected binary packages *)
      Cudf.iter_packages (fun pkg ->
          let is_src = try (Cudf.lookup_package_property pkg "type") = "src"
            with Not_found -> false
          in
          if not is_src then begin
            let arch =
              try Some (Cudf.lookup_package_property pkg "architecture")
              with Not_found -> None
            in
            let id = (pkg.Cudf.package, pkg.Cudf.version, arch) in
            let b = Hashtbl.find cudftobin_table id in
            Debian.Printer.pp_package oc b;
            output_char oc '\n';
          end
        ) soluniv
  end;
  close_out oc;
;;

main ();;
