Permalink
Browse files

Update output to be more user-friendly.

  • Loading branch information...
1 parent 158a6c1 commit d90f6a506e6f28d2d67bda709603d6528beaee51 @samoht samoht committed Aug 21, 2012
Showing with 126 additions and 88 deletions.
  1. +72 −65 src/client.ml
  2. +4 −1 src/opam.ml
  3. +2 −2 src/path.ml
  4. +2 −0 src/repo/curl.ml
  5. +11 −10 src/repo/git.ml
  6. +27 −6 src/scripts/opam_repo_convert.ml
  7. +4 −4 src/solver.ml
  8. +4 −0 src/utils.ml
View
@@ -351,7 +351,7 @@ let update_repo_index t =
) available_versions;
) repo_index
-let update_repo () =
+let update_repo ~show_compilers =
log "update_repo";
let t = load_state () in
let compilers = Path.G.available_compilers t.global in
@@ -360,7 +360,7 @@ let update_repo () =
List.iter (fun (r,_) -> Repositories.update r) t.repositories;
(* Display the new compilers available *)
- List.iter (fun (_, r) -> print_compilers compilers r) t.repositories;
+ List.iter (fun (_, r) -> if show_compilers then print_compilers compilers r) t.repositories;
(* XXX: we could have a special index for compiler descriptions as
well, but that's become a bit too heavy *)
@@ -374,8 +374,7 @@ let update_repo () =
) t.repositories
let update_package () =
- log "update_package";
-
+ log "update_packages";
let t = load_state () in
(* Update the pinned packages *)
let pinned_updated =
@@ -386,10 +385,12 @@ let update_package () =
if mem_installed_package_by_name t n then
let nv = find_installed_package_by_name t n in
let build = Path.C.build t.compiler nv in
+ Globals.msg "Syncronizing %s with %s ...\n" (NV.to_string nv) (Dirname.to_string p);
+ (* XXX: make it more generic *)
if Dirname.exists build then
match
Run.read_command_output
- [ "rsync"; "-arv"; "--delete"; Dirname.to_string p; Dirname.to_string build ]
+ [ "rsync"; "-arv"; "--delete"; Dirname.to_string p ^ "/"; Dirname.to_string build ]
with
| Some o when List.length o > 4 -> Some nv
| _ -> None
@@ -462,7 +463,7 @@ let update_package () =
let update () =
log "update";
- update_repo ();
+ update_repo ~show_compilers:true;
update_package ()
(* Return the contents of a fully qualified variable *)
@@ -886,6 +887,7 @@ let proceed_toinstall t nv =
let proceed_todelete t nv =
log "deleting %s" (NV.to_string nv);
+ Globals.msg "Uninstalling %s ...\n" (NV.to_string nv);
let name = NV.name nv in
(* Run the remove script *)
@@ -895,9 +897,10 @@ let proceed_todelete t nv =
let p_build = Path.C.build t.compiler nv in
if Dirname.exists p_build then
p_build
- else
- let () = Globals.warning "the folder '%s' does not exist anymore" (Dirname.to_string p_build) in
- Path.G.root t.global in
+ else (
+ Globals.warning "the folder '%s' does not exist anymore" (Dirname.to_string p_build);
+ Path.G.root t.global;
+ ) in
(* We try to run the remove scripts in the folder where it was extracted
If it does not exist, we don't really care. *)
let err = Dirname.exec ~add_to_path:[Path.C.bin t.compiler] root_remove remove in
@@ -999,6 +1002,8 @@ let pinned_path t nv =
None
let rec proceed_tochange t nv_old nv =
+ Globals.msg "==== %s ====\n" (NV.to_string nv);
+
(* First, uninstall any previous version *)
(match nv_old with
| Some nv_old -> proceed_todelete t nv_old
@@ -1008,9 +1013,13 @@ let rec proceed_tochange t nv_old nv =
let p_build = Path.C.build t.compiler nv in
Dirname.rmdir p_build;
(match pinned_path t nv with
- | None -> Filename.extract (get_archive t nv) p_build
+ | None ->
+ let archive = get_archive t nv in
+ Globals.msg "Extracting ...\n";
+ Filename.extract archive p_build
| Some p ->
log "rsyncing locally instead of downloading the archive";
+ Globals.msg "Synchronizing with %s ..." (Dirname.to_string p);
Dirname.mkdir p_build;
let err = Dirname.exec p_build [ ["rsync"; "-ar"; Dirname.to_string p; "."] ] in
log "rsync should be done";
@@ -1037,9 +1046,7 @@ let rec proceed_tochange t nv_old nv =
let commands = List.map (List.map (substitute_string t))
(File.OPAM.build opam) in
let commands_s = List.map (fun cmd -> String.concat " " cmd) commands in
- Globals.msg "[%s] Build commands:\n %s\n"
- (NV.to_string nv)
- (String.concat "\n " commands_s);
+ Globals.msg "Build commands:\n %s\n" (String.concat "\n " commands_s);
let err =
Dirname.exec
~add_to_env:env.add_to_env
@@ -1192,43 +1199,43 @@ module Heuristic = struct
unknown_package sname)
let apply_solution t sol =
-(* Globals.msg "The following solution has been found:\n"; *)
- print_solution sol;
- let continue =
- if Solver.delete_or_update sol then
- confirm "Continue ?"
- else
- true in
-
- if continue then (
-
- let installed = ref t.installed in
- let write_installed () =
- File.Installed.write (Path.C.installed t.compiler) !installed in
-
- (* Delete some packages *)
- (* In case of errors, we try to keep the list of installed packages up-to-date *)
- List.iter
- (fun nv ->
- if NV.Set.mem nv !installed then begin
- proceed_todelete t nv;
- installed := NV.Set.remove nv !installed;
- write_installed ()
- end)
- sol.to_remove;
-
- (* Install or recompile some packages on the child process *)
- let child n =
- let t = load_state () in
- match action n with
- | To_change (o, nv) -> proceed_tochange t o nv
- | To_recompile nv -> proceed_torecompile t nv
- | To_delete _ -> assert false in
-
- let pre _ = () in
-
- (* Update the installed file in the parent process *)
- let post n = match action n with
+ Globals.msg "The following actions will be performed:\n";
+ print_solution sol;
+ let continue =
+ if Solver.delete_or_update sol then
+ confirm "Continue ?"
+ else
+ true in
+
+ if continue then (
+
+ let installed = ref t.installed in
+ let write_installed () =
+ File.Installed.write (Path.C.installed t.compiler) !installed in
+
+ (* Delete some packages *)
+ (* In case of errors, we try to keep the list of installed packages up-to-date *)
+ List.iter
+ (fun nv ->
+ if NV.Set.mem nv !installed then begin
+ proceed_todelete t nv;
+ installed := NV.Set.remove nv !installed;
+ write_installed ()
+ end)
+ sol.to_remove;
+
+ (* Install or recompile some packages on the child process *)
+ let child n =
+ let t = load_state () in
+ match action n with
+ | To_change (o, nv) -> proceed_tochange t o nv
+ | To_recompile nv -> proceed_torecompile t nv
+ | To_delete _ -> assert false in
+
+ let pre _ = () in
+
+ (* Update the installed file in the parent process *)
+ let post n = match action n with
| To_delete _ -> assert false
| To_recompile _ -> ()
| To_change (None, nv) ->
@@ -1238,20 +1245,20 @@ module Heuristic = struct
installed := NV.Set.add nv (NV.Set.remove o !installed);
write_installed () in
- let error n =
- let f msg nv =
- Globals.error_and_exit "Command failed while %s %s" msg (NV.to_string nv) in
- match action n with
- | To_change (Some _, nv) -> f "upgrading/downgrading" nv
- | To_change (None, nv) -> f "installing" nv
- | To_recompile nv -> f "recompiling" nv
- | To_delete _ -> assert false in
-
- let cores = File.Config.cores t.config in
- try PA_graph.Parallel.iter cores sol.to_add ~pre ~child ~post
- with PA_graph.Parallel.Errors n -> List.iter error n
- );
- continue
+ let error n =
+ let f msg nv =
+ Globals.error_and_exit "Command failed while %s %s" msg (NV.to_string nv) in
+ match action n with
+ | To_change (Some _, nv) -> f "upgrading/downgrading" nv
+ | To_change (None, nv) -> f "installing" nv
+ | To_recompile nv -> f "recompiling" nv
+ | To_delete _ -> assert false in
+
+ let cores = File.Config.cores t.config in
+ try PA_graph.Parallel.iter cores sol.to_add ~pre ~child ~post
+ with PA_graph.Parallel.Errors n -> List.iter error n
+ );
+ continue
let apply_solutions t =
let rec aux = function
@@ -1300,7 +1307,7 @@ let init repo alias ocaml_version cores =
Dirname.mkdir (Path.G.descr_dir root);
Dirname.mkdir (Path.G.archives_dir root);
Dirname.mkdir (Path.G.compilers_dir root);
- update_repo ();
+ update_repo ~show_compilers:false;
let ocaml_version = init_ocaml
(fun alias_p ->
Globals.error_and_exit "%s does not exist whereas %s already exists"
View
@@ -71,6 +71,9 @@ let init =
| None ->
if Sys.file_exists address then
"rsync"
+ else if Utils.starts_with ~prefix:"git" address
+ || Utils.ends_with ~suffix:"git" address then
+ "git"
else
Globals.default_repository_kind
| Some k -> k in
@@ -330,7 +333,7 @@ let switch =
| _ -> bad_argument "switch" "Too many compiler names")
}
-(* opam pin [-list|-add <url>|-rm <url>] *)
+(* opam pin [-list|<package> <version>|<package> <path>] *)
let pin =
let list = ref false in
{
View
@@ -140,7 +140,7 @@ module G = struct
let archives_dir t = t / "archives"
- let archive t nv = archives_dir t // (NV.to_string nv ^ ".tar.gz")
+ let archive t nv = archives_dir t // (NV.to_string nv ^ "+opam.tar.gz")
let repo_index t = t / "repo" // "index"
@@ -187,7 +187,7 @@ module R = struct
let archives_dir t = t / "archives"
- let archive t nv = archives_dir t // (NV.to_string nv ^ ".tar.gz")
+ let archive t nv = archives_dir t // (NV.to_string nv ^ "+opam.tar.gz")
let available_archives t =
let d = archives_dir t in
View
@@ -121,6 +121,7 @@ module B = struct
log "dowloading %s" (Filename.to_string remote_file);
let local_dir = Filename.dirname local_file in
Dirname.mkdir local_dir;
+ Globals.msg "Downloading %s ...\n" (Filename.to_string remote_file);
match Filename.download remote_file local_dir with
| None -> Globals.error_and_exit "Cannot download %s" (Filename.to_string remote_file);
| Some local_file ->
@@ -140,6 +141,7 @@ module B = struct
(* XXX: use checksums *)
let download_file nv remote_file =
+ Globals.msg "Downloading %s ...\n" (Filename.to_string remote_file);
match Filename.download remote_file (Dirname.cwd ()) with
| None -> Not_available
| Some f -> Result f
View
@@ -2,7 +2,8 @@ open Types
let log fmt = Globals.log "GIT" fmt
-let git_fetch local_path =
+let git_fetch local_path remote_address =
+ Globals.msg "Fetching %s ...\n" (Dirname.to_string remote_address);
Dirname.in_dir local_path (fun () ->
let err = Run.command [ "git" ; "fetch" ; "origin" ] in
if err <> 0 then
@@ -45,9 +46,9 @@ let git_init address =
if err <> 0 then
Globals.error_and_exit "Cannot clone %s" repo
-let check_updates local_path =
+let check_updates local_path remote_address=
if Dirname.exists (local_path / ".git") then begin
- git_fetch local_path;
+ git_fetch local_path remote_address;
let files = git_diff local_path in
git_merge local_path;
Some files
@@ -85,24 +86,24 @@ module B = struct
let file = Path.R.tmp_dir local_repo nv // Basename.to_string basename in
check_file file
- let rec download_dir nv dirname =
+ let rec download_dir nv remote_address =
let local_repo = Path.R.cwd () in
- let basename = Dirname.basename dirname in
+ let basename = Dirname.basename remote_address in
let dir = Path.R.tmp_dir local_repo nv / Basename.to_string basename in
- match check_updates dir with
+ match check_updates dir remote_address with
| None ->
Dirname.mkdir dir;
- Dirname.in_dir dir (fun () -> git_init dirname);
- download_dir nv dirname
+ Dirname.in_dir dir (fun () -> git_init remote_address);
+ download_dir nv remote_address
| Some f ->
if Filename.Set.empty = f then
Up_to_date dir
else
Result dir
- let update address =
+ let update remote_address =
let local_path = Dirname.cwd () in
- match check_updates local_path with
+ match check_updates local_path remote_address with
| Some f -> f
| None ->
Globals.error_and_exit
@@ -244,13 +244,25 @@ module OPAM_X = struct
end
module URL_X = struct
+
let internal = "url"
- type t = string
- let empty = "<none>"
+
+ type t = File.URL.t
+
+ let empty = File.URL.empty
+
let to_string f t =
- Raw.of_string (Utils.string_strip t)
+ Raw.of_string (Utils.string_strip (File.URL.url t))
+
let of_string f t =
- Utils.string_strip (Raw.to_string t)
+ let remote_file = Utils.string_strip (Raw.to_string t) in
+ let checksum =
+ Dirname.with_tmp_dir (fun tmp_dir ->
+ match Filename.download (Filename.raw remote_file) tmp_dir with
+ | None -> Globals.error_and_exit "Cannot download %s" remote_file
+ | Some local_file -> Digest.to_hex (Digest.file (Filename.to_string local_file))
+ ) in
+ File.URL.create ~checksum remote_file
end
module type F = sig
@@ -431,13 +443,22 @@ let () =
~conflicts:opam3.conflicts ~libraries:opam3.libraries ~syntax:opam3.syntax
~others:opam3.others ~ocaml_version:opam3.ocaml_version in
File.OPAM.write (Path.R.opam t4 nv) opam4;
+ let url3_f = Path_0_3.R.url t3 nv in
+ if Filename.exists url3_f then (
+ let url = File_0_3.URL.read url3_f in
+ File.URL.write (Path.R.url t4 nv) url;
+ );
let mv_file src dst =
if Filename.exists (src t3 nv) then
Filename.move (src t3 nv) (dst t4 nv) in
let mv_dir src dst =
if Dirname.exists (src t3 nv) then
Dirname.move (src t3 nv) (dst t4 nv) in
mv_file Path_0_3.R.descr Path.R.descr;
- mv_file Path_0_3.R.url Path.R.url;
mv_dir Path_0_3.R.files Path.R.files;
- ) (Path_0_3.R.available t3)
+ ) (Path_0_3.R.available t3);
+ Globals.msg "Cleaning-up remaining directories ...\n";
+ Dirname.rmdir (Path_0_3.R.opam_dir t3);
+ Dirname.rmdir (Path_0_3.R.files_dir t3);
+ Dirname.rmdir (Path_0_3.R.descr_dir t3);
+ Dirname.rmdir (Path_0_3.R.url_dir t3)
Oops, something went wrong.

0 comments on commit d90f6a5

Please sign in to comment.