Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Bits of refactoring

* remove the functors as they are not necessary now and this greatly simplify the current code
* remove CudfDiff duplication
* add mockups for client-server communications
  • Loading branch information...
commit b582d5e606be08a2e39726ce5bb5a83658f64ea4 1 parent f0e694f
@samoht samoht authored
View
1  config.ml
@@ -1 +0,0 @@
-let version = "0.1+dev"
View
95 file.ml
@@ -1,30 +1,30 @@
open Namespace
open Path
-module File =
-struct
- open Namespace
-
- module type PRINTF =
- sig
- type t
- type out_channel
+module type PRINTF =
+sig
+ type t
+ type out_channel
+
+ val init : unit -> t
+ val read_line : t -> string * t
+ val printf : t -> ('a, out_channel, t) format -> 'a
+end
- val init : unit -> t
- val read_line : t -> string * t
- val printf : t -> ('a, out_channel, t) format -> 'a
- end
+module P : PRINTF =
+struct
+ type t = unit
+ include Pervasives
- module P : PRINTF =
- struct
- type t = unit
- include Pervasives
+ let init x = x
+ let read_line () =
+ read_line (), ()
+ let printf () = Printf.printf
+end
- let init x = x
- let read_line () =
- read_line (), ()
- let printf () = Printf.printf
- end
+module File =
+struct
+ open Namespace
module type IO_FILE =
sig
@@ -38,18 +38,16 @@ struct
sig
include IO_FILE
- val empty_package_manager : internal_version
- val empty_ocaml : internal_version
val version_of_string : string -> internal_version
(** destruct *)
val package_manager : t -> internal_version
- val sources : t -> Path.url option
+ val sources : t -> url
val ocaml_version : t -> internal_version
(** construct *)
- val config : internal_version (* opam *) -> Path.url option -> internal_version (* ocaml *) -> t
+ val config : internal_version (* opam *) -> url -> internal_version (* ocaml *) -> t
end
let filter motif =
@@ -64,10 +62,8 @@ struct
module Config : CONFIG =
struct
- type t = { version : internal_version ; sources : Path.url option ; ocaml_version : internal_version }
+ type t = { version : internal_version ; sources : url ; ocaml_version : internal_version }
- let empty_package_manager = Version "1"
- let empty_ocaml = Version Sys.ocaml_version
let version_of_string s = Version s
let package_manager t = t.version
@@ -75,33 +71,34 @@ struct
let ocaml_version t = t.ocaml_version
let config version sources ocaml_version = { version ; sources ; ocaml_version }
- let ocamlpro_http = "opam.ocamlpro.com"
- let ocamlpro_port = 9999
- let empty1 = { version = Version "" ; sources = Some (Path.url ocamlpro_http (Some ocamlpro_port)) ; ocaml_version = Version Sys.ocaml_version }
- let empty2 = { version = Version "" ; sources = None ; ocaml_version = Version Sys.ocaml_version }
+ let empty = {
+ version = Version Globals.version;
+ sources = url Globals.default_hostname Globals.default_port ;
+ ocaml_version = Version Sys.ocaml_version
+ }
let find t f =
match Path.find t f with
- | Path.File (Binary s) ->
- (match parse_colon s with
- | ("version", version)
- :: ("sources", sources)
- :: ("ocaml-version", ocaml_version)
-
- :: _ -> { version = Version version
- ; sources =
- (try Some (let hostname, port = BatString.split sources ":" in
- Path.url hostname (try Some (int_of_string port) with _ -> None)) with _ -> None)
- ; ocaml_version = Version ocaml_version }
- | _ -> empty1)
- | _ -> empty2
+ | Path.File (Binary s) ->
+ let file = parse_colon s in
+ let version = try List.assoc "version" file with _ -> Globals.default_opam_version in
+ let sources =
+ try
+ let sources = List.assoc "sources" file in
+ let hostname, port = BatString.split sources ":" in
+ url hostname (try int_of_string port with _ -> Globals.default_port)
+ with _ ->
+ url Globals.default_hostname Globals.default_port in
+ let ocaml_version = try List.assoc "ocaml-version" file with _ -> Sys.ocaml_version in
+ { version = Version version; sources; ocaml_version = Version ocaml_version }
+ | _ -> failwith (Printf.sprintf "%s does not exist" (Path.string_of_filename f))
let to_string t =
Printf.sprintf "
version: %s
sources: %s"
(match t.version with Version s -> s)
- (match t.sources with None -> Printf.sprintf "%s:%d" ocamlpro_http ocamlpro_port | Some sources -> Path.string_of_url sources)
+ (string_of_url t.sources)
let add t f v = Path.add t f (Path.File (Binary (to_string v)))
end
@@ -119,7 +116,7 @@ sources: %s"
val cudf : internal_version (* package manager *) -> Cudf.package -> t
end
- module Cudf (F_config : CONFIG) : CUDF =
+ module Cudf : CUDF =
struct
type package =
{ preamble : Cudf.preamble option
@@ -157,7 +154,7 @@ sources: %s"
let cudf opam_version pkg = { opam_version ; package = { preamble = None ; pkg = [ pkg ] ; request = None } }
let empty =
- { opam_version = F_config.empty_package_manager
+ { opam_version = Version Globals.default_opam_version
; package = { preamble = None ; pkg = [] ; request = None } }
let find t f =
@@ -172,7 +169,7 @@ sources: %s"
| Some (preamble, pkg, request) ->
{ opam_version =
(match find_field "opam_version" pkg with
- | Some (`String v) -> F_config.version_of_string v
+ | Some (`String v) -> Config.version_of_string v
| _ -> empty.opam_version)
; package = { preamble ; pkg ; request } })
| _ -> empty
View
10 globals.ml
@@ -0,0 +1,10 @@
+let version = "0.1+dev"
+
+let default_hostname = "opam.ocamlpro.com"
+let default_port = 9999
+
+let default_ocaml_version = Sys.ocaml_version
+let default_opam_version = "1"
+
+let opam_server_path = ".opam-server"
+let opam_path = ".opam"
View
6 ocp-get.ocp
@@ -1,6 +1,4 @@
-(* typerex support *)
-ocamlc = ["ocp-ocamlc.opt"]
-ocamlopt = ["ocp-ocamlopt.opt"]
+comp = [ "-annot" ]
begin library "extlib"
sort = true
@@ -168,7 +166,7 @@ end
begin library "ocp-get-lib"
files = [
- "config.ml"
+ "globals.ml"
"namespace.ml"
"path.ml"
"file.ml"
View
690 ocp.ml
@@ -1,6 +1,5 @@
open Namespace
open Path
-open File
open Server
type 'a installed_status =
@@ -37,58 +36,260 @@ sig
(** Given a description of packages, it returns a list of solution preserving the consistency of the initial description. *)
end
+module Solver = struct
+
+ type 'a request =
+ { wish_install : 'a list
+ ; wish_remove : 'a list
+ ; wish_upgrade : 'a list }
+
+ type ('a, 'b) action =
+ | To_change of 'a
+ | To_delete of 'b
+ | To_recompile of 'b
+
+ type 'a parallel = P of 'a list
+
+ type 'a solution =
+ ( 'a (* old *) installed_status * 'a (* new *)
+ , 'a (* old *) )
+ action parallel list
+
+ let solution_map f =
+ BatList.map (function P l -> P (BatList.map (function
+ | To_change (o_p, p) -> To_change ((match o_p with
+ | Was_installed p -> Was_installed (f p)
+ | Was_not_installed -> Was_not_installed), f p)
+ | To_delete p -> To_delete (f p)
+ | To_recompile p -> To_recompile (f p)) l))
+
+ let solution_print f =
+ BatList.print ~first:"" ~last:"" ~sep:", "
+ (fun oc (P l) ->
+ BatList.print ~first:"" ~last:"" ~sep:", "
+ (fun oc act ->
+ let f_act s l_p =
+ begin
+ BatString.print oc (Printf.sprintf "%s : " s);
+ BatList.print f oc l_p;
+ end in
+ match act with
+ | To_change (o_v_old, p_new) ->
+ f_act "change"
+ (match o_v_old with
+ | Was_not_installed -> [ p_new ]
+ | Was_installed p_old -> [ p_old ; p_new ])
+ | To_recompile _ -> ()
+ | To_delete v -> f_act "remove" [v]) oc l)
+
+ module type CUDFDIFF =
+ sig
+ val resolve_diff : Cudf.package list -> Cudf_types.vpkg request ->
+ (Cudf.package installed_status * Cudf.package, Cudf.package) action list option
+
+ val resolve_summary : Cudf.package list -> Cudf_types.vpkg request ->
+ ( Cudf.package list
+ * (Cudf.package * Cudf.package) list
+ * (Cudf.package * Cudf.package) list
+ * Cudf.package list ) option
+ end
+
+ module CudfDiff : CUDFDIFF = struct
+
+ let to_cudf_doc l_pkg req =
+ None, l_pkg, { Cudf.request_id = ""
+ ; install = req.wish_install
+ ; remove = req.wish_remove
+ ; upgrade = req.wish_upgrade
+ ; req_extra = [] }
+
+
+ let cudf_resolve l_pkg req =
+ let open Algo in
+ let r = Depsolver.check_request (to_cudf_doc l_pkg req) in
+ if Diagnostic.is_solution r then
+ match r with
+ | { Diagnostic.result = Diagnostic.Success f } -> Some (f ~all:true ())
+ | _ -> assert false
+ else
+ None
+
+ module Cudf_set = struct
+ module S = Common.CudfAdd.Cudf_set
+
+ let choose_one s =
+ match S.cardinal s with
+ | 0 -> raise Not_found
+ | 1 -> S.choose s
+ | _ ->
+ failwith "to complete ! Determine if it suffices to remove one arbitrary element from the \"removed\" class, or remove completely every element."
+
+ include S
+ end
+
+ let resolve f_diff l_pkg_pb req =
+ BatOption.bind
+ (fun l_pkg_sol ->
+ let univ_init = Cudf.load_universe l_pkg_pb in
+ BatOption.bind
+ (f_diff univ_init)
+ (try Some (Common.CudfDiff.diff univ_init (Cudf.load_universe l_pkg_sol))
+ with Cudf.Constraint_violation _ -> None))
+ (cudf_resolve l_pkg_pb req)
+
+ let resolve_diff =
+ resolve
+ (fun _ diff ->
+ match
+ Hashtbl.fold (fun pkgname s acc ->
+ let add x = x :: acc in
+ match
+ (try Some (Cudf_set.choose_one s.Common.CudfDiff.removed) with Not_found -> None),
+ try Some (Cudf_set.choose s.Common.CudfDiff.installed) with Not_found -> None
+ with
+ | None, Some p -> add (To_change (Was_not_installed, p))
+ | Some p, None -> add (To_delete p)
+ | Some p_old, Some p_new -> add (To_change (Was_installed p_old, p_new))
+ | None, None -> acc) diff []
+ with
+ | [] -> None
+ | l -> Some l)
+
+ let resolve_summary = resolve (fun univ_init diff -> Some (Common.CudfDiff.summary univ_init diff))
+ end
+
+ module Graph =
+ struct
+ open Algo
+
+ module PG =
+ struct
+ module G = Defaultgraphs.PackageGraph.G
+ let union g1 g2 =
+ let g1 = G.copy g1 in
+ let () =
+ begin
+ G.iter_vertex (G.add_vertex g1) g2;
+ G.iter_edges (G.add_edge g1) g2;
+ end in
+ g1
+ include G
+ end
+ module PO = Defaultgraphs.GraphOper (PG)
+
+ module PG_bfs =
+ struct
+ include Graph.Traverse.Bfs (PG)
+ let fold f acc g =
+ let rec aux acc iter =
+ match try Some (get iter, step iter) with Exit -> None with
+ | None -> acc
+ | Some (x, iter) -> aux (f acc x) iter in
+ aux acc (start g)
+ end
+
+ module O_pkg = struct type t = Cudf.package let compare = compare end
+ module PkgMap = BatMap.Make (O_pkg)
+ module PkgSet = BatSet.Make (O_pkg)
+
+ let dep_reduction v =
+ let g = Defaultgraphs.PackageGraph.dependency_graph (Cudf.load_universe v) in
+ let () = PO.transitive_reduction g in
+ g
+
+ let resolve l_pkg_pb req =
+ [ match
+ BatOption.bind
+ (let cons pkg act = Some (pkg, act) in
+ fun l ->
+ let graph_installed = dep_reduction (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) (Cudf.load_universe l_pkg_pb)) in
+
+ let l_del_p, l_del =
+ BatList.split
+ (BatList.filter_map (function
+ | To_delete pkg as act -> cons pkg act
+ | _ -> None) l) in
+
+ let map_add =
+ PkgMap.of_enum (BatList.enum (BatList.filter_map (function
+ | To_change (_, pkg) as act -> cons pkg act
+ | To_delete _ -> None
+ | To_recompile _ -> assert false) l)) in
+
+ let _, l_act =
+ PG_bfs.fold
+ (fun (set_recompile, l_act) pkg ->
+ let add_succ_rem pkg set act =
+ List.fold_left (fun set x -> PkgSet.add x set) (PkgSet.remove pkg set) (PG.succ graph_installed pkg), act :: l_act in
+
+ match PkgMap.Exceptionless.find pkg map_add with
+ | Some act ->
+ add_succ_rem pkg set_recompile act
+ | None ->
+ if PkgSet.mem pkg set_recompile then
+ add_succ_rem pkg set_recompile (To_recompile pkg)
+ else
+ set_recompile, l_act) (PkgSet.empty, List.rev l_del)
+ (let graph_installed = PG.copy graph_installed in
+ let () = List.iter (PG.remove_vertex graph_installed) l_del_p in
+ PG.union graph_installed (dep_reduction (BatList.of_enum (PkgMap.keys map_add)))) in
+ Some (List.rev l_act))
+ (CudfDiff.resolve_diff l_pkg_pb req)
+ with
+ | None -> []
+ | Some l -> BatList.map (fun x -> P [ x ]) l ]
+ end
+
+ let resolve = Graph.resolve
+end
+
+
module type CLIENT =
sig
type t
val init0 : unit -> t
- val init : t -> Path.url (* repository address *) option (* [None] : default is opam.ocamlpro.com, port = 9999 *) -> t
- (** Initializes in a consistent state. *)
+ (** Initializes the client a consistent state. *)
+ val init : t -> url (* repository address *) option (* [None] : default is opam.ocamlpro.com, port = 9999 *) -> t
+ (** Displays the installed package. [None] : a general summary is given. *)
val info : t -> Namespace.name option -> t
- (** Displays the installed package. [None] : a general summary is given. *)
type config_request = Dir
+
+ (** Returns the directory where the package is installed,
+ in a form suitable to OCaml compilers (i.e. like "-I ..."). *)
val config : t -> config_request -> Namespace.name -> t
- (** Returns the directory where the package is installed,
- in a form suitable to OCaml compilers (i.e. like "-I ..."). *)
+ (** Installs the given package. *)
val install : t -> Namespace.name -> t
- (** Installs the given package. *)
+ (** Downloads the latest packages available. *)
val update : t -> t
- (** Downloads the latest packages available. *)
+ (** Finds a consistent state where most of the installed packages are
+ upgraded to their latest version. *)
val upgrade : t -> t
- (** Finds a consistent state where most of the installed packages are
- upgraded to their latest version. *)
+ (** Sends a new created package to the server. *)
val upload : t -> string -> t
- (** Sends a new created package to the server. *)
+ (** Removes the given package. *)
val remove : t -> Namespace.name -> t
- (** Removes the given package. *)
end
-module Client
- (F_config : File.CONFIG)
- (F_installed : File.INSTALLED)
- (F_cudf : File.CUDF)
- (F_toinstall : File.TO_INSTALL)
- (Solver : SOLVER)
- (Server : SERVER with type package = Cudf.package)
- (P : File.PRINTF)
- : CLIENT =
-struct
+module Client = struct
+ open File
+
type t =
- { server : Server.t
- ; home : Path.t (* ~/.opam *)
+ { server : url
+ ; home : Path.t (* ~/.opam *)
; stdout : P.t }
let init0 x =
- let home = Path.init None ".opam" (F_config.empty_ocaml) in
- { server = Server.init (F_config.sources (F_config.find home (Path.config home)))
+ let home = Path.init Globals.opam_path in
+ { server = File.Config.sources (File.Config.find home (Path.config home))
; home
; stdout = P.init x }
@@ -100,24 +301,28 @@ struct
if Path.file_exists index_nv then
home, map
else
- F_cudf.add home index_nv
- (F_cudf.cudf
- (Server.version_opam t.server)
- (match Server.package (Server.getOpam t.server (n, v)) with
+ File.Cudf.add home index_nv
+ (File.Cudf.cudf
+ (Version Globals.default_opam_version)
+ (match Server.package (RemoteServer.getOpam t.server (n, v)) with
| None -> assert false
| Some pkg -> pkg)),
N_map.modify_def V_set.empty n (V_set.add v) map)
(t.home, N_map.empty)
- (Server.getList t.server) in
+ (RemoteServer.getList t.server) in
{ t with home; stdout =
- P.printf t.stdout "%s" (BatIO.to_string (N_map.print (fun oc name -> BatString.print oc (Namespace.string_user_of_name name))
- (V_set.print (fun oc version -> BatString.print oc (Namespace.string_user_of_version version)))) map) }
+ P.printf t.stdout "%s"
+ (BatIO.to_string
+ (N_map.print
+ (fun oc name -> BatString.print oc (Namespace.string_user_of_name name))
+ (V_set.print (fun oc version -> BatString.print oc (Namespace.string_user_of_version version)))
+ ) map) }
let init t o_url =
update (match o_url with
| None -> t
- | Some url -> { t with server = Server.change_url t.server url })
+ | Some url -> { t with server = url })
let indent_left s nb = s ^ String.make nb ' '
@@ -135,13 +340,13 @@ struct
function
| None ->
- let install_set = NV_set.of_enum (BatList.enum (F_installed.find t.home (Path.installed t.home))) in
+ let install_set = NV_set.of_enum (BatList.enum (File.Installed.find t.home (Path.installed t.home))) in
let map, max_n, max_v =
List.fold_left (fun (map, max_n, max_v) n_v ->
let b = NV_set.mem n_v install_set in
NV_map.add n_v
(b,
- F_cudf.description (F_cudf.package (F_cudf.find t.home (Path.index_opam t.home (Some n_v)))))
+ File.Cudf.description (File.Cudf.package (File.Cudf.find t.home (Path.index_opam t.home (Some n_v)))))
map,
max max_n (String.length (Namespace.string_user_of_name (fst n_v))),
if b then max max_v (String.length (Namespace.string_user_of_version (snd n_v))) else max_v)
@@ -162,7 +367,7 @@ struct
let o_v =
BatOption.map
V_set.choose (* By definition, there is exactly 1 element, we choose it. *)
- (find_from_name (F_installed.find t.home (Path.installed t.home))) in
+ (find_from_name (File.Installed.find t.home (Path.installed t.home))) in
let v_set =
let v_set =
@@ -184,7 +389,7 @@ struct
; "description", "\n" ^
match o_v with None -> ""
| Some v ->
- F_cudf.description (F_cudf.package (F_cudf.find t.home (Path.index_opam t.home (Some (name, v))))) ] }
+ File.Cudf.description (File.Cudf.package (File.Cudf.find t.home (Path.index_opam t.home (Some (name, v))))) ] }
let confirm_ msg chan =
match P.read_line
@@ -205,14 +410,15 @@ struct
if Path.file_exists p_targz then
t, Path.R_filename (BatList.map (Path.concat p_build) (match Path.find t.home p_build with Path.Directory l -> l | _ -> []))
else
- let tgz = Path.extract_targz t.home (Server.getArchive t.server (Server.getOpam t.server (name, v))) in
- { t with home = Path.add_rec t.home p_build tgz }, tgz in
+ let tgz = Path.extract_targz t.home
+ (RemoteServer.getArchive t.server (RemoteServer.getOpam t.server (name, v))) in
+ { t with home = Path.add_rec t.home p_build tgz }, tgz in
let t = f_build t tgz in
- let to_install = F_toinstall.find t.home (Path.to_install t.home (name, v)) in
+ let to_install = File.To_install.find t.home (Path.to_install t.home (name, v)) in
let filename_of_path_relative t path =
- Path.R_filename (F_toinstall.filename_of_path_relative t.home
+ Path.R_filename (File.To_install.filename_of_path_relative t.home
(Path.build t.home (Some (name, v)))
path) in
@@ -222,27 +428,27 @@ struct
(filename_of_path_relative t path) in
let t = (* lib *)
- List.fold_left (add_rec Path.lib) t (F_toinstall.lib to_install) in
+ List.fold_left (add_rec Path.lib) t (File.To_install.lib to_install) in
let t = (* bin *)
- add_rec (fun t _ -> Path.bin t) t (F_toinstall.bin to_install) in
+ add_rec (fun t _ -> Path.bin t) t (File.To_install.bin to_install) in
let t = (* misc *)
List.fold_left
(fun t misc ->
- let ok, t = confirm t (F_toinstall.string_of_misc misc) in
+ let ok, t = confirm t (File.To_install.string_of_misc misc) in
if ok then
- let path_from = filename_of_path_relative t (F_toinstall.path_from misc) in
+ let path_from = filename_of_path_relative t (File.To_install.path_from misc) in
List.fold_left
(fun t path_to -> { t with home = Path.add_rec t.home path_to path_from })
t
- (F_toinstall.filename_of_path_absolute t.home (F_toinstall.path_to misc))
+ (File.To_install.filename_of_path_absolute t.home (File.To_install.path_to misc))
else
- t) t (F_toinstall.misc to_install) in
+ t) t (File.To_install.misc to_install) in
t
let proceed_todelete t (n, v0) =
- let map_installed = N_map.of_enum (BatList.enum (F_installed.find t.home (Path.installed t.home))) in
+ let map_installed = N_map.of_enum (BatList.enum (File.Installed.find t.home (Path.installed t.home))) in
match N_map.Exceptionless.find n map_installed with
| Some v when v = v0 ->
let t =
@@ -255,7 +461,7 @@ struct
t
(n, v) in
- let t = { t with home = F_installed.add t.home (Path.installed t.home) (N_map.bindings (N_map.remove n map_installed)) } in
+ let t = { t with home = File.Installed.add t.home (Path.installed t.home) (N_map.bindings (N_map.remove n map_installed)) } in
t
| _ -> t
@@ -302,7 +508,7 @@ struct
(let l_pkg, map_pkg =
List.fold_left
(fun (l, map) n_v ->
- let pkg = F_cudf.package (F_cudf.find t.home (Path.index_opam t.home (Some n_v))) in
+ let pkg = File.Cudf.package (File.Cudf.find t.home (Path.index_opam t.home (Some n_v))) in
pkg :: l, PkgMap.add pkg n_v map) ([], PkgMap.empty) l_index in
(BatList.map (Solver.solution_map (fun p -> PkgMap.find p map_pkg)) (Solver.resolve l_pkg request)) ) in
@@ -335,7 +541,7 @@ struct
let remove t name =
match
- match BatList.Exceptionless.assoc name (F_installed.find t.home (Path.installed t.home)) with
+ match BatList.Exceptionless.assoc name (File.Installed.find t.home (Path.installed t.home)) with
| None ->
let ok, t = confirm t (Printf.sprintf "Package \"%s\" not found. We will call the solver to see its output."
(Namespace.string_user_of_name name)) in
@@ -354,7 +560,9 @@ struct
let upgrade t =
resolve t (Path.index_opam_list t.home)
- { Solver.wish_install = [] ; wish_remove = [] ; wish_upgrade = BatList.map vpkg_of_nv (F_installed.find t.home (Path.installed t.home)) }
+ { Solver.wish_install = []
+ ; wish_remove = []
+ ; wish_upgrade = BatList.map vpkg_of_nv (File.Installed.find t.home (Path.installed t.home)) }
let upload t s_filename =
let filename = Path.package t.home s_filename in
@@ -373,7 +581,9 @@ struct
match o with
| Some v ->
{ t with server =
- Server.newArchive t.server (Server.getOpam t.server (Path.nv_of_extension Namespace.default_version (Path.basename filename))) v }
+ RemoteServer.newArchive t.server
+ (RemoteServer.getOpam t.server
+ (Path.nv_of_extension Namespace.default_version (Path.basename filename))) v }
| None -> t
type config_request = Dir
@@ -394,350 +604,6 @@ struct
| I s -> s) }
end
-module Solver
- (F_cudf : File.CUDF)
- : SOLVER =
-struct
-
- type 'a request =
- { wish_install : 'a list
- ; wish_remove : 'a list
- ; wish_upgrade : 'a list }
-
- type ('a, 'b) action =
- | To_change of 'a
- | To_delete of 'b
- | To_recompile of 'b
-
- type 'a parallel = P of 'a list
-
- type 'a solution =
- ( 'a (* old *) installed_status * 'a (* new *)
- , 'a (* old *) )
- action parallel list
-
- let solution_map f =
- BatList.map (function P l -> P (BatList.map (function
- | To_change (o_p, p) -> To_change ((match o_p with
- | Was_installed p -> Was_installed (f p)
- | Was_not_installed -> Was_not_installed), f p)
- | To_delete p -> To_delete (f p)
- | To_recompile p -> To_recompile (f p)) l))
-
- let solution_print f =
- BatList.print ~first:"" ~last:"" ~sep:", "
- (fun oc (P l) ->
- BatList.print ~first:"" ~last:"" ~sep:", "
- (fun oc act ->
- let f_act s l_p =
- begin
- BatString.print oc (Printf.sprintf "%s : " s);
- BatList.print f oc l_p;
- end in
- match act with
- | To_change (o_v_old, p_new) ->
- f_act "change"
- (match o_v_old with
- | Was_not_installed -> [ p_new ]
- | Was_installed p_old -> [ p_old ; p_new ])
- | To_recompile _ -> ()
- | To_delete v -> f_act "remove" [v]) oc l)
-
- module type CUDFDIFF =
- sig
- val resolve_diff : Cudf.package list -> Cudf_types.vpkg request ->
- (Cudf.package installed_status * Cudf.package, Cudf.package) action list option
-
- val resolve_summary : Cudf.package list -> Cudf_types.vpkg request ->
- ( Cudf.package list
- * (Cudf.package * Cudf.package) list
- * (Cudf.package * Cudf.package) list
- * Cudf.package list ) option
- end
-
- module CudfDiff : CUDFDIFF =
- struct
- module type CUDFDIFF =
- sig
- type solution =
- { installed : Common.CudfAdd.Cudf_set.t
- ; removed : Common.CudfAdd.Cudf_set.t }
- val diff : Cudf.universe -> Cudf.universe -> (Common.CudfAdd.StringSet.elt, solution) ExtLib.Hashtbl.t
- val summary : Cudf.universe -> (Common.CudfAdd.StringSet.elt, solution) ExtLib.Hashtbl.t ->
- Cudf.package list * (Cudf.package * Cudf.package) list * (Cudf.package * Cudf.package) list * Cudf.package list
- end
-
- module CudfDiff : CUDFDIFF =
- struct
- (**************************************************************************************)
- (* Copyright (C) 2010 Pietro Abate <pietro.abate@pps.jussieu.fr> *)
- (* Copyright (C) 2010 Mancoosi Project *)
- (* *)
- (* This library 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. A special linking *)
- (* exception to the GNU Lesser General Public License applies to this *)
- (* library, see the COPYING file for more information. *)
- (**************************************************************************************)
-
-
- open ExtLib
- open Common
-
- module Cudf_set = CudfAdd.Cudf_set
- module StringSet = CudfAdd.StringSet
-
- type solution = {
- installed : Cudf_set.t ;
- removed : Cudf_set.t ;
- }
-
- (* the 'package' is always taken from the universe *)
- let to_set univ l =
- List.fold_left (fun s p ->
- let q = Cudf.lookup_package univ (p.Cudf.package,p.Cudf.version) in
- Cudf_set.add q s
- ) Cudf_set.empty l
- ;;
-
- (* for each pkgname I've the list of all versions that were installed or removed *)
- let diff univ sol =
- let pkgnames = CudfAdd.pkgnames univ in
- let h = Hashtbl.create (StringSet.cardinal pkgnames) in
- StringSet.iter (fun pkgname ->
- let were_installed = to_set univ (Cudf.get_installed univ pkgname) in
- let are_installed = to_set univ (Cudf.get_installed sol pkgname) in
- let r = Cudf_set.diff were_installed are_installed in
- let i = Cudf_set.diff are_installed were_installed in
- let s = { removed = r ; installed = i } in
- Hashtbl.add h pkgname s
- ) pkgnames ;
- h
-
- (*
- [all] : all versions of a package in the universe .
- [s] : the set of version for version of a package in a solution
- returns a list that contains for each version its status : installed,
- removed, upgraded, etc
- *)
- type summary_t = {
- mutable i : Cudf.package list; (* installed *)
- mutable r : Cudf.package list; (* removed *)
- mutable u : (Cudf.package * Cudf.package) option ; (* upgraded *)
- mutable d : (Cudf.package * Cudf.package) option ; (* downgraded *)
- mutable nu : Cudf.package list; (* not upgraded *)
- }
-
- (* for one package *)
- let default_summary () = { u = None; d = None ; i = [] ; r = [] ; nu = [] }
-
- let uniqueversion all s =
- let l = default_summary () in
- let i = Cudf_set.filter (fun pkg -> pkg.Cudf.installed) all in
- if (Cudf_set.cardinal i <= 1) && ((Cudf_set.cardinal s.installed) <= 1) then
- begin
- if (Cudf_set.cardinal s.installed) = 1 then begin
- if (Cudf_set.cardinal i) = 1 then begin
- let np = Cudf_set.choose i in
- let op = Cudf_set.choose s.installed in
- if np.Cudf.version < op.Cudf.version
- then l.u <- Some(np,op)
- else l.d <- Some(op,np)
- end
- else
- l.i <- Cudf_set.elements s.installed;
- end else
- if not (Cudf_set.is_empty s.removed) then
- l.r <- Cudf_set.elements s.removed;
- end
- else begin
- if not (Cudf_set.is_empty s.removed) then
- l.r <- Cudf_set.elements s.removed;
- if not (Cudf_set.is_empty s.installed) then
- l.i <- Cudf_set.elements s.installed;
- end;
- l
- ;;
-
- let summary univ diff =
- let i = ref [] in
- let u = ref [] in
- let d = ref [] in
- let r = ref [] in
- let names = CudfAdd.pkgnames univ in
- StringSet.iter (fun pkgname ->
- let all = CudfAdd.to_set (Cudf.lookup_packages univ pkgname) in
- let s = Hashtbl.find diff pkgname in
- let l = uniqueversion all s in
- i := l.i @ !i ;
- r := l.r @ !r ;
- if not (Option.is_none l.u) then
- u := (Option.get l.u) :: !u;
- if not (Option.is_none l.d) then
- d := (Option.get l.d) :: !d;
- ) names;
- (!i,!u,!d,!r)
- ;;
- end
-
- let to_cudf_doc l_pkg req =
- None, l_pkg, { Cudf.request_id = ""
- ; install = req.wish_install
- ; remove = req.wish_remove
- ; upgrade = req.wish_upgrade
- ; req_extra = [] }
-
-
- let cudf_resolve l_pkg req =
- let open Algo in
- let r = Depsolver.check_request (to_cudf_doc l_pkg req) in
- if Diagnostic.is_solution r then
- match r with
- | { Diagnostic.result = Diagnostic.Success f } -> Some (f ~all:true ())
- | _ -> assert false
- else
- None
-
- module Cudf_set =
- struct
- module S = Common.CudfAdd.Cudf_set
-
- let choose_one s =
- match S.cardinal s with
- | 0 -> raise Not_found
- | 1 -> S.choose s
- | _ ->
- failwith "to complete ! Determine if it suffices to remove one arbitrary element from the \"removed\" class, or remove completely every element."
-
- include S
- end
-
- let resolve f_diff l_pkg_pb req =
- BatOption.bind
- (fun l_pkg_sol ->
- let univ_init = Cudf.load_universe l_pkg_pb in
- BatOption.bind
- (f_diff univ_init)
- (try Some (CudfDiff.diff univ_init (Cudf.load_universe l_pkg_sol)) with Cudf.Constraint_violation _ -> None))
- (cudf_resolve l_pkg_pb req)
-
- let resolve_diff =
- resolve
- (fun _ diff ->
- match
- Hashtbl.fold (fun pkgname s acc ->
- let add x = x :: acc in
- match
- (try Some (Cudf_set.choose_one s.CudfDiff.removed) with Not_found -> None),
- try Some (Cudf_set.choose s.CudfDiff.installed) with Not_found -> None
- with
- | None, Some p -> add (To_change (Was_not_installed, p))
- | Some p, None -> add (To_delete p)
- | Some p_old, Some p_new -> add (To_change (Was_installed p_old, p_new))
- | None, None -> acc) diff []
- with
- | [] -> None
- | l -> Some l)
-
- let resolve_summary = resolve (fun univ_init diff -> Some (CudfDiff.summary univ_init diff))
- end
-
- module Graph =
- struct
- open Algo
-
- module PG =
- struct
- module G = Defaultgraphs.PackageGraph.G
- let union g1 g2 =
- let g1 = G.copy g1 in
- let () =
- begin
- G.iter_vertex (G.add_vertex g1) g2;
- G.iter_edges (G.add_edge g1) g2;
- end in
- g1
- include G
- end
- module PO = Defaultgraphs.GraphOper (PG)
-
- module PG_bfs =
- struct
- include Graph.Traverse.Bfs (PG)
- let fold f acc g =
- let rec aux acc iter =
- match try Some (get iter, step iter) with Exit -> None with
- | None -> acc
- | Some (x, iter) -> aux (f acc x) iter in
- aux acc (start g)
- end
-
- module O_pkg = struct type t = Cudf.package let compare = compare end
- module PkgMap = BatMap.Make (O_pkg)
- module PkgSet = BatSet.Make (O_pkg)
-
- let dep_reduction v =
- let g = Defaultgraphs.PackageGraph.dependency_graph (Cudf.load_universe v) in
- let () = PO.transitive_reduction g in
- g
-
- let resolve l_pkg_pb req =
- [ match
- BatOption.bind
- (let cons pkg act = Some (pkg, act) in
- fun l ->
- let graph_installed = dep_reduction (Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) (Cudf.load_universe l_pkg_pb)) in
-
- let l_del_p, l_del =
- BatList.split
- (BatList.filter_map (function
- | To_delete pkg as act -> cons pkg act
- | _ -> None) l) in
-
- let map_add =
- PkgMap.of_enum (BatList.enum (BatList.filter_map (function
- | To_change (_, pkg) as act -> cons pkg act
- | To_delete _ -> None
- | To_recompile _ -> assert false) l)) in
-
- let _, l_act =
- PG_bfs.fold
- (fun (set_recompile, l_act) pkg ->
- let add_succ_rem pkg set act =
- List.fold_left (fun set x -> PkgSet.add x set) (PkgSet.remove pkg set) (PG.succ graph_installed pkg), act :: l_act in
-
- match PkgMap.Exceptionless.find pkg map_add with
- | Some act ->
- add_succ_rem pkg set_recompile act
- | None ->
- if PkgSet.mem pkg set_recompile then
- add_succ_rem pkg set_recompile (To_recompile pkg)
- else
- set_recompile, l_act) (PkgSet.empty, List.rev l_del)
- (let graph_installed = PG.copy graph_installed in
- let () = List.iter (PG.remove_vertex graph_installed) l_del_p in
- PG.union graph_installed (dep_reduction (BatList.of_enum (PkgMap.keys map_add)))) in
- Some (List.rev l_act))
- (CudfDiff.resolve_diff l_pkg_pb req)
- with
- | None -> []
- | Some l -> BatList.map (fun x -> P [ x ]) l ]
- end
-
- let resolve = Graph.resolve
-end
-
-module M =
-struct
- open File
- module Cudf = Cudf (Config)
- module Solv = Solver (Cudf)
- module S = Server (Config) (Cudf)
- module C = Client (Config) (Installed) (Cudf) (To_install) (Solv) (S) (P)
-end
-
-module C = M.C
open Namespace
(*
@@ -748,7 +614,7 @@ let filename_of_string s =
(BatString.nsplit (BatString.strip ~chars:"/" s) "/")
*)
let _ =
- let client = C.init0 () in
+ let client = Client.init0 () in
let f x =
let _ = Printf.printf "(* command not found *)\n%!" in
x in
@@ -757,24 +623,28 @@ let _ =
| _ :: l ->
match l with
- | "init" :: url :: port :: _ -> C.init client (Some (Path.url url (Some (int_of_string port))))
- | "init" :: url :: _ -> C.init client (Some (Path.url url None))
- | "init" :: _ -> C.init client None
+ | "init" :: host :: port :: [] ->
+ let port =
+ try int_of_string port
+ with _ -> failwith (port ^ " is not a valid port") in
+ Client.init client (Some (url host port))
+ | "init" :: host :: [] -> Client.init client (Some (url host Globals.default_port))
+ | "init" :: _ -> Client.init client None
- | "info" :: name :: _ -> C.info client (Some (Name name))
- | "info" :: _ -> C.info client None
+ | "info" :: name :: _ -> Client.info client (Some (Name name))
+ | "info" :: _ -> Client.info client None
| "config" :: name :: []
- | "config" :: _ :: name :: _ -> C.config client C.Dir (Name name)
+ | "config" :: _ :: name :: _ -> Client.config client Client.Dir (Name name)
- | "install" :: name :: _ -> C.install client (Name name)
+ | "install" :: name :: _ -> Client.install client (Name name)
- | "update" :: _ -> C.update client
+ | "update" :: _ -> Client.update client
- | "upgrade" :: _ -> C.upgrade client
+ | "upgrade" :: _ -> Client.upgrade client
- | "upload" :: s :: _ -> C.upload client s
+ | "upload" :: s :: _ -> Client.upload client s
- | "remove" :: name :: _ -> C.remove client (Name name)
+ | "remove" :: name :: _ -> Client.remove client (Name name)
| _ -> f client
View
10 ocp_get_server.ml
@@ -3,9 +3,6 @@ open Unix
open File
open Server
-module Cudf = File.Cudf(File.Config)
-module Server = Server(File.Config)(Cudf)
-
let usage =
Printf.sprintf "%s -p <port> [--debug]" Sys.argv.(0)
@@ -21,11 +18,11 @@ Copyright (C) 2012 OCamlPro - INRIA
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n"
- Sys.argv.(0) Config.version
+ Sys.argv.(0) Globals.version
let debug = ref false
-let port = ref 9999
+let port = ref Globals.default_port
let set_port p = port := p
let args = Arg.align [
@@ -47,8 +44,7 @@ let server fn =
let fn stdin stdout =
let print s = Printf.eprintf "%s\n%!" s in
- let open Server in
- match (input_value stdin : Server.api) with
+ match (input_value stdin : api) with
| GetList t -> print "getList"
| GetOpam (t, name_version) -> print "GetOpam"
| GetArchive (t, opam) -> print "GetArchive"
View
115 path.ml
@@ -1,5 +1,15 @@
open Namespace
+type url = {
+ hostname: string;
+ port: int;
+}
+
+let url hostname port = { hostname; port }
+
+let string_of_url url =
+ Printf.sprintf "%s:%d" url.hostname url.port
+
type 'a ocaml_options =
| I of 'a
@@ -21,7 +31,6 @@ sig
type t
type filename
- type url
type 'a contents =
| Directory of basename list
@@ -33,95 +42,104 @@ sig
| R_file of 'a
| R_filename of filename list
- val init : url option (* [None] : local *) -> string (* $HOME_OPAM *) -> internal_version (* OVERSION *) -> t
+ val init : string (* $HOME_OPAM *) -> t
(* $HOME_OPAM_OVERSION = $HOME_OPAM/OVERSION *)
(** definitions of some shortcuts *)
- val root : filename (* / *)
+
(** the root of every path *)
- val package : t -> string (* computed from $PWD *) -> filename
+ val root : filename (* ~/ *)
+
(** path in the packager filesystem, contains the collection of libraries and programs *)
- val lib : t -> Namespace.name -> filename (* $HOME_OPAM_OVERSION/lib/NAME *)
+ val package : t -> string (* computed from $PWD *) -> filename
+
(** installed libraries for the package (at most one version installed) *)
- val bin : t -> filename (* $HOME_OPAM_OVERSION/bin *)
+ val lib : t -> Namespace.name -> filename (* $HOME_OPAM_OVERSION/lib/NAME *)
+
(** contain installed binaries *)
- val config : t -> filename (* $HOME_OPAM/config *)
+ val bin : t -> filename (* $HOME_OPAM_OVERSION/bin *)
+
(** main configuration file *)
- val installed : t -> filename (* $HOME_OPAM_OVERSION/installed *)
+ val config : t -> filename (* $HOME_OPAM/config *)
+
(** list of installed packages with their version *)
- val index_opam : t -> name_version option -> filename (* $HOME_OPAM/index/NAME-VERSION.opam *)
+ val installed : t -> filename (* $HOME_OPAM_OVERSION/installed *)
+
(** OPAM files considered for an arbitrary version and package *)
- val index_opam_list : t -> name_version list (* [ $HOME_OPAM/index/NAME-VERSION.opam ] -> [ NAME, VERSION ] *)
+ val index_opam : t -> name_version option -> filename (* $HOME_OPAM/index/NAME-VERSION.opam *)
+ (* THOMAS: why option *)
+
(** list of OPAM files *)
- val archives_targz : t -> name_version option -> filename (* $HOME_OPAM/archives/NAME-VERSION.tar.gz *)
+ val index_opam_list : t -> name_version list (* [ $HOME_OPAM/index/NAME-VERSION.opam ] -> [ NAME, VERSION ] *)
+
(** source archives for all versions of all packages *)
- val build : t -> name_version option -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION *)
+ val archives_targz : t -> name_version option -> filename (* $HOME_OPAM/archives/NAME-VERSION.tar.gz *)
+ (* THOMAS: why option *)
+
(** tempory folders used to decompress the corresponding archives *)
- val to_install : t -> name_version -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION/NAME.install *)
+ val build : t -> name_version option -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION *)
+ (* THOMAS: why option *)
+
(** compiled files in the extracted archive to install *)
+ val to_install : t -> name_version -> filename (* $HOME_OPAM_OVERSION/build/NAME-VERSION/NAME.install *)
+
(** **)
- val find : t -> filename -> binary_data contents
(** Retrieves the contents from the hard disk. *)
+ val find : t -> filename -> binary_data contents
- val remove : t -> filename -> t
(** Removes everything in [filename] if existed. *)
+ val remove : t -> filename -> t
- val add : t -> filename -> binary_data contents -> t
(** Removes everything in [filename] if existed, then write [contents] instead. *)
+ val add : t -> filename -> binary_data contents -> t
- val add_rec : t -> filename -> binary_data contents_rec -> t
(** Removes everything in [filename] if existed, then write [contents_rec] inside [filename]. *)
+ val add_rec : t -> filename -> binary_data contents_rec -> t
- val extract_targz : t -> binary_data archive -> binary_data contents_rec
(** Returns the same meaning as [archive] but in extracted form. *)
+ val extract_targz : t -> binary_data archive -> binary_data contents_rec
- val raw_targz : filename -> binary_data archive
(** Considers the given [filename] as the contents of an [archive] already extracted. *)
+ val raw_targz : filename -> binary_data archive
+ (** Executes this particularly named script. *)
val exec_buildsh : t -> name_version -> t
(* $HOME_OPAM/build/NAME-VERSION/build.sh *)
- (** Executes this particularly named script. *)
-
- val dirname : filename -> filename
+
(** see [Filename.dirname] *)
+ val dirname : filename -> filename
- val basename : filename -> basename
(** see [Filename.basename] *)
+ val basename : filename -> basename
val nv_of_extension : string (* version *) -> basename -> Namespace.name * Namespace.version
(** see [Filename.chop_extension], but in case of no extensions, it behaves as the identity function.
When [basename] is not of the form "NAME-VERSION", or when we can not extract the version, [string]
is returned as version. *)
- val concat : filename -> basename -> filename
(** see [Filename.concat] *)
+ val concat : filename -> basename -> filename
- val file_exists : filename -> bool
(** see [Sys.file_exists] *)
+ val file_exists : filename -> bool
+ (** Returns the exact path to give to the OCaml compiler (ie. -I ...) *)
val ocaml_options_of_library : t -> Namespace.name -> string ocaml_options
(* $HOME_OPAM/lib/NAME *)
- (** Returns the exact path to give to the OCaml compiler (ie. -I ...) *)
- val url : string (* hostname *) -> int option (* port *) -> url
- val change_url : t -> url -> t
- val string_of_url : url -> string
- (** in the format "HOSTNAME:PORT" *)
- val compare_computer : t -> t -> int
+ val string_of_filename: filename -> string
end
+
module Path : PATH = struct
open Printf
- type url = U of string
-
type filename =
| Normalized of string
| Raw of string
- type t = { computer : url option (* [None] : local *)
- ; home : string
+ type t = { home : string
; home_ocamlversion : string }
type 'a contents =
@@ -154,9 +172,9 @@ module Path : PATH = struct
let (//) = sprintf "%s/%s"
let concat f (B s) = filename_map (fun filename -> filename // s) f
let (///) = concat
- let init o s (Version ocamlv) =
+ let init s =
let home = home // s in
- { computer = o ; home ; home_ocamlversion = home // ocamlv }
+ { home ; home_ocamlversion = home // Globals.default_ocaml_version }
let root = Raw "/"
let package _ s = Raw (Printf.sprintf "%s" s)
@@ -179,20 +197,12 @@ module Path : PATH = struct
let to_install t (n, v) = build t (Some (n, v)) /// B (Namespace.string_of_name n ^ ".install")
- let url x o = U (sprintf "%s%s" x (match o with None -> "" | Some i -> sprintf ":%d" i))
-
- let change_url t u = { t with computer = Some u }
-
let contents f_dir f_fic f_not_exists t f =
- match t.computer with
- | None ->
- let fic = s_of_filename f in
- if Sys.file_exists fic then
- (if Sys.is_directory fic then f_dir else f_fic) fic
- else
- f_not_exists
- | Some _ -> failwith "to complete !"
-
+ let fic = s_of_filename f in
+ if Sys.file_exists fic then
+ (if Sys.is_directory fic then f_dir else f_fic) fic
+ else
+ f_not_exists
let find =
contents
@@ -273,8 +283,6 @@ module Path : PATH = struct
t
| Not_exists -> t
- let compare_computer t1 t2 = compare t1.computer t2.computer
-
let exec_buildsh t n_v =
let _ = Sys.chdir (s_of_filename (build t (Some n_v))) in
let _ = Sys.command "build.sh" in
@@ -324,5 +332,6 @@ module Path : PATH = struct
let ocaml_options_of_library t name =
I (Printf.sprintf "%s" (s_of_filename (lib t name)))
- let string_of_url (U s) = s
+ let string_of_filename = s_of_filename
+
end
View
87 server.ml
@@ -5,18 +5,8 @@ open File
module type SERVER =
sig
type t
- type opam
- type package
-
- type api =
- | GetList of t
- | GetOpam of t * name_version
- | GetArchive of t * opam
- | NewArchive of t * opam * binary_data archive
-
- val init : Path.url option -> t
-
- val change_url : t -> Path.url -> t
+ type opam = name_version * Cudf.package option
+ type package = Cudf.package
val getList : t -> name_version list
(** Returns the list of the available versions for all
@@ -33,68 +23,43 @@ sig
(** Receives an upload, it contains an OPAM file and the
corresponding package archive. *)
- val version_opam : t -> internal_version
- val version_ocaml : t -> internal_version
-
val package : opam -> package option
(** [None] : the [opam] associated to the [(name, version)] does not exist.
Note that every [(name, version)] given by [getList] do exist. *)
end
-module Server
- (F_config : File.CONFIG)
- (F_cudf : File.CUDF)
- : SERVER with type package = Cudf.package =
-struct
- module Path_map = BatMap.Make (struct type t = Path.t let compare = Path.compare_computer end)
+type server_state =
+ { current_repository : Cudf.package NV_map.t
+ ; home : Path.t (* ~/.opam-server *)
+ ; version_package_manager : internal_version }
+
+
+module Server : SERVER with type t = server_state = struct
- type t =
- { current_repository : Cudf.package NV_map.t
- ; home : Path.t (* ~/.opam-server *)
- ; all_repository : Cudf.package NV_map.t Path_map.t
- ; version_package_manager : internal_version
- ; version_ocaml : internal_version }
+ type t = server_state
type opam = name_version * Cudf.package option
(* [None] : the current repository does not contain the package associated to the [name] and [version] *)
type package = Cudf.package
- type api =
- | GetList of t
- | GetOpam of t * name_version
- | GetArchive of t * opam
- | NewArchive of t * opam * binary_data archive
-
let read_archives home =
let archives = Path.archives_targz home None in
List.fold_left
(fun map x ->
NV_map.add
(Path.nv_of_extension Namespace.default_version x)
- (F_cudf.package (F_cudf.find home (Path.concat archives x)))
+ (File.Cudf.package (File.Cudf.find home (Path.concat archives x)))
map) NV_map.empty
(match Path.find home archives with
| Path.Directory l -> l
| _ -> [])
- let init o =
- let version_ocaml = F_config.empty_ocaml in
- let home = Path.init o ".opam-server" version_ocaml in
+ let init home =
+ let home = Path.init Globals.opam_server_path in
{ current_repository = read_archives home
; home
- ; all_repository = Path_map.empty
- ; version_package_manager = F_config.empty_package_manager
- ; version_ocaml }
-
- let change_url t url =
- let home = Path.change_url t.home url in
- { t with
- current_repository = (match Path_map.Exceptionless.find home t.all_repository with
- | None -> read_archives home
- | Some v -> v);
- home;
- all_repository = Path_map.add t.home t.current_repository t.all_repository }
+ ; version_package_manager = Version Globals.default_opam_version }
let getList t = BatList.map fst (NV_map.bindings t.current_repository)
let getOpam t n_v = n_v, NV_map.Exceptionless.find n_v t.current_repository
@@ -117,10 +82,28 @@ struct
| Tar_gz s -> Path.File s) } in
match o_pack with
- | None -> { t with current_repository = NV_map.add n_v (F_cudf.new_package n_v "") t.current_repository }
+ | None -> { t with current_repository = NV_map.add n_v (File.Cudf.new_package n_v "") t.current_repository }
| Some _ -> t
- let version_opam t = t.version_package_manager
- let version_ocaml t = t.version_ocaml
let package = snd
end
+
+type api =
+ | GetList of server_state
+ | GetOpam of server_state * name_version
+ | GetArchive of server_state * Server.opam
+ | NewArchive of server_state * Server.opam * binary_data archive
+
+module RemoteServer : SERVER with type t = url = struct
+
+ type t = url
+ type opam = Server.opam
+ type package = Cudf.package
+
+ let getList t = failwith "TODO"
+ let getOpam t name_version = failwith "TODO"
+ let getArchive t opam = failwith "TODO"
+ let newArchive t opam archive = failwith "TODO"
+ let package opam = failwith "TODO"
+
+end
Please sign in to comment.
Something went wrong with that request. Please try again.