From 2c4e5a394ef5a0833b68f6731026d58345928f13 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 18 Jul 2023 17:01:25 +0200 Subject: [PATCH] `alr publish --status` (#1400) * Update doc on publishing to match new behavior * Retrieve status of opened PRs by the user Make it so the maximum number of results is returned by github * Self-review --- alire.toml | 2 +- deps/minirest | 2 +- doc/publishing.md | 23 +++--- src/alire/alire-github.adb | 41 +++++++---- src/alire/alire-github.ads | 3 + src/alire/alire-publish-states.adb | 113 +++++++++++++++++++++++++---- src/alire/alire-publish-states.ads | 31 +++++--- src/alire/alire-utils-tables.adb | 8 ++ src/alire/alire-utils-tables.ads | 4 + src/alr/alr-commands-publish.adb | 26 +++++-- src/alr/alr-commands-publish.ads | 3 + 11 files changed, 197 insertions(+), 59 deletions(-) diff --git a/alire.toml b/alire.toml index 59873a8c..107a13cf 100644 --- a/alire.toml +++ b/alire.toml @@ -49,7 +49,7 @@ aaa = { url = "https://github.com/mosteo/aaa", commit = "fbfffb1cb269a852201d172 ada_toml = { url = "https://github.com/mosteo/ada-toml", commit = "da4e59c382ceb0de6733d571ecbab7ea4919b33d" } clic = { url = "https://github.com/alire-project/clic", commit = "6879b90876a1c918b4e112f59c6db0e25b713f52" } gnatcoll = { url = "https://github.com/alire-project/gnatcoll-core.git", commit = "403efe11405113cf12ae3d014df474cf7a046176" } -minirest = { url = "https://github.com/mosteo/minirest.git", commit = "9045d8faafcea996fa7b51ccda84c54712eff821" } +minirest = { url = "https://github.com/mosteo/minirest.git", commit = "17fa789b71ccaf65e8c892816456c94a09a384d0" } semantic_versioning = { url = "https://github.com/alire-project/semantic_versioning", commit = "2f23fc5f6b4855b836b599adf292fed9c0ed4144" } simple_logging = { url = "https://github.com/alire-project/simple_logging", commit = "3505dc645f3eef6799a486aae223d37e88cfc4d5" } stopwatch = { url = "https://github.com/mosteo/stopwatch", commit = "f607a63b714f09bbf6126de9851cbc21cf8666c9" } diff --git a/deps/minirest b/deps/minirest index 834835b0..17fa789b 160000 --- a/deps/minirest +++ b/deps/minirest @@ -1 +1 @@ -Subproject commit 834835b04457349f516ce7d7de51b59703facaa0 +Subproject commit 17fa789b71ccaf65e8c892816456c94a09a384d0 diff --git a/doc/publishing.md b/doc/publishing.md index 1a941f56..da82f11f 100644 --- a/doc/publishing.md +++ b/doc/publishing.md @@ -10,13 +10,14 @@ the [gitter channel](https://gitter.im/ada-lang/Alire) of the project. The simplest publishing experience, provided you have a GitHub account and Personal Access Token, consist on issuing ``` -alr publish --submit +alr publish ``` at the root of your workspace, when said workspace is an up-to-date clone of a git repository. The publishing assistant will review your submission, point out any necessary -fixes or additional information required, and provide you with a tracking URL. +fixes or additional information required, and request a pull into the community +index on GitHub on your behalf. Read on for the details underlying these automated steps, or in case you need to perform further tweaking. @@ -48,10 +49,11 @@ The community index is supported through two kinds of branches: format, during the development of `alr`. Your `alr` version knows which branch to use, so you do not need to manually -select one. When using `alr publish` to assist on creating a release, you will +select one. When using `alr publish` to assist on creating a release, `alr` +will either create the pull request against the proper branch, or you will be provided with an upload link for the branch your `alr` is using. -However, when submitting releases manually, you must decide to which branch +However, when submitting releases manually, you can decide to which branch they will be added: selecting the latest stable branch results in the release becoming immediately available to the latest stable `alr`. Conversely, using the latest development branch will make the releases available for testing by @@ -122,8 +124,9 @@ path to it. At this point, `alr publish` will carry out a few tests and, if everything checks out, it will create a `${repo_root}/alire/releases/crate-version.toml` -file. This file must be submitted to the community index via a PR. A link for -conveniently creating this PR will also be provided by `alr`: +file. This file must be submitted to the community index via a PR. `alr` will +offer to create the pull request for you, unless you specify `--skip-submit`. +If so, a link for conveniently creating this PR will also be provided by `alr`: - Upload the generated index manifest file (`crate-version.toml`) to the supplied page link on github and create a pull-request. @@ -185,8 +188,7 @@ URL to do so. Invoking `alr publish --tar` inside an Alire workspace will result in the creation of a source archive at `${CRATE_ROOT}/alire/archives/`. This archive -must be manually uploaded (for now) by the user to a publicly accessible -hosting service. +must be manually uploaded by the user to a publicly accessible hosting service. After the upload, the user can supply the URL to fetch this archive to the publishing assistant (which will be waiting for this information), and the @@ -251,8 +253,9 @@ link, you can follow the usual procedure to submit a PR to a github repository: ## Publishing outcome Once the pull request is verified and merged, the new release will become -available for normal use. The open source Ada ecosystem needs all the help it -can get, so thank you for contributing! +available for normal use after running `alr index --update-all`. The open +source Ada ecosystem needs all the help it can get, so thank you for +contributing! ## ALR Badge diff --git a/src/alire/alire-github.adb b/src/alire/alire-github.adb index 8a96e919..cb2289d2 100644 --- a/src/alire/alire-github.adb +++ b/src/alire/alire-github.adb @@ -11,6 +11,7 @@ with Minirest; package body Alire.GitHub is + use Minirest; use URI.Operators; Base_URL : constant URL := "https://api.github.com"; @@ -28,7 +29,6 @@ package body Alire.GitHub is Token : String := OS_Lib.Getenv (Env_GH_Token, "")) return Minirest.Response is - use Minirest; Full_URL : constant String := Base_URL & (if Proc (Proc'First) /= '/' then "/" else "") @@ -124,7 +124,6 @@ package body Alire.GitHub is ) return Natural is - use all type Minirest.Parameters; Response : constant Minirest.Response := API_Call (Kind => POST, @@ -153,25 +152,21 @@ package body Alire.GitHub is end; end Create_Pull_Request; - ----------------------- - -- Find_Pull_Request -- - ----------------------- + --------------- + -- Get_Pulls -- + --------------- - function Find_Pull_Request (M : Milestones.Milestone) - return GNATCOLL.JSON.JSON_Value + function Get_Pulls (Args : Minirest.Parameters) + return GNATCOLL.JSON.JSON_Value is - use all type Minirest.Parameters; - Response : constant Minirest.Response := API_Call ("repos" / Index.Community_Organization / Index.Community_Repo_Name / "pulls", Kind => GET, - Args => - "state" = "all" - and "head" = User_Info.User_GitHub_Login & ":" - & Publish.Branch_Name (M)); + Args => Args + and "per_page" = 100); begin if Response.Succeeded then return GNATCOLL.JSON.Read (Response.Content.Flatten ("")); @@ -183,7 +178,25 @@ package body Alire.GitHub is & " and status: " & Response.Status_Line & Response.Content.Flatten (ASCII.LF)); end if; - end Find_Pull_Request; + end Get_Pulls; + + ----------------------- + -- Find_Pull_Request -- + ----------------------- + + function Find_Pull_Request (M : Milestones.Milestone) + return GNATCOLL.JSON.JSON_Value + is (Get_Pulls ("state" = "all" + and "head" = User_Info.User_GitHub_Login & ":" + & Publish.Branch_Name (M))); + + ------------------------ + -- Find_Pull_Requests -- + ------------------------ + + function Find_Pull_Requests return GNATCOLL.JSON.JSON_Value + is (Get_Pulls ("state" = "open" + and "head" = User_Info.User_GitHub_Login)); ---------- -- Fork -- diff --git a/src/alire/alire-github.ads b/src/alire/alire-github.ads index eb53fd9f..7764c442 100644 --- a/src/alire/alire-github.ads +++ b/src/alire/alire-github.ads @@ -45,6 +45,9 @@ package Alire.GitHub is -- JSON info. It will return the unique open PR, or the most recent closed -- one. + function Find_Pull_Requests return GNATCOLL.JSON.JSON_Value; + -- Return open pull requests created by the user + function Fork (User : String := User_Info.User_GitHub_Login; Owner : String; diff --git a/src/alire/alire-publish-states.adb b/src/alire/alire-publish-states.adb index de86953e..3f5067f0 100644 --- a/src/alire/alire-publish-states.adb +++ b/src/alire/alire-publish-states.adb @@ -1,6 +1,8 @@ with Alire.GitHub; with Alire.Index; with Alire.URI; +with Alire.Utils.Tables; +with Alire.Utils.User_Input.Query_Config; with GNATCOLL.JSON; @@ -26,6 +28,39 @@ package body Alire.Publish.States is function Webpage (PR : PR_Status) return URL is (Webpage (PR.Number)); + --------- + -- Key -- + --------- + + package Key is + Head : constant String := "head"; + Label : constant String := "label"; + Number : constant String := "number"; + State : constant String := "state"; + end Key; + + package Val is + Open : constant String := "open"; + end Val; + + --------------- + -- To_Status -- + --------------- + + function To_Status (Info : GNATCOLL.JSON.JSON_Value) return PR_Status + is + begin + return + (Exists => True, + Branch => +Info.Get (Key.Head).Get (Key.Label), + Number => Info.Get (Key.Number), + Status => (if Info.Get (Key.State) = Val.Open + then Open + else Rejected), -- TODO: be more precise in the future + Checks => <> -- TODO: extract info about checks + ); + end To_Status; + ----------------------- -- Find_Pull_Request -- ----------------------- @@ -36,25 +71,21 @@ package body Alire.Publish.States is Result : constant JSON_Value := GitHub.Find_Pull_Request (M); List : constant JSON_Array := Result.Get; Target : JSON_Value := JSON_Null; - - Key_Number : constant String := "number"; - Key_State : constant String := "state"; - Val_Open : constant String := "open"; begin for I in 1 .. Length (List) loop declare Obj : constant JSON_Value := Get (List, I); begin -- Keep the first one we see - if Obj.Get (Key_State).Get = Val_Open then + if Obj.Get (Key.State).Get = Val.Open then Target := Obj; exit; elsif Target.Is_Empty or else - (Target.Get (Key_State) /= Val_Open - and then Integer'(Target.Get (Key_Number).Get) < - Obj.Get (Key_Number)) + (Target.Get (Key.State) /= Val.Open + and then Integer'(Target.Get (Key.Number).Get) < + Obj.Get (Key.Number)) then -- Keep the one with the highest #number Target := Obj; @@ -65,14 +96,66 @@ package body Alire.Publish.States is if Target.Is_Empty then return (Exists => False); else - return - (Exists => True, - Number => Target.Get (Key_Number), - Status => (if Target.Get (Key_State) = Val_Open - then Open - else Rejected), -- TODO: be more precise in the future - others => <>); -- TODO: likewise, inform the rest of fields + return To_Status (Target); end if; end Find_Pull_Request; + ------------------------ + -- Find_Pull_Requests -- + ------------------------ + + function Find_Pull_Requests return Status_Array is + use AAA.Strings; + use GNATCOLL.JSON; + List : constant JSON_Array := GitHub.Find_Pull_Requests.Get; + Result : Status_Array (1 .. Length (List)); + I : Natural := Result'First; + begin + -- We can filter at GitHub side using the complete reference, but + -- surprisingly not by author only. Hence we have to filter here. + for J in 1 .. Length (List) loop + declare + Status : constant PR_Status := To_Status (Get (List, J)); + begin + if Has_Prefix + (+Status.Branch, + Utils.User_Input.Query_Config.User_GitHub_Login & ":") + then + Result (I) := Status; + I := I + 1; + end if; + end; + end loop; + + return Result (Result'First .. I - 1); + end Find_Pull_Requests; + + ------------------ + -- Print_Status -- + ------------------ + + procedure Print_Status is + States : constant Status_Array := Find_Pull_Requests; + Table : Utils.Tables.Table; + begin + if States'Length = 0 then + Trace.Always ("No pending submissions found."); + return; + end if; + + Table.Header ("PR").Header ("Reference").Header ("Status").Header ("URL") + .New_Row; + + for PR of States loop + Table + .Append (TTY.Emph (AAA.Strings.Trim (PR.Number'Image))) + .Append (+PR.Branch) + .Append (AAA.Strings.To_Mixed_Case (PR.Status'Image)) + .Append (TTY.URL (Webpage (PR))) + .New_Row; + end loop; + + Table.Print (Always); + end Print_Status; + end Alire.Publish.States; diff --git a/src/alire/alire-publish-states.ads b/src/alire/alire-publish-states.ads index d472dd56..1b815e35 100644 --- a/src/alire/alire-publish-states.ads +++ b/src/alire/alire-publish-states.ads @@ -4,30 +4,41 @@ package Alire.Publish.States is type Check_States is (Pending, Running, Failed, Succeeded); - type Life_States is (Open, Merged, Changes_Requested, Rejected); - -- Those are specific to our publishing needs, and cooked from github data + type Life_States is (Open, Changes_Requested, Merged, Rejected); + + subtype Open_States is Life_States range Open .. Changes_Requested; type PR_Status (Exists : Boolean) is tagged record case Exists is when False => null; when True => - Number : Natural := 0; - Status : Life_States := Open; - Checks : Check_States := Pending; - Changes_Requested : Boolean := False; + Branch : UString; -- In truth, it's `user:branch` + Number : Natural := 0; + Status : Life_States := Open; + Checks : Check_States := Pending; end case; end record; - function Is_Open (PR : PR_Status) return Boolean - is (PR.Exists and then PR.Status in Open | Changes_Requested); - function Webpage (PR : PR_Status) return URL; function Webpage (PR : Natural) return URL; - -- Build the URL from the PR number + + subtype Existing_PR_Status is PR_Status (Exists => True); + + type Status_Array is array (Positive range <>) of Existing_PR_Status; + + function Is_Open (PR : PR_Status) return Boolean + is (PR.Exists and then PR.Status in Open_States); function Find_Pull_Request (M : Milestones.Milestone) return PR_Status; -- Find the status of a PR. Only one can be open, that will be returned in -- preference. Otherwise, the one closed more recently will be returned. + function Find_Pull_Requests return Status_Array + with Post => (for all PR of Find_Pull_Requests'Result => + PR.Status in Open_States); + -- Find all open pull requests created by the user + + procedure Print_Status; + end Alire.Publish.States; diff --git a/src/alire/alire-utils-tables.adb b/src/alire/alire-utils-tables.adb index ff701fbb..a4ea9d76 100644 --- a/src/alire/alire-utils-tables.adb +++ b/src/alire/alire-utils-tables.adb @@ -11,6 +11,14 @@ package body Alire.Utils.Tables is T.Append (TTY.Emph (AAA.Strings.To_Upper_Case (Cell))); end Header; + function Header (T : aliased in out Table; + Cell : String) + return access Table is + begin + T.Header (Cell); + return T'Access; + end Header; + ----------- -- Print -- ----------- diff --git a/src/alire/alire-utils-tables.ads b/src/alire/alire-utils-tables.ads index a19cf722..f6f3ef93 100644 --- a/src/alire/alire-utils-tables.ads +++ b/src/alire/alire-utils-tables.ads @@ -6,6 +6,10 @@ package Alire.Utils.Tables with Preelaborate is procedure Header (T : in out Table; Cell : String); + function Header (T : aliased in out Table; + Cell : String) + return access Table; + procedure Print (T : Table; Level : Trace.Levels := Info; Separator : String := " "; diff --git a/src/alr/alr-commands-publish.adb b/src/alr/alr-commands-publish.adb index c5fbd2de..938b8547 100644 --- a/src/alr/alr-commands-publish.adb +++ b/src/alr/alr-commands-publish.adb @@ -1,5 +1,5 @@ with Alire.Origins; -with Alire.Publish; +with Alire.Publish.States; with Alire.URI; with Alire.Utils; @@ -29,7 +29,8 @@ package body Alr.Commands.Publish is Skip_Submit => Cmd.Skip_Submit); begin - if Alire.Utils.Count_True ((Cmd.Tar, Cmd.Print_Trusted)) > 1 or else + if Alire.Utils.Count_True + ((Cmd.Tar, Cmd.Print_Trusted, Cmd.Status)) > 1 or else (Cmd.Manifest.all /= "" and then Cmd.Print_Trusted) then Reportaise_Wrong_Arguments @@ -52,6 +53,9 @@ package body Alr.Commands.Publish is Revision => (if Args.Count >= 2 then Args (2) else "HEAD"), Options => Options); + elsif Cmd.Status then + Alire.Publish.States.Print_Status; + else if Args.Count < 1 then Alire.Publish.Local_Repository (Options => Options); @@ -111,12 +115,24 @@ package body Alr.Commands.Publish is "", "--manifest=", "Selects a manifest file other than ./alire.toml"); + Define_Switch + (Config, + Cmd.Skip_Build'Access, + "", "--skip-build", + "Skip the build check step"); + Define_Switch (Config, Cmd.Skip_Submit'Access, "", "--skip-submit", "Do not create the online pull request onto the community index"); + Define_Switch + (Config, + Cmd.Status'Access, + "", "--status", + "Check the status of the last pull request for the crate"); + Define_Switch (Config, Cmd.Tar'Access, @@ -129,12 +145,6 @@ package body Alr.Commands.Publish is Cmd.Print_Trusted'Access, "", "--trusted-sites", "Print a list of trusted git repository sites"); - - Define_Switch - (Config, - Cmd.Skip_Build'Access, - "", "--skip-build", - "Skip the build check step"); end Setup_Switches; end Alr.Commands.Publish; diff --git a/src/alr/alr-commands-publish.ads b/src/alr/alr-commands-publish.ads index d7e12830..cade7ad1 100644 --- a/src/alr/alr-commands-publish.ads +++ b/src/alr/alr-commands-publish.ads @@ -68,6 +68,9 @@ private Skip_Submit : aliased Boolean := False; -- Stop after generation instead of asking the user to continue + Status : aliased Boolean := False; + -- Retrieve the status of PRs opened by the user + Tar : aliased Boolean := False; -- Start the assistant from a local folder to be tar'ed and uploaded end record; -- 2.39.5