Commit 6a01fb14 authored by Oleg Grenrus's avatar Oleg Grenrus

Resolve #6683: Make cabal list patterns be regular expressions (regex-posix)

To get exact match you can

    % cabal list ^QuickCheck$ -I
    * QuickCheck
        Synopsis: Automatic testing of Haskell programs
    ...

But not the prefix/suffix/regexp matching is in your power for
searching. e.g.

    % cabal list ^Cabal
    * Cabal
        Synopsis: A framework for packaging Haskell software
    ...
    * cabal-install
        Synopsis: The command-line interface for Cabal and Hackage.
    ...
    and many others
parent 636aa6dd
......@@ -77,7 +77,7 @@ module Distribution.Simple.PackageIndex (
searchByName,
SearchResult(..),
searchByNameSubstring,
searchByNameExact,
searchWithPredicate,
-- ** Bulk queries
allPackages,
......@@ -527,24 +527,19 @@ 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 =
searchByNameInternal False
searchByNameExact :: PackageIndex a -> String -> [a]
searchByNameExact =
searchByNameInternal True
searchByNameSubstring index searchterm =
searchWithPredicate index (\n -> lsearchterm `isInfixOf` lowercase n)
where lsearchterm = lowercase searchterm
searchByNameInternal :: Bool -> PackageIndex a -> String -> [a]
searchByNameInternal exactMatch index searchterm =
-- | @since 3.4.0.0
searchWithPredicate :: PackageIndex a -> (String -> Bool) -> [a]
searchWithPredicate index predicate =
[ pkg
-- Don't match internal packages
| ((pname, LMainLibName), pvers) <- Map.toList (packageIdIndex index)
, if exactMatch
then searchterm == unPackageName pname
else lsearchterm `isInfixOf` lowercase (unPackageName pname)
, predicate (unPackageName pname)
, pkgs <- Map.elems pvers
, pkg <- pkgs ]
where lsearchterm = lowercase searchterm
--
-- * Special queries
......
......@@ -37,7 +37,7 @@ import Distribution.Simple.Compiler
import Distribution.Simple.Program (ProgramDb)
import Distribution.Simple.Utils
( equating, comparing, die', notice )
import Distribution.Simple.Setup (fromFlag)
import Distribution.Simple.Setup (fromFlag, fromFlagOrDefault)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import Distribution.Version
......@@ -65,6 +65,7 @@ import Distribution.Client.IndexUtils as IndexUtils
import Distribution.Client.FetchUtils
( isFetched )
import Data.Bits ((.|.))
import Data.List
( maximumBy, partition )
import Data.List.NonEmpty (groupBy, nonEmpty)
......@@ -86,6 +87,8 @@ import System.Directory
import Distribution.Utils.ShortText (ShortText)
import qualified Distribution.Utils.ShortText as ShortText
import qualified Text.Regex.Base as Regex
import qualified Text.Regex.Posix.String as Regex
-- | Return a list of packages matching given search strings.
......@@ -100,6 +103,13 @@ getPkgList verbosity packageDBs repoCtxt mcompprogdb listFlags pats = do
installedPkgIndex <- for mcompprogdb $ \(comp, progdb) ->
getInstalledPackages verbosity comp packageDBs progdb
sourcePkgDb <- getSourcePackages verbosity repoCtxt
regexps <- for pats $ \pat -> do
e <- Regex.compile compOption Regex.execBlank pat
case e of
Right r -> return r
Left err -> die' verbosity $ "Failed to compile regex " ++ pat ++ ": " ++ snd err
let sourcePkgIndex = packageIndex sourcePkgDb
prefs name = fromMaybe anyVersion
(Map.lookup name (packagePreferences sourcePkgDb))
......@@ -107,17 +117,17 @@ getPkgList verbosity packageDBs repoCtxt mcompprogdb listFlags pats = do
pkgsInfoMatching ::
[(PackageName, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])]
pkgsInfoMatching =
let matchingInstalled = maybe [] (matchingPackages ipiSearch) installedPkgIndex
matchingSource = matchingPackages (\ idx n -> concatMap snd (piSearch idx n)) sourcePkgIndex
let matchingInstalled = maybe [] (matchingPackages InstalledPackageIndex.searchWithPredicate regexps) installedPkgIndex
matchingSource = matchingPackages (\ idx n -> concatMap snd (PackageIndex.searchWithPredicate idx n)) regexps sourcePkgIndex
in mergePackages matchingInstalled matchingSource
pkgsInfo ::
[(PackageName, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])]
pkgsInfo
-- gather info for all packages
| null pats = mergePackages
(maybe [] InstalledPackageIndex.allPackages installedPkgIndex)
( PackageIndex.allPackages sourcePkgIndex)
| null regexps = mergePackages
(maybe [] InstalledPackageIndex.allPackages installedPkgIndex)
( PackageIndex.allPackages sourcePkgIndex)
-- gather info for packages matching search term
| otherwise = pkgsInfoMatching
......@@ -131,16 +141,16 @@ getPkgList verbosity packageDBs repoCtxt mcompprogdb listFlags pats = do
selectedPkg = latestWithPref pref sourcePkgs ]
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 =
onlyInstalled = fromFlagOrDefault False (listInstalled listFlags)
caseInsensitive = fromFlagOrDefault True (listCaseInsensitive listFlags)
compOption | caseInsensitive = Regex.compExtended .|. Regex.compIgnoreCase
| otherwise = Regex.compExtended
matchingPackages search regexps index =
[ pkg
| pat <- pats
, pkg <- search index pat ]
| re <- regexps
, pkg <- search index (Regex.matchTest re) ]
-- | Show information about packages.
......
......@@ -1523,23 +1523,23 @@ instance Semigroup GetFlags where
-- ------------------------------------------------------------
data ListFlags = ListFlags
{ listInstalled :: Flag Bool
, listSimpleOutput :: Flag Bool
, listExactMatch :: Flag Bool
, listVerbosity :: Flag Verbosity
, listPackageDBs :: [Maybe PackageDB]
, listHcPath :: Flag FilePath
{ listInstalled :: Flag Bool
, listSimpleOutput :: Flag Bool
, listCaseInsensitive :: Flag Bool
, listVerbosity :: Flag Verbosity
, listPackageDBs :: [Maybe PackageDB]
, listHcPath :: Flag FilePath
}
deriving Generic
defaultListFlags :: ListFlags
defaultListFlags = ListFlags
{ listInstalled = Flag False
, listSimpleOutput = Flag False
, listExactMatch = Flag False
, listVerbosity = toFlag normal
, listPackageDBs = []
, listHcPath = mempty
{ listInstalled = Flag False
, listSimpleOutput = Flag False
, listCaseInsensitive = Flag True
, listVerbosity = toFlag normal
, listPackageDBs = []
, listHcPath = mempty
}
listCommand :: CommandUI ListFlags
......@@ -1575,10 +1575,10 @@ listOptions =
"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 ['i'] ["ignore-case"]
"Ignore case destictions"
listCaseInsensitive (\v flags -> flags { listCaseInsensitive = v })
(boolOpt' (['i'], ["ignore-case"]) (['I'], ["strict-case"]))
, option "" ["package-db"]
( "Append the given package database to the list of package"
......
......@@ -40,7 +40,7 @@ module Distribution.Solver.Types.PackageIndex (
searchByName,
SearchResult(..),
searchByNameSubstring,
searchByNameExact,
searchWithPredicate,
-- ** Bulk queries
allPackages,
......@@ -325,23 +325,14 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a]
--
searchByNameSubstring :: PackageIndex pkg
-> String -> [(PackageName, [pkg])]
searchByNameSubstring =
searchByNameInternal False
searchByNameExact :: PackageIndex pkg
-> String -> [(PackageName, [pkg])]
searchByNameExact =
searchByNameInternal True
searchByNameInternal :: Bool
-> PackageIndex pkg
-> String -> [(PackageName, [pkg])]
searchByNameInternal exactMatch (PackageIndex m) searchterm =
searchByNameSubstring index searchterm =
searchWithPredicate index (\n -> lsearchterm `isInfixOf` lowercase n)
where lsearchterm = lowercase searchterm
searchWithPredicate :: PackageIndex pkg
-> (String -> Bool) -> [(PackageName, [pkg])]
searchWithPredicate (PackageIndex m) predicate =
[ pkgs
| pkgs@(pname, _) <- Map.toList m
, if exactMatch
then searchterm == unPackageName pname
else lsearchterm `isInfixOf` lowercase (unPackageName pname)
, predicate (unPackageName pname)
]
where
lsearchterm = lowercase searchterm
......@@ -271,6 +271,8 @@ DIGEST_VER="0.0.1.2"; DIGEST_REGEXP="0\.0\.(1\.[2-9]|[2-9]\.?)"
# >= 0.0.1.2 && < 0.1
LUKKO_VER="0.1.1"; LUKKO_VER_REGEXP="0\.1\.[1-9]"
# >= 0.1.1 && <0.2
REGEX_POSIX_VER="0.96.0.0"; REGEX_POSIX_REGEXP="0\.96\.[0-9]"
REGEX_BASE_VER="0.94.0.0"; REGEX_BASE_REGEXP="0\.94\.[0-9]"
HACKAGE_URL="https://hackage.haskell.org/package"
......@@ -475,6 +477,8 @@ info_pkg "ed25519" ${ED25519_VER} ${ED25519_VER_REGEXP}
info_pkg "tar" ${TAR_VER} ${TAR_VER_REGEXP}
info_pkg "digest" ${DIGEST_VER} ${DIGEST_REGEXP}
info_pkg "lukko" ${LUKKO_VER} ${LUKKO_REGEXP}
info_pkg "regex-base" ${REGEX_BASE_VER} ${REGEX_BASE_REGEXP}
info_pkg "regex-posix" ${REGEX_POSIX_VER} ${REGEX_POSIX_REGEXP}
info_pkg "hackage-security" ${HACKAGE_SECURITY_VER} \
${HACKAGE_SECURITY_VER_REGEXP}
......@@ -513,6 +517,8 @@ do_pkg "ed25519" ${ED25519_VER} ${ED25519_VER_REGEXP}
do_pkg "tar" ${TAR_VER} ${TAR_VER_REGEXP}
do_pkg "digest" ${DIGEST_VER} ${DIGEST_REGEXP}
do_pkg "lukko" ${LUKKO_VER} ${LUKKO_REGEXP}
do_pkg "regex-base" ${REGEX_BASE_VER} ${REGEX_BASE_REGEXP}
do_pkg "regex-posix" ${REGEX_POSIX_VER} ${REGEX_POSIX_REGEXP}
do_pkg "hackage-security" ${HACKAGE_SECURITY_VER} \
${HACKAGE_SECURITY_VER_REGEXP}
......
......@@ -356,7 +356,9 @@ executable cabal
zlib >= 0.5.3 && < 0.7,
hackage-security >= 0.6.0.1 && < 0.7,
text >= 1.2.3 && < 1.3,
parsec >= 3.1.13.0 && < 3.2
parsec >= 3.1.13.0 && < 3.2,
regex-base >= 0.94.0.0 && <0.95,
regex-posix >= 0.96.0.0 && <0.97
if !impl(ghc >= 8.0)
build-depends: fail == 4.9.*
......
......@@ -45,7 +45,9 @@ Version: 3.3.0.0
zlib >= 0.5.3 && < 0.7,
hackage-security >= 0.6.0.1 && < 0.7,
text >= 1.2.3 && < 1.3,
parsec >= 3.1.13.0 && < 3.2
parsec >= 3.1.13.0 && < 3.2,
regex-base >= 0.94.0.0 && <0.95,
regex-posix >= 0.96.0.0 && <0.97
if !impl(ghc >= 8.0)
build-depends: fail == 4.9.*
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment