migrate show_full_path from OptionState to Logging

src/backend/optionState.ml

@@ -4,7 +4,6 @@ open MyUtil
 
 type state = {
   input_file     : abs_path option;
-  show_full_path : bool;
 }
 
 
@@ -27,10 +26,6 @@ let get_input_file () =
   | None             -> assert false
 
 
-let does_show_full_path () =
-  (get ()).show_full_path
-
-
 let job_directory () =
   let abspath = get_input_file () in
   Filename.dirname (get_abs_path_string abspath)

src/backend/optionState.mli

@@ -2,12 +2,9 @@
 open MyUtil
 
 type state = {
-  input_file     : abs_path option;
-  show_full_path : bool;
+  input_file : abs_path option;
 }
 
 val set : state -> unit
 
-val does_show_full_path : unit -> bool
-
 val job_directory : unit -> string

src/frontend/closedLockDependencyResolver.ml

@@ -11,7 +11,7 @@ type 'a ok = ('a, config_error) result
 module LockDependencyGraph = DependencyGraph.Make(String)
 
 
-let main ~(use_test_only_lock : bool) ~library_root:(absdir_lib_root : abs_path) ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * (PackageConfig.t * untyped_package)) list) ok =
+let main (display_config : Logging.config) ~(use_test_only_lock : bool) ~library_root:(absdir_lib_root : abs_path) ~(extensions : string list) (lock_config : LockConfig.t) : ((lock_name * (PackageConfig.t * untyped_package)) list) ok =
   let open ResultMonad in
 
   let locks = lock_config.LockConfig.locked_packages in
@@ -31,7 +31,7 @@ let main ~(use_test_only_lock : bool) ~library_root:(absdir_lib_root : abs_path)
               make_abs_path (Filename.concat (get_abs_path_string absdir_lib_root) (get_lib_path_string libdir))
         in
         let* package_with_config =
-          PackageReader.main ~use_test_files:use_test_only_lock ~extensions absdir_package
+          PackageReader.main display_config ~use_test_files:use_test_only_lock ~extensions absdir_package
         in
         let* (graph, vertex) =
           graph |> LockDependencyGraph.add_vertex lock_name package_with_config

src/frontend/lockConfig.ml

@@ -96,12 +96,12 @@ let load (abspath_lock_config : abs_path) : t ok =
     |> Result.map_error (fun e -> LockConfigError(abspath_lock_config, e))
 
 
-let write (abspath_lock_config : abs_path) (lock_config : t) : unit =
+let write (display_config : Logging.config) (abspath_lock_config : abs_path) (lock_config : t) : unit =
   let yaml = lock_config_encoder lock_config in
   match Yaml.to_string ~encoding:`Utf8 ~layout_style:`Block ~scalar_style:`Plain yaml with
   | Ok(data) ->
       Core.Out_channel.write_all (get_abs_path_string abspath_lock_config) ~data;
-      Logging.end_lock_output abspath_lock_config
+      Logging.end_lock_output display_config abspath_lock_config
 
   | Error(_) ->
       assert false

src/frontend/logging.ml

@@ -3,26 +3,31 @@ open MyUtil
 open PackageSystemBase
 
 
-let show_path abspath =
+type config = {
+  show_full_path : bool;
+}
+
+
+let show_path (config : config) (abspath : abs_path) =
   let pathstr = get_abs_path_string abspath in
-  if OptionState.does_show_full_path () then pathstr else Filename.basename pathstr
+  if config.show_full_path then pathstr else Filename.basename pathstr
 
 
-let begin_to_typecheck_file abspath_in =
+let begin_to_typecheck_file (config : config) (abspath_in : abs_path) =
   print_endline (" ---- ---- ---- ----");
-  print_endline ("  type checking '" ^ (show_path abspath_in) ^ "' ...")
+  print_endline ("  type checking '" ^ (show_path config abspath_in) ^ "' ...")
 
 
-let begin_to_preprocess_file abspath_in =
-  print_endline ("  preprocessing '" ^ (show_path abspath_in) ^ "' ...")
+let begin_to_preprocess_file (config : config) (abspath_in : abs_path) =
+  print_endline ("  preprocessing '" ^ (show_path config abspath_in) ^ "' ...")
 
 
-let begin_to_eval_file abspath_in =
-  print_endline ("  evaluating '" ^ (show_path abspath_in) ^ "' ...")
+let begin_to_eval_file (config : config) (abspath_in : abs_path) =
+  print_endline ("  evaluating '" ^ (show_path config abspath_in) ^ "' ...")
 
 
-let begin_to_parse_file abspath_in =
-  print_endline ("  parsing '" ^ (show_path abspath_in) ^ "' ...")
+let begin_to_parse_file (config : config) (abspath_in : abs_path) =
+  print_endline ("  parsing '" ^ (show_path config abspath_in) ^ "' ...")
 
 
 let pass_type_check opt =
@@ -79,25 +84,25 @@ let achieve_fixpoint unresolved_crossrefs =
     print_endline ("  some cross references were not solved: " ^ String.concat " " unresolved_crossrefs ^ ".")
 
 
-let end_output file_name_out =
+let end_output (config : config) (file_name_out : abs_path) =
   print_endline (" ---- ---- ---- ----");
-  print_endline ("  output written on '" ^ (show_path file_name_out) ^ "'.")
+  print_endline ("  output written on '" ^ (show_path config file_name_out) ^ "'.")
 
 
-let target_file file_name_out =
+let target_file (config : config) (file_name_out : abs_path) =
   print_endline (" ---- ---- ---- ----");
-  print_endline ("  target file: '" ^ (show_path file_name_out) ^ "'")
+  print_endline ("  target file: '" ^ (show_path config file_name_out) ^ "'")
 
 
-let dump_file ~(already_exists : bool) dump_file =
+let dump_file (config : config) ~(already_exists : bool) (dump_file : abs_path) =
   if already_exists then
-    print_endline ("  dump file: '" ^ (show_path dump_file) ^ "' (already exists)")
+    print_endline ("  dump file: '" ^ (show_path config dump_file) ^ "' (already exists)")
   else
-    print_endline ("  dump file: '" ^ (show_path dump_file) ^ "' (will be created)")
+    print_endline ("  dump file: '" ^ (show_path config dump_file) ^ "' (will be created)")
 
 
-let lock_config_file (abspath_lock_config : abs_path) =
-  Printf.printf "  lock file: '%s'\n" (show_path abspath_lock_config)
+let lock_config_file (config : config) (abspath_lock_config : abs_path) =
+  Printf.printf "  lock file: '%s'\n" (show_path config abspath_lock_config)
 
 
 let begin_to_embed_fonts () =
@@ -134,13 +139,14 @@ let show_package_dependency_solutions (solutions : package_solution list) =
   )
 
 
-let end_lock_output file_name_out =
+let end_lock_output (config : config) (file_name_out : abs_path) =
   print_endline (" ---- ---- ---- ----");
-  print_endline ("  output written on '" ^ (show_path file_name_out) ^ "'.")
+  print_endline ("  output written on '" ^ (show_path config file_name_out) ^ "'.")
 
 
-let warn_cmyk_image file_name =
-  print_endline ("  [Warning] (" ^ (show_path file_name) ^ ") Jpeg images with CMYK color mode are not fully supported.");
+let warn_cmyk_image (file_name : abs_path) =
+  let config = { show_full_path = true } in (* TODO: make this changeable *)
+  print_endline ("  [Warning] (" ^ (show_path config file_name) ^ ") Jpeg images with CMYK color mode are not fully supported.");
   print_endline ("  Please convert the image to a jpeg image with YCbCr (RGB) color model.")
 
 

src/frontend/logging.mli

@@ -2,13 +2,19 @@
 open MyUtil
 open PackageSystemBase
 
-val begin_to_typecheck_file : abs_path -> unit
+type config = {
+  show_full_path : bool;
+}
 
-val begin_to_preprocess_file : abs_path -> unit
+val show_path : config -> abs_path -> string
 
-val begin_to_eval_file : abs_path -> unit
+val begin_to_typecheck_file : config -> abs_path -> unit
 
-val begin_to_parse_file : abs_path -> unit
+val begin_to_preprocess_file : config -> abs_path -> unit
+
+val begin_to_eval_file : config -> abs_path -> unit
+
+val begin_to_parse_file : config -> abs_path -> unit
 
 val pass_type_check : string option -> unit
 
@@ -22,13 +28,13 @@ val achieve_count_max : unit -> unit
 
 val achieve_fixpoint : string list -> unit
 
-val end_output : abs_path -> unit
+val end_output : config -> abs_path -> unit
 
-val target_file : abs_path -> unit
+val target_file : config -> abs_path -> unit
 
-val dump_file : already_exists:bool -> abs_path -> unit
+val dump_file : config -> already_exists:bool -> abs_path -> unit
 
-val lock_config_file : abs_path -> unit
+val lock_config_file : config -> abs_path -> unit
 
 val show_package_dependency_before_solving : (dependency_flag * package_dependency) list -> unit
 
@@ -40,7 +46,7 @@ val begin_to_write_page : unit -> unit
 
 val needs_another_trial : unit -> unit
 
-val end_lock_output : abs_path -> unit
+val end_lock_output : config -> abs_path -> unit
 
 val warn_noninjective_cmap : Uchar.t -> Uchar.t -> Otfed.Value.glyph_id -> unit