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

(** Random Access Package Information Data Structure.

    Provides a fast, indexed archive for working on historical metadata archives expressed in the NAPKIN format.
*)

open Lifetime
open Napkin

(** This exception is raised if the database gets non-unifiable, conflicting pieces
    of information. *)
exception Conflicting_information of string

type liquid = RPM | Debian | Pkgsrc

module type ORDERED_LITERATE =
  sig
    type t
    val compare : t -> t -> int
    val scribe : 'a Conduit.conduit -> 'a -> t -> unit
    val io : t Io.literate
  end

module type STRING_ORDERED_LITERATE =
  sig
    type t = string
    val compare : t -> t -> int
    val scribe : 'a Conduit.conduit -> 'a -> t -> unit
    val io : string Io.literate
  end

module Version_order :
  sig
    type t = string
    val compare : t -> t -> int
    val set_comparator : (t -> t -> int) -> unit
    val scribe : 'a Conduit.conduit -> 'a -> t -> unit
    val io : string Io.literate
  end

module Release_order :
  sig
    type t = string option
    val compare : t -> t -> int
    val set_comparator : (t -> t -> int) -> unit
    val scribe : 'a Conduit.conduit -> 'a -> t -> unit
    val io : string option Io.literate
  end
module type SET =
  sig
    include Set.S
    val io : t Io.literate
  end

module type ID =
  sig
    type id
    val to_int : id -> int
		val from_int : int -> id
    val compare : id -> id -> int
    val succ : id -> id
    val scribe : 'a Conduit.conduit -> 'a -> id -> unit
    val zero : id
    val sweep : id -> (id -> unit) -> unit
    val io : id Io.literate
  end

module type INDEX =
  sig
    type elt
    type id
    type t
    val create : unit -> t
    val register : t -> elt -> id
    val search : t -> elt -> id
    val find : t -> id -> elt
    val compare_id : id -> id -> int
    val scribe_id : 'a Conduit.conduit -> 'a -> id -> unit
    val io_id : id Io.literate
    val iter : t -> (id -> elt -> unit) -> unit
    val set_watcher : t -> (id -> elt -> unit) -> unit
  end

module type DOUBLE_INDEX =
  sig
    type e1
    type e2
    type elt = e1 * e2
    type id
    type t
    val create : unit -> t
    val register : t -> elt -> id
		val replace : t -> elt -> unit
    val find : t -> id -> elt
    val search1 : t -> e1 -> id
    val search2 : t -> e2 -> id
    val compare_id : id -> id -> int
    val scribe_id : 'a Conduit.conduit -> 'a -> id -> unit
    val iter : t -> (id -> elt -> unit) -> unit
    val set_watcher : t -> (id -> elt -> unit) -> unit
  end

module type VERSION_POOL =
  sig
    type version
    type handle
    type id
    type t
    val create : unit -> t
    val register : t -> version -> handle
    val search : t -> version -> handle
    val compare_versions : t -> handle -> handle -> int
    val find : t -> id -> handle
    val get_version : handle -> version
    val get_id : handle -> id
    val iter : t -> (handle -> unit) -> unit
    (*val set_watcher : t -> (handle -> unit) -> unit*)
    val scribe_id : 'a Conduit.conduit -> 'a -> id -> unit
    val io_id : id Io.literate
  end

module type LABELED_INDEX =
  sig
    type data
    type elt
    type id
    type t
    val create : unit -> t
    val register : t -> elt -> (unit -> data) -> id
    val search : t -> elt -> id
    val find : t -> id -> elt
    val data : t -> id -> data
    val compare_id : id -> id -> int
    val scribe_id : 'a Conduit.conduit -> 'a -> id -> unit
    val io_id : id Io.literate
    val iter : t -> (id -> elt -> data -> unit) -> unit
    val set_watcher : t -> (id -> elt -> data -> unit) -> unit
  end

module type CHRONOLOGICAL_MAP =
  sig
    type t
    type set
    type elt
    type day = int
    val io : t Io.literate
    val create : unit -> t
    val iter : (day -> set -> unit) -> t -> unit
    val range : t -> day * day
    val get : t -> day -> set
    val add : t -> day -> day -> set -> unit
  end

(** An archive name is a list of strings intended to identify
 *  a component such as debian/stable/main/i386 by a list like
 *  [["debian";"stable";"main";"i386"]].  However it is up to the user to enforce
 *  constraints such as homogeneity of a given archive with respect to architecture. *)
type archive_name        = string
type architecture_name   = string
type unit_name           = string
type version_name        = string
type source_name         = unit_name * version_name
type source_version_name = version_name

(** A comparable version number *)
type version_number
type release_number

(** The following are opaque, but unique IDs *)
type version_id
type release_id
type unit_id
type source_id
type architecture_id
type package_id
type archive_id

(* Globs are stored as strings for the moment *)
type glob = string

(** An archive is a map from dates to sets of packages. *)
type archive

(** Architectures, units and versions are indexed for reducing memory usage and allowing
  * for fast set operations.  These modules contain [Set] modules, scribeers and [Io] literates. *)
module Architecture_name  : ORDERED_LITERATE with type   t = architecture_name
module Architecture_index : INDEX            with type elt = architecture_name and type id = architecture_id
module Unit_name          : ORDERED_LITERATE with type   t = unit_name
module Package_ID         : ID               with type id  = package_id
module Package_set        : SET              with type elt = package_id
module Unit_index         : LABELED_INDEX    with type elt = unit_name and type id = unit_id
module Unit_set           : SET              with type elt = unit_id
module Source_name        : ORDERED_LITERATE with type   t = source_name
module Source_index       : INDEX            with type elt = source_name and type id = source_id
module Source_set         : SET              with type elt = source_id
module Version_index      : VERSION_POOL     with type version = string and type id = version_id and type handle = version_number
module Release_index      : VERSION_POOL     with type version = string option and type id = release_id and type handle = release_number
module Archive_index      : LABELED_INDEX    with type elt = archive_name and type data = archive and type id = archive_id
module Archive_set        : SET              with type elt = archive_id

(** A package is uniquely identified by its unit, version and architecture.
    We use IDs for speed. *)
type package_name        = unit_id * version_id * release_id * architecture_id;;

(** Extra private information (cached results and other things) *)
type package_extra

(** A package is essentially a Napkin with strings replaced by IDs for efficiency. *)
type package =
  (package_extra,
   unit_id,
   version_number * release_number,
	 glob,
   architecture_id,
   source_id)
  Napkin.package
;;

(** The database contains a ``double index'' for packages, the first is for
    mapping package names to package IDs. *)
module Package_index : DOUBLE_INDEX with
  type e1 = package_name and
  type e2 = package and
  type id = package_id

(** Handy aliases. *)
type package_set = Package_set.t
type unit_set = Unit_set.t
type source_set = Source_set.t
type archive_set = Archive_set.t

(** The [Chronology] module efficiently maps days to sets of packages. *)
module Chronology : CHRONOLOGICAL_MAP with type elt = Package_ID.id and type set = Package_set.t

(** A RAPIDS database. *)
type db

(** Create a fresh database. *)
val create_database : unit -> db

(** Add the given napkin into the database and return its ID.  This operation is
    idempotent -- if the napkin is already interned, it does no harm and returns the correct package ID with an
    efficient lookup, provided the information in the given and stored napkins coincide.  If not, a
    [Conflicting_information] exception is raised.  If the package had only its name interned, this will fill the
    package's napkin. *)
val add_package : db -> Napkin.default_package -> package_id

(** Replace a package in the database. If the package did not already exist,
    it will be added. *)
val replace_package: db -> package -> unit

(** Run a series of self-tests on the database, which must have been previously filled. *)
val self_test : db -> unit

(** The following functions return the various indexes from the database. *)
val get_liquid : db -> liquid option
val get_package_index : db -> Package_index.t
val get_unit_index : db -> Unit_index.t
val get_version_index : db -> Version_index.t
val get_release_index : db -> Release_index.t
val get_architecture_index : db -> Architecture_index.t
val get_archive_index : db -> Archive_index.t
val get_source_index : db -> Source_index.t

val set_liquid : db -> liquid -> unit

val split_version: string -> string * string option

(** Register an archive.  Efficient and idempotent. *)
val add_archive : db -> archive_name -> archive_id

(** Get an archive *)
val get_archive : db -> archive_id -> archive

(** Get the contents of an archive on a given day *)
val get_archive_contents : archive -> day -> package_set

(** Iterate over the days of an archive *)
val iterate_over_archive : (day -> package_set -> unit) -> archive -> unit

(** Get the first and last days for which this archive contains packages. *)
val archive_range : db -> archive -> day * day

(** Add the given packages to the archive for the given days. *)
val add_packages_to_archive : db -> archive -> package_set -> lifetime -> unit

(*
(** Create a copy of the database *)
val copy : db -> db

(** Create a copy of the database limited to the given date range. *)
val limit_to_dates : db -> day -> day -> db

(** Create a copy of the database limited to the given archives. *)
val limit_to_archives : db -> archive_name list -> db

(** Intern the given package into the database and return its ID.  This function is idempotent
    and is also used as an efficient way to look up a package's ID. *)
val intern_package_name : db -> unit_name:string -> version_name:string -> architecture_name:string -> package_id


(** Intern a unit name. *)
val intern_unit : db -> string -> unit_id
*)

module Functions :
  sig
    val packages : db -> package_set (** Return the set of all packages *)
    val units : db -> unit_set (** Return the set of all units *)
    val sources : db -> source_set (** Return the set of all sources *)
    val archives : db -> archive_set (** Return the set of all archives *)
    val unit_id_to_package_set : db -> unit_id -> package_set (** Return the set of packages matching a unit *)
    val unit_id_to_providers : db -> unit_id -> (package_id, version_number * release_number, glob) versioned list (** Return the set of packages providing a unit *)

    (** Return the set of packages matching a selector *)
    val select : db -> (Unit_index.id, Version_index.handle * Release_index.handle, string) Napkin.versioned -> package_set

    (** Compute the forward dependencies closure of a given set of packages on the relation
        in the list relations: [`Pre] is for the pre-dependency relation,
        [`Dep] is for the dependency relation. *)
    val dependency_closure : db -> ?relations:[`Pre|`Dep] list -> package_set -> package_set

		(** Compute a dependency path in package_set from a to b (if it does not
	    	exist, raise Not_found *)
		val dependency_path: ?conjunctive:bool -> db -> package_set -> package_id -> package_id -> package_id list option

    (** Compute the set of packages that conflict with a given set. *)
    val conflicts : db -> package_set -> package_set

    (** Return a package from its ID. *)
    val get_package_from_id : db -> package_id -> package

    (** Scribes *)

    (** Scribe the name of a package, omitting the architecture if it
        is the default one. *)
    val scribe_package :
      db -> 'a Conduit.conduit -> 'a -> ?default_architecture:architecture_id -> package -> unit

    (** Scribe the name of a package from its ID, omitting the architecture if it
        is the default one. *)
    val scribe_package_from_id :
      db -> 'a Conduit.conduit -> 'a -> ?default_architecture:architecture_id -> package_id-> unit

    val scribe_unit_from_id :
      db -> 'a Conduit.conduit -> 'a -> unit_id -> unit (** Scribe the name of a unit from its ID *)
    val scribe_archive_from_id :
      db -> 'a Conduit.conduit -> 'a -> archive_id -> unit (** Scribe the name of a archive from its ID *)
    val scribe_source_from_id :
      db -> 'a Conduit.conduit -> 'a -> source_id -> unit (** Scribe the name of a source from its ID *)
    val scribe_version_from_number :
      db -> 'a Conduit.conduit -> 'a -> version_number * release_number -> unit (** Scribe the name of a version from its number *)
  end

