From 3b8458015da41fa9985f59f4d16184dcfd9e9b8d Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Mon, 26 Mar 2018 20:06:40 +0200 Subject: [PATCH] Basic support for external actions --- index/alire-index-whitakers_words.ads | 11 +++- index/native/alire-index-make.ads | 11 ++++ index/native/alire-index-native_template.ads | 2 +- src/alire-actions.adb | 12 ++++ src/alire-actions.ads | 64 ++++++++++++++++++++ src/alire-index.adb | 21 ------- src/alire-index.ads | 23 +++---- src/alire-releases.adb | 24 +++++++- src/alire-releases.ads | 13 +++- src/alire-utils.adb | 19 ++++++ src/alire-utils.ads | 2 + src/alire.ads | 5 ++ 12 files changed, 168 insertions(+), 39 deletions(-) create mode 100644 index/native/alire-index-make.ads create mode 100644 src/alire-actions.adb create mode 100644 src/alire-actions.ads diff --git a/index/alire-index-whitakers_words.ads b/index/alire-index-whitakers_words.ads index df900d5d..b4d8b7a3 100644 --- a/index/alire-index-whitakers_words.ads +++ b/index/alire-index-whitakers_words.ads @@ -1,3 +1,5 @@ +with Alire.Index.Make; + package Alire.Index.Whitakers_Words is function Project is new Catalogued_Project ("whitakers_words", @@ -12,6 +14,9 @@ package Alire.Index.Whitakers_Words is Project.Register (V ("2017.09.10"), Git (Prj_Repo, "27be95b8a06d7b22c0600c824cf929ab43efcf25"), + Dependencies => + Make.Project.Current, + Properties => Project_File ("words.gpr") and @@ -20,10 +25,10 @@ package Alire.Index.Whitakers_Words is Author (Prj_Author) and Maintainer (Prj_Maintainer) and Website (Prj_Website) and - License (Public_Domain) and + License (Public_Domain), - Comment ("This package builds the binary but additional steps are needed") and - Comment ("See the README file for further instructions"), + Private_Properties => + Action_Run (Post_Compile, "make"), Available_When => Compiler > GNAT_FSF_7_2 -- bug with SAL library failing binding diff --git a/index/native/alire-index-make.ads b/index/native/alire-index-make.ads new file mode 100644 index 00000000..f1585405 --- /dev/null +++ b/index/native/alire-index-make.ads @@ -0,0 +1,11 @@ +package Alire.Index.Make is + + function Project is new Catalogued_Project ("make", + "Utility for directing compilation"); + + V_Native : constant Release := + Project.Register (V ("0"), + Native ((Debian | Ubuntu => Packaged_As ("make"), + others => Unavailable))); + +end Alire.Index.Make; diff --git a/index/native/alire-index-native_template.ads b/index/native/alire-index-native_template.ads index 39fe838c..e9db8d23 100644 --- a/index/native/alire-index-native_template.ads +++ b/index/native/alire-index-native_template.ads @@ -1,6 +1,6 @@ package Alire.Index.Native_Template is --- function Project is new Catalogued_Project (Projects.Name); +-- function Project is new Catalogued_Project ("name", "description"); -- V : constant Release := -- Project.Register (V (""), diff --git a/src/alire-actions.adb b/src/alire-actions.adb new file mode 100644 index 00000000..3595894b --- /dev/null +++ b/src/alire-actions.adb @@ -0,0 +1,12 @@ +package body Alire.Actions is + + ------------- + -- Execute -- + ------------- + + procedure Execute (This : Action; Implementer : access procedure (This : Action'Class)) is + begin + Implementer (This); + end Execute; + +end Alire.Actions; diff --git a/src/alire-actions.ads b/src/alire-actions.ads new file mode 100644 index 00000000..f2862af2 --- /dev/null +++ b/src/alire-actions.ads @@ -0,0 +1,64 @@ +with Alire.Properties; +with Alire.Utils; + +package Alire.Actions with Preelaborate is + + type Moments is ( + Post_Fetch, -- After being downloaded + Post_Compile -- After being compiled as the main project + ); + + -- It's probable that there'll be a need to pre-compile every dependency after being downloaded, + -- and then we will have the possibility of having another moment post THAT compilation + -- But that compilation may depend on configuration set by the main project... -_-' + -- We'll cross that bridge once it proves necessary + + type Action (<>) is abstract new Properties.Property with private; + + function Moment (This : Action) return Moments; + + procedure Execute (This : Action; Implementer : access procedure (This : Action'Class)); + + + type Run (<>) is new Action with private; + -- Encapsulates the execution of an external command + + function New_Run (Moment : Moments; + Relative_Command_Line : Platform_Independent_Path; + Working_Folder : Platform_Independent_Path) return Run; + -- Working folder will be entered for execution + -- Relative command-line must consider being in working folder + + function Command_Line (This : Run) return String; + function Working_Folder (This : Run) return String; + +private + + type Action (Moment : Moments) is abstract new Properties.Property with null record; + + function Moment (This : Action) return Moments is (This.Moment); + + type Run (Moment : Moments; Cmd_Len, Folder_Len : Natural) is new Action (Moment) with record + Relative_Command_Line : Platform_Independent_Path (1 .. Cmd_Len); + Working_Folder : Platform_Independent_Path (1 .. Folder_Len); + end record; + + overriding function Image (This : Run) return String is + (Utils.To_Mixed_Case (This.Moment'Img) & " run: " & + (if This.Working_Folder /= "" then "/" else "") & + This.Working_Folder & "/" & This.Relative_Command_Line); + + function New_Run (Moment : Moments; + Relative_Command_Line : Platform_Independent_Path; + Working_Folder : Platform_Independent_Path) return Run is + (Moment, + Relative_Command_Line'Length, + Working_Folder'Length, + Utils.To_Native (Relative_Command_Line), + Utils.To_Native (Working_Folder)); + + function Command_Line (This : Run) return String is (This.Relative_Command_Line); + + function Working_Folder (This : Run) return String is (This.Working_Folder); + +end Alire.Actions; diff --git a/src/alire-index.adb b/src/alire-index.adb index 32607e96..f66f2b00 100644 --- a/src/alire-index.adb +++ b/src/alire-index.adb @@ -1,10 +1,7 @@ with Ada.Containers.Indefinite_Ordered_Maps; -with Ada.Strings.Maps; with Alire.Projects; -with Gnat.OS_Lib; - package body Alire.Index is use all type Version; @@ -217,22 +214,4 @@ package body Alire.Index is Available => Available_When); end Bypass; - --------------- - -- To_Native -- - --------------- - - Dir_Seps : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("/\"); - - function To_Native (Path : Platform_Independent_Path) return String is - use Ada.Strings.Maps; - begin - return Native : String := Path do - for I in Native'Range loop - if Is_In (Path (I), Dir_Seps) then - Native (I) := GNAT.OS_Lib.Directory_Separator; - end if; - end loop; - end return; - end To_Native; - end Alire.Index; diff --git a/src/alire-index.ads b/src/alire-index.ads index 1377f198..8ded9eab 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -1,5 +1,6 @@ private with Alire_Early_Elaboration; pragma Unreferenced (Alire_Early_Elaboration); +with Alire.Actions; with Alire.Conditional; with Alire.Containers; with Alire.Dependencies.Vectors; @@ -120,14 +121,7 @@ package Alire.Index is Private_Properties : Release_Properties := No_Properties; Available_When : Release_Requisites := No_Requisites) return Release; - -- Does nothing: used for some examples and available to quickly retire a release (!) - - subtype Platform_Independent_Path is String with Dynamic_Predicate => - (for all C of Platform_Independent_Path => C /= '\'); - -- This type is used to ensure that folder separators are externally always '/', - -- and internally properly converted to the platform one - - function To_Native (Path : Platform_Independent_Path) return String; + -- Does nothing: used for some examples and available to quickly retire a release (!) --------------------- -- BASIC QUERIES -- @@ -227,6 +221,7 @@ package Alire.Index is -- Properties -- ------------------ + use all type Actions.Moments; use all type Alire.Dependencies.Vectors.Vector; use all type GPR.Value; use all type GPR.Value_Vector; @@ -257,10 +252,11 @@ package Alire.Index is function Maintainer is new PL.Cond_New_Label (Properties.Labeled.Maintainer); function Website is new PL.Cond_New_Label (Properties.Labeled.Website); - function U (Prop : Properties.Vector) return Conditional.Properties - renames Conditional.For_Properties.New_Value; + function U (Prop : Properties.Vector) return Conditional.Properties renames Conditional.For_Properties.New_Value; + function U (Prop : Properties.Property'Class) return Conditional.Properties is (U (+Prop)); -- Non-label attributes or processed data require a custom builder function + function GPR_Free_Scenario (Name : String) return Properties.Vector is (+Properties.Scenarios.New_Property (GPR.Free_Variable (Name))); function GPR_Free_Scenario (Name : String) return Conditional.Properties is (U (GPR_Free_Scenario (Name))); @@ -281,6 +277,11 @@ package Alire.Index is ------------------------ -- Those instruct alr on how to build, but are not the main concern of the project user + function Action_Run (Moment : Actions.Moments; + Relative_Command : Platform_Independent_Path; + Working_Folder : Platform_Independent_Path := "") return Release_Properties is + (U (Actions.New_Run (Moment, Relative_Command, Working_Folder))); + function GPR_External (Name : String; Value : String) return Conditional.Properties is (U (+Properties.Scenarios.New_Property (GPR.External_Value (Name, Value)))); @@ -370,7 +371,7 @@ private function Project_File_Unsafe is new PL.Cond_New_Label (Properties.Labeled.Project_File); function Project_File (File : Platform_Independent_Path) return Release_Properties is - (Project_File_Unsafe (To_Native (File))); + (Project_File_Unsafe (Utils.To_Native (File))); function Unavailable return Conditional.Dependencies is (Conditional.For_Dependencies.New_Value -- A conditional (without condition) dependency vector diff --git a/src/alire-releases.adb b/src/alire-releases.adb index a543af88..49a35617 100644 --- a/src/alire-releases.adb +++ b/src/alire-releases.adb @@ -125,8 +125,28 @@ package body Alire.Releases is -- On_Platform_Properties -- ---------------------------- - function On_Platform_Properties (R : Release; P : Properties.Vector) return Properties.Vector is - (R.Properties.Evaluate (P) and R.Priv_Props.Evaluate (P)); + function On_Platform_Properties (R : Release; + P : Properties.Vector; + Descendant_Of : Ada.Tags.Tag := Ada.Tags.No_Tag) return Properties.Vector + is + use Ada.Tags; + begin + if Descendant_Of = No_Tag then + return R.Properties.Evaluate (P) and R.Priv_Props.Evaluate (P); + else + declare + Props : constant Properties.Vector := R.On_Platform_Properties (P); + begin + return Result : Properties.Vector do + for P of Props loop + if Is_Descendant_At_Same_Level (P'Tag, Descendant_Of) then + Result.Append (P); + end if; + end loop; + end return; + end; + end if; + end On_Platform_Properties; ------------ -- Values -- diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 8f76e537..a477e2c9 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -1,3 +1,6 @@ +with Ada.Tags; + +with Alire.Actions; with Alire.Conditional; with Alire.Dependencies; with Alire.Milestones; @@ -95,8 +98,13 @@ package Alire.Releases with Preelaborate is -- NOTE: property retrieval functions do not distinguish between public/private, since that's -- merely informative for the users + + function On_Platform_Actions (R : Release; P : Properties.Vector) return Properties.Vector; + -- Get only Action properties for the platform - function On_Platform_Properties (R : Release; P : Properties.Vector) return Properties.Vector; + function On_Platform_Properties (R : Release; + P : Properties.Vector; + Descendant_Of : Ada.Tags.Tag := Ada.Tags.No_Tag) return Properties.Vector; -- Return properties that apply to R under platform properties P function Labeled_Properties (R : Release; P : Properties.Vector; Label : Properties.Labeled.Labels) @@ -192,5 +200,8 @@ private when Git | Hg => (if R.Origin.Commit'Length <= 8 then R.Origin.Commit else R.Origin.Commit (R.Origin.Commit'First .. R.Origin.Commit'First + 7)))); + + function On_Platform_Actions (R : Release; P : Properties.Vector) return Properties.Vector is + (R.On_Platform_Properties (P, Actions.Action'Tag)); end Alire.Releases; diff --git a/src/alire-utils.adb b/src/alire-utils.adb index b3d419ed..7deee4d9 100644 --- a/src/alire-utils.adb +++ b/src/alire-utils.adb @@ -1,6 +1,8 @@ with Ada.Strings.Fixed; +with Ada.Strings.Maps; with GNAT.Case_Util; +with GNAT.OS_Lib; package body Alire.Utils is @@ -116,4 +118,21 @@ package body Alire.Utils is end if; end Image_One_Line; + --------------- + -- To_Native -- + --------------- + + function To_Native (Path : Platform_Independent_Path) return String is + Dir_Seps : constant Ada.Strings.Maps.Character_Set := Ada.Strings.Maps.To_Set ("/\"); + use Ada.Strings.Maps; + begin + return Native : String := Path do + for I in Native'Range loop + if Is_In (Path (I), Dir_Seps) then + Native (I) := GNAT.OS_Lib.Directory_Separator; + end if; + end loop; + end return; + end To_Native; + end Alire.Utils; diff --git a/src/alire-utils.ads b/src/alire-utils.ads index 68f480c6..1ce41f28 100644 --- a/src/alire-utils.ads +++ b/src/alire-utils.ads @@ -18,6 +18,8 @@ package Alire.Utils with Preelaborate is function Replace (Text : String; Match : String; Subst : String) return String; + function To_Native (Path : Platform_Independent_Path) return String; + generic with package Vectors is new Ada.Containers.Indefinite_Vectors (<>); type Vector is new Vectors.Vector with private; diff --git a/src/alire.ads b/src/alire.ads index 408fd681..0724198b 100644 --- a/src/alire.ads +++ b/src/alire.ads @@ -33,6 +33,11 @@ package Alire with Preelaborate is (for all C of Folder_String => C in 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | Extension_Separator); -- Used for cross-platform folder names + subtype Platform_Independent_Path is String with Dynamic_Predicate => + (for all C of Platform_Independent_Path => C /= '\'); + -- This type is used to ensure that folder separators are externally always '/', + -- and internally properly converted to the platform one + --------------- -- LOGGING -- ---------------