(* Copyright 2005-2008 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER.

This file is part of Dose2.

Dose2 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.

Dose2 is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>. *)

open Napkin
open Rapids
module R = Rapids
module DBI = Dosebase.In
;;

type waterway = File of string | Directory of string | Dose of string
type specification = (liquid * waterway) list
;;

(*** specification_of_string *)
let specification_of_string u =
  let sl = Util.split_at ',' u in
  List.map
    begin fun v ->
      let (lq,fn) = Util.split_once_at ((=) ':') v in
      match lq with
      | "dose"    -> let tp = DBI.get_type (DBI.open_in fn) in 
				(match tp with
					"debian" -> (Debian, Dose fn)
				| "rpm" -> (RPM, Dose fn)
				| "pkgsrc" -> (Pkgsrc, Dose fn)
				| f -> invalid_arg (Printf.sprintf "Unknown dosebase type %s\n" f))
      | "deb"     -> (Debian, File fn)
      | "rpm"     -> (RPM, File fn)
			| "ps"      -> (Pkgsrc, File fn)
      | _         -> invalid_arg (Printf.sprintf "Bad waterway specification %S" lq)
    end
    sl
;;
(* ***)
(*** mode_of_specification *)
let mode_of_specification sl =
  let mode = ref None in
  List.iter
    begin fun (lq, _) ->
      match (lq, !mode) with
      | (Debian, (None|Some Debian)) -> mode := Some Debian
      | (RPM,    (None|Some RPM)) -> mode := Some RPM
      | (Pkgsrc, (None|Some Pkgsrc)) -> mode := Some Pkgsrc
      | (_,_) -> invalid_arg "Different package types do not mix"
    end
    sl;
  !mode
;;
(* ***)
(*** load_from_dosebase *)
(* load_from_dosebase ignores overlay, because packages are in archives
 * anyway *)
let load_from_dosebase db (progress : Progress.indicator) ~(overlay: bool) base =
  let dbi = DBI.open_in base in
  let lifetimes = ref [] in
	let pop = DBI.count_population dbi in
  let count = ref 0 in
  DBI.iter
    ~package:
      begin fun ~unit_name ~version ~architecture package ->
        incr count;
        progress#display (!count,pop);
        let nk = Dosebase.napkin_of_fields (DBI.get_field_first dbi package) in
        ignore (add_package db nk)
      end
    ~lifetime:
      begin fun ~archive ~unit_name ~version ~architecture lifetime ->
        lifetimes := (unit_name, version, architecture, archive, lifetime) :: !lifetimes
      end
    dbi;
  let unit_index = get_unit_index db in
  let architecture_index = get_architecture_index db in
  let version_index = get_version_index db in
	let release_index = get_release_index db in
  let package_index = get_package_index db in
  List.iter
    begin fun (unit_name, version, architecture, archive_name, lifetime) ->
      let unit_id          = Unit_index.search unit_index unit_name in
      let architecture_id  = Architecture_index.search architecture_index architecture in
			let v, r             = Rapids.split_version version in
      let version_id       = Version_index.get_id (Version_index.search version_index v) in
      let release_id       = Release_index.get_id (Release_index.search release_index r) in
      let package_id       = Package_index.search1 package_index (unit_id, version_id, release_id, architecture_id) in
      let archive_id       = add_archive db archive_name in
      let archive          = get_archive db archive_id in
      add_packages_to_archive
        db
        archive
        (Package_set.singleton package_id)
        lifetime
    end
    !lifetimes;
  DBI.close_in dbi
;;
(* ***)
(*** load_from_debian *)
let load_from_debian db (progress : Progress.indicator) ~(overlay: bool) fn =
  let ps = Ocamldeb.read_pool_file fn progress in
	if not (Ocamldeb.detect_pre_dependency_cycle ps) then
	let n = ref 1 in
	let nr_pkgs = List.length ps in
	begin
		progress#set_label "Adding...";
		List.iter (fun (p: Napkin.default_package) ->
			progress#display (!n, nr_pkgs);
      if overlay then
      begin
        let ps = Functions.unit_id_to_package_set db (Unit_index.search (get_unit_index db) p.pk_unit) in
        Package_set.iter (fun p' ->
          let pkg' = Functions.get_package_from_id db p' in
          let (v', r') = pkg'.pk_version in
          Printf.printf "Should replace %s%s by %s.\n" (Version_index.get_version v')
            (match Release_index.get_version r' with None -> "" | Some x -> "-"^x) p.pk_version
        ) ps
      end ;
			ignore (add_package db p);
			incr n
		) ps
	end
	else
		prerr_endline "There is a pre-dependency cycle."
;; 
(* ***)
(*** load_from_rpm *)
let load_from_rpm db (progress : Progress.indicator) ?(add_file_conflicts=true) ~(overlay:bool) fn =
begin
  let ps = 
    if Util.string_contains fn "synthesis" then
      Ocamlrpm.read_synthesis_hdlist fn 
    else
    begin
      let hl = Ocamlrpm.add_file_provides progress (Ocamlrpm.read_hdlist "" fn) in
      if add_file_conflicts then Ocamlrpm.add_file_conflicts progress hl else hl
    end in
  List.iter (fun p -> try 
    (* if overlay then
    begin
      let u_id = Unit_index.search (get_unit_index db) p.pk_unit in
      let ps = Functions.unit_id_to_package_set db u_id in
      Package_set.iter (fun p' ->
        let pkg' = Functions.get_package_from_id db p' in
        let (v', r') = pkg'.pk_version in
        Printf.printf "Replacing %s: %s%s -> %s.\n" p.pk_unit (Version_index.get_version v')
          (match Release_index.get_version r' with None -> "" | Some x -> "-"^x) p.pk_version;
        let new_p = Napkin.map
          ~extra:(fun _ -> pkg'.pk_extra) 
          ~unit:(fun _ -> u_id)
          ~version:(fun x -> let (v, r) = split_version x in
            Version_index.register (get_version_index db) v,
            Release_index.register (get_release_index db) r)
          ~glob:(fun g -> g)
          ~architecture:(Architecture_index.register (get_architecture_index db))
          ~source:(Source_index.register (get_source_index db)) 
          p in
        replace_package db new_p
      ) ps
    end; *)
	 ignore (add_package db (to_default_package p))
	with Failure s ->
	 Printf.eprintf "Error while adding package %s: %s\n%!" p.pk_unit s) ps;
end;; 
(* ***)
(*** load_from_pkgsrc *)
let load_from_pkgsrc db (progress : Progress.indicator) ~(overlay:bool) fn =
	let ps = Ocamlpkgsrc.read_summary_file fn in
	List.iter (fun p -> try 
		ignore (add_package db (to_default_package p))
	with Failure s ->
		Printf.eprintf "Error while adding package %s: %s\n%!" p.pk_unit s) ps
;; 
(* ***)
(*** adjust_comparator *)
let adjust_comparator db sl =
  match mode_of_specification sl with
  | None -> ()
  | Some Debian -> 
		begin
			match get_liquid db with
				None -> (set_liquid db Debian;
				Version_order.set_comparator Ocamldeb.compare_versions;
				Release_order.set_comparator (fun c1 c2 ->
					match (c1, c2) with
					| (None, None) -> 0
					| (None, _) -> 1
					| (_, None) -> -1
					| (Some x1, Some x2) -> Ocamldeb.compare_versions x1 x2
				))
			| Some Debian -> ()
			| Some RPM -> invalid_arg "Debian and RPM do not match"
			| Some Pkgsrc -> invalid_arg "Debian and pkgsrc do not match"
		end
  | Some RPM -> 
		begin
			match get_liquid db with
				None -> (set_liquid db RPM;
				Version_order.set_comparator Ocamlrpm.compare_versions;
				Release_order.set_comparator (fun c1 c2 ->
					match (c1, c2) with
					| (None, None) -> 0
					| (None, _) -> 1
					| (_, None) -> -1
					| (Some x1, Some x2) -> Ocamlrpm.compare_versions x1 x2
				))
			| Some RPM -> ()
			| Some Debian -> invalid_arg "RPM and Debian do not match"
			| Some Pkgsrc -> invalid_arg "RPM and pkgsrc do not match"
		end
	| Some Pkgsrc ->
		begin
			match get_liquid db with
				None -> (set_liquid db Pkgsrc;
				Version_order.set_comparator Ocamlpkgsrc.compare_versions;
				Release_order.set_comparator (fun c1 c2 ->
					match (c1, c2) with
					| (None, None) -> 0
					| (None, _) -> 1
					| (_, None) -> -1
					| (Some x1, Some x2) -> Ocamlpkgsrc.compare_versions x1 x2
				))
			| Some Pkgsrc -> ()
			| Some Debian -> invalid_arg "Pkgsrc and Debian do not match"
			| Some RPM -> invalid_arg "Pkgsrc and RPM do not match"
		end
;;
(*** complete conflicts *)
let complete_conflicts db (progress: Progress.indicator) =
let pkgs = Functions.packages db in
let i = ref 0 in
let n = Package_set.cardinal pkgs in
begin
	progress#set_label "Completing conflicts...";
	Package_set.iter (fun p ->
		let pkg = Functions.get_package_from_id db p in
		progress#display (!i, n);
		List.iter (fun c ->
			Package_set.iter (fun p' ->
				let pkg' = Functions.get_package_from_id db p' in
				if not (Package_set.mem p
					(List.fold_left Package_set.union Package_set.empty (List.map (Functions.select db) pkg'.pk_conflicts))) then
					let new_pkg' = { pkg' with pk_conflicts = (Unit_version (pkg.pk_unit, Sel_EQ pkg.pk_version))::pkg'.pk_conflicts } in
					replace_package db new_pkg'	
			) (Functions.select db c)
		) pkg.pk_conflicts;
		incr i
	) (Functions.packages db)
end;;
(* ***)
(*** merge *)
let merge db ?progress ?(add_file_conflicts=true) ?(overlay=false) sl =
	let p = match progress with
	| None -> new Progress.indicator ~decimation:1000 ~label:"Merging..." ~channel:stderr ()
	| Some pr -> pr in
  adjust_comparator db sl; 
	p#start;
  List.iter
    begin function
      | (_,      Dose base) -> load_from_dosebase db p ~overlay base
      | (Debian, File fn)   -> load_from_debian db p ~overlay fn
      | (RPM,    File fn)   -> load_from_rpm db p ~add_file_conflicts ~overlay fn
			| (Pkgsrc, File fn)   -> load_from_pkgsrc db p ~overlay fn
      | (_,      _)         -> invalid_arg "Unsupported waterway"
    end
    sl;
	complete_conflicts db p;
	p#finish
;;
(* ***)
(*** perform *)
let perform sl handle =
  let db = create_database () in
  let progress = new Progress.indicator ~decimation:1000 ~label:"Loading" ~channel:stderr () in
  progress#start;
  List.iter
    begin function
      | (_,      Dose base) -> load_from_dosebase db progress ~overlay:false base
      (* | (Debian, File fn)   -> load_from_debian db progress fn *)
      | (_,      _)         -> invalid_arg "Unsupported waterway"
    end
    sl;
  progress#finish;
  handle db
;;
(* ***)
(*** with_database *)
(* let with_database sl handle =
  adjust_comparator sl;
  perform sl handle
;;  *)
(* ***)
