(*
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 Egraph
open Napkin

{{ namespace "http://graphml.graphdrawing.org/xmlns/1.0rc" }}
{{ namespace edos = "http://www.edos-project.org/egraph" }}

type pkg_hashtable = (string, (string, default_package) Hashtbl.t) Hashtbl.t

let empty_metadata = 
	{ pk_extra = ();
		pk_unit = "";
		pk_version = "";
		pk_architecture = "";
		pk_source = ("", "");
		pk_essential = false;
		pk_build_essential = false;
		pk_size = 0L;
		pk_installed_size = 0L;
		pk_provides = [];
		pk_conflicts = [];
		pk_replaces = [];
		pk_depends = [];
		pk_pre_depends = [];
		pk_suggests = [];
		pk_recommends = [];
		pk_enhances = []
	};;

let parse_egraph_file (filename: string): {{ graphml_type }} =
let buflen = 1024 in
let buf = String.create buflen
and ic = open_in filename
and expat_parser = Expat.parser_create ~encoding:None
and od_loader = Ocamlduce.Load.make () in
let rec loop p =
	let n = input ic buf 0 buflen in
	if n > 0 then (p buf 0 n; loop p)
in
begin
	Expat.set_start_element_handler expat_parser (Ocamlduce.Load.start_elem od_loader);
	Expat.set_end_element_handler expat_parser (Ocamlduce.Load.end_elem od_loader);
	Expat.set_character_data_handler expat_parser (Ocamlduce.Load.text od_loader);
	ignore (Expat.set_param_entity_parsing expat_parser Expat.ALWAYS);
	loop (Expat.parse_sub expat_parser);
	close_in ic;
	Expat.final expat_parser;
	{{ ({{ Ocamlduce.Load.get od_loader }} :? graphml_type) }}
end;;

let add_node_information (ht: pkg_hashtable) (xml: {{ node_type }}): unit =
begin
	match xml with
		{{ <node package=pkg_name id=_>[_* data::node_data_type _*] }} ->
		begin
			let pkg_ht = try Hashtbl.find ht {: pkg_name :}
			with Not_found -> Hashtbl.create 1 in
			begin
			match data with
				{{ [<data key="nodedata" id=?_>versions] }} -> 
					List.iter (fun pkg_version ->
						let metadata = try Hashtbl.find pkg_ht pkg_version
						with Not_found -> { empty_metadata with pk_unit = {: pkg_name :}; pk_version = pkg_version } in
							Hashtbl.replace pkg_ht pkg_version { metadata with pk_unit = {: pkg_name :}; pk_version = pkg_version }
					)
					{: map versions with <edos:version number=nr filename=?_>[]  -> [nr] :}
			end;
			Hashtbl.replace ht {: pkg_name :} pkg_ht		
		end
	| {{ <node package=_ id=_>_ }} -> ()
end;;

let create_dependency (op: string) (tgt_name: string) (tgt_version: string): (string, string, 'a) versioned =
begin
	Unit_version 
		(tgt_name, 
			if op = "all" then Sel_ANY
			else if op = "lt" then Sel_LT tgt_version
			else if op = "le" then Sel_LEQ tgt_version
			else if op = "eq" then Sel_EQ tgt_version
			else if op = "ge" then Sel_GEQ tgt_version
			else if op = "gt" then Sel_GT tgt_version
			else raise (Failure ("Unknown version operator: " ^ op)))
end;;

let add_edge_information (ht: pkg_hashtable) (xml: {{ edge_type }}): unit =
begin
	match xml with
		{{ <edge id=?_ directed=?_ source=src_name target=tgt_name sourceport=?_ targetport=?_ type=tp>[_* data::edge_data_type _*] }} ->
		begin
			match data with
				{{ [<data key="edgedata" id=?_>versions] }} -> 
					List.iter (fun (src_version, op, tgt_version) ->
						let pkg_dependency = create_dependency op {: tgt_name :} tgt_version in
						let pkg_ht = try Hashtbl.find ht {: src_name :}
						with Not_found -> Hashtbl.create 1 in	
						let metadata = try Hashtbl.find pkg_ht src_version
						with Not_found -> { empty_metadata with pk_unit = {: src_name :}; pk_version = src_version } in
						let new_metadata = 
							if {: tp :} = "run" then { metadata with pk_depends = [pkg_dependency]::metadata.pk_depends }
							else if {: tp :} = "install" then { metadata with pk_pre_depends = [pkg_dependency]::metadata.pk_pre_depends }
							else if {: tp :} = "recommend" then { metadata with pk_recommends = [pkg_dependency]::metadata.pk_recommends }
							else if {: tp :} = "suggest" then { metadata with pk_suggests = [pkg_dependency]::metadata.pk_suggests }
							else if {: tp :} = "enhance" then { metadata with pk_enhances = [pkg_dependency]::metadata.pk_enhances }
							else if {: tp :} = "conflict" then { metadata with pk_conflicts = pkg_dependency::metadata.pk_conflicts }
							else if {: tp :} = "replace" then { metadata with pk_replaces = pkg_dependency::metadata.pk_replaces }
							else if {: tp :} = "provide" then { metadata with pk_provides = pkg_dependency::metadata.pk_provides }
							else raise (Failure ("Unknown dependency type " ^ {: tp :})) in
							Hashtbl.replace pkg_ht src_version new_metadata
					)
					{: map versions with
						<edos:version operator=op source=src_version target=tgt_version>[] -> [(src_version, op, tgt_version)]
					:}
		end
	| {{ <edge ..>_ }} -> ()
end;;

let add_hyperedge_information (ht: pkg_hashtable) (xml: {{ hyperedge_type }}): unit =
let dep_type = ref ""
and src_name = ref "" 
and disj_ht = Hashtbl.create 1 in
begin
	match xml with
		{{ <hyperedge type=tp id=?_>[(e::endpoint_type|_)*] }} ->
		dep_type := {: tp :};
		List.iter (fun (e: {{ endpoint_type }}) -> 
			begin
			match e with
				{{ <endpoint type="out" node=src>_ }} -> src_name := {: src :};
			| {{ <endpoint type="in" node=tgt_name>[_* data::endpoint_data_type _*] }} ->
				begin
					match data with
						{{ [<data key="endpointdata" id=?_>versions] }} -> 
						begin
							List.iter	
							(fun ((src_version, op, tgt_version): string * string * string) -> 
								let deps = try Hashtbl.find disj_ht src_version
								with Not_found -> [] in
								let new_deps = (create_dependency op {: tgt_name :} tgt_version)::deps in
									Hashtbl.replace disj_ht src_version new_deps
							)
							{: map versions with
								<edos:version operator=op source=src_version target=tgt_version>[] -> [(src_version, op, tgt_version)]
							:}
						end
				end
			| {{ <endpoint type=etp ..>_ }} -> raise (Failure ("Unknown endpoint type " ^ {: etp :}))
			end;
		) {: e :};
		Hashtbl.iter (fun src_version disj ->
			let versions_ht = try Hashtbl.find ht !src_name
			with Not_found -> Hashtbl.create 1 in
			let metadata = try Hashtbl.find versions_ht src_version
			with Not_found -> { empty_metadata with pk_unit = !src_name; pk_version = src_version } in
			let new_metadata =
				if !dep_type = "run" then
					{ metadata with pk_depends = disj::metadata.pk_depends }
				else if !dep_type = "install" then
					{ metadata with pk_pre_depends = disj::metadata.pk_pre_depends }
				else if !dep_type = "recommend" then
					{ metadata with pk_recommends = disj::metadata.pk_recommends }
				else if !dep_type = "suggest" then
					{ metadata with pk_suggests = disj::metadata.pk_suggests }
				else if !dep_type = "enhance" then
					{ metadata with pk_enhances = disj::metadata.pk_enhances }
				else if (!dep_type = "conflict") || (!dep_type = "replace") || (!dep_type = "provide") then
					raise (Failure ("hyperedge for non-disjunctive dependency type " ^ !dep_type))
				else
					raise (Failure ("unknown edge type " ^ !dep_type)) in
				Hashtbl.replace versions_ht src_version new_metadata				
		) disj_ht
end;;

let read_graph (xml: {{ graph_type }}): default_package list =
let result = ref []
and ht = Hashtbl.create 1024 in
begin
	begin
	match xml with
		{{ <graph id=?_ edgedefault="directed" version_type=vt>[(items::(node_type|edge_type|hyperedge_type)|_)*] }} -> 
			if !Options.version_type = Options.Unspecified then
			begin
				if {: vt :} = "rpm" then Options.version_type := Options.RPMVersions
				else if {: vt :} = "debian" then Options.version_type := Options.DebianVersions	
				else raise (Failure ("Unknown version type: " ^ {: vt :}))
			end;
			List.iter
			(fun (item: {{ node_type | edge_type | hyperedge_type }}) ->
				match item with
					{{ node_type & n }} -> add_node_information ht {: n :}
				| {{ edge_type & e }} -> add_edge_information ht {: e :}
				| {{ hyperedge_type & h }} -> add_hyperedge_information ht {: h :}
			)	{: items :}
	| {{ <graph id=?_ edgedefault=_ version_type=_>_ }} ->
			raise (Failure "graph is not directed")
	end;
	Hashtbl.iter (fun name pht ->
		Hashtbl.iter (fun version metadata ->
			result := metadata::!result
		) pht
	) ht;
	!result
end;;

(** Filter <graph> tags from <graphml> contents *)
let read_graphml (xml: {{ graphml_type }}): default_package list =
begin
	match xml with
		{{ <graphml>[ (graphs::graph_type | _)* ] }} ->
			List.flatten (List.map read_graph {: graphs :})
end;;

let read_egraph_file (filename: string): default_package list =
begin
	prerr_endline ("[EGraph] Reading EGraph file " ^ filename);
	let xml_contents = parse_egraph_file filename in
		read_graphml (xml_contents);
end;;
