From f54654fad6bf4f2fc85a362f97c611c2fb0d9ee9 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 22 Sep 2020 15:20:11 -0700 Subject: [PATCH] Add support for gitlab/bitbucket sources It's just as easy to support them as github Signed-off-by: Rudi Grinberg --- CHANGES.md | 6 ++- src/dune_engine/package.ml | 96 +++++++++++++++++++++++++++++------- src/dune_engine/package.mli | 17 ++++++- src/dune_rules/watermarks.ml | 7 ++- 4 files changed, 104 insertions(+), 22 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 42d4aab4395..766505378f6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -16,11 +16,15 @@ Unreleased - Add the `executable` field to `inline_tests` to customize the compilation flags of the test runner executable (#3747, fixes #3679, @lubegasimon) -- Add (enabled_if ...) to (copy_files ...) (#3756, @nojb) +- Add `(enabled_if ...)` to `(copy_files ...)` (#3756, @nojb) - Make sure Dune cleans up the status line before exiting (#3767, fixes #3737, @alan-j-hu) +- Add `{gitlab,bitbucket}` as options for defining project sources with `source` + stanza `(source ( user/repo))` in the `dune-project` file. (#3813, + @rgrinberg) + 2.7.1 (2/09/2020) ----------------- diff --git a/src/dune_engine/package.ml b/src/dune_engine/package.ml index cbc5e1115d7..88990d04aac 100644 --- a/src/dune_engine/package.ml +++ b/src/dune_engine/package.ml @@ -225,33 +225,95 @@ module Dependency = struct end module Source_kind = struct + module Host = struct + type kind = + | Github + | Bitbucket + | Gitlab + + let to_string = function + | Github -> "github" + | Bitbucket -> "bitbucket" + | Gitlab -> "gitlab" + + type t = + { user : string + ; repo : string + ; kind : kind + } + + let dyn_of_kind kind = kind |> to_string |> Dyn.Encoder.string + + let to_dyn { user; repo; kind } = + let open Dyn.Encoder in + record + [ ("kind", dyn_of_kind kind) + ; ("user", string user) + ; ("repo", string repo) + ] + + let host_of_kind = function + | Github -> "github.com" + | Bitbucket -> "bitbucket.org" + | Gitlab -> "gitlab.com" + + let homepage { kind; user; repo } = + let host = host_of_kind kind in + sprintf "https://%s/%s/%s" host user repo + + let bug_reports t = + homepage t + ^ + match t.kind with + | Bitbucket + | Github -> + "/issues" + | Gitlab -> "/-/issues" + + let enum k = + [ ("GitHub", Github, None) + ; ("Bitbucket", Bitbucket, Some (2, 8)) + ; ("Gitlab", Gitlab, Some (2, 8)) + ] + |> 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 + let open Dune_lang.Decoder in + ( match since with + | None -> return () + | Some v -> Dune_lang.Syntax.since Stanza.syntax v ) + >>> plain_string of_string + in + let constr = to_string kind in + (constr, decode)) + + let to_string { user; repo; kind } = + sprintf "git+https://%s/%s/%s.git" (host_of_kind kind) user repo + end + type t = - | Github of string * string + | Host of Host.t | Url of string let to_dyn = let open Dyn.Encoder in function - | Github (user, repo) -> constr "Github" [ string user; string repo ] + | Host h -> constr "Host" [ Host.to_dyn h ] | Url url -> constr "Url" [ string url ] let to_string = function - | Github (user, repo) -> - sprintf "git+https://github.com/%s/%s.git" user repo + | Host h -> Host.to_string h | Url u -> u let decode = let open Dune_lang.Decoder in - sum - [ ( "github" - , plain_string (fun ~loc s -> - match String.split ~on:'/' s with - | [ user; repo ] -> Github (user, repo) - | _ -> - User_error.raise ~loc - [ Pp.textf "GitHub repository must be of form user/repo" ]) ) - ; ("uri", string >>| fun s -> Url s) - ] + sum (("uri", string >>| fun s -> Url s) :: Host.enum (fun x -> Host x)) end module Info = struct @@ -273,14 +335,12 @@ module Info = struct let homepage t = match (t.homepage, t.source) with - | None, Some (Github (user, repo)) -> - Some (sprintf "https://github.com/%s/%s" user repo) + | None, Some (Host h) -> Some (Source_kind.Host.homepage h) | s, _ -> s let bug_reports t = match (t.bug_reports, t.source) with - | None, Some (Github (user, repo)) -> - Some (sprintf "https://github.com/%s/%s/issues" user repo) + | None, Some (Host h) -> Some (Source_kind.Host.bug_reports h) | s, _ -> s let documentation t = t.documentation diff --git a/src/dune_engine/package.mli b/src/dune_engine/package.mli index 18002bc232c..c071cfc79a9 100644 --- a/src/dune_engine/package.mli +++ b/src/dune_engine/package.mli @@ -59,8 +59,23 @@ module Dependency : sig end module Source_kind : sig + module Host : sig + type kind = + | Github + | Bitbucket + | Gitlab + + type t = + { user : string + ; repo : string + ; kind : kind + } + + val homepage : t -> string + end + type t = - | Github of string * string + | Host of Host.t | Url of string val to_dyn : t Dyn.Encoder.t diff --git a/src/dune_rules/watermarks.ml b/src/dune_rules/watermarks.ml index 471920f4f39..62b37dc5968 100644 --- a/src/dune_rules/watermarks.ml +++ b/src/dune_rules/watermarks.ml @@ -230,6 +230,9 @@ let make_watermark_map ~commit ~version ~dune_project ~package = in let name = Dune_project.name dune_project in let info = package.Package.info in + (* XXX these error messages aren't particularly good as these values do not + necessarily come from the project file. It's possible for them to be + defined in the .opam file directly*) let make_value name = function | None -> Error (sprintf "variable %S not found in dune-project file" name) | Some value -> Ok value @@ -239,8 +242,8 @@ let make_watermark_map ~commit ~version ~dune_project ~package = | Some value -> Ok (String.concat ~sep value) in let make_dev_repo_value = function - | Some (Package.Source_kind.Github (user, repo)) -> - Ok (sprintf "https://github.com/%s/%s" user repo) + | Some (Package.Source_kind.Host h) -> + Ok (Package.Source_kind.Host.homepage h) | Some (Package.Source_kind.Url url) -> Ok url | None -> Error (sprintf "variable dev-repo not found in dune-project file") in