(****************************************************************************

Copyright 2009 Ralf Treinen <treinen@pps.jussieu.fr>

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

let output_string_field out field value =
  output_string out field;
  output_string out ": ";
  output_string out value;
  output_char out '\n'
;;

let output_int64_field out field value =
  output_string out field;
  output_string out ": ";
  output_string out (Int64.to_string value);
  output_char out '\n'
;;

let output_bool_field out field value =
  if value then begin
    output_string out field;
    output_string out ": ";
    output_string out (if value then "yes" else "no");
    output_char out '\n'
  end
;;

let output_versionend out = function
  | Glob_pattern _glob -> failwith "this cannot happen"
  | Unit_version(unit,versionend) ->
      output_string out unit;
      match versionend with
	  Sel_ANY -> ()
	| Sel_LEQ version ->
	    output_string out " (<= ";
	    output_string out version;
	    output_string out ")"
	| Sel_GEQ version ->
	    output_string out " (>= ";
	    output_string out version;
	    output_string out ")"
	| Sel_EQ version -> 
	    output_string out " (= ";
	    output_string out version;
	    output_string out ")"
	| Sel_LT version ->
	    output_string out " (<< ";
	    output_string out version;
	    output_string out ")"
	| Sel_GT version ->
	    output_string out " (>> ";
	    output_string out version;
	    output_string out ")"
;;

let output_clause out clause =
  (* a clause cannot be empty *)
  assert (clause <> []);
  output_versionend out (List.hd clause);
  List.iter 
    (function versionend ->
       output_string out "|";
       output_versionend out versionend
    )
    (List.tl clause)
;;

let output_list_field out field vlist =
  if vlist <> [] then begin
    output_string out field;
    output_string out ": ";
    if vlist <> [] then begin 
      output_versionend out (List.hd vlist);
      List.iter 
	(function versionend ->
	   output_string out ", ";
	   output_versionend out versionend
	)
	(List.tl vlist)
    end;
    output_char out '\n'
  end
;;

let output_cnf_field out field cnf =
  if cnf <> [] then begin 
    output_string out field;
    output_string out ": ";
    if cnf <> [] then begin 
      output_clause out (List.hd cnf);
      List.iter 
	(function clause ->
	   output_string out ", ";
	   output_clause out clause
	)
	(List.tl cnf)
    end;
    output_char out '\n'
  end
;;

let output_package out package =
  output_string_field out "Package"        package.pk_unit;
  output_string_field out "Version"        package.pk_version;
  output_string_field out "Architecture"   package.pk_architecture;
  output_int64_field  out "Size"           package.pk_size;
  output_int64_field  out "Installed-Size" package.pk_installed_size;
  output_bool_field   out "Essential"      package.pk_essential;
  output_string_field out "Source"         (fst package.pk_source);
  output_list_field   out "Provides"       package.pk_provides;
  output_list_field   out "Conflicts"      package.pk_conflicts;
  output_list_field   out "Breaks"         package.pk_breaks;
  output_list_field   out "Replaces"       package.pk_replaces;
  output_cnf_field    out "Depends"        package.pk_depends;
  output_cnf_field    out "Pre-Depends"    package.pk_pre_depends;
  output_cnf_field    out "Suggests"       package.pk_suggests;
  output_cnf_field    out "Recommends"     package.pk_recommends;
  output_cnf_field    out "Enhances"       package.pk_enhances;
;;

let output_package_list out packages =
  List.iter
    (function package ->
       output_package out package;
       output_char out '\n'
    )
    packages
;;
