4267 Add --exact flag to the list command

This PR adds `--exact` flag to the cabal list command which
enables exact match on the package name while searching.

Cabal/Distribution/Simple/PackageIndex.hs

@@ -77,6 +77,7 @@ module Distribution.Simple.PackageIndex (
   searchByName,
   SearchResult(..),
   searchByNameSubstring,
+  searchByNameExact,
 
   -- ** Bulk queries
   allPackages,
@@ -526,16 +527,25 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a]
 -- That is, all packages that contain the given string in their name.
 --
 searchByNameSubstring :: PackageIndex a -> String -> [a]
-searchByNameSubstring index searchterm =
+searchByNameSubstring =
+  searchByNameInternal False
+
+searchByNameExact :: PackageIndex a -> String -> [a]
+searchByNameExact =
+  searchByNameInternal True
+
+searchByNameInternal :: Bool -> PackageIndex a -> String -> [a]
+searchByNameInternal exactMatch index searchterm =
   [ pkg
   -- Don't match internal packages
   | ((pname, LMainLibName), pvers) <- Map.toList (packageIdIndex index)
-  , lsearchterm `isInfixOf` lowercase (unPackageName pname)
+  , if exactMatch
+      then searchterm == unPackageName pname
+      else lsearchterm `isInfixOf` lowercase (unPackageName pname)
   , pkgs <- Map.elems pvers
   , pkg <- pkgs ]
   where lsearchterm = lowercase searchterm
 
-
 --
 -- * Special queries
 --

cabal-install/Distribution/Client/List.hs

@@ -112,12 +112,12 @@ getPkgList verbosity packageDBs repoCtxt comp progdb listFlags pats = do
           [(PackageName, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])]
         pkgsInfoMatching =
           let matchingInstalled = matchingPackages
-                                  InstalledPackageIndex.searchByNameSubstring
+                                  ipiSearch
                                   installedPkgIndex
               matchingSource   = matchingPackages
                                  (\ idx n ->
                                    concatMap snd
-                                   (PackageIndex.searchByNameSubstring idx n))
+                                   (piSearch idx n))
                                  sourcePkgIndex
           in mergePackages matchingInstalled matchingSource
 
@@ -131,6 +131,11 @@ getPkgList verbosity packageDBs repoCtxt comp progdb listFlags pats = do
     return matches
   where
     onlyInstalled = fromFlag (listInstalled listFlags)
+    exactMatch = fromFlag (listExactMatch listFlags)
+    ipiSearch | exactMatch = InstalledPackageIndex.searchByNameExact
+              | otherwise  = InstalledPackageIndex.searchByNameSubstring
+    piSearch  | exactMatch = PackageIndex.searchByNameExact
+              | otherwise  = PackageIndex.searchByNameSubstring
     matchingPackages search index =
       [ pkg
       | pat <- pats

cabal-install/Distribution/Client/Setup.hs

@@ -1623,6 +1623,7 @@ instance Semigroup GetFlags where
 data ListFlags = ListFlags {
     listInstalled    :: Flag Bool,
     listSimpleOutput :: Flag Bool,
+    listExactMatch   :: Flag Bool,
     listVerbosity    :: Flag Verbosity,
     listPackageDBs   :: [Maybe PackageDB]
   } deriving Generic
@@ -1631,6 +1632,7 @@ defaultListFlags :: ListFlags
 defaultListFlags = ListFlags {
     listInstalled    = Flag False,
     listSimpleOutput = Flag False,
+    listExactMatch   = Flag False,
     listVerbosity    = toFlag normal,
     listPackageDBs   = []
   }
@@ -1666,6 +1668,10 @@ listCommand = CommandUI {
             "Print in a easy-to-parse format"
             listSimpleOutput (\v flags -> flags { listSimpleOutput = v })
             trueArg
+        , option [] ["exact"]
+            "Print only exact match"
+            listExactMatch (\v flags -> flags { listExactMatch = v })
+            trueArg
 
         , option "" ["package-db"]
           (   "Append the given package database to the list of package"

cabal-install/Distribution/Solver/Types/PackageIndex.hs

@@ -39,6 +39,7 @@ module Distribution.Solver.Types.PackageIndex (
   searchByName,
   SearchResult(..),
   searchByNameSubstring,
+  searchByNameExact,
 
   -- ** Bulk queries
   allPackages,
@@ -312,9 +313,23 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a]
 --
 searchByNameSubstring :: PackageIndex pkg
                       -> String -> [(PackageName, [pkg])]
-searchByNameSubstring (PackageIndex m) searchterm =
+searchByNameSubstring =
+  searchByNameInternal False
+
+searchByNameExact :: PackageIndex pkg
+                  -> String -> [(PackageName, [pkg])]
+searchByNameExact =
+  searchByNameInternal True
+
+searchByNameInternal :: Bool
+                     -> PackageIndex pkg
+                     -> String -> [(PackageName, [pkg])]
+searchByNameInternal exactMatch (PackageIndex m) searchterm =
     [ pkgs
     | pkgs@(pname, _) <- Map.toList m
-    , lsearchterm `isInfixOf` lowercase (unPackageName pname) ]
+    , if exactMatch
+        then searchterm `isInfixOf` unPackageName pname
+        else lsearchterm `isInfixOf` lowercase (unPackageName pname)
+    ]
   where
     lsearchterm = lowercase searchterm

cabal-install/changelog

@@ -1,6 +1,8 @@
 -*-change-log-*-
 
 3.2.0.0 Someone <mailto:[email protected]> February 2020
+	* Add `--exact` flag to `cabal list` command that enables exact match on the
+	  search package name (#4267)
 	* `v2-build` (and other `v2-`prefixed commands) now accept the
 	  `--benchmark-option(s)` flags, which pass options to benchmark executables
 	  (analogous to how `--test-option(s)` works). (#6209)

solver-benchmarks/HackageBenchmark.hs

@@ -164,7 +164,7 @@ hackageBenchmarkMain = do
           if null argPackages
           then do
             putStrLn $ "Obtaining the package list (using " ++ argCabal1 ++ ") ..."
-            list <- readProcess argCabal1 ["list", "--simple-output"] ""
+            list <- readProcess argCabal1 ["list", "--simple-output", "--exact"] ""
             return $ nub [mkPackageName $ head (words line) | line <- lines list]
           else do
             putStrLn "Using given package list ..."