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

(**
Writer for the Graphviz (DOT) format.
@author Jaap Boender
*)

open Napkin

let output_node (oc: out_channel) (pkg: default_package): unit =
begin
	output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" [shape=record, color=black, label=\"{" ^ pkg.pk_unit ^ "|" ^ pkg.pk_version ^ "}\"];\n")
end;;

let output_provides (oc: out_channel) (pkg: default_package): unit =
begin
	List.iter (fun d ->
	match d with
	| Unit_version (t, s) ->
		output_string oc ("\"" ^ t ^ "\" -> \"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" [style=dashed];\n")
	| Glob_pattern _ -> raise (Failure "ARGH XI")
	) pkg.pk_provides
end;;

let get_depname (ht: Dependencies.pkg_hashtable) (dep: (string, string, string) versioned): string =
match dep with
| Glob_pattern _ -> raise (Failure "ARGH XII")
| Unit_version (target, spec) ->
begin
	let res = String.concat "/" 
	(let versions = Hashtbl.find_all ht target in
		List.flatten (List.map (fun (v, md) ->
			if Dependencies.can_provide spec (Sel_EQ v) then 
				[md.pk_unit ^ "=" ^ md.pk_version]
			else
				[]
		) versions)) in
		if res = "" then target else res
end

let get_disjname (ht: Dependencies.pkg_hashtable) (disj: (string, string, string) versioned list): string =
begin
	String.concat "/" (List.map (get_depname ht) disj)
end;;

let output_disjunctions (oc: out_channel) (ht: Dependencies.pkg_hashtable) (pkg: default_package): unit =
let output_disj (disj: (string, string, string) versioned list) =
begin
	if List.length disj > 1 then
	let disjname = get_disjname ht disj in
		output_string oc ("\"" ^ disjname ^ "\" [shape=point, color=black];\n");
		List.iter (fun dep ->
			output_string oc ("\"" ^ disjname ^ "\" -> \"" ^ (get_depname ht dep) ^ "\" [style=dotted];\n")
		) disj
end in
begin
	List.iter output_disj pkg.pk_depends;
	List.iter output_disj pkg.pk_pre_depends;
end;;

let output_dependencies (oc: out_channel) (ht: Dependencies.pkg_hashtable) (pkg: default_package): unit =
let output_with_disjs (e: (string, string, string) versioned list list) (style: string) =
begin
	List.iter (fun disj ->
		if List.length disj > 1 then
		let disjname = get_disjname ht disj in
			output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" -> \"" ^ disjname ^ "\" [" ^ style ^ "];\n")
		else
			List.iter (fun dep ->
				output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" -> \"" ^ (get_depname ht dep) ^ "\" [" ^ style ^ "];\n")
			) disj
	) e
end
and output_without_disjs (e: (string, string, string) versioned list) (style: string) =
begin
	List.iter (fun dep ->
		output_string oc ("\"" ^ pkg.pk_unit ^ "=" ^ pkg.pk_version ^ "\" -> \"" ^ (get_depname ht dep) ^ "\" [" ^ style ^ "];\n")
	) e
end in
begin
	output_with_disjs pkg.pk_depends "color=black";
	output_with_disjs pkg.pk_pre_depends "color=blue";
	output_without_disjs pkg.pk_conflicts "color=red";
	output_without_disjs pkg.pk_replaces "color=orange";
	output_with_disjs pkg.pk_enhances "color=green";
	output_with_disjs pkg.pk_recommends "color=yellow";
	output_with_disjs pkg.pk_suggests "color=yellow, style=dashed"
end;;

let output_graphviz (pkgs: default_package list): unit =
begin
	prerr_endline "[Graphviz] Outputting Graphviz file...";
	let ht = Dependencies.create_pkgs_hashtable pkgs in
	output_string !Options.output_channel "digraph G {\n";
	output_string !Options.output_channel "node [shape=ellipse, color=red];\n";
	List.iter (output_node !Options.output_channel) pkgs;
	List.iter (output_provides !Options.output_channel) pkgs;
	List.iter (output_disjunctions !Options.output_channel ht) pkgs;
	List.iter (output_dependencies !Options.output_channel ht) pkgs;
	output_string !Options.output_channel "}\n"
end;;
