Merge pull request ocaml#2292 from OCamlPro/lib-config-init

Provide a function for easy general initialisation in OpamClientConfig

src/client/opamArg.ml

@@ -61,26 +61,21 @@ let apply_global_options o =
   let open OpamStd.Option.Op in
   let flag f = if f then Some true else None in
   let some x = match x with None -> None | some -> Some some in
-  (* (i) get root dir *)
-  let root = OpamStateConfig.opamroot ?root_dir:o.opt_root () in
-  (* (ii) load conf file and set defaults *)
-  (* the init for OpamFormat is done in advance since (a) it has an effect on
-     loading the global config (b) the global config has no effect on it *)
-  OpamFormatConfig.init
+  let external_solver =
+    if o.use_internal_solver then Some (lazy None) else
+      o.external_solver >>| fun s ->
+      lazy (
+        let args = OpamStd.String.split s ' ' in
+        Some (List.map (fun a -> OpamTypes.CString a, None) args)
+      )
+  in
+  let solver_prefs = o.solver_preferences >>| fun p -> lazy p in
+  OpamClientConfig.opam_init
+    (* - format options - *)
     ?strict:(flag o.strict)
     (* ?skip_version_checks:bool *)
     (* ?all_parens:bool *)
-    ();
-  let initialised =
-    OpamStateConfig.load_defaults root
-  in
-  (* (iii) load from env and options using OpamXxxGlobals.init_config *)
-  let log_dir =
-      if initialised then
-        Some OpamFilename.(Dir.to_string Op.(root / "log"))
-      else None
-  in
-  OpamStd.Config.init
+    (* - core options - *)
     ?debug_level:(if o.safe_mode then Some 0 else o.debug_level)
     ?verbose_level:(if o.quiet then Some 0 else
                     if o.verbose = 0 then None else Some o.verbose)
@@ -90,33 +85,21 @@ let apply_global_options o =
     ?answer:(some (flag o.yes))
     ?safe_mode:(flag o.safe_mode)
     (* ?lock_retries:int *)
-    ?log_dir
+    (* ?log_dir:OpamTypes.dirname *)
     (* ?keep_log_dir:bool *)
-    ();
-  OpamRepositoryConfig.init
+    (* - repository options - *)
     (* ?download_tool:(OpamTypes.arg list * dl_tool_kind) Lazy.t *)
     (* ?retries:int *)
     (* ?force_checksums:bool option *)
-    ();
-  let external_solver =
-    if o.use_internal_solver then Some (lazy None) else
-      o.external_solver >>| fun s ->
-      lazy (
-        let args = OpamStd.String.split s ' ' in
-        Some (List.map (fun a -> OpamTypes.CString a, None) args)
-      )
-  in
-  let solver_prefs = o.solver_preferences >>| fun p -> lazy p in
-  OpamSolverConfig.init
+    (* - solver options *)
     ?cudf_file:(some o.cudf_file)
     (* ?solver_timeout:float *)
     ?external_solver
     ?solver_preferences_default:(some solver_prefs)
     ?solver_preferences_upgrade:(some solver_prefs)
     ?solver_preferences_fixup:(some solver_prefs)
-    ();
-  OpamStateConfig.init
-    ~root_dir:root
+    (* - state options - *)
+    ?root_dir:o.opt_root
     ?current_switch:(o.opt_switch >>| OpamSwitch.of_string)
     ?switch_from:(o.opt_switch >>| fun _ -> `Command_line)
     (* ?jobs: int *)
@@ -131,8 +114,7 @@ let apply_global_options o =
     (* ?fake:bool *)
     (* ?makecmd:string Lazy.t *)
     ?json_out:OpamStd.Option.Op.(o.json >>| function "" -> None | s -> Some s)
-    ();
-  OpamClientConfig.init
+    (* - client options - *)
     (* ?print_stats:bool *)
     (* ?sync_archives:bool *)
     (* ?pin_kind_auto:bool *)

src/client/opamClientConfig.ml

@@ -35,15 +35,14 @@ type 'a options_fun =
   ?pin_kind_auto:bool ->
   ?autoremove:bool ->
   ?editor:string ->
-  unit -> 'a
+  'a
 
 let setk k t
     ?print_stats
     ?sync_archives
     ?pin_kind_auto
     ?autoremove
     ?editor
-   ()
   =
   let (+) x opt = match opt with Some x -> x | None -> x in
   k {
@@ -54,24 +53,50 @@ let setk k t
     editor = t.editor + editor;
   }
 
-let set t = setk (fun x -> x) t
+let set t = setk (fun x () -> x) t
 
 let r = ref default
 
-let update ?noop:_ = setk (fun cfg -> r := cfg) !r
+let update ?noop:_ = setk (fun cfg () -> r := cfg) !r
 
-let init ?noop:_ =
+let initk k =
   let open OpamStd.Config in
   let open OpamStd.Option.Op in
   let editor =
     env_string "EDITOR" ++ OpamStd.Env.(getopt "VISUAL" ++ getopt "EDITOR")
   in
-  setk (setk (fun c -> r := c)) !r
+  setk (setk (fun c -> r := c; k)) !r
     ?print_stats:(env_bool "STATS")
     ?sync_archives:(env_bool "SYNCARCHIVES")
     ?pin_kind_auto:(env_bool "PINKINDAUTO")
     ?autoremove:(env_bool "AUTOREMOVE")
     ?editor
-    ()
+
+let init ?noop:_ = initk (fun () -> ())
 
 let search_files = ["findlib"]
+
+open OpamStd.Op
+
+let opam_init ?root_dir ?strict =
+  (* (i) get root dir *)
+  let root = OpamStateConfig.opamroot ?root_dir () in
+
+  (* (ii) load conf file and set defaults *)
+  (* the init for OpamFormat is done in advance since (a) it has an effect on
+     loading the global config (b) the global config has no effect on it *)
+  OpamFormatConfig.initk ?strict @@ fun ?log_dir ->
+  let initialised = OpamStateConfig.load_defaults root in
+
+  (* (iii) load from env and options using OpamXxxConfig.init *)
+  let log_dir =
+    if log_dir = None && initialised
+    then Some OpamFilename.(Dir.to_string Op.(root / "log"))
+    else None
+  in
+  (fun () -> ()) |>
+  OpamStd.Config.initk ?log_dir |>
+  OpamRepositoryConfig.initk |>
+  OpamSolverConfig.initk |>
+  OpamStateConfig.initk ~root_dir:root |>
+  initk

src/client/opamClientConfig.mli

@@ -27,21 +27,61 @@ type 'a options_fun =
   ?pin_kind_auto:bool ->
   ?autoremove:bool ->
   ?editor:string ->
-  unit -> 'a
+  'a
+  (* constraint 'a = 'b -> 'c *)
 
-val default : t
-
-val set : t -> t options_fun
-
-val setk : (t -> 'a) -> t -> 'a options_fun
-
-val r : t ref
-
-val update : ?noop:_ -> unit options_fun
-
-(** Sets the options, reading the environment to get default
-    values when unspecified *)
-val init: ?noop:_ -> unit options_fun
+include OpamStd.Config.Sig
+  with type t := t
+   and type 'a options_fun := 'a options_fun
 
 (** Extra files included in [opam search] *)
 val search_files: string list
+
+(** Load the global configuration file (opamroot/config) and initialise all opam
+    sub-libraries, overriding the given arguments *)
+
+val opam_init:
+  ?root_dir:OpamTypes.dirname ->
+  ?strict:bool ->
+  ?skip_version_checks:bool ->
+  ?all_parens:bool ->
+  ?log_dir:OpamTypes.dirname ->
+  ?print_stats:bool ->
+  ?sync_archives:bool ->
+  ?pin_kind_auto:bool ->
+  ?autoremove:bool ->
+  ?editor:string ->
+  ?current_switch:OpamSwitch.t ->
+  ?switch_from:[ `Command_line | `Default | `Env ] ->
+  ?jobs:int Lazy.t ->
+  ?dl_jobs:int ->
+  ?external_tags:string list ->
+  ?keep_build_dir:bool ->
+  ?no_base_packages:bool ->
+  ?build_test:bool ->
+  ?build_doc:bool ->
+  ?show:bool ->
+  ?dryrun:bool ->
+  ?fake:bool ->
+  ?makecmd:string Lazy.t ->
+  ?json_out:string option ->
+  ?cudf_file:string option ->
+  ?solver_timeout:float ->
+  ?external_solver:OpamTypes.arg list option Lazy.t ->
+  ?solver_preferences_default:string Lazy.t option ->
+  ?solver_preferences_upgrade:string Lazy.t option ->
+  ?solver_preferences_fixup:string Lazy.t option ->
+  ?download_tool:(OpamTypes.arg list * OpamRepositoryConfig.dl_tool_kind) Lazy.t ->
+  ?retries:int ->
+  ?force_checksums:bool option ->
+  ?debug_level:int ->
+  ?verbose_level:int ->
+  ?color:[ `Always | `Auto | `Never ] ->
+  ?utf8:[ `Always | `Auto | `Extended | `Never ] ->
+  ?disp_status_line:[ `Always | `Auto | `Never ] ->
+  ?answer:bool option ->
+  ?safe_mode:bool ->
+  ?lock_retries:int ->
+  ?keep_log_dir:bool ->
+  ?errlog_length:int ->
+  unit -> unit

src/core/opamCoreConfig.ml

@@ -41,7 +41,7 @@ type 'a options_fun =
   ?log_dir:string ->
   ?keep_log_dir:bool ->
   ?errlog_length:int ->
-  unit -> 'a
+  'a
 
 let default = {
   debug_level = 0;
@@ -72,7 +72,6 @@ let setk k t
     ?log_dir
     ?keep_log_dir
     ?errlog_length
-    ()
   =
   let (+) x opt = match opt with Some x -> x | None -> x in
   k {
@@ -89,10 +88,10 @@ let setk k t
     errlog_length = t.errlog_length + errlog_length;
   }
 
-let set t = setk (fun x -> x) t
+let set t = setk (fun x () -> x) t
 
 (* Global configuration reference *)
 
 let r = ref default
 
-let update ?noop:_ = setk (fun cfg -> r := cfg) !r
+let update ?noop:_ = setk (fun cfg () -> r := cfg) !r

src/core/opamCoreConfig.mli

@@ -54,14 +54,14 @@ type 'a options_fun =
   ?log_dir:string ->
   ?keep_log_dir:bool ->
   ?errlog_length:int ->
-  unit -> 'a
+  'a
 
 val default : t
 
-val set : t -> t options_fun
+val set : t -> (unit -> t) options_fun
 
 val setk : (t -> 'a) -> t -> 'a options_fun
 
 val r : t ref
 
-val update : ?noop:unit -> unit options_fun
+val update : ?noop:_ -> (unit -> unit) options_fun

src/core/opamProcess.mli

@@ -19,17 +19,26 @@
 (** The type of shell commands *)
 type command
 
+(** Builds a shell command for later execution.
+    @param ?env         environment for the command
+    @param ?verbose     force verbosity
+    @param ?name        title, used to name log files, etc.
+    @param ?metadata    additional info to log
+    @param ?dir         CWD for the command
+    @param ?allow_stdin whether to forward stdin
+    @param ?text        Short text that may be displayed in the status-line
+    @param command      The command itself
+    @param args         Command-line arguments *)
 val command:
-  ?env:string array ->              (** env for the comman d*)
-  ?verbose:bool ->                  (** force verbosity *)
-  ?name:string ->                   (** title, used to name log files, etc. *)
-  ?metadata:(string*string) list -> (** additional info to log *)
-  ?dir:string ->                    (** CWD for the command *)
-  ?allow_stdin:bool ->              (** whether to forward stdin *)
-  ?text:string ->                   (** Short text that may be displayed in
-                                        status *)
-  string ->                         (** The command itself *)
-  string list ->                    (** Command-line arguments *)
+  ?env:string array ->
+  ?verbose:bool ->
+  ?name:string ->
+  ?metadata:(string*string) list ->
+  ?dir:string ->
+  ?allow_stdin:bool ->
+  ?text:string ->
+  string ->
+  string list ->
   command
 
 val string_of_command: command -> string

src/core/opamStd.ml

@@ -798,6 +798,21 @@ end
 
 module Config = struct
 
+  module type Sig = sig
+
+    type t
+    type 'a options_fun
+
+    val default: t
+    val set: t -> (unit -> t) options_fun
+    val setk: (t -> 'a) -> t -> 'a options_fun
+    val r: t ref
+    val update: ?noop:_ -> (unit -> unit) options_fun
+    val init: ?noop:_ -> (unit -> unit)  options_fun
+    val initk: 'a -> 'a options_fun
+
+  end
+
   type env_var = string
 
   let env conv var =
@@ -852,7 +867,7 @@ module Config = struct
     | `Never -> false
     | `Auto -> Lazy.force auto
 
-  let init ?noop:_ =
+  let initk k =
     let utf8 = Option.Op.(
         env_when_ext "UTF8" ++
         (env_bool "UTF8MSGS" >>= function
@@ -865,7 +880,7 @@ module Config = struct
       | None, None -> None
       | _ -> Some None
     in
-    OpamCoreConfig.(setk (setk (fun c -> r := c)) !r)
+    OpamCoreConfig.(setk (setk (fun c -> r := c; k)) !r)
       ?debug_level:(env_level "DEBUG")
       ?verbose_level:(env_level "VERBOSE")
       ?color:(env_when "COLOR")
@@ -877,7 +892,8 @@ module Config = struct
       ?log_dir:(env_string "LOGS")
       ?keep_log_dir:(env_bool "KEEPLOGS")
       ?errlog_length:(env_int "ERRLOGLEN")
-      ()
+
+  let init ?noop:_ = initk (fun () -> ())
 end
 
 module List = OpamList