Merge pull request #2041 from OCamlPro/verbosity-control

Finer verbosity control

CHANGES

@@ -13,8 +13,9 @@
 * Fixed behaviour of `opam switch` and related commands when a switch
   is locally set in a shell (through `OPAMSWITCH`)
 * Better behaviour on failed `opam switch`
-* New pinning mode, set by default on local VC repos: use current file
-  tree, but limited to version-tracked files
+* New pinning mode: when pinning using version-control on a local path and
+  without a branch specified, use current file tree, but limited to
+  version-tracked files
 * Faster and cleaner handling of downloads
 * Now compiles with --safe-string on OCaml 4.02, better compatibility handling
 * `opam unpin` now accepts multiple arguments
@@ -35,6 +36,12 @@
 * ~/.opam/config doesn't refer to OPAM's patch-version anymore, to allow
   downgrading
 * Recognise <name>.opam files and directories when pinning a package to source
+* Cleaned up debug and verbose messages, allow more control (`-v` can now be
+  repeated)
+* Pinning URL can now be explicit in the form `VC+URL`, e.g. `git+ssh://`,
+  `hg+https://`...
+* New flexible way to specify download and solver commands in `~/.opam/config`
+  or in variables `OPAMFETCH` and `OPAMEXTERNALSOLVER`
 * Lots of bug-fixes
 
 1.2.0

src/client/opamAction.ml

@@ -368,6 +368,7 @@ let remove_package_aux t ~metadata ?(keep_build=false) ?(silent=false) nv =
                 (OpamSystem.make_command ?name:nameopt ~metadata ~text cmd args
                    ~env:(OpamFilename.env_of_list env)
                    ~dir:(OpamFilename.Dir.to_string exec_dir)
+                   ~verbose:!OpamGlobals.verbose
                    ~check_existence:false))
           remove
       in
@@ -531,7 +532,7 @@ let build_and_install_package_aux t ~metadata:save_meta source nv =
       let text = OpamProcess.make_command_text name ~args cmd in
       let dir = OpamFilename.Dir.to_string dir in
       OpamSystem.make_command ~env ~name ~metadata ~dir ~text
-        ~check_existence:false
+        ~verbose:!OpamGlobals.verbose ~check_existence:false
         cmd args
       @@> fun result ->
       if List.mem Pkgflag_Verbose (OpamFile.OPAM.flags opam) then

src/client/opamArg.ml

@@ -22,7 +22,7 @@ open Cmdliner
 type global_options = {
   debug  : bool;
   debug_level: int;
-  verbose: bool;
+  verbose: int;
   quiet  : bool;
   color  : bool;
   switch : string option;
@@ -105,6 +105,7 @@ let create_global_options
     switch_to_updated_self debug root; (* do this asap, don't waste time *)
   if not safe_mode && Unix.getuid () = 0 then
     OpamGlobals.warning "Running as root is not recommended";
+  let verbose = List.length verbose in
   { git_version; debug; debug_level; verbose; quiet; color; switch; yes; strict; root;
     no_base_packages; external_solver; use_internal_solver; cudf_file; solver_preferences;
     no_self_upgrade; safe_mode; }
@@ -120,7 +121,9 @@ let apply_global_options o =
   OpamGlobals.debug    := not o.safe_mode && !OpamGlobals.debug || o.debug;
   OpamGlobals.debug_level := max !OpamGlobals.debug_level o.debug_level;
   OpamMisc.debug       := !OpamGlobals.debug;
-  OpamGlobals.verbose  := (not o.quiet) && (!OpamGlobals.verbose || o.verbose);
+  OpamGlobals.verbose  :=
+    (not o.quiet) && (!OpamGlobals.verbose || o.verbose > 0);
+  OpamGlobals.verbose_level := max !OpamGlobals.verbose_level o.verbose;
   OpamGlobals.color    := o.color;
   begin match o.switch with
     | None   -> ()
@@ -559,9 +562,10 @@ let global_options =
        integer."
       Arg.(some int) None in
   let verbose =
-    mk_flag ~section ["v";"verbose"]
-      "Be more verbose. Show output of all sub-commands. \
-       This is equivalent to setting $(b,\\$OPAMVERBOSE) to \"true\"." in
+    Arg.(value & flag_all & info ~docs:section ["v";"verbose"] ~doc:
+           "Be more verbose, show package sub-commands and their output. \
+            Repeat to see more. Repeating $(i,n) times is equivalent to \
+            setting $(b,\\$OPAMVERBOSE) to \"$(i,n)\".") in
   let quiet =
     mk_flag ~section ["q";"quiet"] "Be quiet when installing a new compiler." in
   let color =

src/client/opamClient.ml

@@ -1102,10 +1102,12 @@ module API = struct
       in
       let t, compiler_updates =
         let t = OpamRepositoryCommand.update_compiler_index t in
-        t, OpamRepositoryCommand.fix_compiler_descriptions t ~verbose:!OpamGlobals.verbose in
+        t, OpamRepositoryCommand.fix_compiler_descriptions t
+          ~verbose:(!OpamGlobals.verbose_level >= 2) in
       let package_updates =
         let t = OpamRepositoryCommand.update_package_index t in
-        OpamRepositoryCommand.fix_package_descriptions t ~verbose:!OpamGlobals.verbose in
+        OpamRepositoryCommand.fix_package_descriptions t
+          ~verbose:(!OpamGlobals.verbose_level >= 2) in
 
       (* If necessary, output a JSON file *)
       if OpamJson.verbose () then

src/client/opamRepositoryCommand.ml

@@ -448,7 +448,8 @@ let update_config t repos =
   let new_config = OpamFile.Config.with_repositories t.config repos in
   OpamFile.Config.write (OpamPath.config t.root) new_config
 
-let fix_descriptions ?(save_cache=true) t ~verbose =
+let fix_descriptions
+    ?(save_cache=true) ?(verbose = !OpamGlobals.verbose_level >= 3) t =
   let t = update_compiler_index t in
   let _ = fix_compiler_descriptions t ~verbose in
   let t = update_package_index t in
@@ -464,7 +465,7 @@ let cleanup t repo =
   let repos = OpamRepositoryName.Map.keys t.repositories in
   update_config t (List.filter ((<>) repo.repo_name) repos);
   OpamFilename.rmdir repo.repo_root;
-  fix_descriptions t ~verbose:!OpamGlobals.verbose
+  fix_descriptions t
 
 let priority repo_name ~priority =
   log "repository-priority";
@@ -478,7 +479,7 @@ let priority repo_name ~priority =
     { config with repo_priority = priority } in
   OpamFile.Repo_config.write config_f config;
   (* relink the compiler and package descriptions *)
-  fix_descriptions t ~verbose:!OpamGlobals.verbose
+  fix_descriptions t
 
 let add name kind address ~priority:prio =
   log "repository-add";
@@ -523,7 +524,7 @@ let add name kind address ~priority:prio =
   OpamState.remove_state_cache ();
   try
     let t = OpamProcess.Job.run (update t repo) t in
-    fix_descriptions t ~verbose:!OpamGlobals.verbose
+    fix_descriptions t
   with
   | OpamRepository.Unknown_backend ->
     cleanup t repo;

src/client/opamRepositoryCommand.mli

@@ -42,7 +42,7 @@ val fix_compiler_descriptions: t -> verbose:bool -> compiler_set updates
 val fix_package_descriptions: t -> verbose:bool -> package_set updates
 
 (** Fix all the package and compiler descriptions. *)
-val fix_descriptions: ?save_cache:bool -> t -> verbose:bool -> unit
+val fix_descriptions: ?save_cache:bool -> ?verbose:bool -> t -> unit
 
 (** List the available repositories. *)
 val list: short:bool -> unit

src/client/opamState.ml

@@ -1658,7 +1658,7 @@ let install_global_config root switch =
     config
 
 let fix_descriptions_hook =
-  ref (fun ?save_cache:_ _ ~verbose:_ -> assert false)
+  ref (fun ?save_cache:_ ?verbose:_ _ -> assert false)
 
 (* Upgrade to the new file overlay *)
 let upgrade_to_1_1 () =
@@ -1751,7 +1751,7 @@ let upgrade_to_1_1 () =
 
     (* Fix all the descriptions *)
     let t = load_state ~save_cache:false "update-to-1.1." in
-    !fix_descriptions_hook t ~verbose:false;
+    !fix_descriptions_hook ~verbose:false t;
 
     (* Fix the pinned packages *)
     OpamSwitch.Map.iter (fun switch _ ->
@@ -2577,6 +2577,7 @@ let install_compiler t ~quiet:_ switch compiler =
               Some (OpamSystem.make_command
                       ~text
                       ~dir:(OpamFilename.Dir.to_string build_dir)
+                      ~verbose:!OpamGlobals.verbose
                       cmd args))
           commands
       in

src/client/opamState.mli

@@ -408,4 +408,5 @@ val dl_jobs: state -> int
 val switch_reinstall_hook: (switch -> unit) ref
 
 (** Update hook *)
-val fix_descriptions_hook: (?save_cache:bool -> state -> verbose:bool -> unit) ref
+val fix_descriptions_hook:
+  (?save_cache:bool -> ?verbose:bool -> state -> unit) ref

src/core/opamFilename.ml

@@ -83,7 +83,8 @@ let exec dirname ?env ?name ?metadata ?keep_going cmds =
     (fun () -> OpamSystem.commands ?env ?name ?metadata ?keep_going cmds)
 
 let move_dir ~src ~dst =
-  OpamSystem.command [ "mv"; Dir.to_string src; Dir.to_string dst ]
+  OpamSystem.command ~verbose:(OpamSystem.verbose_for_base_commands ())
+    [ "mv"; Dir.to_string src; Dir.to_string dst ]
 
 let exists_dir dirname =
   try (Unix.stat (Dir.to_string dirname)).Unix.st_kind = Unix.S_DIR
@@ -93,7 +94,8 @@ let copy_dir ~src ~dst =
   if exists_dir dst then
     OpamSystem.internal_error
       "Cannot create %s as the directory already exists." (Dir.to_string dst);
-  OpamSystem.command [ "cp"; "-PR"; Dir.to_string src; Dir.to_string dst ]
+  OpamSystem.command ~verbose:(OpamSystem.verbose_for_base_commands ())
+    [ "cp"; "-PR"; Dir.to_string src; Dir.to_string dst ]
 
 let link_dir ~src ~dst =
   if exists_dir dst then
@@ -215,7 +217,9 @@ let install ?exec ~src ~dst () =
   if src <> dst then OpamSystem.install ?exec (to_string src) (to_string dst)
 
 let move ~src ~dst =
-  if src <> dst then OpamSystem.command [ "mv"; to_string src; to_string dst ]
+  if src <> dst then
+    OpamSystem.command ~verbose:(OpamSystem.verbose_for_base_commands ())
+      [ "mv"; to_string src; to_string dst ]
 
 let link ~src ~dst =
   if src <> dst then OpamSystem.link (to_string src) (to_string dst)
@@ -362,7 +366,7 @@ let copy_files ~src ~dst =
       if not !OpamGlobals.do_not_copy_files then
         let base = remove_prefix src file in
         let dst_file = create dst (Base.of_string base) in
-        if !OpamGlobals.verbose then
+        if !OpamGlobals.verbose_level >= 2 then
         OpamGlobals.msg "Copying %s %s %s/\n"
           (prettify file)
           (if exists dst_file then "over" else "to")

src/core/opamGlobals.ml

@@ -59,7 +59,11 @@ let debug_level      =
   try ref (int_of_string (OpamMisc.getenv ("OPAMDEBUG")))
   with Not_found | Failure _ -> ref 1
 let _ = if !debug_level > 1 then debug := true
-let verbose          = check "VERBOSE"
+let verbose          = check ~warn:false "VERBOSE"
+let verbose_level    =
+  try ref (int_of_string (OpamMisc.getenv ("OPAMVERBOSE"))) with
+  | Not_found -> ref 0
+  | Failure _ -> ref 1
 let color_when       = when_var "COLOR"
 let color            =
   ref (color_when = `Always ||

src/core/opamGlobals.mli

@@ -21,6 +21,7 @@
 val debug : bool ref
 val debug_level : int ref
 val verbose : bool ref
+val verbose_level : int ref
 val color_when : [> `Always | `Auto | `Never ]
 val color : bool ref
 val disp_status_line : unit -> bool

src/core/opamProcess.ml

@@ -33,8 +33,9 @@ type command = {
 
 let string_of_command c = String.concat " " (c.cmd::c.args)
 let text_of_command c = c.cmd_text
+let default_verbose () = !OpamGlobals.verbose_level >= 2
 let is_verbose_command c =
-  OpamMisc.Option.default !OpamGlobals.verbose c.cmd_verbose
+  OpamMisc.Option.default (default_verbose ()) c.cmd_verbose
 
 let make_command_text ?(color=`green) str ?(args=[]) cmd =
   let summary =
@@ -232,11 +233,11 @@ let interrupt p = match OpamGlobals.os () with
 
 let run_background command =
   let { cmd; args;
-        cmd_env=env; cmd_verbose=verbose; cmd_name=name;
+        cmd_env=env; cmd_verbose=_; cmd_name=name;
         cmd_metadata=metadata; cmd_dir=dir; cmd_stdin=allow_stdin } =
     command
   in
-  let verbose = OpamMisc.Option.default !OpamGlobals.verbose verbose in
+  let verbose = is_verbose_command command in
   let allow_stdin = OpamMisc.Option.default false allow_stdin in
   let env = match env with Some e -> e | None -> Unix.environment () in
   let file ext = match name with
@@ -259,10 +260,12 @@ let run_background command =
     ~allow_stdin ?dir cmd args
 
 let verbose_print_cmd p =
-  OpamGlobals.msg "%s %s %s\n"
+  OpamGlobals.msg "%s %s %s%s\n"
     (OpamGlobals.colorise `yellow "+")
     p.p_name
     (OpamMisc.sconcat_map " " (Printf.sprintf "%S") p.p_args)
+    (if p.p_cwd = Sys.getcwd () then ""
+     else Printf.sprintf " (CWD=%s)" p.p_cwd)
 
 let verbose_print_out =
   let pfx = OpamGlobals.colorise `yellow "- " in

src/core/opamSystem.ml

@@ -371,7 +371,7 @@ let make_command
     cmd args =
   let name = log_file ?dir name in
   let verbose =
-    OpamMisc.Option.default (!OpamGlobals.debug || !OpamGlobals.verbose) verbose
+    OpamMisc.Option.default (!OpamGlobals.verbose_level >= 2) verbose
   in
   (* Check that the command doesn't contain whitespaces *)
   if None <> try Some (String.index cmd ' ') with Not_found -> None then
@@ -396,7 +396,7 @@ let run_process ?verbose ?(env=default_env) ~name ?metadata ?allow_stdin command
     if command_exists ~env cmd then (
 
       let verbose = match verbose with
-        | None   -> !OpamGlobals.debug || !OpamGlobals.verbose
+        | None   -> !OpamGlobals.verbose_level >= 2
         | Some b -> b in
 
       let r =
@@ -451,6 +451,9 @@ let read_command_output_opt ?verbose ?env cmd =
   try Some (read_command_output ?verbose ?env cmd)
   with Command_not_found _ -> None
 
+let verbose_for_base_commands () =
+  !OpamGlobals.verbose_level >= 3
+
 let copy src dst =
   if (try Sys.is_directory src
       with Sys_error _ -> raise (File_not_found src))
@@ -460,7 +463,7 @@ let copy src dst =
   if Sys.file_exists dst
   then remove_file dst;
   mkdir (Filename.dirname dst);
-  command ["cp"; src; dst ]
+  command ~verbose:(verbose_for_base_commands ()) ["cp"; src; dst ]
 
 let is_exec file =
   let stat = Unix.stat file in
@@ -476,8 +479,7 @@ let install ?exec src dst =
   let exec = match exec with
     | Some e -> e
     | None -> is_exec src in
-  command
-    ("install" :: "-m" :: (if exec then "0755" else "0644") ::
+  command ("install" :: "-m" :: (if exec then "0755" else "0644") ::
      [ src; dst ])
 
 module Tar = struct
@@ -744,7 +746,8 @@ let really_download ~overwrite ?(compress=false) ~src ~dst =
       if Sys.file_exists dst then
         if overwrite then remove dst
         else internal_error "The downloaded file will overwrite %s." dst;
-      OpamProcess.command ~dir "mv" [filename; dst ]
+      OpamProcess.command ~dir ~verbose:(verbose_for_base_commands ())
+        "mv" [filename; dst ]
       @@> fun r -> raise_on_process_error r; Done dst
   in
   OpamProcess.Job.catch
@@ -763,7 +766,7 @@ let download ~overwrite ?compress ~filename:src ~dst:dst =
     if Sys.file_exists dst then
       if overwrite then remove dst
       else internal_error "The downloaded file will overwrite %s." dst;
-    OpamProcess.command "cp" [src; dst]
+    OpamProcess.command ~verbose:(verbose_for_base_commands ()) "cp" [src; dst]
     @@> fun r -> raise_on_process_error r; Done dst
   ) else
     really_download ~overwrite ?compress ~src ~dst

src/core/opamSystem.mli

@@ -40,6 +40,10 @@ val with_tmp_dir: (string -> 'a) -> 'a
 (** Runs a job with a temp dir that is cleaned up afterwards *)
 val with_tmp_dir_job: (string -> 'a OpamProcess.job) -> 'a OpamProcess.job
 
+(** Returns true if the default verbose level for base commands (cp, mv, etc.)
+    is reached *)
+val verbose_for_base_commands: unit -> bool
+
 (** [copy src dst] copies [src] to [dst]. Remove [dst] before the copy
     if it is a link. *)
 val copy: string -> string -> unit

src/repositories/opamLocal.ml

@@ -195,7 +195,7 @@ module B = struct
     let local_dir = OpamPath.Repository.archives_dir repo in
     OpamFilename.mkdir local_dir;
     pull_file_quiet local_dir filename @@| function
-    | Not_available _ as r when not !OpamGlobals.verbose -> r
+    | Not_available _ as r when !OpamGlobals.verbose_level < 2 -> r
     | r ->
       OpamGlobals.msg "[%s] %s %s\n"
         (OpamGlobals.colorise `blue