Opam: Use the 'user' option as the fork owner

CHANGES.md

@@ -4,6 +4,8 @@
 
 ### Changed
 
+- Use the 'user' option as the fork owner, only attempt to decode the remote URL if the user option is not set. (#480, @Julow)
+
 ### Deprecated
 
 ### Fixed

bin/opam.ml

@@ -6,6 +6,7 @@
 
 open Bos_setup
 open Dune_release
+open Stdext.Result.Let_syntax
 
 let get_pkg_dir pkg =
   Pkg.build_dir pkg >>= fun bdir ->
@@ -164,19 +165,25 @@ let open_pr ~dry_run ~changes ~remote_repo ~fork_owner ~branch ~token ~title
         | Ok () -> Ok 0
         | Error _ -> msg ())
 
-let parse_remote_repo remote_repo =
+(** Get the value from the [user] config, if it is unset try to parse it from
+    the [remote_repo]. *)
+let get_fork_owner ~remote_repo =
   match Github_repo.from_uri remote_repo with
-  | Some repo -> Ok repo
+  | Some repo -> Ok repo.owner
   | None ->
       R.error_msgf
-        "The URL to your remote fork of opam-repository %s does not seem to \
-         point to a github repo.\n\
-         Try editing your config with `dune-release config set remote <URL>` \
-         or providing a valid Github repo URL via the --remote-repo option."
-        remote_repo
-
-let submit ~token ~dry_run ~yes ~opam_repo ~pkgs_to_submit local_repo
-    remote_repo pkgs auto_open ~draft =
+        "The owner of the opam-repository fork on Github is needed but \
+         couldn't be parsed from the remote fork.\n\
+         Please configure your Github user name with `dune-release config set \
+         user <owner>` or providing it via the\n\
+        \             `--user` option."
+
+let submit ~token ~dry_run ~yes ~opam_repo ~pkgs_to_submit
+    {
+      Config.Opam_repo_fork.local = local_repo;
+      remote = remote_repo;
+      user = fork_owner;
+    } pkgs auto_open ~draft =
   List.fold_left
     (fun acc pkg ->
       get_pkg_dir pkg >>= fun pkg_dir ->
@@ -215,7 +222,10 @@ let submit ~token ~dry_run ~yes ~opam_repo ~pkgs_to_submit local_repo
     | Some { owner; repo } -> Text.rewrite_github_refs ~user:owner ~repo changes
     | None -> changes
   in
-  parse_remote_repo remote_repo >>= fun { owner = fork_owner; _ } ->
+  let* fork_owner =
+    Bos_setup.R.of_option fork_owner ~none:(fun () ->
+        get_fork_owner ~remote_repo)
+  in
   let msg = strf "%s\n\n%s\n" title changes in
   App_log.status (fun l ->
       l "Preparing %a to %a" Text.Pp.maybe_draft (draft, "pull request")
@@ -289,11 +299,12 @@ let submit ?local_repo:local ?remote_repo:remote ?opam_repo ?user ?token
   in
   report_user_option_use user;
   Config.token ~token ~dry_run () >>= fun token ->
-  Config.opam_repo_fork ~pkgs ~local ~remote () >>= fun { remote; local } ->
+  Config.opam_repo_fork ~pkgs ~user:None ~local ~remote ()
+  >>= fun remote_config ->
   Config.auto_open ~no_auto_open >>= fun auto_open ->
   App_log.status (fun m ->
       m "Submitting %a" Fmt.(list ~sep:sp Text.Pp.name) pkg_names);
-  submit ~token ~dry_run ~yes ~opam_repo ~pkgs_to_submit:pkg_names local remote
+  submit ~token ~dry_run ~yes ~opam_repo ~pkgs_to_submit:pkg_names remote_config
     pkgs auto_open ~draft
 
 let field ~pkgs ~field_name = field pkgs field_name

bin/undraft.ml

@@ -43,7 +43,7 @@ let undraft ?opam ?distrib_file ?opam_repo ?token ?local_repo:local
     ?remote_repo:remote ?build_dir ?pkg_names ~dry_run ~yes:_ () =
   Config.token ~token ~dry_run () >>= fun token ->
   let pkg = Pkg.v ?opam ?distrib_file ?build_dir ~dry_run:false () in
-  Config.opam_repo_fork ~pkgs:[ pkg ] ~local ~remote ()
+  Config.opam_repo_fork ~pkgs:[ pkg ] ~user:None ~local ~remote ()
   >>= fun opam_repo_fork ->
   Pkg.name pkg >>= fun pkg_name ->
   Pkg.build_dir pkg >>= fun build_dir ->

lib/config.ml

@@ -29,7 +29,7 @@ type t = {
 }
 
 module Opam_repo_fork = struct
-  type t = { remote : string; local : Fpath.t }
+  type t = { remote : string; local : Fpath.t; user : string option }
 end
 
 let of_yaml_exn str =
@@ -249,9 +249,10 @@ let keep_v ~keep_v =
 let auto_open ~no_auto_open =
   if no_auto_open then Ok false else read (fun t -> t.auto_open) ~default:true
 
-let opam_repo_fork ?pkgs ~remote ~local () =
-  match (remote, local) with
-  | Some remote, Some local -> Ok { Opam_repo_fork.remote; local }
+let opam_repo_fork ?pkgs ~user ~remote ~local () =
+  match (remote, local, user) with
+  | Some remote, Some local, Some user ->
+      Ok { Opam_repo_fork.remote; local; user }
   | _ ->
       let config =
         Lazy.force file >>= function
@@ -261,7 +262,8 @@ let opam_repo_fork ?pkgs ~remote ~local () =
       config >>= fun config ->
       let local = Stdext.Option.value ~default:config.local local in
       let remote = Stdext.Option.value ~default:config.remote remote in
-      Ok { Opam_repo_fork.remote; local }
+      let user = Stdext.Option.value ~default:config.user user in
+      Ok { Opam_repo_fork.remote; local; user }
 
 module type S = sig
   val path : build_dir:Fpath.t -> name:string -> version:Version.t -> Fpath.t

lib/config.mli

@@ -23,7 +23,7 @@ type t = {
 }
 
 module Opam_repo_fork : sig
-  type t = { remote : string; local : Fpath.t }
+  type t = { remote : string; local : Fpath.t; user : string option }
 end
 
 val create : ?pkgs:Pkg.t list -> unit -> (unit, Bos_setup.R.msg) result
@@ -52,6 +52,7 @@ val auto_open : no_auto_open:bool Cli.t -> (bool, Bos_setup.R.msg) result
 
 val opam_repo_fork :
   ?pkgs:Pkg.t list ->
+  user:string option Cli.t option ->
   remote:string Cli.t option ->
   local:Fpath.t Cli.t option ->
   unit ->

lib/stdext.ml

@@ -75,6 +75,11 @@ module Result = struct
     let iter ~f l =
       List.fold_left (fun acc x -> acc >>= fun () -> f x) (Ok ()) l
   end
+
+  module Let_syntax = struct
+    let ( let+ ) = Bos_setup.R.( >>| )
+    let ( let* ) = Bos_setup.R.( >>= )
+  end
 end
 
 module String = struct

lib/stdext.mli

@@ -73,4 +73,14 @@ module Result : sig
     (** [iter ~f l] applies [f] on each element of list [l] until an error
         occurs. *)
   end
+
+  module Let_syntax : sig
+    val ( let+ ) :
+      ('a, 'b) Result.result -> ('a -> 'c) -> ('c, 'b) Result.result
+
+    val ( let* ) :
+      ('a, 'b) Result.result ->
+      ('a -> ('c, 'b) Result.result) ->
+      ('c, 'b) Result.result
+  end
 end