(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) 2012 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) ;;

let binwithoutsrc ?(reqsrcarchall=false) ?(allowmismatch=false) universe bl =
  List.filter (fun binpkg ->
    try
      ignore (BootstrapCommon.get_src_package ~allowmismatch universe binpkg);
      false
    with Sources.NotfoundSrc ->
      (* Source for this package was not found. But if this package is not
       * arch:all or reqsrcarchall is true, then we don't care. *)
      (BootstrapCommon.pkg_is_not_arch_all binpkg) || reqsrcarchall
  ) bl
;;

let srcwithoutbin ?(addsrcarchall=false) ?(allowmismatch=false) universe bl sl =
  let h = CudfAdd.Cudf_hashtbl.create (Cudf.universe_size universe) in
  List.iter (fun binpkg ->
    (* if the binary package is not arch:all or if addsrcarchall is true, then
     * try to retrieve the source package for this binary package *)
    if (BootstrapCommon.pkg_is_not_arch_all binpkg) || addsrcarchall then begin
      try
        let srcpkg = BootstrapCommon.get_src_package ~allowmismatch universe binpkg in
        CudfAdd.Cudf_hashtbl.replace h srcpkg ()
      with Sources.NotfoundSrc -> ()
    end
  ) bl;
  List.filter (fun srcpkg -> not (CudfAdd.Cudf_hashtbl.mem h srcpkg)) sl
;;

let listminus l1 l2 =
  CudfAdd.Cudf_set.elements (CudfAdd.Cudf_set.diff (CudfAdd.to_set l1) (CudfAdd.to_set l2))
;;

let maxclosure ?(reqsrcarchall=false) ?(addsrcarchall=false) ?(allowmismatch=false) bl sl =
  (* first, remove uninstallable ones and those without partner, then alternate between both *)
  (* the algo also works with only recursively calling "aux" but is twice as
     fast when alternating between aux1 and aux2 instead *)
  let rec aux (notinstacc, notcompacc, nobinacc, nosrcacc) bl sl =
    info "called aux with %d %d %d %d" (CudfAdd.Cudf_set.cardinal notinstacc) (CudfAdd.Cudf_set.cardinal notcompacc) (CudfAdd.Cudf_set.cardinal nobinacc) (CudfAdd.Cudf_set.cardinal nosrcacc);
    let universe = Cudf.load_universe (bl@sl) in
  
    (* find binary packages that can't be installed *)
    let notinst = Depsolver.find_listbroken universe bl in
    (* find source packages that can't be compiled *)
    let notcomp = Depsolver.find_listbroken universe sl in
    (* find source packages without binary packages *)
    let nobin = srcwithoutbin ~addsrcarchall ~allowmismatch universe bl sl in
    (* find binary packages without source packages *)
    let nosrc = binwithoutsrc ~reqsrcarchall ~allowmismatch universe bl in
  
    match (notinst,notcomp,nobin,nosrc) with
      | [],[],[],[] -> notinstacc, notcompacc, nobinacc, nosrcacc, bl
      | _ -> begin
          let bl = listminus bl (notinst@nosrc) in
          let sl = listminus sl (notcomp@nobin) in
          let notinstacc = CudfAdd.Cudf_set.union notinstacc (CudfAdd.to_set notinst) in
          let notcompacc = CudfAdd.Cudf_set.union notcompacc (CudfAdd.to_set notcomp) in
          let nobinacc = CudfAdd.Cudf_set.union nobinacc (CudfAdd.to_set nobin) in
          let nosrcacc = CudfAdd.Cudf_set.union nosrcacc (CudfAdd.to_set nosrc) in
          debug "%d %d %d %d" (List.length notinst) (List.length notcomp) (List.length nobin) (List.length nosrc);
          aux2 (notinstacc, notcompacc, nobinacc, nosrcacc) bl sl
        end
  and aux1 (notinstacc, notcompacc, nobinacc, nosrcacc) bl sl =
    info "called aux1 with %d %d %d %d" (CudfAdd.Cudf_set.cardinal notinstacc) (CudfAdd.Cudf_set.cardinal notcompacc) (CudfAdd.Cudf_set.cardinal nobinacc) (CudfAdd.Cudf_set.cardinal nosrcacc);
    let universe = Cudf.load_universe (bl@sl) in
  
    (* find binary packages that can't be installed *)
    let notinst = Depsolver.find_listbroken universe bl in
    (* find source packages that can't be compiled *)
    let notcomp = Depsolver.find_listbroken universe sl in

    match (notinst,notcomp) with
      | [],[] -> notinstacc, notcompacc, nobinacc, nosrcacc, bl
      | _ -> begin
          let bl = listminus bl notinst in
          let sl = listminus sl notcomp in
          let notinstacc = CudfAdd.Cudf_set.union notinstacc (CudfAdd.to_set notinst) in
          let notcompacc = CudfAdd.Cudf_set.union notcompacc (CudfAdd.to_set notcomp) in
          debug "%d %d" (List.length notinst) (List.length notcomp);
          aux2 (notinstacc, notcompacc, nobinacc, nosrcacc) bl sl
        end
  and aux2 (notinstacc, notcompacc, nobinacc, nosrcacc) bl sl =
    info "called aux2 with %d %d %d %d" (CudfAdd.Cudf_set.cardinal notinstacc) (CudfAdd.Cudf_set.cardinal notcompacc) (CudfAdd.Cudf_set.cardinal nobinacc) (CudfAdd.Cudf_set.cardinal nosrcacc);
    let universe = Cudf.load_universe (bl@sl) in
  
    (* find source packages without binary packages *)
    let nobin = srcwithoutbin ~addsrcarchall ~allowmismatch universe bl sl in
    (* find binary packages without source packages *)
    let nosrc = binwithoutsrc ~reqsrcarchall ~allowmismatch universe bl in
  
    match (nobin,nosrc) with
      | [],[] -> notinstacc, notcompacc, nobinacc, nosrcacc, bl
      | _ -> begin
          let bl = listminus bl nosrc in
          let sl = listminus sl nobin in
          let nobinacc = CudfAdd.Cudf_set.union nobinacc (CudfAdd.to_set nobin) in
          let nosrcacc = CudfAdd.Cudf_set.union nosrcacc (CudfAdd.to_set nosrc) in
          debug "%d %d" (List.length nobin) (List.length nosrc);
          aux1 (notinstacc, notcompacc, nobinacc, nosrcacc) bl sl
        end
  in
  let e = CudfAdd.Cudf_set.empty in
  aux (e,e,e,e) bl sl
;;

module Options = struct
  open OptParse
  let description = (
    "given a repository of binary packages and source packages, clean up that "^
    "repository by removing packages that can't be compiled or installed and "^
    "packages which don't have an associated binary or source package and "^
    "packages which do not match the specified architecture."
  )
  let usage = "%prog [options] Packages Sources"

  let options = OptParser.make ~description ~usage
  include BootstrapCommon.MakeOptions(struct let options = options end)

  let reqsrcarchall = StdOpt.store_true ()
  let addsrcarchall = 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:"reqsrcarchall" ~help:"require source packages for arch:all binary packages" reqsrcarchall;
  add options ~group:prog_group ~long_name:"addsrcarchall" ~help:"add source packages which only build arch:all binary packages" addsrcarchall;
  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);
  Util.Warning.disable "Sources";

  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 reqsrcarchall = OptParse.Opt.get Options.reqsrcarchall in
  let addsrcarchall = OptParse.Opt.get Options.addsrcarchall in
  let noindep = OptParse.Opt.get Options.noindep in
  let allowmismatch = 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

  (* save mappings from cudf packages to binary packages *)
  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 notinst, notcomp, nobin, nosrc, bl = maxclosure ~reqsrcarchall ~addsrcarchall ~allowmismatch bl sl in

  debug "not installable: %s" (BootstrapCommon.string_of_list BootstrapCommon.string_of_package " " (CudfAdd.Cudf_set.elements notinst));
  debug "not compilable: %s" (BootstrapCommon.string_of_list BootstrapCommon.string_of_package " " (CudfAdd.Cudf_set.elements notcomp));
  debug "source without binary: %s" (BootstrapCommon.string_of_list BootstrapCommon.string_of_package " " (CudfAdd.Cudf_set.elements nobin));
  debug "binary without source: %s" (BootstrapCommon.string_of_list BootstrapCommon.string_of_package " " (CudfAdd.Cudf_set.elements nosrc));
  info "not installable: %d" (CudfAdd.Cudf_set.cardinal notinst);
  info "not compilable: %d" (CudfAdd.Cudf_set.cardinal notcomp);
  info "source without binary: %d" (CudfAdd.Cudf_set.cardinal nobin);
  info "binary without source: %d" (CudfAdd.Cudf_set.cardinal nosrc);

  let oc =
    if OptParse.Opt.is_set Options.outfile then
      open_out (OptParse.Opt.get Options.outfile)
    else
      stdout
  in

  (* for each binary package, get the associated format822 stanza and print it
   * to stdout *)
  match bl with
    | [] -> failwith "no binary package remains compilable"
    | _ -> begin
        List.iter (fun p ->
          let arch =
            try Some (Cudf.lookup_package_property p "architecture")
            with Not_found -> None
          in
          let id = (p.Cudf.package, p.Cudf.version, arch) in
          let b = Hashtbl.find cudftobin_table id in
          Debian.Printer.pp_package oc b;
          output_char oc '\n';
        ) (BootstrapCommon.pkg_sort bl);
    end;

  close_out oc;
;;

main ();;
