sig
exception Lexer_error of string
type basename = OpamFilename.Base.t
type dirname = OpamFilename.Dir.t
type filename = OpamFilename.t
type filename_set = OpamFilename.Set.t
type 'a filename_map = 'a OpamFilename.Map.t
type generic_file =
OpamFilename.generic_file =
D of OpamTypes.dirname
| F of OpamTypes.filename
type 'a download =
Up_to_date of 'a
| Not_available of string
| Result of 'a
val download_dir :
OpamTypes.dirname OpamTypes.download ->
OpamTypes.generic_file OpamTypes.download
val download_file :
OpamTypes.filename OpamTypes.download ->
OpamTypes.generic_file OpamTypes.download
type package = OpamPackage.t
type package_set = OpamPackage.Set.t
type 'a package_map = 'a OpamPackage.Map.t
type name = OpamPackage.Name.t
type name_set = OpamPackage.Name.Set.t
type 'a name_map = 'a OpamPackage.Name.Map.t
type version = OpamPackage.Version.t
type version_set = OpamPackage.Version.Set.t
type compiler = OpamCompiler.t
type compiler_set = OpamCompiler.Set.t
type 'a compiler_map = 'a OpamCompiler.Map.t
type compiler_version = OpamCompiler.Version.t
type opam_version = OpamVersion.t
type compiler_constraint = OpamCompiler.Version.constr
type variable = OpamVariable.t
type full_variable = OpamVariable.Full.t
type section = OpamVariable.Section.t
type full_section = OpamVariable.Section.Full.t
type variable_contents =
OpamVariable.variable_contents =
B of bool
| S of string
type variable_map = OpamVariable.variable_contents OpamVariable.Map.t
type ppflag = Camlp4 of string list | Cmd of string list
type 'a generic_formula =
'a OpamFormula.formula =
Empty
| Atom of 'a
| Block of 'a OpamTypes.generic_formula
| And of 'a OpamTypes.generic_formula * 'a OpamTypes.generic_formula
| Or of 'a OpamTypes.generic_formula * 'a OpamTypes.generic_formula
type atom = OpamFormula.atom
type formula = OpamFormula.t
type 'a conjunction = 'a OpamFormula.conjunction
type 'a disjunction = 'a OpamFormula.disjunction
type repository_name = OpamRepositoryName.t
type 'a repository_name_map = 'a OpamRepositoryName.Map.t
type repository_kind = [ `darcs | `git | `hg | `http | `local ]
type address = string * string option
val string_of_address : OpamTypes.address -> string
val address_of_string : string -> OpamTypes.address
val guess_repository_kind :
OpamTypes.repository_kind option ->
OpamTypes.address -> OpamTypes.repository_kind
val string_of_repository_kind :
[ `darcs | `git | `hg | `http | `local ] -> string
val repository_kind_of_string :
string -> [ `darcs | `git | `hg | `http | `local ]
type repository_root = OpamTypes.dirname
type repository = {
repo_root : OpamTypes.repository_root;
repo_name : OpamTypes.repository_name;
repo_kind : OpamTypes.repository_kind;
repo_address : OpamTypes.address;
repo_priority : int;
}
type 'a action =
To_change of 'a option * 'a
| To_delete of 'a
| To_recompile of 'a
type 'a cause =
Use of 'a list
| Required_by of 'a list
| Upstream_changes
| Unknown
val action_contents : 'a OpamTypes.action -> 'a
module type ACTION_GRAPH =
sig
type package
type t
module V :
sig
type t = package action
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t
val compare : t -> t -> int
type vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val create : ?size:int -> unit -> t
val clear : t -> unit
val copy : t -> t
val add_vertex : t -> vertex -> unit
val remove_vertex : t -> vertex -> unit
val add_edge : t -> vertex -> vertex -> unit
val add_edge_e : t -> edge -> unit
val remove_edge : t -> vertex -> vertex -> unit
val remove_edge_e : t -> edge -> unit
type g = t
val transitive_closure : ?reflexive:bool -> g -> g
val add_transitive_closure : ?reflexive:bool -> g -> g
val mirror : g -> g
val complement : g -> g
val intersect : g -> g -> g
val union : g -> g -> g
module Parallel :
sig
module G :
sig
type t = t
module V :
sig
type t = V.t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t
val compare : t -> t -> int
type vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges :
(vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val create : ?size:int -> unit -> t
val clear : t -> unit
val copy : t -> t
val add_vertex : t -> vertex -> unit
val remove_vertex : t -> vertex -> unit
val add_edge : t -> vertex -> vertex -> unit
val add_edge_e : t -> edge -> unit
val remove_edge : t -> vertex -> vertex -> unit
val remove_edge_e : t -> edge -> unit
val iter_vertex : (V.t -> unit) -> t -> unit
val iter_succ : (V.t -> unit) -> t -> V.t -> unit
val in_degree : t -> V.t -> int
val has_cycle : t -> bool
val scc_list : t -> V.t list list
val string_of_vertex : V.t -> string
end
val iter :
int ->
G.t ->
pre:(G.V.t -> unit) ->
child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
val iter_l :
int ->
G.vertex list ->
pre:(G.V.t -> unit) ->
child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
val map_reduce :
int ->
G.t ->
map:(G.V.t -> 'a) -> merge:('a -> 'a -> 'a) -> init:'a -> 'a
val map_reduce_l :
int ->
G.vertex list ->
map:(G.V.t -> 'a) -> merge:('a -> 'a -> 'a) -> init:'a -> 'a
val create : G.V.t list -> G.t
exception Errors of (G.V.t * OpamParallel.error) list * G.V.t list
exception Cyclic of G.V.t list list
end
module Topological :
sig
val iter :
(OpamTypes.ACTION_GRAPH.package OpamTypes.action -> unit) ->
t -> unit
val fold :
(OpamTypes.ACTION_GRAPH.package OpamTypes.action -> 'a -> 'a) ->
t -> 'a -> 'a
end
type solution = {
to_remove : OpamTypes.ACTION_GRAPH.package list;
to_process : t;
root_causes :
(OpamTypes.ACTION_GRAPH.package *
OpamTypes.ACTION_GRAPH.package OpamTypes.cause)
list;
}
val dump_solution : OpamTypes.ACTION_GRAPH.solution -> unit
end
module type PKG =
sig
type t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
val to_string : t -> string
val string_of_action :
?causes:(t -> t OpamTypes.cause) -> t OpamTypes.action -> string
end
module MakeActionGraph :
functor (Pkg : PKG) ->
sig
type package = Pkg.t
type t
module V :
sig
type t = package action
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t
val compare : t -> t -> int
type vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val create : ?size:int -> unit -> t
val clear : t -> unit
val copy : t -> t
val add_vertex : t -> vertex -> unit
val remove_vertex : t -> vertex -> unit
val add_edge : t -> vertex -> vertex -> unit
val add_edge_e : t -> edge -> unit
val remove_edge : t -> vertex -> vertex -> unit
val remove_edge_e : t -> edge -> unit
type g = t
val transitive_closure : ?reflexive:bool -> g -> g
val add_transitive_closure : ?reflexive:bool -> g -> g
val mirror : g -> g
val complement : g -> g
val intersect : g -> g -> g
val union : g -> g -> g
module Parallel :
sig
module G :
sig
type t = t
module V :
sig
type t = V.t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t
val compare : t -> t -> int
type vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges :
(vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ :
(vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred :
(vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e :
(edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e :
(edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val create : ?size:int -> unit -> t
val clear : t -> unit
val copy : t -> t
val add_vertex : t -> vertex -> unit
val remove_vertex : t -> vertex -> unit
val add_edge : t -> vertex -> vertex -> unit
val add_edge_e : t -> edge -> unit
val remove_edge : t -> vertex -> vertex -> unit
val remove_edge_e : t -> edge -> unit
val iter_vertex : (V.t -> unit) -> t -> unit
val iter_succ : (V.t -> unit) -> t -> V.t -> unit
val in_degree : t -> V.t -> int
val has_cycle : t -> bool
val scc_list : t -> V.t list list
val string_of_vertex : V.t -> string
end
val iter :
int ->
G.t ->
pre:(G.V.t -> unit) ->
child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
val iter_l :
int ->
G.vertex list ->
pre:(G.V.t -> unit) ->
child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
val map_reduce :
int ->
G.t ->
map:(G.V.t -> 'a) -> merge:('a -> 'a -> 'a) -> init:'a -> 'a
val map_reduce_l :
int ->
G.vertex list ->
map:(G.V.t -> 'a) -> merge:('a -> 'a -> 'a) -> init:'a -> 'a
val create : G.V.t list -> G.t
exception Errors of (G.V.t * OpamParallel.error) list *
G.V.t list
exception Cyclic of G.V.t list list
end
module Topological :
sig
val iter : (package action -> unit) -> t -> unit
val fold : (package action -> 'a -> 'a) -> t -> 'a -> 'a
end
type solution = {
to_remove : package list;
to_process : t;
root_causes : (package * package cause) list;
}
val dump_solution : solution -> unit
end
module PackageAction :
sig
type t = package
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
val to_string : t -> string
val string_of_action : ?causes:(t -> t cause) -> t action -> string
end
module PackageActionGraph :
sig
type package = package
type t
module V :
sig
type t = package action
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t
val compare : t -> t -> int
type vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val in_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val iter_vertex : (vertex -> unit) -> t -> unit
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges : (vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_succ : (vertex -> unit) -> t -> vertex -> unit
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val create : ?size:int -> unit -> t
val clear : t -> unit
val copy : t -> t
val add_vertex : t -> vertex -> unit
val remove_vertex : t -> vertex -> unit
val add_edge : t -> vertex -> vertex -> unit
val add_edge_e : t -> edge -> unit
val remove_edge : t -> vertex -> vertex -> unit
val remove_edge_e : t -> edge -> unit
type g = t
val transitive_closure : ?reflexive:bool -> g -> g
val add_transitive_closure : ?reflexive:bool -> g -> g
val mirror : g -> g
val complement : g -> g
val intersect : g -> g -> g
val union : g -> g -> g
module Parallel :
sig
module G :
sig
type t = t
module V :
sig
type t = V.t
val compare : t -> t -> int
val hash : t -> int
val equal : t -> t -> bool
type label
val create : label -> t
val label : t -> label
end
type vertex = V.t
module E :
sig
type t
val compare : t -> t -> int
type vertex = vertex
val src : t -> vertex
val dst : t -> vertex
type label
val create : vertex -> label -> vertex -> t
val label : t -> label
end
type edge = E.t
val is_directed : bool
val is_empty : t -> bool
val nb_vertex : t -> int
val nb_edges : t -> int
val out_degree : t -> vertex -> int
val mem_vertex : t -> vertex -> bool
val mem_edge : t -> vertex -> vertex -> bool
val mem_edge_e : t -> edge -> bool
val find_edge : t -> vertex -> vertex -> edge
val find_all_edges : t -> vertex -> vertex -> edge list
val succ : t -> vertex -> vertex list
val pred : t -> vertex -> vertex list
val succ_e : t -> vertex -> edge list
val pred_e : t -> vertex -> edge list
val fold_vertex : (vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges : (vertex -> vertex -> unit) -> t -> unit
val fold_edges :
(vertex -> vertex -> 'a -> 'a) -> t -> 'a -> 'a
val iter_edges_e : (edge -> unit) -> t -> unit
val fold_edges_e : (edge -> 'a -> 'a) -> t -> 'a -> 'a
val map_vertex : (vertex -> vertex) -> t -> t
val iter_pred : (vertex -> unit) -> t -> vertex -> unit
val fold_succ : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val fold_pred : (vertex -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_succ_e : (edge -> unit) -> t -> vertex -> unit
val fold_succ_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val iter_pred_e : (edge -> unit) -> t -> vertex -> unit
val fold_pred_e : (edge -> 'a -> 'a) -> t -> vertex -> 'a -> 'a
val create : ?size:int -> unit -> t
val clear : t -> unit
val copy : t -> t
val add_vertex : t -> vertex -> unit
val remove_vertex : t -> vertex -> unit
val add_edge : t -> vertex -> vertex -> unit
val add_edge_e : t -> edge -> unit
val remove_edge : t -> vertex -> vertex -> unit
val remove_edge_e : t -> edge -> unit
val iter_vertex : (V.t -> unit) -> t -> unit
val iter_succ : (V.t -> unit) -> t -> V.t -> unit
val in_degree : t -> V.t -> int
val has_cycle : t -> bool
val scc_list : t -> V.t list list
val string_of_vertex : V.t -> string
end
val iter :
int ->
G.t ->
pre:(G.V.t -> unit) ->
child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
val iter_l :
int ->
G.vertex list ->
pre:(G.V.t -> unit) ->
child:(G.V.t -> unit) -> post:(G.V.t -> unit) -> unit
val map_reduce :
int ->
G.t ->
map:(G.V.t -> 'a) -> merge:('a -> 'a -> 'a) -> init:'a -> 'a
val map_reduce_l :
int ->
G.vertex list ->
map:(G.V.t -> 'a) -> merge:('a -> 'a -> 'a) -> init:'a -> 'a
val create : G.V.t list -> G.t
exception Errors of (G.V.t * OpamParallel.error) list * G.V.t list
exception Cyclic of G.V.t list list
end
module Topological :
sig
val iter : (package action -> unit) -> t -> unit
val fold : (package action -> 'a -> 'a) -> t -> 'a -> 'a
end
type solution = {
to_remove : package list;
to_process : t;
root_causes : (package * package cause) list;
}
val dump_solution : solution -> unit
end
type solution = OpamTypes.PackageActionGraph.solution
type solver_result =
Nothing_to_do
| OK of OpamTypes.package OpamTypes.action list
| Aborted
| No_solution
| Error of OpamTypes.package OpamTypes.action list *
OpamTypes.package OpamTypes.action list *
OpamTypes.package OpamTypes.action list
type ('a, 'b) result = Success of 'a | Conflicts of (unit -> 'b)
type 'a request = {
wish_install : 'a OpamTypes.conjunction;
wish_remove : 'a OpamTypes.conjunction;
wish_upgrade : 'a OpamTypes.conjunction;
}
type user_action =
Install of OpamTypes.name_set
| Upgrade of OpamTypes.package_set
| Reinstall
| Depends
| Init of OpamTypes.name_set
| Remove
| Switch of OpamTypes.name_set
| Import of OpamTypes.name_set
type universe = {
u_packages : OpamTypes.package_set;
u_installed : OpamTypes.package_set;
u_available : OpamTypes.package_set;
u_depends : OpamTypes.formula OpamTypes.package_map;
u_depopts : OpamTypes.formula OpamTypes.package_map;
u_conflicts : OpamTypes.formula OpamTypes.package_map;
u_action : OpamTypes.user_action;
u_installed_roots : OpamTypes.package_set;
u_pinned : OpamTypes.name_set;
}
type upload = {
upl_opam : OpamTypes.filename;
upl_descr : OpamTypes.filename;
upl_archive : OpamTypes.filename;
}
val string_of_upload : OpamTypes.upload -> string
type pin_option =
Version of OpamTypes.version
| Local of OpamTypes.dirname
| Git of OpamTypes.address
| Darcs of OpamTypes.address
| Hg of OpamTypes.address
| Unpin
| Edit
type pin = {
pin_package : OpamTypes.name;
pin_option : OpamTypes.pin_option;
}
val string_of_pin : OpamTypes.pin -> string
type pin_kind = [ `darcs | `git | `hg | `local | `version ]
val repository_kind_of_pin_kind :
OpamTypes.pin_kind -> OpamTypes.repository_kind option
val pin_kind_of_string : string -> OpamTypes.pin_kind
val string_of_pin_kind : OpamTypes.pin_kind -> string
val pin_option_of_string :
?kind:OpamTypes.pin_kind -> string -> OpamTypes.pin_option
val string_of_pin_option : OpamTypes.pin_option -> string
val kind_of_pin_option : OpamTypes.pin_option -> OpamTypes.pin_kind option
type config = {
conf_is_rec : bool;
conf_is_byte : bool;
conf_is_link : bool;
conf_options : OpamVariable.Section.Full.t list;
}
type shell = [ `bash | `csh | `fish | `sh | `zsh ]
val string_of_shell : OpamTypes.shell -> string
type global_config = { complete : bool; switch_eval : bool; }
type user_config = {
shell : OpamTypes.shell;
ocamlinit : bool;
dot_profile : OpamTypes.filename option;
}
type symbol = Eq | Neq | Le | Ge | Lt | Gt
val string_of_symbol : OpamTypes.symbol -> string
type filter =
FBool of bool
| FString of string
| FIdent of string
| FOp of OpamTypes.filter * OpamTypes.symbol * OpamTypes.filter
| FAnd of OpamTypes.filter * OpamTypes.filter
| FOr of OpamTypes.filter * OpamTypes.filter
| FNot of OpamTypes.filter
val string_of_filter : OpamTypes.filter -> string
type simple_arg = CString of string | CIdent of string
type arg = OpamTypes.simple_arg * OpamTypes.filter option
type command = OpamTypes.arg list * OpamTypes.filter option
type value =
Bool of bool
| Int of int
| String of string
| Symbol of string
| Ident of string
| List of OpamTypes.value list
| Group of OpamTypes.value list
| Option of OpamTypes.value * OpamTypes.value list
type file_section = {
section_kind : string;
section_name : string;
section_items : OpamTypes.file_item list;
}
and file_item =
Section of OpamTypes.file_section
| Variable of string * OpamTypes.value
type file = {
file_contents : OpamTypes.file_item list;
file_name : string;
file_format : OpamTypes.opam_version;
}
type switch = OpamSwitch.t
type switch_set = OpamSwitch.Set.t
type 'a switch_map = 'a OpamSwitch.Map.t
type lock =
Read_lock of (unit -> unit)
| Global_lock of (unit -> unit)
| Switch_lock of (unit -> unit)
type file_attribute = OpamFilename.Attribute.t
type file_attribute_set = OpamFilename.Attribute.Set.t
type 'a optional = { c : 'a; optional : bool; }
type stats = {
s_install : int;
s_reinstall : int;
s_upgrade : int;
s_downgrade : int;
s_remove : int;
}
type env = (string * string) list
type env_updates = (string * string * string) list
type tags = OpamMisc.StringSet.t OpamMisc.StringSetMap.t
type checksums = string list
type json = OpamJson.t
type 'a updates = {
created : 'a;
updated : 'a;
deleted : 'a;
changed : 'a;
}
end