diff --git a/doc/changes/10766.md b/doc/changes/10766.md new file mode 100644 index 00000000000..67994b5ba34 --- /dev/null +++ b/doc/changes/10766.md @@ -0,0 +1,2 @@ +- Add support for specifying Gitlab organization repositories in `source` + stanzas (#10766, fixes #6723, @H-ANSEN) diff --git a/doc/reference/dune-project/generate_opam_files.rst b/doc/reference/dune-project/generate_opam_files.rst index a84048e0a55..b2cb57eb7fb 100644 --- a/doc/reference/dune-project/generate_opam_files.rst +++ b/doc/reference/dune-project/generate_opam_files.rst @@ -71,7 +71,8 @@ defined in the project: * - `Bitbucket `_ - ``(bitbucket user/repo)`` * - `Gitlab `_ - - ``(gitlab user/repo)`` + - | ``(gitlab user/repo)`` + | ``(gitlab organization/project/repo)`` *(New in 3.17)* * - `Sourcehut `_ - ``(sourcehut user/repo)`` diff --git a/src/dune_lang/package_info.ml b/src/dune_lang/package_info.ml index 7110059a59f..177ff173101 100644 --- a/src/dune_lang/package_info.ml +++ b/src/dune_lang/package_info.ml @@ -43,7 +43,7 @@ let empty = let example = { source = - Some (Host { kind = Source_kind.Host.Github; user = "username"; repo = "reponame" }) + Some (Host (Source_kind.Host.Github { user = "username"; repo = "reponame" })) ; license = Some [ "LICENSE" ] ; authors = Some [ "Author Name" ] ; maintainers = Some [ "Maintainer Name" ] diff --git a/src/dune_lang/source_kind.ml b/src/dune_lang/source_kind.ml index 99bd2847102..4913e697fbb 100644 --- a/src/dune_lang/source_kind.ml +++ b/src/dune_lang/source_kind.ml @@ -2,103 +2,147 @@ open Stdune open Dune_sexp module Host = struct - type kind = - | Github - | Bitbucket - | Gitlab - | Sourcehut - - let to_string = function - | Github -> "github" - | Bitbucket -> "bitbucket" - | Gitlab -> "gitlab" - | Sourcehut -> "sourcehut" - ;; - - type t = + type user_repo = { user : string ; repo : string - ; kind : kind } - let dyn_of_kind kind = kind |> to_string |> Dyn.string + type gitlab_repo = + | User_repo of user_repo + | Org_repo of + { org : string + ; proj : string + ; repo : string + } + + type t = + | Github of user_repo + | Bitbucket of user_repo + | Gitlab of gitlab_repo + | Sourcehut of user_repo + + let kind_string = function + | Github _ -> "github" + | Bitbucket _ -> "bitbucket" + | Gitlab _ -> "gitlab" + | Sourcehut _ -> "sourcehut" + ;; - let to_dyn { user; repo; kind } = + let dyn_of_user_repo kind { user; repo } = let open Dyn in - record [ "kind", dyn_of_kind kind; "user", string user; "repo", string repo ] + record [ "kind", kind; "user", string user; "repo", string repo ] ;; - let host_of_kind = function - | Github -> "github.com" - | Bitbucket -> "bitbucket.org" - | Gitlab -> "gitlab.com" - | Sourcehut -> "sr.ht" + let dyn_of_gitlab_repo kind repo = + match repo with + | User_repo user_repo -> dyn_of_user_repo kind user_repo + | Org_repo { org; proj; repo } -> + let open Dyn in + record [ "kind", kind; "org", string org; "proj", string proj; "repo", string repo ] ;; - let base_uri { kind; user; repo } = - let host = host_of_kind kind in - sprintf - "%s/%s/%s" - host - (match kind with - | Sourcehut -> "~" ^ user - | _ -> user) - repo + let to_dyn repo = + let kind = Dyn.string (kind_string repo) in + match repo with + | Gitlab gitlab_repo -> dyn_of_gitlab_repo kind gitlab_repo + | Github user_repo | Bitbucket user_repo | Sourcehut user_repo -> + dyn_of_user_repo kind user_repo + ;; + + let host_of_repo = function + | Github _ -> "github.com" + | Bitbucket _ -> "bitbucket.org" + | Gitlab _ -> "gitlab.com" + | Sourcehut _ -> "sr.ht" + ;; + + let base_uri repo = + let host = host_of_repo repo in + match repo with + | Gitlab (Org_repo { org; proj; repo }) -> sprintf "%s/%s/%s/%s" host org proj repo + | Sourcehut { user; repo } -> sprintf "%s/~%s/%s" host user repo + | Gitlab (User_repo { user; repo }) | Github { user; repo } | Bitbucket { user; repo } + -> sprintf "%s/%s/%s" host user repo ;; let add_https s = "https://" ^ s let homepage t = add_https (base_uri t) - let bug_reports t = - match t.kind with - | Sourcehut -> add_https ("todo." ^ base_uri t) - | _ -> - homepage t - ^ - (match t.kind with - | Sourcehut -> assert false - | Bitbucket | Github -> "/issues" - | Gitlab -> "/-/issues") + let bug_reports = function + | Gitlab _ as repo -> homepage repo ^ "/-/issues" + | Github _ as repo -> homepage repo ^ "/issues" + | Bitbucket _ as repo -> homepage repo ^ "/issues" + | Sourcehut _ as repo -> add_https ("todo." ^ base_uri repo) ;; let enum k = - [ "GitHub", Github, None - ; "Bitbucket", Bitbucket, Some (2, 8) - ; "Gitlab", Gitlab, Some (2, 8) - ; "Sourcehut", Sourcehut, Some (3, 1) + let stub_user_repo = { user = ""; repo = "" } in + let stub_org_repo = Org_repo { org = ""; proj = ""; repo = "" } in + let repo_name k = k |> kind_string |> String.capitalize in + [ Github stub_user_repo + ; Bitbucket stub_user_repo + ; Sourcehut stub_user_repo + ; Gitlab (User_repo stub_user_repo) + ; Gitlab stub_org_repo ] - |> List.map ~f:(fun (name, kind, since) -> - let decode = - let of_string ~loc s = - match String.split ~on:'/' s with - | [ user; repo ] -> k { kind; user; repo } - | _ -> - User_error.raise - ~loc - [ Pp.textf "%s repository must be of form user/repo" name ] - in + |> List.map ~f:(fun kind -> + let of_string ~loc str = + let name = repo_name kind in + match kind, String.split ~on:'/' str with + | Github _, [ user; repo ] -> Github { user; repo }, None + | Bitbucket _, [ user; repo ] -> Bitbucket { user; repo }, Some ((2, 8), name) + | Sourcehut _, [ user; repo ] -> Sourcehut { user; repo }, Some ((3, 1), name) + | Gitlab _, [ user; repo ] -> + Gitlab (User_repo { user; repo }), Some ((2, 8), name) + | Gitlab _, [ org; proj; repo ] -> + Gitlab (Org_repo { org; proj; repo }), Some ((3, 17), "Gitlab organization repo") + | Gitlab _, _ -> + User_error.raise + ~loc + [ Pp.textf "%s repository must be of form user/repo or org/proj/repo" name ] + | _, [ _; _; _ ] -> + User_error.raise + ~loc + ~hints: + [ Pp.textf "The provided form '%s' is specific to Gitlab projects" str ] + [ Pp.textf "%s repository must be of form user/repo" name ] + | _, _ -> + User_error.raise + ~loc + [ Pp.textf "%s repository must be of form user/repo" name ] + in + let decoder = let open Decoder in + plain_string of_string + >>= fun (t, since) -> (match since with | None -> return () - | Some v -> Syntax.since Stanza.syntax v) - >>> plain_string of_string + | Some (v, what) -> Syntax.since ~what Stanza.syntax v) + >>> return t + >>| k in - let constr = to_string kind in - constr, decode) + kind_string kind, decoder) ;; - let encode { user; repo; kind } = - let forge = to_string kind in - let path = user ^ "/" ^ repo in + let encode repo = + let path = + match repo with + | Gitlab (Org_repo { org; proj; repo }) -> sprintf "%s/%s/%s" org proj repo + | Gitlab (User_repo { user; repo }) -> sprintf "%s/%s" user repo + | Sourcehut { user; repo } -> sprintf "%s/%s" user repo + | Github { user; repo } -> sprintf "%s/%s" user repo + | Bitbucket { user; repo } -> sprintf "%s/%s" user repo + in let open Encoder in + let forge = kind_string repo in pair string string (forge, path) ;; - let to_string t = + let to_string repo = let base_uri = - let base = base_uri t in - match t.kind with - | Sourcehut -> "git." ^ base + let base = base_uri repo in + match repo with + | Sourcehut _ -> "git." ^ base | _ -> base ^ ".git" in "git+https://" ^ base_uri diff --git a/src/dune_lang/source_kind.mli b/src/dune_lang/source_kind.mli index 389ad974f06..768d5ebf9dd 100644 --- a/src/dune_lang/source_kind.mli +++ b/src/dune_lang/source_kind.mli @@ -1,16 +1,23 @@ module Host : sig - type kind = - | Github - | Bitbucket - | Gitlab - | Sourcehut - - type t = + type user_repo = { user : string ; repo : string - ; kind : kind } + type gitlab_repo = + | User_repo of user_repo + | Org_repo of + { org : string + ; proj : string + ; repo : string + } + + type t = + | Github of user_repo + | Bitbucket of user_repo + | Gitlab of gitlab_repo + | Sourcehut of user_repo + val homepage : t -> string val bug_reports : t -> string end diff --git a/test/blackbox-tests/test-cases/source-stanza.t b/test/blackbox-tests/test-cases/source-stanza.t new file mode 100644 index 00000000000..903d6e8e33a --- /dev/null +++ b/test/blackbox-tests/test-cases/source-stanza.t @@ -0,0 +1,114 @@ +Test 'source' stanza compatibility with both user and organization paths from +the supported 'github', 'gitlab', 'sourcehut', and 'bitbucket'. + +Test a generated 'github' user repo + + $ cat > dune-project < (lang dune 3.17) + > (name foo) + > (generate_opam_files true) + > (source (github user/repo)) + > (package + > (allow_empty) + > (name foo)) + > EOF + + $ dune build + $ cat foo.opam | grep -i github + homepage: "https://github.com/user/repo" + bug-reports: "https://github.com/user/repo/issues" + dev-repo: "git+https://github.com/user/repo.git" + +Test a generated 'gitlab' user repo + + $ sed -i -e '4s|.*|(source (gitlab user/repo))|' dune-project + $ dune build + $ cat foo.opam | grep -i gitlab + homepage: "https://gitlab.com/user/repo" + bug-reports: "https://gitlab.com/user/repo/-/issues" + dev-repo: "git+https://gitlab.com/user/repo.git" + +Test a generated 'sourcehut' user repo + + $ sed -i -e '4s|.*|(source (sourcehut user/repo))|' dune-project + $ dune build + $ cat foo.opam | grep -i sr.ht + homepage: "https://sr.ht/~user/repo" + bug-reports: "https://todo.sr.ht/~user/repo" + dev-repo: "git+https://git.sr.ht/~user/repo" + +Test a generated 'bitbucket' user repo + + $ sed -i -e '4s|.*|(source (bitbucket user/repo))|' dune-project + $ dune build + $ cat foo.opam | grep -i bitbucket + homepage: "https://bitbucket.org/user/repo" + bug-reports: "https://bitbucket.org/user/repo/issues" + dev-repo: "git+https://bitbucket.org/user/repo.git" + +Test a generated 'gitlab' organization repo + + $ sed -i -e '4s|.*|(source (gitlab organization/project/repo))|' dune-project + $ dune build + $ cat foo.opam | grep -i gitlab + homepage: "https://gitlab.com/organization/project/repo" + bug-reports: "https://gitlab.com/organization/project/repo/-/issues" + dev-repo: "git+https://gitlab.com/organization/project/repo.git" + +Test that the creation of a source stanza of the form 'org/project/repo' is +disallowed by any forge type other than gitlab and that associated error +messages are provided + +Test github forge. + + $ sed -i -e '4s|.*|(source (github org/proj/repo))|' dune-project + $ dune build + File "dune-project", line 4, characters 16-29: + 4 | (source (github org/proj/repo)) + ^^^^^^^^^^^^^ + Error: Github repository must be of form user/repo + Hint: The provided form 'org/proj/repo' is specific to Gitlab projects + [1] + +Test bitbucket forge. + + $ sed -i -e '4s|.*|(source (bitbucket org/proj/repo))|' dune-project + $ dune build + File "dune-project", line 4, characters 19-32: + 4 | (source (bitbucket org/proj/repo)) + ^^^^^^^^^^^^^ + Error: Bitbucket repository must be of form user/repo + Hint: The provided form 'org/proj/repo' is specific to Gitlab projects + [1] + +Test sourcehut forge. + + $ sed -i -e '4s|.*|(source (sourcehut org/proj/repo))|' dune-project + $ dune build + File "dune-project", line 4, characters 19-32: + 4 | (source (sourcehut org/proj/repo)) + ^^^^^^^^^^^^^ + Error: Sourcehut repository must be of form user/repo + Hint: The provided form 'org/proj/repo' is specific to Gitlab projects + [1] + +So far we have been using '(lang dune 3.17)' which supports gitlab organization +style syntax, we will bump the version down and check to make sure an error is +thrown telling us we need a more recent version of dune to use orginaziton +syntax. + + $ sed -i -e '1s|.*|(lang dune 3.16)|' dune-project + $ sed -i -e '4s|.*|(source (gitlab org/proj/repo))|' dune-project + $ dune build + File "dune-project", line 4, characters 8-30: + 4 | (source (gitlab org/proj/repo)) + ^^^^^^^^^^^^^^^^^^^^^^ + Error: Gitlab organization repo is only available since version 3.17 of the + dune language. Please update your dune-project file to have (lang dune 3.17). + [1] + +With the version bumped down we will also check to make sure that the user/repo +style gitlab stanza still works without any error. + + $ sed -i -e '4s|.*|(source (gitlab user/repo))|' dune-project + $ dune build