Permalink
Browse files

Implement repository priority

This should fix #206
  • Loading branch information...
1 parent ba0b854 commit 4dfd64dc5053013557940389ef250e3de1b458a0 @samoht samoht committed Oct 10, 2012
View
@@ -23,13 +23,14 @@ begin library "opam-lib"
"opamCompiler.ml"
"opamVariable.ml"
"opamAlias.ml"
+ "opamRepositoryName.ml"
"opamTypes.ml"
"opamFormat.ml"
"opamParser.mly"
"opamLexer.mll"
"opamLineLexer.mll"
- "opamFile.ml"
"opamPath.ml"
+ "opamFile.ml"
"opamRepository.ml"
"repo/opamCurl.ml"
"repo/opamRsync.ml"
View

Large diffs are not rendered by default.

Oops, something went wrong.
View
@@ -43,7 +43,7 @@ val install : name_set -> unit
val reinstall : OpamPackage.Name.Set.t -> unit
(** Refresh the available packages. Take the global file lock. *)
-val update : string list -> unit
+val update : repository_name list -> unit
(** Find a consistent state where most of the installed packages are
upgraded to their latest version.
@@ -55,7 +55,7 @@ val upgrade : OpamPackage.Name.Set.t -> unit
will look for the repository associated with the package
name. Otherwise, it will look for a repository having the right
name. Take the global file lock. *)
-val upload : upload -> string option -> unit
+val upload : upload -> repository_name option -> unit
(** Remove the given set of packages. Take the global file lock. *)
val remove : OpamPackage.Name.Set.t -> unit
View
@@ -260,7 +260,7 @@ module Repo_index = struct
let internal = "repo-index"
- type t = string list OpamPackage.Name.Map.t
+ type t = repository_name list OpamPackage.Name.Map.t
let empty = OpamPackage.Name.Map.empty
@@ -272,12 +272,14 @@ module Repo_index = struct
if OpamPackage.Name.Map.mem name map then
OpamGlobals.error_and_exit "multiple lines for package %s" name_s
else
+ let repo_s = List.map OpamRepositoryName.of_string repo_s in
OpamPackage.Name.Map.add name repo_s map
| [] -> map
) OpamPackage.Name.Map.empty lines
let to_string filename map =
let lines = OpamPackage.Name.Map.fold (fun name repo_s lines ->
+ let repo_s = List.map OpamRepositoryName.to_string repo_s in
(OpamPackage.Name.to_string name :: repo_s) :: lines
) map [] in
Lines.to_string filename (List.rev lines)
@@ -293,16 +295,30 @@ module Pinned = struct
let empty = OpamPackage.Name.Map.empty
let of_string filename str =
- let m = Repo_index.of_string filename str in
- OpamPackage.Name.Map.map (function
- | [x] -> pin_option_of_string x
- | [k;x] -> pin_option_of_string ?kind:(Some k) x
+ let lines = Lines.of_string filename str in
+ let add name_s pin map =
+ let name = OpamPackage.Name.of_string name_s in
+ if OpamPackage.Name.Map.mem name map then
+ OpamGlobals.error_and_exit "multiple lines for package %s" name_s
+ else
+ OpamPackage.Name.Map.add name pin map in
+ List.fold_left (fun map -> function
+ | [] -> map
+ | [name_s; x] -> add name_s (pin_option_of_string x) map
+ | [name_s;k;x] -> add name_s (pin_option_of_string ?kind:(Some k) x) map
| _ -> OpamGlobals.error_and_exit "too many pinning options"
- ) m
+ ) OpamPackage.Name.Map.empty lines
let to_string filename map =
- let aux x = [ kind_of_pin_option x; path_of_pin_option x ] in
- Repo_index.to_string filename (OpamPackage.Name.Map.map aux map)
+ let lines = OpamPackage.Name.Map.fold (fun name pin lines ->
+ let l = [
+ OpamPackage.Name.to_string name;
+ kind_of_pin_option pin;
+ path_of_pin_option pin
+ ] in
+ l :: lines
+ ) map [] in
+ Lines.to_string filename (List.rev lines)
end
@@ -312,26 +328,38 @@ module Repo_config = struct
type t = repository
- let empty = create_repository ~name:"<none>" ~address:"<none>" ~kind:"<none>"
+ let empty = {
+ repo_name = OpamRepositoryName.of_string "<none>";
+ repo_address = OpamFilename.address_of_string "<none>";
+ repo_kind = "<none>";
+ repo_priority = 0;
+ }
let s_name = "name"
let s_kind = "kind"
let s_address = "address"
+ let s_priority = "priority"
let of_string filename str =
let s = Syntax.of_string filename str in
- let name = OpamFormat.assoc s.file_contents s_name OpamFormat.parse_string in
- let address = OpamFormat.assoc s.file_contents s_address OpamFormat.parse_string in
- let kind = OpamFormat.assoc s.file_contents s_kind OpamFormat.parse_string in
- create_repository ~name ~address ~kind
+ let repo_name =
+ OpamFormat.assoc s.file_contents s_name (OpamFormat.parse_string |> OpamRepositoryName.of_string) in
+ let repo_address =
+ OpamFormat.assoc s.file_contents s_address (OpamFormat.parse_string |> OpamFilename.address_of_string) in
+ let repo_kind =
+ OpamFormat.assoc s.file_contents s_kind OpamFormat.parse_string in
+ let repo_priority =
+ OpamFormat.assoc_default 0 s.file_contents s_priority OpamFormat.parse_int in
+ { repo_name; repo_address; repo_kind; repo_priority }
let to_string filename t =
let s = {
file_name = OpamFilename.to_string filename;
file_contents = [
- Variable (s_name , OpamFormat.make_string t.repo_name);
- Variable (s_address, OpamFormat.make_string (OpamFilename.Dir.to_string t.repo_address));
- Variable (s_kind , OpamFormat.make_string t.repo_kind);
+ Variable (s_name , OpamFormat.make_string (OpamRepositoryName.to_string t.repo_name));
+ Variable (s_address , OpamFormat.make_string (OpamFilename.Dir.to_string t.repo_address));
+ Variable (s_kind , OpamFormat.make_string t.repo_kind);
+ Variable (s_priority, OpamFormat.make_int t.repo_priority);
] } in
Syntax.to_string filename s
@@ -395,22 +423,9 @@ module Config = struct
let internal = "config"
- let to_repo (name, option) =
- let address, kind = match option with
- | Some (address, kind) -> address, kind
- | None ->
- OpamGlobals.default_repository_kind,
- OpamGlobals.default_repository_address in
- create_repository ~name ~address ~kind
-
- let of_repo r =
- Option (String r.repo_name,
- [ String (OpamFilename.Dir.to_string r.repo_address);
- String r.repo_kind ])
-
type t = {
opam_version : opam_version ;
- repositories : repository list ;
+ repositories : repository_name list ;
alias : alias option ;
system_version: compiler_version option ;
cores : int;
@@ -463,8 +478,34 @@ module Config = struct
OpamFormat.assoc s.file_contents s_opam_version (OpamFormat.parse_string |> OpamVersion.of_string) in
let repositories =
OpamFormat.assoc_list s.file_contents s_repositories
- (OpamFormat.parse_list
- (OpamFormat.parse_string_option OpamFormat.parse_string_pair_of_list |> to_repo)) in
+ (OpamFormat.parse_or [
+ ("new-version", OpamFormat.parse_list (OpamFormat.parse_string |> OpamRepositoryName.of_string));
+ ("old-version",
+ (* We try to keep backward compatibilty here. The following code is not very beautiful, but it works *)
+ fun x ->
+ let list =
+ OpamFormat.parse_list (OpamFormat.parse_string_option OpamFormat.parse_string_pair_of_list) x in
+ let _ = List.fold_left (fun i (name, option) ->
+ match option with
+ | None -> i+1
+ | Some (address, kind) ->
+ let repo_name = OpamRepositoryName.of_string name in
+ let repo = {
+ repo_name;
+ repo_kind = kind;
+ repo_address = OpamFilename.address_of_string address;
+ repo_priority = 10 * i;
+ } in
+ let repo_p = OpamPath.Repository.create (OpamPath.default ()) repo_name in
+ let config_f = OpamPath.Repository.config repo_p in
+ if not (OpamFilename.exists config_f) then (
+ OpamGlobals.log internal "write %s" (OpamFilename.to_string config_f);
+ OpamFilename.write config_f (Repo_config.to_string filename repo)
+ );
+ i+1)
+ 0 list in
+ List.map (fst |> OpamRepositoryName.of_string) list)
+ ]) in
let alias =
OpamFormat.assoc_option s.file_contents s_ocaml_version (OpamFormat.parse_string |> OpamAlias.of_string) in
let alias2 =
@@ -491,7 +532,10 @@ module Config = struct
file_name = OpamFilename.to_string filename;
file_contents = [
Variable (s_opam_version , OpamFormat.make_string (OpamVersion.to_string t.opam_version));
- Variable (s_repositories , OpamFormat.make_list of_repo t.repositories);
+ Variable (s_repositories ,
+ OpamFormat.make_list
+ (OpamRepositoryName.to_string |> OpamFormat.make_string)
+ t.repositories);
Variable (s_cores , OpamFormat.make_int t.cores);
]
@ (
View
@@ -41,13 +41,13 @@ module Config: sig
include IO_FILE
(** Creation *)
- val create: opam_version -> repository list -> int -> t
+ val create: opam_version -> repository_name list -> int -> t
(** OCaml alias updates *)
val with_alias : t -> alias -> t
(** Repository updates *)
- val with_repositories: t -> repository list -> t
+ val with_repositories: t -> repository_name list -> t
(** system-wide's OCaml version updates *)
val with_system_version: t -> compiler_version -> t
@@ -56,7 +56,7 @@ module Config: sig
val opam_version: t -> opam_version
(** Return the list of repository *)
- val repositories: t -> repository list
+ val repositories: t -> repository_name list
(** Return the OCaml alias *)
val alias: t -> alias
@@ -361,7 +361,7 @@ end
(** {2 Repository files} *)
(** Association between package names and repository: [$opam/repo/index] *)
-module Repo_index: IO_FILE with type t = string list name_map
+module Repo_index: IO_FILE with type t = repository_name list name_map
(** Repository config: [$opam/repo/$repo/config] *)
module Repo_config: IO_FILE with type t = repository
View
@@ -236,6 +236,11 @@ let download_iter filenames dirname =
let patch filename dirname =
in_dir dirname (fun () -> OpamSystem.patch (to_string filename))
+let address_of_string address =
+ if Sys.file_exists address
+ then Dir.of_string address
+ else raw_dir address
+
module O = struct
type tmp = t
type t = tmp
View
@@ -157,6 +157,10 @@ val touch: t -> unit
(** Change file permissions *)
val chmod: t -> int -> unit
+(** Create an local of remote address from a string,
+ depending whether the string exits in the filesystem. *)
+val address_of_string: string -> Dir.t
+
module OP: sig
(** Create a new directory *)
View
@@ -69,6 +69,7 @@ let init =
let kind = ref None in
let comp = ref None in
let cores = ref OpamGlobals.default_cores in
+ let repo_priority = 0 in
{
name = "init";
usage = "";
@@ -86,13 +87,16 @@ let init =
| [] ->
OpamClient.init OpamRepository.default !comp !cores
| [address] ->
- let name = OpamGlobals.default_repository_name in
- let kind = guess_repository_kind !kind address in
- let repo = OpamRepository.create ~name ~address ~kind in
+ let repo_name = OpamRepositoryName.default in
+ let repo_kind = guess_repository_kind !kind address in
+ let repo_address = OpamRepository.repository_address address in
+ let repo = { repo_name; repo_kind; repo_address; repo_priority } in
OpamClient.init repo !comp !cores
| [name; address] ->
- let kind = guess_repository_kind !kind address in
- let repo = OpamRepository.create ~name ~address ~kind in
+ let repo_name = OpamRepositoryName.of_string name in
+ let repo_kind = guess_repository_kind !kind address in
+ let repo_address = OpamRepository.repository_address address in
+ let repo = { repo_name; repo_address; repo_kind; repo_priority } in
OpamClient.init repo !comp !cores
| _ -> bad_argument "init" "Need a repository name and address")
}
@@ -257,7 +261,9 @@ let update = {
help = "";
specs = [];
anon;
- main = parse_args OpamClient.update
+ main = parse_args (fun names ->
+ OpamClient.update (List.map OpamRepositoryName.of_string names)
+ )
}
(* opam upgrade *)
@@ -302,7 +308,7 @@ let upload =
let upl_opam = OpamFilename.of_string !opam in
let upl_descr = OpamFilename.of_string !descr in
let upl_archive = OpamFilename.of_string !archive in
- let repo = if !repo = "" then None else Some !repo in
+ let repo = if !repo = "" then None else Some (OpamRepositoryName.of_string !repo) in
OpamClient.upload { upl_opam; upl_descr; upl_archive } repo)
}
@@ -325,8 +331,13 @@ let remove = {
(* opam remote [-list|-add <url>|-rm <url>] *)
let remote =
let kind = ref None in
- let command : [`add|`list|`rm] option ref = ref None in
+ let command : [`add|`list|`rm|`priority] option ref = ref None in
let set c () = command := Some c in
+ let add name address priority =
+ let name = OpamRepositoryName.of_string name in
+ let kind = guess_repository_kind !kind address in
+ let address = OpamRepository.repository_address address in
+ OpamClient.remote (RAdd (name, kind, address, priority)) in
{
name = "remote";
usage = "[-list|add <name> <address>|rm <name>]";
@@ -337,15 +348,18 @@ let remote =
("-add" , Arg.Unit (set `add) , " Add a new repository");
("-rm" , Arg.Unit (set `rm) , " Remove a remote repository");
("-kind" , Arg.String (fun s -> kind := Some s) , " (optional) Specify the repository kind");
+ ("-priority", Arg.Unit (set `priority) , " Set the repository priority (higher is better)");
];
anon;
main = parse_args (fun args ->
match !command, args with
+ | Some `priority, [name; p] ->
+ OpamClient.remote (RPriority (OpamRepositoryName.of_string name, int_of_string p))
| Some `list, [] -> OpamClient.remote RList
- | Some `rm, [ name ] -> OpamClient.remote (RRm name)
- | Some `add , [ name; address ] ->
- let kind = guess_repository_kind !kind address in
- OpamClient.remote (RAdd (OpamRepository.create ~name ~kind ~address))
+ | Some `rm, [ name ] -> OpamClient.remote (RRm (OpamRepositoryName.of_string name))
+ | Some `add , [ name; address ] -> add name address 0
+ | Some `add ,
+ [ name; address; priority ] -> add name address (int_of_string priority)
| None, _ -> bad_argument "remote" "Command missing [-list|-add|-rm]"
| _ -> bad_argument "remote" "Wrong arguments")
}
View
@@ -25,6 +25,7 @@ module type MAP = sig
include Map.S
val to_string: ('a -> string) -> 'a t -> string
val values: 'a t -> 'a list
+ val keys: 'a t -> key list
val merge_max: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t
val of_list: (key * 'a) list -> 'a t
end
@@ -82,6 +83,8 @@ module Map = struct
let values map = List.map snd (bindings map)
+ let keys map = List.map fst (bindings map)
+
let merge_max f =
merge
(fun k -> function
@@ -236,3 +239,11 @@ let confirm fmt =
else
true
) fmt
+
+(* XXX: not optimized *)
+let insert comp x l =
+ let rec aux = function
+ | [] -> [x]
+ | h::t when comp h x < 0 -> h::aux t
+ | l -> x :: l in
+ aux l
Oops, something went wrong.

0 comments on commit 4dfd64d

Please sign in to comment.