(**************************************************************************)
(*                                                                        *)
(*  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

module StringSet = BootstrapCommon.StringSet

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

(* given a list of source packages, return a tuple of two sets.
 * the first set contains the source packages that were compilable and the
 * second set contains the union of the binary packages that were chosen as
 * their installation set *)
(* TODO: allow to modify selected installation set *)
let compute_is ?(global_constraints=true) universe l err =
  let module Set = CudfAdd.Cudf_set in
  let accsrc = ref Set.empty in
  let accbin = ref Set.empty in
  (* we build a set of error strings because compute_is might be called
   * multiple times with the same packages, therefore throwing the same error
   * multiple times *)
  let callback = function
    | {Diagnostic.result = Diagnostic.Success f;
                 request = Diagnostic.Package pkg } -> begin
        let l = CudfAdd.to_set (f ~all:true ()) in
        let l = Set.remove pkg l in
        accbin := Set.union !accbin l;
        accsrc := Set.add pkg !accsrc
    end
    | { Diagnostic.request = Diagnostic.Package pkg } as res ->
        let buf = Buffer.create 512 in
        let fmt = Format.make_formatter (Buffer.add_substring buf) ignore in
        Diagnostic.fprintf ~explain:true ~failure:true fmt res;
        Hashtbl.replace err pkg (Buffer.contents buf);
    | _ -> ()
  in
  ignore(Depsolver.listcheck ~global_constraints ~callback universe l);
  (!accsrc,!accbin)
;;

(* given a set of binary packages, return the set of source packages they build
 * from*)
let srcset ?(allowmismatch=false) universe binset =
  let module Set = CudfAdd.Cudf_set in
  Set.fold (fun pkg acc ->
    if (BootstrapCommon.pkg_is_not_arch_all pkg) then begin
      let src = try BootstrapCommon.get_src_package ~allowmismatch universe pkg
      with Sources.NotfoundSrc -> failwith (Printf.sprintf "can't find source package for binary package %s" (CudfAdd.string_of_package pkg)) in
      Set.add src acc
    end else acc
  ) binset Set.empty
;;

(*
   given an empty universe and a set of source packages, add those
   binary packages to the universe that are needed to compile the set of
   source packages. Then add to the set of source packages those from
   which the additional binary packages build from. Add those binary
   packages that are needed to compile the additional source packages.
   Repeat until all binary packages are buildable from the list of
   source packages and all source packages are buildable using the
   binary packages.
*)
let build_closure ?(allowmismatch=false) universe minimalsys tocompile =
  let module Set = CudfAdd.Cudf_set in

  let rec aux (binuniv,compiled) tocompile err =
    info "aux called with:";
    info "# binuniv: %d" (Set.cardinal binuniv);
    info "# compiled: %d" (Set.cardinal compiled);
    info "# tocompil: %d" (Set.cardinal compiled);
    (* compute_is returns the list of all installation set of all
     * source packages in 'tocompile' that is possible to compile *)
    (* for this computation, global_constraints must be true in case minimalsys
     * doesnt contain all essential:yes packages *)
    match compute_is ~global_constraints:true universe (Set.elements tocompile) err with
    |(s,_) when (Set.is_empty s) ->
        Hashtbl.iter (fun p e -> warning "Package %s cannot be compiled:\n%s" (CudfAdd.string_of_package p) e) err;
        (binuniv,compiled)
        (* ns is the list of installable source, nb is the union of
           all installation sets nb = \big_cup_{s \in ns} IS(s) *)
    |(ns,nb) ->
        (* B_{i+1} = B_i \cup NB *)
        let newbinset = Set.union binuniv nb in

        (* C_{i+1} = C_i \cup NS *)
        let newcompiled = Set.union compiled ns in

        (* NS = Src(NB) \ C_{i+1} *)
        let newtocompile = Set.diff (srcset ~allowmismatch universe nb) newcompiled in

        aux (newbinset,newcompiled) newtocompile err
  in

  aux (minimalsys,Set.empty) tocompile (Hashtbl.create (Set.cardinal tocompile))
;;

module Options = struct
  open OptParse
  let description = (
    "Given a list of source packages (InitSources), return the list of binary"^
    "packages of a self-contained repository which is created starting from"^
    "those source packages."
  )
  let usage = "%prog [options] --minimal=minimal --bg Sources Packages... InitSources"

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

  let minimalsys = StdOpt.str_option ()
  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 ~short_name:'m' ~long_name:"minimal" ~help:"Minimal Build System - must be a coinstallation set" minimalsys;
  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"])) 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 hostarch = match options.Debian.Debcudf.host with None -> "" | Some s -> s in
  let buildarch = Option.get options.Debian.Debcudf.native in
  let foreignarchs = options.Debian.Debcudf.foreign 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 tables = Debian.Debcudf.init_tables (fgsrclist@bgsrclist@binlist) in
  let fgsl = List.map (Debian.Debcudf.tocudf ~options tables) fgsrclist in
  let bgsl = List.map (Debian.Debcudf.tocudf ~options tables) bgsrclist in
  let bl = List.map (Debian.Debcudf.tocudf ~options tables) binlist in

  (* create a hashtable associating cudf name,version,architecture 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 pkglist = BootstrapCommon.unique [fgsl;bgsl;bl] in

  (* read package list for minimal build system *)
  let minimalsys =
    if OptParse.Opt.is_set Options.minimalsys then
      BootstrapCommon.read_package_file ~archs:(buildarch::hostarch::foreignarchs) (Debcudf.tocudf ~options tables) (OptParse.Opt.get Options.minimalsys)
    else CudfAdd.Cudf_set.empty
  in

  (* test if all packages in the minimal system are installable (it must be a
   * coinstallation set, otherwise it can't be guaranteed that all essential
   * packages are installable by the output of this program) *)
  if not (CudfAdd.Cudf_set.is_empty minimalsys) then begin
    let universe = Cudf.load_universe (CudfAdd.Cudf_set.elements minimalsys) in
    let broken = Depsolver.find_broken ~global_constraints:true universe in
    if List.length broken > 0 then
      fatal "not all binary packages in the minimal system are installable: %s" (BootstrapCommon.string_of_pkglist broken)
  end;

  let universe = Cudf.load_universe pkglist in

  let tocompile = CudfAdd.to_set fgsl in

  let (bin,_) = build_closure ~allowmismatch:allowsrcmismatch universe minimalsys tocompile in

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

  (* for each binary package that was returned by the build-closure algorithm,
   * print its associated format822 stanza to stdout *)
  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 (CudfAdd.Cudf_set.elements bin));

  close_out oc;
;;

main ();;
