From 24e2fff00c8c358d0ca011ac688a127c4cfb2839 Mon Sep 17 00:00:00 2001
From: Michele Alberti <michele.alberti@cea.fr>
Date: Fri, 18 Dec 2020 12:02:28 +0100
Subject: [PATCH] Rework command detect (remove force option).
---
main.ml | 14 +++---
solver.ml | 123 ++++++++++++++++++++++++++++++++---------------------
solver.mli | 8 ++--
3 files changed, 83 insertions(+), 62 deletions(-)
diff --git a/main.ml b/main.ml
index d8fe3fb..9bde6da 100644
--- a/main.ml
+++ b/main.ml
@@ -45,13 +45,13 @@ let setup_logs =
(* Commands. *)
-let config cmd detect force filename () =
+let config cmd detect filename () =
Logs.debug
(fun m -> m "Command `%s' with configuration file `%s'."
cmd filename);
if detect
then begin
- match Solver.detect ~force filename with
+ match Solver.detect filename with
| Ok () -> Logs.app (fun m -> m "Configuration saved in `%s'." filename)
| Error e -> Logs.err (fun m -> m "%s" e)
end
@@ -90,10 +90,6 @@ let config_cmd =
Arg.(value & pos 0 file Solver.default_config_filename
& info [] ~docv:docv_filename ~doc)
in
- let force =
- let doc = "Force creation of configuration $(b,FILE)." in
- Arg.(value & flag & info ["f"; "force-create"] ~doc)
- in
let doc = Format.sprintf "%s configuration." caisar in
let exits = Term.default_exits in
let man = [
@@ -107,11 +103,11 @@ let config_cmd =
Solver.env_vars
in
Term.(ret
- (const (fun cmdname detect force filename _ ->
+ (const (fun cmdname detect filename _ ->
if not detect
then `Help (`Pager, Some "config")
- else `Ok (config cmdname detect force filename ()))
- $ const cmdname $ detect $ force $ filename $ setup_logs)),
+ else `Ok (config cmdname detect filename ()))
+ $ const cmdname $ detect $ filename $ setup_logs)),
Term.info cmdname ~sdocs:Manpage.s_common_options ~envs ~exits ~doc ~man
let verify_cmd =
diff --git a/solver.ml b/solver.ml
index c507b10..496474e 100644
--- a/solver.ml
+++ b/solver.ml
@@ -69,7 +69,8 @@ let exe_name_of_solver solver =
(* Configuration. *)
-type version = [`Unknown_version | `Version of string] [@@deriving yojson, show]
+type version =
+ [`Unknown_version | `Version of string] [@@deriving yojson, show]
let version_of_solver solver s =
let regexp_string =
@@ -103,30 +104,55 @@ let default_config_filename =
| None -> filename
| Some p -> p ^ "/.caisar.conf"
-let out_channel_of_config_filename ~force filename =
- if force || not (Sys.file_exists filename)
- then begin
- Logs.debug (fun m -> m "Creating configuration file `%s'." filename);
- Ok (Stdlib.open_out filename)
- end
- else
- Error (Format.sprintf "Configuration file `%s' already exists." filename)
+let get_config filename =
+ try config_of_yojson (Yojson.Safe.from_file filename)
+ with Yojson.Json_error e -> Error e
-let detect ~force filename =
+let get_config_solver ~solver filename =
let open Result in
+ Logs.info
+ (fun m -> m "Reading configuration file `%s' for solver `%s'."
+ filename solver);
+ if not (Sys.file_exists filename)
+ then Error (Format.sprintf "Configuration file `%s' not exist." filename)
+ else begin
+ (* Read all solver configs present in the given configuration file. *)
+ get_config filename >>= fun config ->
+ (* Search for a [config_solver] with a name [solver]. *)
+ match List.find ~f:(fun cs -> String.equal cs.name solver) config with
+ | None ->
+ Error
+ (Format.sprintf
+ "No solver with name `%s' found in configuration file `%s'."
+ solver filename)
+ | Some config_solver ->
+ begin
+ Logs.info
+ (fun m -> m "Found `%s' `%s'."
+ (show_solver config_solver.solver)
+ (show_version config_solver.version));
+ Ok config_solver
+ end
+ end
+
+let create_config_file filename =
+ Logs.debug (fun m -> m "Creating configuration file `%s'." filename);
+ let config =
+ if Sys.file_exists filename
+ then Some (get_config filename)
+ else None
+ in
+ Stdlib.open_out filename, config
+
+let detect_default_solvers () =
let module Filename = Caml.Filename in
- Logs.info (fun m ->
- m "Detecting%s solvers in $PATH, and writing configuration file `%s'."
- (if force then " (force)" else "") filename);
- (* Create the configuration file. *)
- out_channel_of_config_filename ~force filename >>= fun out_channel ->
- (* Build a [config_solver] for each supported solver. *)
try
let config =
List.filter_map
~f:(fun solver ->
- (* We detect whether solver is available in PATH, or in the provided
- path via env variable, by executing `solver --version' command. *)
+ (* We detect whether solver is available in $PATH, or in the
+ provided path via env variable, by executing `solver
+ --version' command. *)
let tmp = Filename.temp_file "caisar" "detect" in
let exe = exe_name_of_solver solver in
let cmd =
@@ -162,41 +188,42 @@ let detect ~force filename =
end)
defaults
in
- Logs.app (fun m -> m "%d solver(s) added." (List.length config));
- (* We write all solver configs in the configuration file, as JSON data. *)
- let config_json = config_to_yojson config in
- Yojson.Safe.pretty_to_channel out_channel config_json;
- Ok ()
+ Ok config
with _ ->
Error "Unexpected failure."
-let get_config_solver ~solver filename =
+
+let detect filename =
let open Result in
- Logs.info
- (fun m -> m "Reading configuration file `%s' for solver `%s'."
- filename solver);
- if not (Sys.file_exists filename)
- then Error (Format.sprintf "Configuration file `%s' not exist." filename)
- else begin
- (* Read all solver configs present in the given configuration file. *)
- config_of_yojson (Yojson.Safe.from_file filename) >>= fun config ->
- (* Search for a [config_solver] with a name [solver]. *)
- match List.find ~f:(fun cs -> String.equal cs.name solver) config with
+ Logs.info (fun m ->
+ m "Detecting solvers in $PATH, and writing configuration file `%s'."
+ filename);
+ (* Create new configuration file and retrieve the `config' from the existing
+ one, if any. *)
+ let out_channel, config_opt = create_config_file filename in
+ (* Detect default supported solvers in $PATH. *)
+ detect_default_solvers () >>= fun default_config ->
+ (* Build [config] by first appending [default_config] and the existing one
+ [config_opt], and then deduping the result. *)
+ begin
+ match config_opt with
| None ->
- Error
- (Format.sprintf
- "No solver with name `%s' found in configuration file `%s'."
- solver filename)
- | Some config_solver ->
- begin
- Logs.info
- (fun m -> m "Found `%s' `%s'."
- (show_solver config_solver.solver)
- (show_version config_solver.version));
- Ok config_solver
- end
- end
-
+ Ok default_config
+ | Some or_config ->
+ or_config >>= fun current_config ->
+ (* We consider two solvers equal as soon as their `name' is. *)
+ (* TODO: This comparison is not optimal but needed as long as we register
+ solver names as lazily as done in [detect_default_solvers]. *)
+ let compare cs1 cs2 = String.compare cs1.name cs2.name in
+ Ok
+ (List.dedup_and_sort
+ ~compare
+ (List.append current_config default_config))
+ end >>= fun config ->
+ (* We write all solver configs in the configuration file, as JSON data. *)
+ let config_json = config_to_yojson config in
+ Yojson.Safe.pretty_to_channel out_channel config_json;
+ Ok ()
(* Verification. *)
diff --git a/solver.mli b/solver.mli
index 5975819..cb85fc7 100644
--- a/solver.mli
+++ b/solver.mli
@@ -14,11 +14,9 @@ val env_vars: string list
val default_config_filename: string
-(** [detect ~force file] searches for solvers in $PATH, or in the paths provided
- via [env_vars], and save the configurations in [file].
- By default, it does not overwrite [file] if it already exists.
- @param force if true, forces the creation of [file]. *)
-val detect: force:bool -> string -> (unit, string) Result.t
+(** [detect file] searches for solvers in $PATH, or in the paths provided
+ via [env_vars], and save the configurations in [file]. *)
+val detect: string -> (unit, string) Result.t
(** Solver configuration. *)
type config_solver
--
GitLab