feature(pkg): Support for specifying particular branches/commits (oca…

…ml#9241)

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

bin/pkg/pkg_common.ml

@@ -79,7 +79,7 @@ let location_of_opam_url url =
   match (url : OpamUrl.t).backend with
   | `rsync -> `Path (Path.of_string url.path)
   (* contrary to OPAM we also attempt to load HTTP sources via git *)
-  | `git | `http -> `Git (OpamUrl.base_url url)
+  | `git | `http -> `Git
   | `darcs | `hg ->
     User_error.raise
       ~hints:[ Pp.text "Specify either a file path or git repo via SSH/HTTPS" ]
@@ -88,6 +88,7 @@ let location_of_opam_url url =
 ;;
 
 let get_repos repos ~repositories ~update_opam_repositories =
+  let open Fiber.O in
   let module Repository_id = Dune_pkg.Repository_id in
   let module Opam_repo = Dune_pkg.Opam_repo in
   let module Repository = Dune_pkg.Pkg_workspace.Repository in
@@ -103,8 +104,9 @@ let get_repos repos ~repositories ~update_opam_repositories =
     | Some repo ->
       let opam_url = Dune_pkg.Pkg_workspace.Repository.opam_url repo in
       (match location_of_opam_url opam_url with
-       | `Git source ->
-         Opam_repo.of_git_repo ~repo_id:None ~update:update_opam_repositories ~source
+       | `Git ->
+         let* source = Opam_repo.Source.of_opam_url opam_url in
+         Opam_repo.of_git_repo ~repo_id:None ~update:update_opam_repositories source
        | `Path path ->
          let repo_id = Repository_id.of_path path in
          Fiber.return @@ Opam_repo.of_opam_repo_dir_path ~source:None ~repo_id path))

src/dune_pkg/lock_dir.ml

@@ -876,3 +876,20 @@ let compute_missing_checksums t =
   in
   { t with packages }
 ;;
+
+module Private = struct
+  let used_with_commit ~commit xs =
+    List.map xs ~f:(fun serializable ->
+      Opam_repo.Serializable.Private.with_commit ~commit serializable)
+  ;;
+
+  let repos_with_commit ~commit ({ Repositories.used; _ } as repos) =
+    let used = Option.map used ~f:(used_with_commit ~commit) in
+    { repos with used }
+  ;;
+
+  let with_commit ~commit ({ repos; _ } as lock_dir) =
+    let repos = repos_with_commit ~commit repos in
+    { lock_dir with repos }
+  ;;
+end

src/dune_pkg/lock_dir.mli

@@ -95,6 +95,10 @@ end
 
 val read_disk : Path.Source.t -> t
 
+module Private : sig
+  val with_commit : commit:string -> t -> t
+end
+
 module Make_load (Io : sig
     include Monad.S
 

src/dune_pkg/opam_repo.ml

@@ -34,6 +34,80 @@ module Paths = struct
   let opam_file package = Path.Local.relative (package_dir package) "opam"
 end
 
+module Source = struct
+  type commitish =
+    | Commit of string
+    | Branch of string
+    | Tag of string
+
+  let commitish_to_dyn = function
+    | Commit c -> Dyn.variant "Commit" [ Dyn.string c ]
+    | Branch b -> Dyn.variant "Branch" [ Dyn.string b ]
+    | Tag t -> Dyn.variant "Tag" [ Dyn.string t ]
+  ;;
+
+  let commitish_equal a b =
+    match a, b with
+    | Commit x, Commit x' | Branch x, Branch x' | Tag x, Tag x' -> String.equal x x'
+    | _, _ -> false
+  ;;
+
+  type t =
+    { url : string
+    ; commit : commitish option
+    }
+
+  module Private = struct
+    let of_opam_url rev_store ({ OpamUrl.hash; _ } as opam_url) =
+      (* fairly ugly to pull the rev-store out of thin air *)
+      let url = OpamUrl.base_url opam_url in
+      let+ commit =
+        match hash with
+        | None -> Fiber.return None
+        | Some ref ->
+          (* OpamUrl doesn't distinguish between branches/tags and commits, so we need to look up *)
+          let* member = Rev_store.mem rev_store ~rev:ref in
+          (match member with
+           | true -> Fiber.return @@ Some (Commit ref)
+           | false ->
+             let+ type' = Rev_store.ref_type rev_store ~source:url ~ref in
+             (match type' with
+              | Some `Tag -> Some (Tag ref)
+              | Some `Head -> Some (Branch ref)
+              | None ->
+                User_error.raise
+                  ~hints:
+                    [ Pp.text
+                        "Make sure the URL is correct and the repository contains the \
+                         branch/tag"
+                    ]
+                  [ Pp.textf
+                      "Opam repository at '%s' does not have a reference '%s'"
+                      url
+                      ref
+                  ]))
+      in
+      { commit; url }
+    ;;
+  end
+
+  let of_opam_url opam_url =
+    (* fairly ugly to pull the rev-store out of thin air *)
+    let* rev_store = rev_store in
+    Private.of_opam_url rev_store opam_url
+  ;;
+
+  let to_string { url; commit = _ } = url
+
+  let to_dyn { url; commit } =
+    Dyn.record [ "url", Dyn.string url; "commit", Dyn.option commitish_to_dyn commit ]
+  ;;
+
+  let equal { url; commit } t =
+    String.equal url t.url && Option.equal commitish_equal commit t.commit
+  ;;
+end
+
 module Serializable = struct
   type t =
     { repo_id : Repository_id.t option
@@ -64,6 +138,21 @@ module Serializable = struct
        and+ repo_id = field_o "repo_id" Repository_id.decode in
        { repo_id; source })
   ;;
+
+  module Private = struct
+    let with_commit ~commit { repo_id; source } =
+      let repo_id =
+        match repo_id with
+        | None -> None
+        | Some repo_id as orig ->
+          let candidate_repo_id = Repository_id.of_git_hash commit in
+          (match Repository_id.equal repo_id candidate_repo_id with
+           | true -> Some (Repository_id.of_git_hash "MATCHING")
+           | false -> orig)
+      in
+      { repo_id; source }
+    ;;
+  end
 end
 
 module Backend = struct
@@ -97,12 +186,6 @@ let repo_id t =
   serializable.repo_id
 ;;
 
-let source t =
-  let open Option.O in
-  let+ serializable = serializable t in
-  serializable.source
-;;
-
 let of_opam_repo_dir_path ~source ~repo_id opam_repo_dir_path =
   (match Path.stat opam_repo_dir_path with
    | Error (Unix.ENOENT, _, _) ->
@@ -138,11 +221,16 @@ let of_opam_repo_dir_path ~source ~repo_id opam_repo_dir_path =
   { source = Directory opam_repo_dir_path; serializable }
 ;;
 
-let of_git_repo ~repo_id ~update ~source =
+let of_git_repo ~repo_id ~update (source : Source.t) =
   let+ at_rev, computed_repo_id =
     let* remote =
       let* repo = rev_store in
-      let* remote = Rev_store.add_repo repo ~source in
+      let branch =
+        match source.commit with
+        | Some (Branch b) -> Some b
+        | _ -> None
+      in
+      let* remote = Rev_store.add_repo repo ~source:source.url ~branch in
       match update with
       | true -> Rev_store.Remote.update remote
       | false -> Fiber.return @@ Rev_store.Remote.don't_update remote
@@ -153,8 +241,11 @@ let of_git_repo ~repo_id ~update ~source =
       at_rev, Some repo_id
     | None ->
       let+ at_rev =
-        let name = Rev_store.Remote.default_branch remote in
-        Rev_store.Remote.rev_of_name remote ~name
+        match source.commit with
+        | Some (Commit ref) -> Rev_store.Remote.rev_of_ref remote ~ref
+        | _ ->
+          let name = Rev_store.Remote.default_branch remote in
+          Rev_store.Remote.rev_of_name remote ~name
       in
       let repo_id = Option.map at_rev ~f:Rev_store.At_rev.repository_id in
       at_rev, repo_id
@@ -163,9 +254,11 @@ let of_git_repo ~repo_id ~update ~source =
   | None ->
     User_error.raise
       ~hints:[ Pp.text "Double check that the revision is included in the repository" ]
-      [ Pp.textf "Could not find revision in repository %s" source ]
+      [ Pp.textf "Could not find revision in repository %s" (Source.to_string source) ]
   | Some at_rev ->
-    let serializable = Some { Serializable.repo_id = computed_repo_id; source } in
+    let serializable =
+      Some { Serializable.repo_id = computed_repo_id; source = source.url }
+    in
     { source = Repo at_rev; serializable }
 ;;
 

src/dune_pkg/opam_repo.mli

@@ -9,31 +9,51 @@ module Serializable : sig
   val decode : t Decoder.t
   val equal : t -> t -> bool
   val to_dyn : t -> Dyn.t
+
+  module Private : sig
+    val with_commit : commit:string -> t -> t
+  end
 end
 
 val equal : t -> t -> bool
 
-(** [of_opam_repo_dir_path opam_repo_dir] creates a repo representedy by a local
+module Source : sig
+  type commitish =
+    | Commit of string
+    | Branch of string
+    | Tag of string
+
+  type t =
+    { url : string
+    ; commit : commitish option
+    }
+
+  val of_opam_url : OpamUrl.t -> t Fiber.t
+  val to_string : t -> string
+  val to_dyn : t -> Dyn.t
+  val equal : t -> t -> bool
+
+  module Private : sig
+    val of_opam_url : Rev_store.t -> OpamUrl.t -> t Fiber.t
+  end
+end
+
+(** [of_opam_repo_dir_path opam_repo_dir] creates a repo represented by a local
     directory in the path given by [opam_repo_dir]. *)
 val of_opam_repo_dir_path
   :  source:string option
   -> repo_id:Repository_id.t option
   -> Path.t
   -> t
 
-(** [of_git_repo git ~repo_id ~update ~source] loads the opam repository located at [source] from git.
+(** [of_git_repo git ~repo_id ~update source] loads the opam repository located at [source] from git.
     [source] can be any URL that [git remote add] supports.
 
     Set [update] to true to update the source to the newest revision, otherwise it will use the latest
     data available in the cache (if any). *)
-val of_git_repo
-  :  repo_id:Repository_id.t option
-  -> update:bool
-  -> source:string
-  -> t Fiber.t
+val of_git_repo : repo_id:Repository_id.t option -> update:bool -> Source.t -> t Fiber.t
 
 val repo_id : t -> Repository_id.t option
-val source : t -> string option
 val serializable : t -> Serializable.t option
 
 module With_file : sig