Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Alr.Commands.Search: change default behavior to include properties #1575

Merged
merged 2 commits into from
Feb 23, 2024
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
36 changes: 36 additions & 0 deletions src/alire/alire-releases.adb
Original file line number Diff line number Diff line change
Expand Up @@ -919,6 +919,42 @@ package body Alire.Releases is
return False;
end Property_Contains;

-----------------------
-- Property_Contains --
-----------------------

function Property_Contains (R : Release; Str : String)
return AAA.Strings.Vector
is
Results : AAA.Strings.Vector;
use AAA.Strings;

Search : constant String := To_Lower_Case (Str);
begin
for P of Conditional.Enumerate (R.Properties) loop
declare
Image : constant String := P.Image;
begin
if Contains (Image, ":") then
declare
Prop : constant String := Head (Image, ':');
Value : constant String := Trim (Tail (Image, ':'));
begin
if Contains (To_Lower_Case (Value), Search) then
Results.Append (Prop);
end if;
end;
else
if Contains (To_Lower_Case (Image), Search) then
Results.Append (Image);
end if;
end if;
end;
end loop;

return Results;
end Property_Contains;

-------------------
-- From_Manifest --
-------------------
Expand Down
5 changes: 5 additions & 0 deletions src/alire/alire-releases.ads
Original file line number Diff line number Diff line change
Expand Up @@ -308,6 +308,11 @@ package Alire.Releases is
function Property_Contains (R : Release; Str : String) return Boolean;
-- True if some property contains the given string

function Property_Contains (R : Release; Str : String)
return AAA.Strings.Vector;
-- Return a vector with the names of propreties that contain the given
Fabien-Chouteau marked this conversation as resolved.
Show resolved Hide resolved
-- string.

function Satisfies (R : Release;
Dep : Alire.Dependencies.Dependency'Class)
return Boolean;
Expand Down
203 changes: 117 additions & 86 deletions src/alr/alr-commands-search.adb
Original file line number Diff line number Diff line change
Expand Up @@ -32,54 +32,96 @@ package body Alr.Commands.Search is
Flag_Unsolv : constant String := TTY.Error ("X");
Flag_External : constant String := TTY.Warn ("E");

------------------
-- List_Release --
------------------
-------------------
-- Print_Release --
-------------------

procedure List_Release (R : Alire.Releases.Release) is
procedure Print_Release (R : Alire.Releases.Release;
Match_Locations : AAA.Strings.Vector)
is
package Solver renames Alire.Solver;

begin
Trace.Debug ("Listing release: " & R.Milestone.TTY_Image);
if (Cmd.Prop.all = ""
or else
R.Property_Contains (Cmd.Prop.all)
or else
AAA.Strings.Contains (R.Notes, Cmd.Prop.all)
or else
AAA.Strings.Contains (R.Description,
Cmd.Prop.all))
and then
(Cmd.External or else not R.Origin.Is_System)
then
Found := Found + 1;
Tab.New_Row;
Tab.Append (Alire.Utils.TTY.Name (+R.Name));
Tab.Append
((if R.Origin.Is_System then Flag_System else " ") &
(if R.Is_Available (Platform.Properties)
then " " else Flag_Unav) &
(if R.Origin.Is_System then " " else
(if Solver.Is_Resolvable
(R.Dependencies (Platform.Properties),
Platform.Properties,
Alire.Solutions.Empty_Valid_Solution,
Options => (Age => Query_Policy,
On_Timeout => Solver.Stop,
others => <>))
then " "
else Flag_Unsolv)));
Tab.Append (TTY.Version (Semantic_Versioning.Image (R.Version)));
Tab.Append (TTY.Description (R.Description));
Tab.Append (R.Notes);
Found := Found + 1;
Tab.New_Row;
Tab.Append (Alire.Utils.TTY.Name (+R.Name));
Tab.Append
((if R.Origin.Is_System then Flag_System else " ") &
(if R.Is_Available (Platform.Properties)
then " " else Flag_Unav) &
(if R.Origin.Is_System then " " else
(if Solver.Is_Resolvable
(R.Dependencies (Platform.Properties),
Platform.Properties,
Alire.Solutions.Empty_Valid_Solution,
Options => (Age => Query_Policy,
On_Timeout => Solver.Stop,
others => <>))
then " "
else Flag_Unsolv)));
Tab.Append (TTY.Version (Semantic_Versioning.Image (R.Version)));
Tab.Append (TTY.Description (R.Description));
Tab.Append (R.Notes);
Tab.Append (Match_Locations.Flatten (", "));
end Print_Release;

-----------------
-- Match_Crate --
-----------------

function Match_Crate (Crate : Alire.Crates.Crate;
Pattern : String)
return AAA.Strings.Vector
is
Match_Locations : AAA.Strings.Vector;
begin
if AAA.Strings.Contains (+Crate.Name, Pattern) then
Match_Locations.Append ("Name");
end if;
end List_Release;

---------------------
-- List_Undetected --
---------------------
if AAA.Strings.Contains (Crate.Description, Pattern) then
Match_Locations.Append ("Description");
end if;
return Match_Locations;
end Match_Crate;

--------------------
-- Filter_Release --
--------------------

procedure List_Undetected (Name : Alire.Crate_Name;
Ext : Alire.Externals.External'Class) is
procedure Filter_Release (R : Alire.Releases.Release;
Pattern : String)
is
begin
Trace.Debug ("Listing release: " & R.Milestone.TTY_Image);

if Pattern = "" then
-- Empty pattern means include everything
Print_Release (R, Match_Locations => AAA.Strings.Empty_Vector);
else
declare
Match_Locations : constant AAA.Strings.Vector
:= R.Property_Contains (Pattern);
begin
if not Match_Locations.Is_Empty
and then
(Cmd.External or else not R.Origin.Is_System)
then
Print_Release (R, Match_Locations);
end if;
end;
end if;
end Filter_Release;

--------------------
-- Print_External --
--------------------

procedure Print_External (Name : Alire.Crate_Name;
Ext : Alire.Externals.External'Class;
Match_Locations : AAA.Strings.Vector)
is
begin
Found := Found + 1;
Tab.New_Row;
Expand All @@ -90,7 +132,8 @@ package body Alr.Commands.Search is
Tab.Append ("external");
Tab.Append (Alire.Index.Crate (Name).TTY_Description);
Tab.Append (Ext.Image);
end List_Undetected;
Tab.Append (Match_Locations.Flatten (", "));
Fabien-Chouteau marked this conversation as resolved.
Show resolved Hide resolved
end Print_External;

begin

Expand All @@ -103,7 +146,7 @@ package body Alr.Commands.Search is
-- Search into crates

if Alire.Utils.Count_True
((Cmd.Detect, Cmd.External, Cmd.Full, Cmd.Prop.all /= "")) > 0
((Cmd.Detect, Cmd.External, Cmd.Full)) > 0
then
Reportaise_Wrong_Arguments
("Extra switches are incompatible with --crates");
Expand Down Expand Up @@ -133,16 +176,14 @@ package body Alr.Commands.Search is
if Args.Count = 0
and then
not Cmd.List
and then
Cmd.Prop.all = ""
then
-- no search term, nor --list, nor --prop
-- no search term, nor --list
Reportaise_Wrong_Arguments
("Please provide a search term, --property, or use" &
("Please provide a search term, or use" &
" --list to show all available releases");
end if;

if Args.Count = 0 and then Cmd.Prop.all /= "" then
if Args.Count = 0 then
Cmd.List := True;
end if;

Expand All @@ -158,6 +199,7 @@ package body Alr.Commands.Search is
Tab.Append (TTY.Bold ("VERSION"));
Tab.Append (TTY.Bold ("DESCRIPTION"));
Tab.Append (TTY.Bold ("NOTES"));
Tab.Append (TTY.Bold ("MATCHES"));

declare
Busy : Simple_Logging.Ongoing :=
Expand All @@ -167,20 +209,20 @@ package body Alr.Commands.Search is
-- List_All_Or_Latest --
------------------------

procedure List_All_Or_Latest
(Crate : Alire.Crates.Crate)
procedure List_All_Or_Latest (Crate : Alire.Crates.Crate;
Pattern : String)
is
Progress : Trace.Ongoing :=
Trace.Activity (Crate.Name.Index_Prefix)
with Unreferenced;
begin
if Cmd.Full then
for Release of reverse Crate.Releases loop
List_Release (Release);
Filter_Release (Release, Pattern);
Busy.Step;
end loop;
elsif not Crate.Releases.Is_Empty then
List_Release (Crate.Releases.Last_Element);
Filter_Release (Crate.Releases.Last_Element, Pattern);
Busy.Step;
end if;
end List_All_Or_Latest;
Expand All @@ -189,20 +231,28 @@ package body Alr.Commands.Search is
-- List_Externals --
--------------------

procedure List_Externals (Crate : Alire.Crates.Crate)
procedure List_Externals (Crate : Alire.Crates.Crate;
Pattern : String)
is
Progress : Trace.Ongoing :=
Trace.Activity (Crate.Name.Index_Prefix)
with Unreferenced;
with Unreferenced;

Match_Locations : constant AAA.Strings.Vector :=
Match_Crate (Crate, Pattern);
begin
if Cmd.External then
if Cmd.External
and then
(Pattern = "" or else not Match_Locations.Is_Empty)
then
-- We must show only externals that have failed detection
-- (otherwise they'll appear as normal releases with --detect).
for External of Crate.Externals loop
if not Cmd.Detect or else
External.Detect (Crate.Name).Is_Empty
if not Cmd.Detect
or else
External.Detect (Crate.Name).Is_Empty
then
List_Undetected (Crate.Name, External);
Print_External (Crate.Name, External, Match_Locations);
end if;
end loop;
end if;
Expand All @@ -212,14 +262,16 @@ package body Alr.Commands.Search is
-- List_Crate --
----------------

procedure List_Crate (Crate : Alire.Crates.Crate) is
procedure List_Crate (Crate : Alire.Crates.Crate;
Pattern : String)
is
begin
if Cmd.Detect then
Alire.Index.Detect_Externals (Crate.Name, Platform.Properties);
end if;

List_All_Or_Latest (Crate);
List_Externals (Crate);
List_All_Or_Latest (Crate, Pattern);
List_Externals (Crate, Pattern);
Busy.Step;
end List_Crate;

Expand All @@ -244,25 +296,10 @@ package body Alr.Commands.Search is

Crate : Alire.Crates.Crate renames Element (I);
Pattern : constant String := (if Cmd.List
then ""
then "" -- No filtering
else To_Lower_Case (Args (1)));
begin
if Cmd.List then

-- List all releases
List_Crate (Crate);

else

-- Search into release names and descriptions
if Contains (To_Lower_Case (+Crate.Name), Pattern)
or else
Contains (To_Lower_Case (Crate.Description), Pattern)
then
List_Crate (Crate);
end if;

end if;
List_Crate (Crate, Pattern);
end;

Next (I);
Expand All @@ -285,8 +322,8 @@ package body Alr.Commands.Search is
return AAA.Strings.Vector
is
(AAA.Strings.Empty_Vector
.Append ("Searches the given substring in crate names (or properties"
& " with --property), and shows the most recent release"
.Append ("Searches the given substring in crate names and properties,"
& " and shows the most recent release"
& " of matching crates (unless --full is specified).")
.New_Line
.Append ("Use --crates to get a simple list of only crate names and "
Expand Down Expand Up @@ -346,12 +383,6 @@ package body Alr.Commands.Search is
Cmd.External'Access,
"", "--external",
"Include externally-provided releases in search");

Define_Switch (Config,
Cmd.Prop'Access,
"", "--property=",
"Search TEXT in property values",
Argument => "TEXT");
end Setup_Switches;

end Alr.Commands.Search;
3 changes: 0 additions & 3 deletions src/alr/alr-commands-search.ads
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
with AAA.Strings;

private with GNAT.Strings;

package Alr.Commands.Search is

type Command is new Commands.Command with private;
Expand Down Expand Up @@ -38,7 +36,6 @@ private
Full : aliased Boolean := False;
List : aliased Boolean := False;
External : aliased Boolean := False;
Prop : aliased GNAT.Strings.String_Access;
end record;

end Alr.Commands.Search;
Loading
Loading