(* Copyright 2005-2007 Berke DURAK, INRIA Rocquencourt.

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 Io;;

(*** Types *)
type ('a) selector =
| Sel_LEQ of 'a
| Sel_GEQ of 'a
| Sel_LT of 'a
| Sel_GT of 'a
| Sel_EQ of 'a
| Sel_ANY;;

type ('unit, 'version, 'glob) versioned = 
| Unit_version of ('unit * 'version selector)
| Glob_pattern of 'glob

type ('extra, 'unit, 'version, 'glob, 'architecture, 'source) package = {
  pk_unit            : 'unit; 
  pk_version         : 'version; 
  pk_architecture    : 'architecture;
  pk_extra           : 'extra;
  pk_size            : int64;    
  pk_installed_size  : int64;
  pk_source          : 'source;
  pk_provides        : ('unit, 'version, 'glob) versioned list; 
  pk_conflicts       : ('unit, 'version, 'glob) versioned list; 
  pk_breaks          : ('unit, 'version, 'glob) versioned list; 
  pk_replaces        : ('unit, 'version, 'glob) versioned list; 
  pk_depends         : ('unit, 'version, 'glob) versioned list list; 
  pk_pre_depends     : ('unit, 'version, 'glob) versioned list list; 
  pk_suggests        : ('unit, 'version, 'glob) versioned list list; 
  pk_recommends      : ('unit, 'version, 'glob) versioned list list; 
  pk_enhances        : ('unit, 'version, 'glob) versioned list list; 
  pk_essential       : bool; 
  pk_build_essential : bool  
};;

type default_package = (unit, string, string, string, string, string * string) package;;
type package_with_files = ((string * string) list, string, string, string, string, string * string) package;;

(* ***)
(*** string_of_versioned *)
let string_of_versioned v =
	match v with
	| Unit_version (pn, vs) -> begin
  	match vs with
  	| Sel_ANY    -> pn
  	| Sel_LEQ v  -> pn^" (<= "^v^")"
  	| Sel_LT v   -> pn^" (<< "^v^")"
  	| Sel_GEQ v  -> pn^" (>= "^v^")"
  	| Sel_GT v   -> pn^" (>> "^v^")"
  	| Sel_EQ v   -> pn^" (== "^v^")"
		end
	| Glob_pattern g -> g
;;
(* ***)
(*** io_selector
let io_version_selector io_v =
  io_sum
    begin
      begin function
      | "ANY"  -> fun i -> Sel_ANY
      | "LT"   -> fun i -> Sel_LT(read io_v i)
      | "LEQ"  -> fun i -> Sel_LEQ(read io_v i)
      | "EQ"   -> fun i -> Sel_EQ(read io_v i)
      | "GEQ"  -> fun i -> Sel_GEQ(read io_v i)
      | "GT"   -> fun i -> Sel_GT(read io_v i)
      | _      -> fun i -> raise Unknown_constructor
      end,
      begin function
      | Sel_ANY     -> "ANY",  write io_unit ()
      | Sel_LT   vn -> "LT",   write io_v vn
      | Sel_LEQ  vn -> "LEQ",  write io_v vn
      | Sel_EQ   vn -> "EQ",   write io_v vn
      | Sel_GEQ  vn -> "GEQ",  write io_v vn
      | Sel_GT   vn -> "GT",   write io_v vn
      end
    end
;;
***)
(*** io_versioned
let io_versioned io_unit io_version io_glob =
	io_sum 
	begin
		begin function
		| "UV"   -> fun i -> Unit_version (read (io_pair io_unit io_version) i)
		| "GLOB" -> fun i -> Glob_pattern(read io_glob i)
		| _      -> fun i -> raise Unknown_constructor
		end,
		begin function
		| Unit_version uv -> "UV", write (io_pair io_unit io_version) uv
		| Glob_pattern g ->  "GLOB", write io_glob g
		end
	end
;;
***)
(*** map_version_selector *)
let map_selector f = function
 | Sel_LEQ v  -> Sel_LEQ(f v)
 | Sel_GEQ v  -> Sel_GEQ(f v)
 | Sel_LT v   -> Sel_LT(f v)
 | Sel_GT v   -> Sel_GT(f v)
 | Sel_EQ v   -> Sel_EQ(f v)
 | Sel_ANY    -> Sel_ANY
;;
(* ***)
(*** map *)
let map ~extra ~unit ~version ~glob ~architecture ~source p =
  let versioned v =
		match v with
		| Unit_version (u, vs) -> Unit_version (unit u, map_selector version vs)
		| Glob_pattern g -> Glob_pattern (glob g)
  in
  { pk_extra           = extra p.pk_extra;
    pk_unit            = unit p.pk_unit; 
    pk_version         = version p.pk_version; 
    pk_architecture    = architecture p.pk_architecture;
    pk_source          = source p.pk_source; 
    pk_essential       = p.pk_essential; 
    pk_build_essential = p.pk_build_essential; 
    pk_provides        = List.map versioned p.pk_provides; 
    pk_size            = p.pk_size; 
    pk_installed_size  = p.pk_installed_size; 
    pk_conflicts       = List.map versioned p.pk_conflicts; 
    pk_breaks          = List.map versioned p.pk_breaks; 
    pk_replaces        = List.map versioned p.pk_replaces; 
    pk_depends         = List.map (List.map versioned) p.pk_depends; 
    pk_pre_depends     = List.map (List.map versioned) p.pk_pre_depends; 
    pk_suggests        = List.map (List.map versioned) p.pk_suggests;
    pk_recommends      = List.map (List.map versioned) p.pk_recommends;
    pk_enhances        = List.map (List.map versioned) p.pk_enhances }
;;
(* ***)
(*** io_package
let io_package
  ~io_extra
  ~io_unit
  ~io_version
	~io_glob
  ~io_architecture
  ~io_source =
  let io_versioned' = io_versioned io_unit io_version io_glob in
  io_record
  [
    "extra",
    (fun x i -> { x with pk_extra = read io_extra i }),
    (fun x -> write io_extra x.pk_extra);
    "unit",
    (fun x i -> { x with pk_unit = read io_unit i }),
    (fun x -> write io_unit x.pk_unit);
    "version",
    (fun x i -> { x with pk_version = read io_version i }),
    (fun x -> write io_version x.pk_version);
    "architecture",
    (fun x i -> { x with pk_architecture = read io_architecture i }),
    (fun x -> write io_architecture x.pk_architecture);
    "source",
    (fun x i -> { x with pk_source = read io_source i }),
    (fun x -> write io_source x.pk_source);
    "essential",
    (fun x i -> { x with pk_essential = read io_bool i }),
    (fun x -> write io_bool x.pk_essential);
    "build_essential",
    (fun x i -> { x with pk_build_essential = read io_bool i }),
    (fun x -> write io_bool x.pk_build_essential);
    "provides",
    (fun x i -> { x with pk_provides = read (io_list io_versioned') i }),
    (fun x -> write (io_list io_versioned') x.pk_provides);
    "conflicts",
    (fun x i -> { x with pk_conflicts = read (io_list io_versioned') i }),
    (fun x -> write (io_list io_versioned') x.pk_conflicts);
    "replaces",
    (fun x i -> { x with pk_replaces = read (io_list io_versioned') i }),
    (fun x -> write (io_list io_versioned') x.pk_replaces);
    "depends",
    (fun x i -> { x with pk_depends = read (io_list (io_list io_versioned')) i }),
    (fun x -> write (io_list (io_list (io_versioned'))) x.pk_depends);
    "pre_depends",
    (fun x i -> { x with pk_pre_depends = read (io_list (io_list io_versioned')) i }),
    (fun x -> write (io_list (io_list (io_versioned'))) x.pk_pre_depends);
    "suggests",
    (fun x i -> { x with pk_suggests = read (io_list (io_list io_versioned')) i }),
    (fun x -> write (io_list (io_list (io_versioned'))) x.pk_suggests);
    "recommends",
    (fun x i -> { x with pk_recommends = read (io_list (io_list io_versioned')) i }),
    (fun x -> write (io_list (io_list (io_versioned'))) x.pk_recommends);
    "enhances",
    (fun x i -> { x with pk_enhances = read (io_list (io_list io_versioned')) i }),
    (fun x -> write (io_list (io_list (io_versioned'))) x.pk_enhances);
  ]
;;
***)

let name nk = (nk.pk_unit, nk.pk_version, nk.pk_architecture);;

type channel = default_package Stream.t;;

let to_default_package (p: ('a, string, string, string, string, string * string) package): default_package =
	{ p with pk_extra = () };;
