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

…1575)

* Alr.Commands.Search: change default behavior to include properties

This patch comes from a comment of a user looking for gnatpp in Alire.
gnatpp is part of the libabalang_tools crate and a 1.x `alr search gnatpp`
returns nothing. The reason that by default only the release name and
descriptions are searched. This is quite a bad user interaction.

Here we change the default behavior to search in all properties of a
release, including tags, executables, website, etc.

We also display the list of properties that match the pattern.

Searching in names and descriptions only is still possible with the
--crates switch.

* Alr.Commands.Search: use a set rather than a vector for matching props

src/alire/alire-releases.adb

@@ -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.Set
+   is
+      Results : AAA.Strings.Set;
+      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.Include (Prop);
+                  end if;
+               end;
+            else
+               if Contains (To_Lower_Case (Image), Search) then
+                  Results.Include (Image);
+               end if;
+            end if;
+         end;
+      end loop;
+
+      return Results;
+   end Property_Contains;
+
    -------------------
    -- From_Manifest --
    -------------------

src/alire/alire-releases.ads

@@ -308,6 +308,10 @@ 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.Set;
+   --  Return a set with the names of properties that contain the given string
+
    function Satisfies (R   : Release;
                        Dep : Alire.Dependencies.Dependency'Class)
                        return Boolean;

src/alr/alr-commands-search.adb

@@ -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.Set)
+      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.To_Vector.Flatten (", "));
+      end Print_Release;
+
+      -----------------
+      -- Match_Crate --
+      -----------------
+
+      function Match_Crate (Crate   : Alire.Crates.Crate;
+                            Pattern : String)
+                            return AAA.Strings.Set
+      is
+         Match_Locations : AAA.Strings.Set;
+      begin
+         if AAA.Strings.Contains (+Crate.Name, Pattern) then
+            Match_Locations.Include ("Name");
          end if;
-      end List_Release;
 
-      ---------------------
-      -- List_Undetected --
-      ---------------------
+         if AAA.Strings.Contains (Crate.Description, Pattern) then
+            Match_Locations.Include ("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_Set);
+         else
+            declare
+               Match_Locations : constant AAA.Strings.Set
+                 := 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.Set)
+      is
       begin
          Found := Found + 1;
          Tab.New_Row;
@@ -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.To_Vector.Flatten (", "));
+      end Print_External;
 
    begin
 
@@ -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");
@@ -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;
 
@@ -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 :=
@@ -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;
@@ -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.Set :=
+              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;
@@ -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;
 
@@ -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);
@@ -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 "
@@ -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;

src/alr/alr-commands-search.ads

@@ -1,7 +1,5 @@
 with AAA.Strings;
 
-private with GNAT.Strings;
-
 package Alr.Commands.Search is
 
    type Command is new Commands.Command with private;
@@ -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;

testsuite/fixtures/basic_index/li/libhello/libhello-1.0.0.toml

@@ -3,7 +3,9 @@ name = "libhello"
 version = "1.0.0"
 maintainers = ["[email protected]"]
 maintainers-logins = ["mylogin"]
-tags = ["libhello-tag1"]
+
+# for an `alr search` test we need multiple tags that match the same pattern
+tags = ["libhello-tag1", "libhello-tag2"]
 
 [configuration.variables]
 Var1={type="Boolean", default=true}