slight changes about writing files

bin-saphe/configError.ml

@@ -111,3 +111,7 @@ type config_error =
     }
   | PackageRegistryFetcherError   of PackageRegistryFetcher.error
   | CanonicalRegistryUrlError     of CanonicalRegistryUrl.error
+  | CannotWriteEnvelopeConfig of {
+      message : string;
+      path    : abs_path;
+    }

bin-saphe/envelopeConfig.ml

@@ -1,5 +1,6 @@
 
 open MyUtil
+open ConfigError
 
 
 type relative_path = string
@@ -74,12 +75,13 @@ let envelope_config_encoder (envelope_config : t) : Yaml.value =
        ])
 
 
-let write (abspath_envelope_config : abs_path) (envelope_config : t) : unit =
+let write (abspath_envelope_config : abs_path) (envelope_config : t) : (unit, config_error) result =
+  let open ResultMonad in
   let yaml = envelope_config_encoder envelope_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_envelope_config) ~data;
-      Logging.end_envelope_config_output abspath_envelope_config
-
-  | Error(_) ->
-      assert false
+  let data = encode_yaml yaml in
+  try
+    Core.Out_channel.write_all (get_abs_path_string abspath_envelope_config) ~data;
+    return ()
+  with
+  | Sys_error(message) ->
+      err @@ CannotWriteEnvelopeConfig{ message; path = abspath_envelope_config }

bin-saphe/lockConfig.ml

@@ -98,10 +98,6 @@ let load (abspath_lock_config : abs_path) : t ok =
 
 let write (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_config_output abspath_lock_config
-
-  | Error(_) ->
-      assert false
+  let data = encode_yaml yaml in
+  Core.Out_channel.write_all (get_abs_path_string abspath_lock_config) ~data;
+  Logging.end_lock_config_output abspath_lock_config

bin-saphe/main.ml

@@ -334,6 +334,11 @@ let report_config_error = function
             ]
       end
 
+  | CannotWriteEnvelopeConfig{ message; path } ->
+      report_error [
+        NormalLine(Printf.sprintf "cannot output the envelope config to '%s' (message: '%s')" (get_abs_path_string path) message);
+      ]
+
 
 type solve_input =
   | PackageSolveInput of {
@@ -558,8 +563,12 @@ let solve ~(fpath_in : string) =
                 (* Selects the minimum version according to the user's designation for the moment.
                    TODO: take dependencies into account when selecting a language version *)
           in
+
+          (* Writes the envelope config: *)
           let envelope_config = make_envelope_config package_contents in
-          EnvelopeConfig.write abspath_envelope_config envelope_config;
+          let* () = EnvelopeConfig.write abspath_envelope_config envelope_config in
+          Logging.end_envelope_config_output abspath_envelope_config;
+
           begin
             match package_contents with
             | PackageConfig.Library{ dependencies; test_dependencies; _ } ->

src-util/myUtil.ml

@@ -89,6 +89,12 @@ let is_directory (abspath : abs_path) : bool =
   Sys.is_directory (get_abs_path_string abspath)
 
 
+let encode_yaml (yaml : Yaml.value) : string =
+  match Yaml.to_string ~encoding:`Utf8 ~layout_style:`Block ~scalar_style:`Plain yaml with
+  | Ok(data) -> data
+  | Error(_) -> assert false
+
+
 type 'a cycle =
   | Loop  of 'a
   | Cycle of 'a TupleList.t

src-util/myUtil.mli

@@ -38,6 +38,8 @@ val make_absolute_if_relative : origin:string -> string -> abs_path
 
 val is_directory : abs_path -> bool
 
+val encode_yaml : Yaml.value -> string
+
 val read_file : abs_path -> (string, string) result
 
 type 'a cycle =