pushing structures to end-points

src/client/opamAction.ml

@@ -245,7 +245,7 @@ let download_shared_source st url nvs =
          | None, _ | _, [_] -> ""
          | Some url, _ -> " " ^ OpamUrl.to_string (OpamFile.URL.url url))) url;
   if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.fake)
-  then Done None else
+  then Done (Result ()) else
   let nvs =
     (* filter out version-pinned packages since we already have their source *)
     List.filter (fun nv ->
@@ -259,7 +259,7 @@ let download_shared_source st url nvs =
                OpamFile.OPAM.version_opt) = Some nv.version))
       nvs
   in
-  if nvs = [] then Done None
+  if nvs = [] then Done (Up_to_date ())
   else
   let print_action =
     OpamConsole.msg "%s retrieved %s  (%s)\n"
@@ -290,10 +290,11 @@ let download_shared_source st url nvs =
   OpamProcess.Job.catch (fun e ->
       let na =
         match e with
-        | OpamDownload.Download_fail (Generic_failure reason) -> reason
-        | e -> { short_reason = None; long_reason = Printexc.to_string e }
+        | OpamDownload.Download_fail failure -> failure
+        | e -> Generic_failure
+                 { short_reason = None; long_reason = Printexc.to_string e }
       in
-      Done (Some na))
+      Done (Not_available na))
   @@ fun () ->
   OpamUpdate.download_shared_package_source st url nvs @@| function
   | Some (Not_available failure), _ ->
@@ -306,35 +307,36 @@ let download_shared_source st url nvs =
        | Some url, _ ->
          Printf.sprintf " (%s)" (OpamUrl.to_string (OpamFile.URL.url url)))
       msg;
-    Some r
+    Not_available failure
   | _, ((nv, name, Not_available failure) :: _) ->
     let r = OpamTypesBase.get_dl_failure_reason failure in
     let msg = OpamStd.Option.default r.long_reason r.short_reason in
     OpamConsole.error "Failed to get extra source \"%s\" of %s: %s"
       name (OpamPackage.to_string nv) msg;
-    Some r
+    Not_available failure
   | Some (Result msg), _ ->
-    print_full_action msg; None
+    print_full_action msg; Result ()
   | Some (Up_to_date msg), _ ->
-    print_full_action msg; None
-  | None, [] -> None
+    print_full_action msg; Up_to_date ()
+  | None, [] -> Up_to_date ()
   | None, (e :: es as extras) ->
     if List.for_all (function _, _, Up_to_date _ -> true | _ -> false) extras then
-      print_full_action "cached"
+      (print_full_action "cached";
+       Up_to_date ())
     else
-      (match e, es with
-       | (_, _, Result msg), [] -> print_full_action msg
-       | _, _ ->
-         print_single_actions
-           (List.map (fun (nv, _, _) ->
-                nv,
-                (Printf.sprintf "%d extra sources"
-                   (List.length
-                      (List.filter (fun (nv',_,_) ->
-                           OpamPackage.compare nv nv' = 0)
-                          extras))))
-               extras));
-    None
+      ((match e, es with
+          | (_, _, Result msg), [] -> print_full_action msg
+          | _, _ ->
+            print_single_actions
+              (List.map (fun (nv, _, _) ->
+                   nv,
+                   (Printf.sprintf "%d extra sources"
+                      (List.length
+                         (List.filter (fun (nv',_,_) ->
+                              OpamPackage.compare nv nv' = 0)
+                             extras))))
+                  extras));
+       Result ())
 
 let download_package st nv =
   download_shared_source st

src/client/opamAction.mli

@@ -21,14 +21,14 @@ open OpamStateTypes
     This doesn't update dev packages that already have a locally cached
     source. *)
 val download_package:
-  rw switch_state -> package -> dl_fail_reason option OpamProcess.job
+  rw switch_state -> package -> unit download OpamProcess.job
 
 (** [download_same_source_package t url packages]
     As [download_package], download upstream shared source [url] between
     [packages]. *)
 val download_shared_source:
   rw switch_state -> OpamFile.URL.t option -> package list ->
-  dl_fail_reason option OpamProcess.job
+  unit download OpamProcess.job
 
 (** [prepare_package_source t pkg dir] updates the given source [dir] with the
     extra downloads, overlays and patches from the package's metadata

src/client/opamAdminCommand.ml

@@ -10,6 +10,7 @@
 (**************************************************************************)
 
 open OpamTypes
+open OpamTypesBase
 open OpamProcess.Job.Op
 open OpamStateTypes
 open Cmdliner
@@ -175,8 +176,7 @@ let package_files_to_cache repo_root cache_dir cache_urls
               (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf)
             @@| fun r -> match OpamRepository.report_fetch_result nv r with
             | Not_available failure ->
-              let r = OpamTypesBase.get_dl_failure_reason failure in
-              Some r.long_reason
+              Some failure
             | Up_to_date () | Result () -> None
         in
         error_opt @@| function
@@ -286,8 +286,11 @@ let cache_command cli =
            (OpamPackage.Map.keys errors));
       OpamConsole.errmsg "%s"
         (OpamStd.Format.itemize (fun (nv,el) ->
+             let reasons =
+               List.map (fun e -> (get_dl_failure_reason e).long_reason) el
+             in
              Printf.sprintf "[%s] %s" (OpamPackage.to_string nv)
-               (String.concat "\n" el))
+               (String.concat "\n" reasons))
             (OpamPackage.Map.bindings errors))
     );
 

src/client/opamSolution.ml

@@ -632,10 +632,11 @@ let parallel_apply t
               | [] -> None
             in
             OpamAction.download_shared_source t url nvs) @@+ function
-       | None ->
+       | Result () | Up_to_date () ->
          store_time (); Done (`Successful (installed, removed))
-       | Some { short_reason = _; long_reason } ->
-         Done (`Exception (Fetch_fail long_reason)))
+       | Not_available failure ->
+         let r = get_dl_failure_reason failure in
+         Done (`Exception (Fetch_fail r.long_reason)))
 
     | `Build nv ->
       if assume_built && OpamPackage.Set.mem nv requested then

src/repository/opamHTTP.ml

@@ -85,7 +85,8 @@ module B = struct
            | _ ->
              Generic_failure {
                short_reason = Some "Download failed";
-               long_reason = str "download failed"; }
+               long_reason = str "download failed, "^(Printexc.to_string e);
+             }
          in
          Done (Not_available failure))
     @@ fun () ->

src/repository/opamRepository.ml

@@ -321,22 +321,25 @@ let pull_tree_t
             let failing =
               OpamStd.List.filter_map (function
                   | Result _ | Up_to_date _ -> None
-                  | Not_available (Generic_failure
-                                     { short_reason = Some s;
-                                       long_reason = l }) ->
-                    Some (s,l)
-                  | Not_available _ -> assert false
+                  | Not_available failure -> Some failure
                 ) (copies ())
             in
             if failing = [] then Done (Up_to_date msg) else
             let simple =
               Printf.sprintf "Failed to copy source of %s"
-                (OpamStd.Format.pretty_list (List.map fst failing))
+                (OpamStd.Format.pretty_list (List.map (fun e ->
+                     let r = OpamTypesBase.get_dl_failure_reason e in
+                     OpamStd.Option.default r.long_reason r.short_reason)
+                   failing))
             in
             let long =
               Printf.sprintf "Failed to copy source of:\n%s"
-                (OpamStd.Format.itemize (fun (nv, msg) ->
-                     Printf.sprintf "%s: %s" nv msg)
+                (OpamStd.Format.itemize (fun e ->
+                     let r = OpamTypesBase.get_dl_failure_reason e in
+                     match r.short_reason with
+                     | Some nv ->
+                       Printf.sprintf "%s: %s" nv r.long_reason
+                     | None -> r.long_reason)
                     failing)
             in
             Done (Not_available (Generic_failure { short_reason = Some simple;