(**************************************************************************)
(*                                                                        *)
(*  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 Dose_common
open Dose_debian
open Dose_algo
open Dose_doseparse

#define __label __FILE__
let label =  __label ;;
include Util.Logging(struct let label = label 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 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:"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 ["compare";"checkonly";"latest";"inputtype"])) StdOptions.InputOptions.default_options in
  StdOptions.InputOptions.add_options ~default options;;

  include StdOptions.OutputOptions;;
  let default = List.filter (fun e -> not (List.mem e ["outdir"; "dot"])) StdOptions.OutputOptions.default_options in
  StdOptions.OutputOptions.add_options ~default options;;

  include StdOptions.DistribOptions;;
  let default = List.filter (fun e -> not (List.mem e ["deb-profiles"; "deb-ignore-essential"; "deb-builds-from"])) StdOptions.DistribOptions.default_options in
  StdOptions.DistribOptions.add_debian_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.Debcudf.native in
  let hostarch = match options.Debcudf.host with None -> "" | Some s -> s in
  let foreignarchs = options.Debcudf.foreign in
  let addarchall = OptParse.Opt.get Options.addarchall in
  let noindep = options.Debcudf.drop_bd_indep 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 tables = Debcudf.init_tables (fgsrclist@bgsrclist@binlist) in
  let fgsl = List.map (Debcudf.tocudf ?inst:None ~options tables) fgsrclist in
  let bgsl = List.map (Debcudf.tocudf ?inst:None ~options tables) bgsrclist in
  let bl = List.map (Debcudf.tocudf ?inst:None ~options tables) binlist 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 id = (cudfpkg.Cudf.package, cudfpkg.Cudf.version) in
      Hashtbl.add cudftobin_table id binpkg
    ) bl binlist;

  let universe = Cudf.load_universe (BootstrapCommon.unique [bl;fgsl;bgsl]) in

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

  let prepare_cudf_sources = 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))] }
    ) in
  let fgsl = prepare_cudf_sources fgsl in
  let bgsl = prepare_cudf_sources bgsl 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"
                        (BootstrapCommon.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 universe = Cudf.load_universe(BootstrapCommon.unique [fgsl;bgsl;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 to_install = List.map
      (fun pkg -> (pkg.Cudf.package, Some (`Eq, pkg.Cudf.version))) fgsl
  in

  let request = { Cudf.default_request
                  with Cudf.request_id = "";
                       Cudf.install = to_install } in
  let criteria = "-sum(solution,issource)" in
  let cmd = "aspcud $in $out $pref" in
  let dummy = { Depsolver.dummy_request with
                Cudf.depends =
                  List.map (fun (_,pkglist) ->
                      List.map (fun pkg ->
                          (pkg.Cudf.package,Some(`Eq,pkg.Cudf.version))
                        ) pkglist
                    ) (Debcudf.get_essential tables) }
  in
  let r = Depsolver.check_request ~dummy ~cmd ~criteria (preamble,universe,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
    |Depsolver.Error s -> fatal "%s" s
    |Depsolver.Unsat _ -> fatal "(UNSAT) No Solutions according to the given preferences"
    |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 id = (pkg.Cudf.package, pkg.Cudf.version) in
            let b = Hashtbl.find cudftobin_table id in
            b#pp oc;
          end
        ) soluniv
  end;
  close_out oc;
;;

main ();;
