From 87ca3c6f39a1eb1b2a4d2b90fca9eabd102831ff Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 12 May 2020 13:55:03 +0200 Subject: [PATCH] Show changes to dependencies/solutions in relevant commands (#397) * Show dependency changes in applicable commands By relying on the lockfile we can easily summarize changes to the user. There are no functional changes, except for some no-op updates that can now be omitted altogether instead of simply blindly redeploying the same exact dependencies. * Code review fixes --- src/alire/alire-dependencies.ads | 8 +++ src/alire/alire.ads | 6 +++ src/alr/alr-checkout.adb | 9 ++++ src/alr/alr-commands-build.adb | 20 ++++---- src/alr/alr-commands-build.ads | 3 +- src/alr/alr-commands-get.adb | 74 +++++++++++++++++++++------- src/alr/alr-commands-pin.adb | 22 +++++++-- src/alr/alr-commands-run.adb | 4 +- src/alr/alr-commands-update.adb | 41 +++++++++++++--- src/alr/alr-commands-update.ads | 5 +- src/alr/alr-commands-withing.adb | 84 ++++++++++++++++++++++++++------ 11 files changed, 221 insertions(+), 55 deletions(-) diff --git a/src/alire/alire-dependencies.ads b/src/alire/alire-dependencies.ads index 677ba642..b4deb1ed 100644 --- a/src/alire/alire-dependencies.ads +++ b/src/alire/alire-dependencies.ads @@ -1,4 +1,5 @@ with Alire.Interfaces; +with Alire.Milestones; with Alire.TOML_Adapters; with Alire.Utils; @@ -38,6 +39,9 @@ package Alire.Dependencies with Preelaborate is overriding function Key (Dep : Dependency) return String; + function From_Milestones (Allowed : Milestones.Allowed_Milestones) + return Dependency; + function From_TOML (Key : String; Value : TOML.TOML_Value) return Dependency with Pre => @@ -88,6 +92,10 @@ private return Semantic_Versioning.Extended.Version_Set is (Dep.Versions); + function From_Milestones (Allowed : Milestones.Allowed_Milestones) + return Dependency is + (New_Dependency (Allowed.Crate, Allowed.Versions)); + function Image (Dep : Dependency) return String is (if Dep = Unavailable then "Unavailable" diff --git a/src/alire/alire.ads b/src/alire/alire.ads index f2953509..c60abb57 100644 --- a/src/alire/alire.ads +++ b/src/alire/alire.ads @@ -204,6 +204,9 @@ package Alire with Preelaborate is -- * Debug: not shown by default, enabled with '-vv' switch, messages -- intended for developers or curious users, not user friendly. + function Detailed return Boolean; + -- True when Log_Level is Detail or Debug + Log_Debug : aliased Boolean := False; -- This one enables special debug output, irrespectively of the log level. @@ -228,4 +231,7 @@ private function Success (Result : Outcome) return Boolean is (Result.Success); + function Detailed return Boolean is + (Log_Level >= Detail); + end Alire; diff --git a/src/alr/alr-checkout.adb b/src/alr/alr-checkout.adb index e0f7a982..92000e28 100644 --- a/src/alr/alr-checkout.adb +++ b/src/alr/alr-checkout.adb @@ -6,6 +6,7 @@ with Alire.Containers; with Alire.Externals.Lists; with Alire.Lockfiles; with Alire.Origins.Deployers; +with Alire.Solutions; with Alire.Roots; with Alr.Actions; @@ -176,6 +177,14 @@ package body Alr.Checkout is -- current platform (this was also unimplemented in the old index) Templates.Generate_Prj_Alr (R.Whenever (Platform.Properties), Root.Crate_File); + + -- Create also an invalid solution lockfile (since dependencies + -- are still unretrieved). Once they are checked out, the lockfile + -- will be replaced with the complete solution. + Alire.Lockfiles.Write + (Solution => Alire.Solutions.Solution'(Valid => False), + Environment => Platform.Properties, + Filename => Root.Lock_File); end; end if; end Working_Copy; diff --git a/src/alr/alr-commands-build.adb b/src/alr/alr-commands-build.adb index 15100048..ccd147b9 100644 --- a/src/alr/alr-commands-build.adb +++ b/src/alr/alr-commands-build.adb @@ -15,7 +15,7 @@ package body Alr.Commands.Build is -- Do_Compile -- ---------------- - procedure Do_Compile is + function Do_Compile return Boolean is begin Requires_Full_Index; @@ -37,9 +37,7 @@ package body Alr.Commands.Build is exception when others => - Trace.Warning ("alr detected a compilation failure, " & - "re-run with -vv -d for details"); - raise; + return False; end; -- POST-COMPILE ACTIONS @@ -50,11 +48,13 @@ package body Alr.Commands.Build is when others => Trace.Warning ("A post-compile action failed, " & "re-run with -vv -d for details"); - raise; + return False; end; Trace.Detail ("Compilation finished successfully"); Trace.Detail ("Use alr run --list to check available executables"); + + return True; end Do_Compile; ------------- @@ -64,18 +64,16 @@ package body Alr.Commands.Build is overriding procedure Execute (Cmd : in out Command) is pragma Unreferenced (Cmd); begin - Do_Compile; + if not Do_Compile then + Reportaise_Command_Failed ("Compilation failed."); + end if; end Execute; ------------- -- Execute -- ------------- - procedure Execute is - Cmd : Command; - begin - Execute (Cmd); - end Execute; + function Execute return Boolean is (Do_Compile); ---------------------- -- Long_Description -- diff --git a/src/alr/alr-commands-build.ads b/src/alr/alr-commands-build.ads index 5e2577f5..3e95d8cc 100644 --- a/src/alr/alr-commands-build.ads +++ b/src/alr/alr-commands-build.ads @@ -5,7 +5,8 @@ package Alr.Commands.Build is overriding procedure Execute (Cmd : in out Command); - procedure Execute; + function Execute return Boolean; + -- Returns True if compilation succeeded overriding function Long_Description (Cmd : Command) diff --git a/src/alr/alr-commands-get.adb b/src/alr/alr-commands-get.adb index 7e9a5233..cc45ea1e 100644 --- a/src/alr/alr-commands-get.adb +++ b/src/alr/alr-commands-get.adb @@ -6,6 +6,7 @@ with Alire.Milestones; with Alire.Origins.Deployers; with Alire.Platform; with Alire.Platforms; +with Alire.Solutions.Diffs; with Alire.Solver; with Alr.Actions; @@ -36,23 +37,14 @@ package body Alr.Commands.Get is -- resolve the release as part of the dependencies at this point so if -- the latest release is not solvable we get another one that is. We -- should warn in that case that newer releases exist. - Rel : constant Alire.Index.Release := - Query.Find (Name, Versions, Query_Policy); - begin - if not Query.Is_Resolvable - (Rel.Dependencies.Evaluate (Platform.Properties), - Platform.Properties) - and then not Cmd.Only - then - Trace.Error ("Could not resolve dependencies for: " & - Query.Dependency_Image (Name, Versions)); - Trace.Error ("This may happen when requesting a release that" & - " requires system libraries, while using a GPL gnat"); - Trace.Error ("In that case, try again with the system" & - " FSF gnat compiler"); - raise Command_Failed; - end if; + Rel : constant Alire.Index.Release := + Query.Find (Name, Versions, Query_Policy); + + Diff : Alire.Solutions.Diffs.Diff; + -- Used to present dependencies to the user + Build_OK : Boolean; + begin declare R : constant Alire.Index.Release := Query.Find (Name, Versions, Query_Policy); @@ -80,11 +72,35 @@ package body Alr.Commands.Get is end; -- Check if we are already in the fresh copy + if Session_State > Outside then Reportaise_Command_Failed ("Cannot get a release inside another alr release, stopping."); end if; + -- Check that the dependencies can be solved before retrieving anything + + if not Cmd.Only then + declare + Solution : constant Alire.Solutions.Solution := + Query.Resolve + (Rel.Dependencies (Platform.Properties), + Platform.Properties); + begin + if Solution.Valid then + Diff := Alire.Solutions.Solution' + (Valid => True, + others => <>).Changes (Solution); + else + Trace.Error ("Could not resolve dependencies for: " & + Query.Dependency_Image (Name, Versions)); + Trace.Error ("You can still retrieve the crate without " + & "dependencies with --only."); + raise Command_Failed; + end if; + end; + end if; + -- Check out requested crate release under current directory, -- but delay its post-fetch: Checkout.Working_Copy (Rel, @@ -102,16 +118,38 @@ package body Alr.Commands.Get is Guard : Folder_Guard (Enter_Folder (Rel.Unique_Folder)) with Unreferenced; begin - Commands.Update.Execute; + Commands.Update.Execute (Interactive => False); -- Execute the checked out release post_fetch actions, now that -- dependencies are in place Actions.Execute_Actions (Rel, Alire.Actions.Post_Fetch); if Cmd.Build then - Commands.Build.Execute; + Build_OK := Commands.Build.Execute; end if; end; + + -- Final report + + Trace.Info (""); + + Trace.Log (Rel.Milestone.Image & " successfully retrieved" + & (if Cmd.Build + then (if Build_OK + then " and built." + else " but its build failed.") + else "."), + Level => (if not Cmd.Build or else Build_OK + then Info + else Warning)); + + if Diff.Contains_Changes then + Trace.Info ("Dependencies were solved as follows:"); + Diff.Print (Changed_Only => False); + else + Trace.Info ("There are no dependencies."); + end if; + exception when Alire.Query_Unsuccessful => Trace.Info ("Release [" & Query.Dependency_Image (Name, Versions) & diff --git a/src/alr/alr-commands-pin.adb b/src/alr/alr-commands-pin.adb index f8a19505..9c8bdcbf 100644 --- a/src/alr/alr-commands-pin.adb +++ b/src/alr/alr-commands-pin.adb @@ -1,7 +1,9 @@ with Alire.Releases; with Alire.Solver; +with Alire.Solutions.Diffs; with Alr.Commands.Update; +with Alr.Commands.User_Input; with Alr.Platform; with Alr.Root; with Alr.Templates; @@ -22,6 +24,7 @@ package body Alr.Commands.Pin is Requires_Valid_Session; declare + Old : constant Solver.Solution := Root.Current.Solution; Sol : constant Solver.Solution := Solver.Resolve (Root.Current.Release.Dependencies (Platform.Properties), @@ -29,16 +32,29 @@ package body Alr.Commands.Pin is Options => (Age => Query_Policy, Detecting => <>, Hinting => <>)); + Diff : constant Alire.Solutions.Diffs.Diff := Old.Changes (Sol); begin if Sol.Valid then + + -- Pinning not necessarily results in changes in the solution. No + -- need to bother the user with empty questions in that case. + + if Diff.Contains_Changes then + if not User_Input.Confirm_Solution_Changes + (Diff, + Changed_Only => not Alire.Detailed) + then + Trace.Detail ("Abandoning pinning."); + end if; + end if; + Templates.Generate_Prj_Alr (Root.Current.Release.Replacing (Dependencies => Sol.Releases.To_Dependencies)); - Update.Execute; + Update.Execute (Interactive => False); else - Trace.Error ("Could not resolve dependencies"); - raise Command_Failed; + Reportaise_Command_Failed ("Could not resolve dependencies"); end if; end; end Execute; diff --git a/src/alr/alr-commands-run.adb b/src/alr/alr-commands-run.adb index e0b4bb23..0fda6140 100644 --- a/src/alr/alr-commands-run.adb +++ b/src/alr/alr-commands-run.adb @@ -129,7 +129,9 @@ package body Alr.Commands.Run is -- COMPILATION -- if not Cmd.No_Compile then - Commands.Build.Execute; + if not Commands.Build.Execute then + Reportaise_Command_Failed ("Build failed"); + end if; end if; -- EXECUTION -- diff --git a/src/alr/alr-commands-update.adb b/src/alr/alr-commands-update.adb index de9cea5c..81845256 100644 --- a/src/alr/alr-commands-update.adb +++ b/src/alr/alr-commands-update.adb @@ -1,7 +1,9 @@ with Alire.Paths; +with Alire.Solutions.Diffs; with Alire.Solver; with Alr.Checkout; +with Alr.Commands.User_Input; with Alr.Platform; with Alr.Root; @@ -18,7 +20,7 @@ package body Alr.Commands.Update is -- Upgrade -- ------------- - procedure Upgrade is + procedure Upgrade (Interactive : Boolean) is -- The part concerning only to the working release begin Requires_Full_Index; @@ -26,6 +28,8 @@ package body Alr.Commands.Update is Requires_Valid_Session; declare + Old : constant Query.Solution := + Root.Current.Solution; Needed : constant Query.Solution := Query.Resolve (Root.Current.Release.Dependencies.Evaluate @@ -34,12 +38,37 @@ package body Alr.Commands.Update is Options => (Age => Query_Policy, Detecting => <>, Hinting => <>)); + Diff : constant Alire.Solutions.Diffs.Diff := + Old.Changes (Needed); begin if not Needed.Valid then - Reportaise_Command_Failed ("Update failed"); + Reportaise_Command_Failed + ("Could not solve dependencies, update failed"); end if; - -- Requires_Valid_Session ensures we are at the root working dir + -- Early exit when there are no changes + + if not Diff.Contains_Changes then + if Interactive then + Trace.Info ("Nothing to update."); + end if; + + return; + end if; + + -- Show changes and ask user to apply them + + if Interactive then + if not User_Input.Confirm_Solution_Changes + (Diff, + Changed_Only => not Alire.Detailed) + then + Trace.Detail ("Update abandoned."); + return; + end if; + end if; + + -- Apply the update Checkout.Dependencies (Root => Root.Current.Release.Name, Solution => Needed, @@ -56,17 +85,17 @@ package body Alr.Commands.Update is overriding procedure Execute (Cmd : in out Command) is pragma Unreferenced (Cmd); begin - Execute; + Execute (Interactive => True); end Execute; ------------- -- Execute -- ------------- - procedure Execute is + procedure Execute (Interactive : Boolean) is begin if Session_State > Outside then - Upgrade; + Upgrade (Interactive); else Trace.Detail ("No working release to update"); end if; diff --git a/src/alr/alr-commands-update.ads b/src/alr/alr-commands-update.ads index e5cf7648..f6b9b4c3 100644 --- a/src/alr/alr-commands-update.ads +++ b/src/alr/alr-commands-update.ads @@ -23,7 +23,10 @@ package Alr.Commands.Update is function Usage_Custom_Parameters (Cmd : Command) return String is (""); - procedure Execute; + procedure Execute (Interactive : Boolean); + -- Interactive serves to flag that the update is requested from somewhere + -- else within Alire, and is already confirmed by the user. So, when False, + -- not output of differences or confirmation will be presented. private diff --git a/src/alr/alr-commands-withing.adb b/src/alr/alr-commands-withing.adb index 8298da2d..7ee555eb 100644 --- a/src/alr/alr-commands-withing.adb +++ b/src/alr/alr-commands-withing.adb @@ -4,12 +4,15 @@ with Ada.Strings.Maps; with Ada.Text_IO; with Alire.Conditional; +with Alire.Dependencies.Diffs; with Alire.Milestones; with Alire.Roots; +with Alire.Solutions; with Alire.Solver; with Alire.Utils; with Alr.Commands.Update; +with Alr.Commands.User_Input; with Alr.Exceptions; with Alr.OS_Lib; with Alr.Platform; @@ -66,7 +69,7 @@ package body Alr.Commands.Withing is Reportaise_Command_Failed ("Adding " & New_Dep & " has no dependency solution"); else - Trace.Detail ("Dependency " & New_Dep & " successfully added"); + Trace.Detail ("Dependency " & New_Dep & " can be added"); end if; end return; end Add; @@ -82,7 +85,8 @@ package body Alr.Commands.Withing is use all type Alire.Conditional.Dependencies; use all type Semantic_Versioning.Extended.Version_Set; Requested : constant Alire.Milestones.Allowed_Milestones := - Alire.Milestones.Crate_Versions (Old_Dep); + Alire.Milestones.Crate_Versions (Old_Dep); + Found : Boolean := False; begin if Requested.Versions /= Semantic_Versioning.Extended.Any then Trace.Warning @@ -97,11 +101,20 @@ package body Alr.Commands.Withing is Filtered := Filtered and Alire.Conditional.New_Dependency (Dep.Value.Crate, Dep.Value.Versions); + else + -- Simply don't add the one we want to remove + Found := True; end if; end loop; else Trace.Warning ("Skipping unsupported conditional dependency"); end if; + + if not Found then + Trace.Warning + ("Crate slated for removal is not among direct dependencies: " + & (+Requested.Crate)); + end if; end return; end Del; @@ -109,21 +122,49 @@ package body Alr.Commands.Withing is -- Replace_Current -- --------------------- - procedure Replace_Current (Deps : Alire.Conditional.Dependencies) is + procedure Replace_Current (Old_Deps, + New_Deps : Alire.Conditional.Dependencies) + is begin + Requires_Full_Index; + -- Set, regenerate and update declare New_Root : constant Alire.Roots.Root := Alire.Roots.New_Root - (Root.Current.Release.Replacing (Dependencies => Deps), + (Root.Current.Release.Replacing (Dependencies => New_Deps), Root.Current.Path); + New_Solution : constant Alire.Solutions.Solution := + Alire.Solver.Resolve (New_Deps, + Platform.Properties); begin + + -- Show changes to apply + + Trace.Info ("Requested changes:"); + Trace.Info (""); + Alire.Dependencies.Diffs.Between (Old_Deps, New_Deps).Print; + + -- Show the effects on the solution + + if not User_Input.Confirm_Solution_Changes + (Root.Current.Solution.Changes (New_Solution), + Changed_Only => not Alire.Detailed) + then + Trace.Info ("No changes applied."); + return; + end if; + + -- Generate the new .toml file + Templates.Generate_Prj_Alr (New_Root.Release, New_Root.Crate_File); Trace.Detail ("Regeneration finished, updating now"); end; - Commands.Update.Execute; + -- And apply changes (will also generate new lockfile) + + Commands.Update.Execute (Interactive => False); end Replace_Current; --------- @@ -131,14 +172,18 @@ package body Alr.Commands.Withing is --------- procedure Add is - Deps : Alire.Conditional.Dependencies := - Root.Current.Release.Dependencies; + Old_Deps : constant Alire.Conditional.Dependencies := + Root.Current.Release.Dependencies; + New_Deps : Alire.Conditional.Dependencies := Old_Deps; + use type Alire.Conditional.Dependencies; begin for I in 1 .. Num_Arguments loop - Deps := Add (Deps, Argument (I)); + New_Deps := Add (New_Deps, Argument (I)); end loop; - Replace_Current (Deps); + if Old_Deps /= New_Deps then + Replace_Current (Old_Deps, New_Deps); + end if; end Add; --------- @@ -146,14 +191,20 @@ package body Alr.Commands.Withing is --------- procedure Del is - Deps : Alire.Conditional.Dependencies := - Root.Current.Release.Dependencies; + Old_Deps : constant Alire.Conditional.Dependencies := + Root.Current.Release.Dependencies; + New_Deps : Alire.Conditional.Dependencies := Old_Deps; + use type Alire.Conditional.Dependencies; begin for I in 1 .. Num_Arguments loop - Deps := Del (Deps, Argument (I)); + New_Deps := Del (New_Deps, Argument (I)); end loop; - Replace_Current (Deps); + if Old_Deps /= New_Deps then + Replace_Current (Old_Deps, New_Deps); + else + Trace.Warning ("There are no changes to apply."); + end if; end Del; ---------- @@ -243,7 +294,12 @@ package body Alr.Commands.Withing is Check_File (Argument (I)); end loop; - Replace_Current (Deps); + if not Deps.Is_Empty then + Replace_Current (Old_Deps => Alire.Conditional.No_Dependencies, + New_Deps => Deps); + else + Trace.Warning ("No dependencies found."); + end if; end From; ---------- -- 2.39.5