Add support for Gitlab organization repositories

H-ANSEN · Leonidas-from-XIV · commit 83680cda5fec · 2024-08-14T16:57:20.000+02:00
Fixes #6723 Signed-off-by: teague hansen <thanse23@asu.edu> Signed-off-by: Marek Kubica <marek@tarides.com>
diff --git a/doc/changes/10766.md 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
@@ -71,7 +71,8 @@ defined in the project:
      * - `Bitbucket <https://bitbucket.org>`_
        - ``(bitbucket user/repo)``
      * - `Gitlab <https://gitlab.com>`_
-       - ``(gitlab user/repo)``
+       - | ``(gitlab user/repo)``
+         | ``(gitlab organization/project/repo)`` *(New in 3.17)*
      * - `Sourcehut <https://sr.ht>`_
        - ``(sourcehut user/repo)``
 
diff --git 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
@@ -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
@@ -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
@@ -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 <<EOF
+  > (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

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,2 @@`
	`1`	+- Add support for specifying Gitlab organization repositories in `source`
	`2`	`+ stanzas (#10766, fixes #6723, @H-ANSEN)`