feature(pkg): Automatic fetching of opam-repository (#8105)

Signed-off-by: Marek Kubica <marek@tarides.com>

bin/dune

@@ -42,7 +42,8 @@
   dune_rpc_private
   dune_rpc_client
   spawn
-  opam_format)
+  opam_format
+  xdg)
  (bootstrap_info bootstrap-info))
 
 ; Installing the dune binary depends on the kind of build:

bin/pkg.ml

@@ -1,90 +1,116 @@
 open Import
 module Lock_dir = Dune_pkg.Lock_dir
+module Fetch = Dune_pkg.Fetch
+module Opam = Dune_pkg.Opam
+module Repo_selection = Opam.Repo_selection
 
-module Lock = struct
-  module Repo_selection = struct
-    module Env = struct
-      module Source = struct
-        type t =
-          | Global
-          | Pure
+module Opam_repository = struct
+  type t = { url : OpamUrl.t }
 
-        let to_string = function
-          | Global -> "global"
-          | Pure -> "pure"
+  let of_url url = { url }
 
-        let default = Global
+  let default =
+    of_url @@ OpamUrl.of_string "https://opam.ocaml.org/index.tar.gz"
 
-        let term =
-          let all = [ Global; Pure ] in
-          let all_with_strings = List.map all ~f:(fun t -> (to_string t, t)) in
-          let all_strings = List.map all_with_strings ~f:fst in
-          let doc =
-            sprintf
-              "How to initialize the opam environment when taking the opam \
-               repository from a local directory (may only be used along with \
-               the --opam-repository-path option). Possible values are %s. \
-               '%s' will use the environment associated with the current opam \
-               switch. '%s' will use an empty environment. The default is \
-               '%s'."
-              (String.enumerate_and all_strings)
-              (to_string Global) (to_string Pure) (to_string default)
-          in
-          Arg.(
-            value
-            & opt (some (enum all_with_strings)) None
-            & info [ "opam-env" ] ~doc)
-      end
+  let is_archive name =
+    List.exists
+      ~f:(fun suffix -> String.is_suffix ~suffix name)
+      [ ".tar.gz"; ".tgz"; ".tar.bz2"; ".tbz"; ".zip" ]
 
-      let of_source =
-        let open Dune_pkg.Opam.Env in
-        function
-        | Source.Global -> global ()
-        | Pure -> empty
-    end
+  let path =
+    let open Fiber.O in
+    let ( / ) = Filename.concat in
+    fun { url } ->
+      Fiber.of_thunk @@ fun () ->
+      let target_dir =
+        Xdg.cache_dir (Lazy.force Dune_util.xdg) / "dune/opam-repository"
+      in
+      let target = target_dir |> Path.External.of_string |> Path.external_ in
+      let unpack = url |> OpamUrl.to_string |> is_archive in
+      let+ res = Fetch.fetch ~unpack ~checksum:None ~target url in
+      match res with
+      | Ok () -> Ok target
+      | Error _ as failure -> failure
+end
 
-    let term =
-      let+ opam_repository_path =
-        Arg.(
-          value
-          & opt (some string) None
-          & info [ "opam-repository-path" ] ~docv:"PATH"
-              ~doc:
-                "Path to a local opam repository. This should be a directory \
-                 containing a valid opam repository such as the one at \
-                 https://github.com/ocaml/opam-repository. If this option is \
-                 omitted the dependencies will be locked using the current \
-                 switch instead.")
-      and+ opam_switch_name =
+module Lock = struct
+  module Env = struct
+    module Source = struct
+      type t =
+        | Global
+        | Pure
+
+      let to_string = function
+        | Global -> "global"
+        | Pure -> "pure"
+
+      let default = Global
+
+      let term =
+        let all = [ Global; Pure ] in
+        let all_with_strings = List.map all ~f:(fun t -> (to_string t, t)) in
+        let all_strings = List.map all_with_strings ~f:fst in
+        let doc =
+          sprintf
+            "How to initialize the opam environment when taking the opam \
+             repository from a local directory (may only be used along with \
+             the --opam-repository-path option). Possible values are %s. '%s' \
+             will use the environment associated with the current opam switch. \
+             '%s' will use an empty environment. The default is '%s'."
+            (String.enumerate_and all_strings)
+            (to_string Global) (to_string Pure) (to_string default)
+        in
         Arg.(
           value
-          & opt (some string) None
-          & info [ "opam-switch" ] ~docv:"SWITCH"
-              ~doc:
-                "Name or path of opam switch to use while solving \
-                 dependencies. Local switches may be specified with relative \
-                 paths (e.g. `--opam-switch=.`)")
-      and+ env_source = Env.Source.term in
-      let module Repo_selection = Dune_pkg.Opam.Repo_selection in
-      match (opam_switch_name, opam_repository_path, env_source) with
-      | None, None, _env_source | Some _, Some _, _env_source ->
-        User_error.raise
-          [ Pp.text
-              "Exactly one of --opam-switch and --opam-repository-path must be \
-               specified"
-          ]
-      | Some _opam_switch, None, Some _env_source ->
-        User_error.raise
-          [ Pp.text "--opam-env may only used with --opam-repository-path" ]
-      | Some opam_switch_name, None, None ->
-        (* switch with name does not support environments *)
-        Repo_selection.switch_with_name opam_switch_name
-      | None, Some opam_repo_dir_path, env_source_opt ->
-        let env =
-          Option.value env_source_opt ~default:Env.Source.default
-          |> Env.of_source
+          & opt (some (enum all_with_strings)) None
+          & info [ "opam-env" ] ~doc)
+    end
+
+    let of_source =
+      let open Dune_pkg.Opam.Env in
+      function
+      | Source.Global -> global ()
+      | Pure -> empty
+  end
+
+  module Opam_repository_path = struct
+    let term =
+      let dune_path =
+        let parser s =
+          s |> Path.External.of_filename_relative_to_initial_cwd
+          |> Path.external_ |> Result.ok
         in
-        Repo_selection.local_repo_with_env ~opam_repo_dir_path ~env
+        let printer pf p = Pp.to_fmt pf (Path.pp p) in
+        Arg.conv (parser, printer)
+      in
+      Arg.(
+        value
+        & opt (some dune_path) None
+        & info [ "opam-repository-path" ] ~docv:"PATH"
+            ~doc:
+              "Path to a local opam repository. This should be a directory \
+               containing a valid opam repository such as the one at \
+               https://github.com/ocaml/opam-repository. If this option is \
+               omitted the dependencies will be locked using the current \
+               switch instead.")
+  end
+
+  module Opam_repository_url = struct
+    let term =
+      let parser s =
+        match OpamUrl.parse_opt s with
+        | Some url -> Ok url
+        | None -> Error (`Msg "URL can't be parsed")
+      in
+      let printer pf u = Pp.to_fmt pf (Pp.text (OpamUrl.to_string u)) in
+      let opam_url = Arg.conv (parser, printer) in
+      Arg.(
+        value
+        & opt (some opam_url) None
+        & info [ "opam-repository-url" ] ~docv:"URL"
+            ~doc:
+              "URL of opam repository to download. Can be either a git \
+               repository or a link to the tarball of a repository.")
   end
 
   module Version_preference = struct
@@ -244,7 +270,9 @@ module Lock = struct
 
   let term =
     let+ (common : Common.t) = Common.term
-    and+ repo_selection = Repo_selection.term
+    and+ env_source = Env.Source.term
+    and+ opam_repository_path = Opam_repository_path.term
+    and+ opam_repository_url = Opam_repository_url.term
     and+ context_name = context_term
     and+ all_contexts =
       Arg.(
@@ -262,15 +290,33 @@ module Lock = struct
     in
     Per_context.check_for_dup_lock_dir_paths per_context;
     let* source_dir = Memo.run (Source_tree.root ()) in
-    let project = Source_tree.Dir.project source_dir in
-    let dune_package_map = Dune_project.packages project in
-    let opam_file_map = opam_file_map_of_dune_package_map dune_package_map in
+    let* opam_repo_dir =
+      match opam_repository_path with
+      | Some path -> Fiber.return path
+      | None -> (
+        let repo =
+          opam_repository_url
+          |> Option.map ~f:Opam_repository.of_url
+          |> Option.value ~default:Opam_repository.default
+        in
+        let+ opam_repository = Opam_repository.path repo in
+        match opam_repository with
+        | Ok path -> path
+        | Error _ -> failwith "TODO")
+    in
+    let env =
+      Option.value env_source ~default:Env.Source.default |> Env.of_source
+    in
     let+ sys_env =
       Dune_pkg.Sys_poll.sys_env ~path:(Env_path.path Stdune.Env.initial)
     in
+    let env = Dune_pkg.Opam.Env.union env sys_env in
     let repo_selection =
-      Dune_pkg.Opam.Repo_selection.add_env sys_env repo_selection
+      Repo_selection.local_repo_with_env ~opam_repo_dir ~env
     in
+    let project = Source_tree.Dir.project source_dir in
+    let dune_package_map = Dune_project.packages project in
+    let opam_file_map = opam_file_map_of_dune_package_map dune_package_map in
     (* Construct a list of thunks that will perform all the file IO side
        effects after performing validation so that if materializing any
        lockdir would fail then no side effect takes place. *)

src/dune_pkg/fetch.ml

@@ -67,15 +67,15 @@ type failure =
   | Checksum_mismatch of Checksum.t
   | Unavailable of User_message.t option
 
-let fetch ~checksum ~target (url : OpamUrl.t) =
+let fetch ~unpack ~checksum ~target (url : OpamUrl.t) =
   let open Fiber.O in
   let path = Path.to_string target in
   let pull =
     (* hashes have to be empty otherwise OPAM deletes the file after
        downloading if the hash does not match *)
     let hashes = [] in
-    match url.backend with
-    | #OpamUrl.version_control -> (
+    match (url.backend, unpack) with
+    | #OpamUrl.version_control, _ | _, true -> (
       let dirname = OpamFilename.Dir.of_string path in
       fun label url ->
         let open OpamProcess.Job.Op in

src/dune_pkg/fetch.mli

@@ -13,7 +13,8 @@ type failure =
     @raise Unavailable
       When the file can't be retrieved, e.g. not available at the location. *)
 val fetch :
-     checksum:Checksum.t option
+     unpack:bool
+  -> checksum:Checksum.t option
   -> target:Path.t
   -> OpamUrl.t
   -> (unit, failure) result Fiber.t