(* Copyright 2005-2008 Berke DURAK, INRIA Rocquencourt, Jaap BOENDER.

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

type ('package_id, 'versioned) reason =
| Not_available of 'package_id
| Requested of 'package_id
| Dependency of 'package_id * 'package_id list
| Empty_disjunction of 'package_id * 'versioned list
| Conflict of 'package_id * 'package_id
;;

type ('not_installable_id, 'package_id, 'versioned) diagnosis = {
  dg_closure_size : int;
  dg_conflicts    : int;
  dg_disjunctions : int;
  dg_dependencies : int;
  dg_failures     : ('not_installable_id * ('package_id, 'versioned) reason list) array
}
;;

(*** io_reason *)
let io_reason io_id io_range =
  io_sum
    begin
      begin function
      | "Not_available"     -> fun i -> Not_available(read io_id i)
      | "Requested"         -> fun i -> Requested(read io_id i)
      | "Dependency"        -> fun i -> let (x,y) = read (io_pair io_id (io_list io_id)) i in Dependency(x,y)
      | "Conflict"          -> fun i -> let (x,y) = read (io_pair io_id io_id) i in Conflict(x,y)
      | "Empty_disjunction" -> fun i -> let (x,y) = read (io_pair io_id (io_list io_range)) i in Empty_disjunction(x,y)
      | _                   -> fun i -> raise Unknown_constructor
      end,
      begin function
      | Not_available x ->         "Not_available",     write io_id x
      | Requested x ->             "Requested",         write io_id x
      | Dependency(x,xl) ->        "Dependency",        write (io_pair io_id (io_list io_id)) (x,xl)
      | Empty_disjunction(x,xl) -> "Empty_disjunction", write (io_pair io_id (io_list io_range)) (x,xl)
      | Conflict(x,y) ->           "Conflict",          write (io_pair io_id io_id) (x,y)
      end
    end
;;
(* ***)
(*** empty_diagnosis *)
let empty_diagnosis = {
  dg_closure_size = 0;
  dg_conflicts = 0;
  dg_disjunctions = 0;
  dg_dependencies = 0;
  dg_failures = [||]
};;
(* ***)
(*** io_diagnosis *)
let io_diagnosis io_ni io_id io_range =
  io_record
  [
    "closure_size",
      (fun x i -> { x with dg_closure_size = read io_int i }),
      (fun x -> write io_int x.dg_closure_size );
    "conflicts",
      (fun x i -> { x with dg_conflicts = read io_int i }),
      (fun x -> write io_int x.dg_conflicts);
    "disjunctions",
      (fun x i -> { x with dg_disjunctions = read io_int i }),
      (fun x -> write io_int x.dg_disjunctions);
    "dependencies",
      (fun x i -> { x with dg_dependencies = read io_int i }),
      (fun x -> write io_int x.dg_dependencies);
    let io = io_array (io_pair io_ni (io_list (io_reason io_id io_range))) in
    "failures",
      (fun x i -> { x with dg_failures = read io i }),
      (fun x -> write io x.dg_failures)
  ]
  empty_diagnosis
;;
(* ***)
