Merge pull request #6681 from phadej/pr-6618

4267 Add --exact flag to the list command
haskell · Apr 9, 2020 · 244f4aa · 244f4aa
2 parents 30da456 + 7168a78
commit 244f4aa
Show file tree

Hide file tree

Showing 5 changed files with 47 additions and 7 deletions.
diff --git a/Cabal/Distribution/Simple/PackageIndex.hs b/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
 --

diff --git a/cabal-install/Distribution/Client/List.hs b/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

diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
@@ -1624,6 +1624,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
@@ -1632,6 +1633,7 @@ defaultListFlags :: ListFlags
 defaultListFlags = ListFlags {
     listInstalled    = Flag False,
     listSimpleOutput = Flag False,
+    listExactMatch   = Flag False,
     listVerbosity    = toFlag normal,
     listPackageDBs   = []
   }
@@ -1667,6 +1669,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"

diff --git a/cabal-install/Distribution/Solver/Types/PackageIndex.hs b/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 == unPackageName pname
+        else lsearchterm `isInfixOf` lowercase (unPackageName pname)
+    ]
   where
     lsearchterm = lowercase searchterm
diff --git a/changelog.d/issue-4267 b/changelog.d/issue-4267
@@ -0,0 +1,4 @@
+synopsis: Add --exact flag to the list command
+packages: cabal-install
+prs: #6618
+issues: #4267