develop Logging about displaying filepaths

bin-saphe/saphe.ml

@@ -15,8 +15,15 @@ let update fpath_in =
   SapheMain.update ~fpath_in
 
 
-let solve fpath_in =
-  SapheMain.solve ~fpath_in
+let solve
+  fpath_in
+  show_full_path
+  verbosity
+=
+  SapheMain.solve
+    ~fpath_in
+    ~show_full_path
+    ~verbosity
 
 
 let build
@@ -188,7 +195,11 @@ let command_update : unit Cmdliner.Cmd.t =
 let command_solve : unit Cmdliner.Cmd.t =
   let open Cmdliner in
   Cmd.v (Cmd.info "solve")
-    Term.(const solve $ arg_in)
+    Term.(const solve
+      $ arg_in
+      $ flag_full_path
+      $ flag_verbosity
+    )
 
 
 let command_build : unit Cmdliner.Cmd.t =

src-common/commonUtil.ml

@@ -1,4 +1,7 @@
 
+open MyUtil
+
+
 let is_middle_char (char : char) : bool =
   Char.equal char '-' || Core.Char.is_alpha char || Core.Char.is_digit char
 
@@ -38,3 +41,24 @@ let parse_long_identifier (s : string) : (string list * string) option =
     return (modnms, varnm)
   else
     None
+
+
+type path_display_setting =
+  | FullPath
+  | RelativeToCwd of abs_path
+
+
+let display_path (setting : path_display_setting) (abspath : abs_path) =
+  match setting with
+  | FullPath                   -> AbsPath.to_string abspath
+  | RelativeToCwd(abspath_cwd) -> AbsPath.make_relative ~from:abspath_cwd abspath
+
+
+let is_verbose = function
+  | Verbosity.Verbose -> true
+  | _                 -> false
+
+
+let is_not_quiet = function
+  | Verbosity.Quiet -> false
+  | _               -> true

src-common/commonUtil.mli

@@ -1,8 +1,20 @@
 
+open MyUtil
+
 val is_uppercased_identifier : string -> bool
 
 val is_lowercased_identifier : string -> bool
 
 val parse_long_command : prefix:string -> string -> (string list * string) option
 
 val parse_long_identifier : string -> (string list * string) option
+
+type path_display_setting =
+  | FullPath
+  | RelativeToCwd of abs_path
+
+val display_path : path_display_setting -> abs_path -> string
+
+val is_verbose : Verbosity.t -> bool
+
+val is_not_quiet : Verbosity.t -> bool

src-saphe/logging.ml

@@ -1,9 +1,20 @@
 
 open MyUtil
+open CommonUtil
 open PackageSystemBase
 
 
-let show_package_dependency_before_solving (dependencies_with_flags : (dependency_flag * package_dependency) list) =
+type config = {
+  path_display_setting : path_display_setting;
+  verbosity            : Verbosity.t;
+}
+
+
+let show_path (config : config) =
+  display_path config.path_display_setting
+
+
+let show_package_dependency_before_solving (config : config) (dependencies_with_flags : (dependency_flag * package_dependency) list) =
   Printf.printf "  package dependencies to solve:\n";
   dependencies_with_flags |> List.iter (fun (flag, dep) ->
     let PackageDependency{ used_as; spec } = dep in
@@ -16,62 +27,84 @@ let show_package_dependency_before_solving (dependencies_with_flags : (dependenc
           | SourceDependency   -> ""
           | TestOnlyDependency -> ", test_only"
         in
-        Printf.printf "  - %s (%s%s) used as %s\n" package_name s_restr s_test_only used_as
+        Printf.printf "  - %s (%s%s) used as %s\n"
+          package_name
+          s_restr
+          s_test_only
+          used_as
 
     | LocalFixedDependency{ absolute_path } ->
-        Printf.printf "  - '%s' used as %s\n" (AbsPath.to_string absolute_path) used_as
+        Printf.printf "  - '%s' used as %s\n"
+          (show_path config absolute_path)
+          used_as
   )
 
 
-let show_package_dependency_solutions (solutions : package_solution list) =
+let show_package_dependency_solutions (config : config) (solutions : package_solution list) =
   Printf.printf "  package dependency solutions:\n";
   solutions |> List.iter (fun solution ->
     match solution.lock with
     | Lock.Registered(RegisteredLock.{ registered_package_id; locked_version; _ }) ->
         let RegisteredPackageId.{ package_name; _ } = registered_package_id in
-        Printf.printf "  - %s %s\n" package_name (SemanticVersion.to_string locked_version)
+        Printf.printf "  - %s %s\n"
+          package_name
+          (SemanticVersion.to_string locked_version)
 
     | Lock.LocalFixed{ absolute_path } ->
-        Printf.printf "  - %s\n" (AbsPath.to_string absolute_path)
+        Printf.printf "  - %s\n"
+          (show_path config absolute_path)
   )
 
 
-let end_lock_config_output (abspath_lock_config : abs_path) =
-  Printf.printf "  lock config written on '%s'.\n" (AbsPath.to_string abspath_lock_config)
+let end_lock_config_output (config : config) (abspath_lock_config : abs_path) =
+  Printf.printf "  lock config written on '%s'.\n"
+    (show_path config abspath_lock_config)
 
 
-let end_envelope_config_output (abspath_envelope_config : abs_path) =
-  Printf.printf "  envelope config written on '%s'.\n" (AbsPath.to_string abspath_envelope_config)
+let end_envelope_config_output (config : config) (abspath_envelope_config : abs_path) =
+  Printf.printf "  envelope config written on '%s'.\n"
+    (show_path config abspath_envelope_config)
 
 
-let end_deps_config_output (abspath_deps_config : abs_path) =
-  Printf.printf "  deps config written on '%s'.\n" (AbsPath.to_string abspath_deps_config)
+let end_deps_config_output (config : config) (abspath_deps_config : abs_path) =
+  if is_verbose config.verbosity then begin
+    Printf.printf "  deps config written on '%s'.\n"
+      (show_path config abspath_deps_config)
+  end
 
 
 let lock_already_installed (lock_name : lock_name) (absdir : abs_path) =
-  Printf.printf "  '%s': already installed at '%s'\n" lock_name (AbsPath.to_string absdir)
+  Printf.printf "  '%s': already installed at '%s'\n"
+    lock_name
+    (AbsPath.to_string absdir)
 
 
 let lock_cache_exists (lock_name : lock_name) (abspath_tarball : abs_path) =
-  Printf.printf "  cache for '%s' exists at '%s'\n" lock_name (AbsPath.to_string abspath_tarball)
+  Printf.printf "  cache for '%s' exists at '%s'\n"
+    lock_name
+    (AbsPath.to_string abspath_tarball)
 
 
 let store_root_config_updated ~(created : bool) (abspath_store_root_config : abs_path) =
   let verb = if created then "created" else "updated" in
-  Printf.printf "  %s the store root config '%s'\n" verb (AbsPath.to_string abspath_store_root_config)
+  Printf.printf "  %s the store root config '%s'\n"
+    verb
+    (AbsPath.to_string abspath_store_root_config)
 
 
 let package_registry_updated ~(created : bool) (absdir_registry_repo : abs_path) =
   let verb = if created then "fetched" else "updated" in
-  Printf.printf "  %s the package registry '%s'\n" verb (AbsPath.to_string absdir_registry_repo)
+  Printf.printf "  %s the package registry '%s'\n"
+    verb
+    (AbsPath.to_string absdir_registry_repo)
 
 
-let initialize_file (abspath_doc : abs_path) =
-  Printf.printf "  created '%s'\n" (AbsPath.to_string abspath_doc)
+let initialize_file (config : config) (abspath_doc : abs_path) =
+  Printf.printf "  created '%s'\n" (show_path config abspath_doc)
 
 
-let initialize_package_config (abspath_package_config : abs_path) =
-  Printf.printf "  created a package config '%s'\n" (AbsPath.to_string abspath_package_config)
+let initialize_package_config (config : config) (abspath_package_config : abs_path) =
+  Printf.printf "  created a package config '%s'\n" (show_path config abspath_package_config)
 
 
 let downloading_lock (lock_name : lock_name) (absdir : abs_path) =

src-saphe/logging.mli

@@ -1,16 +1,22 @@
 
 open MyUtil
+open CommonUtil
 open PackageSystemBase
 
-val show_package_dependency_before_solving : (dependency_flag * package_dependency) list -> unit
+type config = {
+  path_display_setting : path_display_setting;
+  verbosity            : Verbosity.t;
+}
 
-val show_package_dependency_solutions : package_solution list -> unit
+val show_package_dependency_before_solving : config -> (dependency_flag * package_dependency) list -> unit
 
-val end_lock_config_output : abs_path -> unit
+val show_package_dependency_solutions : config -> package_solution list -> unit
 
-val end_envelope_config_output : abs_path -> unit
+val end_lock_config_output : config -> abs_path -> unit
 
-val end_deps_config_output : abs_path -> unit
+val end_envelope_config_output : config -> abs_path -> unit
+
+val end_deps_config_output : config -> abs_path -> unit
 
 val lock_already_installed : lock_name -> abs_path -> unit
 
@@ -20,9 +26,9 @@ val store_root_config_updated : created:bool -> abs_path -> unit
 
 val package_registry_updated : created:bool -> abs_path -> unit
 
-val initialize_file : abs_path -> unit
+val initialize_file : config -> abs_path -> unit
 
-val initialize_package_config : abs_path -> unit
+val initialize_package_config : config -> abs_path -> unit
 
 val downloading_lock : lock_name -> abs_path -> unit