Merge pull request #12743 from Alizter/push-myqrwlsyrmtm

refactor(pkg): consolidate repository handling

Author: Alizter

bin/pkg/lock.ml

@@ -344,7 +344,9 @@ let solve_lock_dir
     in
     progress_state
     := Some (Progress_indicator.Per_lockdir.State.Updating_repos repo_names);
-    get_repos repo_map ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
+    Dune_pkg.Opam_repo.resolve_repositories
+      ~available_repos:repo_map
+      ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
   in
   let* pins = resolve_project_pins project_pins in
   let time_solve_start = Unix.gettimeofday () in

bin/pkg/outdated.ml

@@ -10,8 +10,8 @@ let find_outdated_packages ~transitive ~lock_dirs_arg () =
       let lock_dir_path = Path.source lock_dir_path in
       (* updating makes sense when checking for outdated packages *)
       let* repos =
-        get_repos
-          (repositories_of_workspace workspace)
+        Dune_pkg.Opam_repo.resolve_repositories
+          ~available_repos:(repositories_of_workspace workspace)
           ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
       and+ local_packages = Memo.run find_local_packages
       and+ platform = solver_env_from_system_and_context ~lock_dir_path in

bin/pkg/pkg_common.ml

@@ -119,31 +119,6 @@ let unset_solver_vars_of_workspace workspace ~lock_dir_path =
   lock_dir.unset_solver_vars
 ;;
 
-let get_repos repos ~repositories =
-  let module Repository = Dune_pkg.Pkg_workspace.Repository in
-  repositories
-  |> Fiber.parallel_map ~f:(fun (loc, name) ->
-    match Repository.Name.Map.find repos name with
-    | None ->
-      User_error.raise
-        ~loc
-        [ Pp.textf "Repository '%s' is not a known repository"
-          @@ Repository.Name.to_string name
-        ]
-    | Some repo ->
-      let loc, opam_url = Repository.opam_url repo in
-      let module Opam_repo = Dune_pkg.Opam_repo in
-      (match Dune_pkg.OpamUrl.classify opam_url loc with
-       | `Git -> Opam_repo.of_git_repo loc opam_url
-       | `Path path -> Fiber.return @@ Opam_repo.of_opam_repo_dir_path loc path
-       | `Archive ->
-         User_error.raise
-           ~loc
-           [ Pp.textf "Repositories stored in archives (%s) are currently unsupported"
-             @@ OpamUrl.to_string opam_url
-           ]))
-;;
-
 let find_local_packages =
   let open Memo.O in
   Dune_rules.Dune_load.packages ()

bin/pkg/pkg_common.mli

@@ -45,12 +45,6 @@ val constraints_of_workspace
   -> Dune_lang.Package_dependency.t list
 
 val depopts_of_workspace : Workspace.t -> lock_dir_path:Path.t -> Package_name.t list
-
-val get_repos
-  :  Dune_pkg.Pkg_workspace.Repository.t Dune_pkg.Pkg_workspace.Repository.Name.Map.t
-  -> repositories:(Loc.t * Dune_pkg.Pkg_workspace.Repository.Name.t) list
-  -> Dune_pkg.Opam_repo.t list Fiber.t
-
 val find_local_packages : Dune_pkg.Local_package.t Package_name.Map.t Memo.t
 
 module Lock_dirs_arg : sig

bin/pkg/search.ml

@@ -36,8 +36,8 @@ let search_packages ~query () =
     | None -> get_default_lock_dir_path ()
   in
   let* repos =
-    Pkg_common.get_repos
-      (Pkg_common.repositories_of_workspace workspace)
+    Dune_pkg.Opam_repo.resolve_repositories
+      ~available_repos:(Pkg_common.repositories_of_workspace workspace)
       ~repositories:(Pkg_common.repositories_of_lock_dir workspace ~lock_dir_path)
   in
   let re = Option.map ~f:(fun q -> Re.str q |> Re.no_case |> Re.compile) query in

src/dune_pkg/opam_repo.ml

@@ -122,6 +122,31 @@ let of_git_repo loc url =
   { source = Repo at_rev; serializable; loc }
 ;;
 
+let resolve_repositories ~available_repos ~repositories =
+  repositories
+  |> Fiber.parallel_map ~f:(fun (loc, name) ->
+    match Workspace.Repository.Name.Map.find available_repos name with
+    | None ->
+      User_error.raise
+        ~loc
+        [ Pp.textf
+            "Repository '%s' is not a known repository"
+            (Workspace.Repository.Name.to_string name)
+        ]
+    | Some repo ->
+      let loc, opam_url = Workspace.Repository.opam_url repo in
+      (match OpamUrl.classify opam_url loc with
+       | `Git -> of_git_repo loc opam_url
+       | `Path path -> Fiber.return @@ of_opam_repo_dir_path loc path
+       | `Archive ->
+         User_error.raise
+           ~loc
+           [ Pp.textf
+               "Repositories stored in archives (%s) are currently unsupported"
+               (OpamUrl.to_string opam_url)
+           ]))
+;;
+
 let revision t =
   match t.source with
   | Repo r -> r

src/dune_pkg/opam_repo.mli

@@ -23,6 +23,16 @@ val of_opam_repo_dir_path : Loc.t -> Path.t -> t
     supports. *)
 val of_git_repo : Loc.t -> OpamUrl.t -> t Fiber.t
 
+(** [resolve_repositories ~available_repos ~repositories] resolves a list of
+    repository references by looking them up in [available_repos] and creating
+    appropriate [t] instances based on their URL types (git, local path, or
+    archive). Raises [User_error] if a repository is not found or if an archive
+    URL is encountered (not supported). *)
+val resolve_repositories
+  :  available_repos:Workspace.Repository.t Workspace.Repository.Name.Map.t
+  -> repositories:(Loc.t * Workspace.Repository.Name.t) list
+  -> t list Fiber.t
+
 val revision : t -> Rev_store.At_rev.t
 val serializable : t -> Serializable.t option
 

src/dune_rules/lock_rules.ml

@@ -312,9 +312,6 @@ let setup_lock_rules ~dir ~lock_dir : Gen_rules.result =
          >>| Dune_lang.Package.Name.Map.map ~f:Local_package.of_package
          |> Action_builder.of_memo
        and+ repos =
-         (* CR-soon Alizter: This repository handling logic is duplicated in
-            bin/pkg/pkg_common.ml:get_repos. The OpamUrl.classify pattern
-            matching and repository resolution could be shared. *)
          Action_builder.of_memo
            (Memo.of_thunk (fun () ->
               let repositories =
@@ -334,30 +331,7 @@ let setup_lock_rules ~dir ~lock_dir : Gen_rules.result =
                   Pkg_workspace.Repository.name repo, repo)
                 |> Pkg_workspace.Repository.Name.Map.of_list_exn
               in
-              let module Repository = Pkg_workspace.Repository in
-              repositories
-              |> Fiber.parallel_map ~f:(fun (loc, name) ->
-                match Repository.Name.Map.find available_repos name with
-                | None ->
-                  User_error.raise
-                    ~loc
-                    [ Pp.textf "Repository '%s' is not a known repository"
-                      @@ Repository.Name.to_string name
-                    ]
-                | Some repo ->
-                  let loc, opam_url = Repository.opam_url repo in
-                  (match OpamUrl.classify opam_url loc with
-                   | `Git -> Opam_repo.of_git_repo loc opam_url
-                   | `Path path ->
-                     Fiber.return @@ Opam_repo.of_opam_repo_dir_path loc path
-                   | `Archive ->
-                     User_error.raise
-                       ~loc
-                       [ Pp.textf
-                           "Repositories stored in archives (%s) are currently \
-                            unsupported"
-                         @@ OpamUrl.to_string opam_url
-                       ]))
+              Opam_repo.resolve_repositories ~available_repos ~repositories
               |> Memo.of_non_reproducible_fiber))
        and+ pins =
          (* CR-soon Alizter: This pin logic (extracting workspace pins,