(*
This file is part of Ceve.

Ceve is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

Ceve 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 General Public License for more details.

You should have received a copy of the GNU General Public License
along with Ceve; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*)

open Options
open Napkin

type vp_hashtable = (string, (string selector) * (string * (string selector))) Hashtbl.t
type pkg_hashtable = (string, string * default_package) Hashtbl.t

let ifd = Hashtbl.create 256 (* file dependencies to be ignored (no warning) *);;

let version_of (spec: (string) selector): string =
begin
	match spec with
	  Sel_ANY -> ""
	| Sel_LT x | Sel_LEQ x | Sel_EQ x | Sel_GEQ x | Sel_GT x -> x
end;;

let split_version (v: string): string * string * string =
let split_epoch (v: string): string * string =
begin
	try
		let colon_index = String.index v ':' in
			(String.sub v 0 colon_index, String.sub v (colon_index+1) ((String.length v)-colon_index-1)) 
	with
		Not_found -> ("0", v)
end
and split_release (v: string): string * string =
begin
	try
		let hyphen_index = String.rindex v '-' in
			(String.sub v 0 hyphen_index, String.sub v (hyphen_index+1) ((String.length v)-hyphen_index-1))
	with
		Not_found -> (v, "")
end in
begin
	let (epoch, rest) = split_epoch v in
	let (upstream, release) = split_release rest in
		(epoch, upstream, release)
end;;

let compare_versions = match !version_type with
| DeweyVersions -> Ocamlpkgsrc.compare_versions
| RPMVersions -> Ocamlrpm.compare_versions
| _ -> Ocamldeb.compare_versions;;

(**
Find out whether a package (with a certain version) can provide a dependency.
For example: [can_provide (Equal "6.3") (Less "6.4")] returns true, since
version 6.3 satisfies the condition "less than 6.4".
*)
let can_provide (provider: (string) selector) (dependency: (string) selector): bool =
begin
	match dependency with
	| Sel_ANY -> true (* any version can be satisfied by anything *) 
	| Sel_EQ d -> (match provider with
		| Sel_ANY -> true
		| Sel_EQ p -> compare_versions d p = 0
		| Sel_LT p -> compare_versions d p < 0
		| Sel_LEQ p -> compare_versions d p <= 0
		| Sel_GT p -> compare_versions d p > 0
		| Sel_GEQ p -> compare_versions d p >= 0)
	| Sel_LT d -> (match provider with
		| Sel_ANY -> true
		| Sel_EQ p -> compare_versions p d < 0
		| Sel_LT p | Sel_LEQ p -> true
		| Sel_GT p | Sel_GEQ p -> compare_versions p d < 0)
	| Sel_LEQ d -> (match provider with
		| Sel_ANY -> true
		| Sel_EQ p -> compare_versions p d <= 0
		| Sel_LT p | Sel_LEQ p -> true
		| Sel_GT p -> compare_versions p d < 0
		| Sel_GEQ p -> compare_versions p d <= 0)
	| Sel_GT d -> (match provider with
		| Sel_ANY -> true
		| Sel_EQ p -> compare_versions p d > 0
		| Sel_LT p | Sel_LEQ p -> compare_versions p d > 0
		| Sel_GT p | Sel_GEQ p -> true)
	| Sel_GEQ d -> (match provider with
		| Sel_ANY -> true
		| Sel_EQ p -> compare_versions p d >= 0
		| Sel_LT p -> compare_versions p d > 0
		| Sel_LEQ p -> compare_versions p d >= 0
		| Sel_GT p | Sel_GEQ p -> true)
end;;

let create_vp_hashtable (pkgs: default_package list): vp_hashtable =
let ht = Hashtbl.create (List.length pkgs) in
begin
	if !verbose then prerr_endline "[Deps] Creating virtual package hashtable...";
	List.iter (fun pkg ->
		List.iter (fun p ->
			match p with
			| Unit_version (pu, ps) -> Hashtbl.add ht pu (ps, (pkg.pk_unit, Sel_EQ pkg.pk_version))
			| Glob_pattern g -> raise (Failure "ARGH I")
		) pkg.pk_provides;
		(* And for Debian, packages provide themselves *)
		if !Options.version_type = Options.DebianVersions then
			Hashtbl.add ht pkg.pk_unit (Sel_EQ pkg.pk_version, (pkg.pk_unit, Sel_EQ pkg.pk_version))
	) pkgs;
	ht
end;;

let create_pkgs_hashtable (pkgs: default_package list): pkg_hashtable =
let ht = Hashtbl.create (List.length pkgs) in
begin
	if !verbose then prerr_endline "[Deps] Creating package hashtable...";
	List.iter (fun pkg -> Hashtbl.add ht pkg.pk_unit (pkg.pk_version, pkg)) pkgs;
	ht
end;;

let get_dependencies (pkg: default_package): (string, string, string) versioned list =
let result = ref [] in
begin
	List.iter (fun x ->
		match x with
			Conflicts -> result := !result @ pkg.pk_conflicts
		| Depends -> result := !result @ (List.flatten pkg.pk_depends)
		| Enhances -> result := !result @ (List.flatten pkg.pk_enhances)
		| PreDepends -> result := !result @ (List.flatten pkg.pk_pre_depends)
		| Recommends -> result := !result @ (List.flatten pkg.pk_recommends)
		| Replaces -> result := !result @ pkg.pk_replaces
		| Suggests -> result := !result @ (List.flatten pkg.pk_suggests)
	) !Options.cone_types;
	!result
end;;

let replace_virtual_dependencies (name, version) (dep_type: string) (pht: pkg_hashtable) (vht: vp_hashtable) (deps: (string, string, string) versioned list list): (string, string, string) versioned list list =
begin
	List.map (fun disj ->
		List.flatten (List.map (fun d ->
			match d with
			| Unit_version (target, spec) ->
			if Tools.starts_with "rpmlib" target then []
			else if (!Options.version_type = Options.DebianVersions) && (spec <> Sel_ANY) then [Unit_version (target, spec)] (* Debian provide resolution ONLY if dependency is not versioned *)
			else
			let possible_providers = Hashtbl.find_all vht target in
			(* if !verbose then
				Printf.eprintf "[Deps] %s possibly provided by: %s\n" (string_of_ts (target, spec)) (String.concat "|" (List.map (fun (vs, d) -> "[" ^ (string_of_versioned d) ^ "]") possible_providers)); *)
			if possible_providers = [] && (target.[0] <> '/' || not (Hashtbl.mem ifd target)) then
      begin
		    Printf.eprintf "[Deps] WARNING: package %s-%s has a %s on %s, but %s does not exist.\n" name version dep_type (string_of_versioned (Unit_version (target, spec))) target; 
				Printf.eprintf "[Deps] Dropping %s, which might lead to inaccurate results (see manual).\n" dep_type 
			end;
			let providers = List.filter (fun (vs, _) -> can_provide vs spec) possible_providers in
			(* if !verbose then
				Printf.eprintf "[Deps] %s finally provided by: %s\n" (string_of_versioned (target, spec)) (String.concat "|" (List.map (fun (vs, d) -> "[" ^ (string_of_versioned d) ^ "]") providers)); *)
			Tools.uniq (List.sort compare (List.map (fun p -> Unit_version (snd p)) providers))
		| Glob_pattern _ -> raise (Failure "ARGH II")
		) disj)
	) deps
end;;

let replace_virtual_conflicts (pht: pkg_hashtable) (vht: vp_hashtable) (pname: string) (cfls: (string, string, string) versioned list): (string, string, string) versioned list =
begin
	List.flatten (List.map (fun d ->
	match d with
	| Unit_version (target, spec) ->
		if Tools.starts_with "rpmlib" target then []
		else if (!Options.version_type = Options.DebianVersions) && (spec <> Sel_ANY) then [Unit_version (target, spec)] (* Debian provide resolution ONLY if dependency is not versioned *)
		else
		let possible_providers = Hashtbl.find_all vht target in
		let providers = List.filter (fun (vs, (t, s)) -> can_provide vs spec && (if !Options.version_type = Options.DebianVersions then (t <> pname) && (target <> pname) else true)) possible_providers in
		let pkgs = Hashtbl.find_all pht target in
		let providers_plus =
		if !Options.version_type = Options.DebianVersions then
			(List.map snd providers) @ 
			(List.map
				(fun (v, m) -> (target, Sel_EQ v))
				(List.filter (fun (v, _) ->
				can_provide (Sel_EQ v) spec) pkgs))
		else
			List.map snd providers in
				Tools.uniq (List.sort compare (List.map (fun d -> Unit_version d) providers_plus))
	| Glob_pattern g -> raise (Failure "ARGH III")
	) cfls)
end;;

let resolve_dependencies (pkgs: default_package list): default_package list =
begin
	prerr_endline "[Deps] Resolving dependencies...";
	if !verbose then
		prerr_endline ("[Deps] Using " ^ (match !version_type with RPMVersions -> "RPM" | _ -> "Debian") ^ " versions...");
  if !Options.ignore_file_deps <> "" then
  begin
    let f = open_in !Options.ignore_file_deps in
    try
      while true
      do
        Hashtbl.add ifd (input_line f) true;
      done;
    with End_of_file -> close_in f
  end;
	let pht = create_pkgs_hashtable pkgs 
	and vht = create_vp_hashtable pkgs in
	List.map (fun pkg ->
		{ pkg with
			pk_depends =
				replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "dependency" pht vht pkg.pk_depends;
			pk_pre_depends =
				replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "pre-dependency" pht vht pkg.pk_pre_depends;
			pk_conflicts = replace_virtual_conflicts pht vht pkg.pk_unit pkg.pk_conflicts;
			pk_recommends =
				replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "recommendation" pht vht pkg.pk_recommends;
			pk_suggests =
				replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "suggestion" pht vht pkg.pk_suggests;
			pk_enhances =
				replace_virtual_dependencies (pkg.pk_unit, pkg.pk_version) "enhancement" pht vht pkg.pk_enhances
		}
	) pkgs
end;;

let enlarge_cone (ht: pkg_hashtable) (vht: vp_hashtable) (units: (string * string * bool) list) : (string * string * bool) list =
let rec cone_uniq (x: (string * string * bool) list) (b: bool): (string * string * bool) list =
begin
	match x with
	| [] -> []
	| y::ys ->
		begin
			match ys with
			| [] -> let (ny, vy, dy) = y in [(ny, vy, b)]
			| z::zs -> let (ny, vy, dy) = y and (nz, vz, dz) = z in
				if ny = nz && vy = vz then
					cone_uniq ys (b || (dy || dz))
				else
					(ny, vy, dy)::(cone_uniq ys (b || dy))
		end
end in
begin
	let res = (List.flatten (List.flatten (List.map (fun (n, v, d) ->
	if not d then
	begin
		if (not (List.exists (fun (x, y) -> n = x && v = y) !Options.cone_stops)) then
		begin
		try
			let versions = Hashtbl.find_all ht n in
			let pkgs = List.map snd (if v = "" then versions else List.filter (fun (x, _) -> x = v) versions) in
			let deps = Tools.uniq (List.sort compare (List.flatten (List.map get_dependencies pkgs))) in
			List.map (fun d -> match d with
			| Unit_version (target, spec) ->
				let av_versions = Hashtbl.find_all ht target in
				let providers = Hashtbl.find_all vht target in
				List.flatten (List.map (fun (av_version, av_md) -> 
					if can_provide (Sel_EQ av_version) spec then
						[(av_md.pk_unit, av_md.pk_version, false)]	
					else
						[]
				) av_versions) @
				(List.flatten (List.map 
					(fun (vs, (t, s)) -> if can_provide spec vs then
						[(t, version_of s, false)]
					else
					[])
				providers))
			| Glob_pattern _ -> raise (Failure "ARGH IV")
			) deps
		with
			Not_found -> []
		end
		else
		begin
			prerr_endline ("[Deps] not enlarging for " ^ n ^ "/" ^ v ^ " because not allowed by user");
			[]
		end
	end
	else (* d is true *)
		[]
	) units))) in
	let new_units = List.map (fun (n,v,_) -> (n,v,true)) units in
	cone_uniq (List.sort (fun (n1,v1,d1) (n2,v2,d2) -> compare (n1,v1) (n2,v2)) (res @ new_units)) false
end;;

let extract_cone (pkgs: default_package list) (spec: string * string): default_package list =
let name, version = spec in
begin
	Printf.eprintf "[Deps] Extracting dependency cone for %s %s...\n" name (if version <> "" then " (version " ^ version ^")" else "");
	let pht = create_pkgs_hashtable pkgs
	and vht = create_vp_hashtable pkgs in
	let units = Tools.fixpoint [(name,version,false)] (enlarge_cone pht vht) in
	let result = List.flatten (List.map (fun (n, v, _) -> 
			let versions = Hashtbl.find_all pht n in
			List.map snd (if v = "" then versions else List.filter (fun (x, _) -> x = v) versions)
		) units) in
		prerr_endline ("[Deps] Cone size: " ^ (string_of_int (List.length result)));
		result
end;;

let generate_explicit_conflicts (pkgs: default_package list): default_package list =
begin
	Printf.eprintf "[Deps] Generating explicit conflicts...\n%!";
	let pht = create_pkgs_hashtable pkgs in
	let units = Tools.uniq (List.sort compare (List.map (fun p -> p.pk_unit) pkgs)) in
	let res = ref [] in
	List.iter (fun u ->
		match Hashtbl.find_all pht u with
		| [] -> () (* no packages for unit u - this should not be the case *)
		| [v, pkg] -> res := pkg::!res
		| l -> List.iter (fun (v, pkg) -> 
						let new_pkg = { pkg with pk_conflicts =
							pkg.pk_conflicts @ (List.map (fun (_, c) -> Unit_version (c.pk_unit, Sel_EQ c.pk_version)) (List.filter (fun (_, x) -> x <> pkg) l))
						} in
						res := new_pkg::!res
					) l
	) units;
	!res
end;;
