diff --git a/Cabal/Distribution/Simple/PackageIndex.hs b/Cabal/Distribution/Simple/PackageIndex.hs index 86b312608b4..26d0147a3c7 100644 --- a/Cabal/Distribution/Simple/PackageIndex.hs +++ b/Cabal/Distribution/Simple/PackageIndex.hs @@ -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 diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs index c86b8651ecb..02facc1e1c2 100644 --- a/cabal-install/Distribution/Client/List.hs +++ b/cabal-install/Distribution/Client/List.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Client.List @@ -13,6 +14,9 @@ module Distribution.Client.List ( list, info ) where +import Prelude () +import Distribution.Client.Compat.Prelude + import Distribution.Package ( PackageName, Package(..), packageName , packageVersion, UnitId ) @@ -33,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 @@ -61,64 +65,73 @@ import Distribution.Client.IndexUtils as IndexUtils import Distribution.Client.FetchUtils ( isFetched ) +import Data.Bits ((.|.)) import Data.List - ( sortBy, groupBy, sort, nub, intersperse, maximumBy, partition ) + ( maximumBy, partition ) +import Data.List.NonEmpty (groupBy, nonEmpty) +import qualified Data.List as L import Data.Maybe - ( listToMaybe, fromJust, fromMaybe, isJust, maybeToList ) + ( fromJust ) import qualified Data.Map as Map import Data.Tree as Tree import Control.Monad - ( MonadPlus(mplus), join ) + ( join ) import Control.Exception ( assert ) -import Text.PrettyPrint as Disp +import qualified Text.PrettyPrint as Disp +import Text.PrettyPrint + ( lineLength, ribbonsPerLine, Doc, renderStyle, char + , (<+>), nest, ($+$), text, vcat, style, parens, fsep) import System.Directory ( doesDirectoryExist ) 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. getPkgList :: Verbosity -> PackageDBStack -> RepoContext - -> Compiler - -> ProgramDb + -> Maybe (Compiler, ProgramDb) -> ListFlags -> [String] -> IO [PackageDisplayInfo] -getPkgList verbosity packageDBs repoCtxt comp progdb listFlags pats = do - installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb +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)) + pkgsInfoMatching :: + [(PackageName, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])] + pkgsInfoMatching = + 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 - (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 - pkgsInfoMatching :: - [(PackageName, [Installed.InstalledPackageInfo], [UnresolvedSourcePackage])] - pkgsInfoMatching = - let matchingInstalled = matchingPackages - ipiSearch - installedPkgIndex - matchingSource = matchingPackages - (\ idx n -> - concatMap snd - (piSearch idx n)) - sourcePkgIndex - in mergePackages matchingInstalled matchingSource - matches :: [PackageDisplayInfo] matches = [ mergePackageInfo pref installedPkgs sourcePkgs selectedPkg False @@ -128,29 +141,28 @@ getPkgList verbosity packageDBs repoCtxt comp progdb 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. list :: Verbosity -> PackageDBStack -> RepoContext - -> Compiler - -> ProgramDb + -> Maybe (Compiler, ProgramDb) -> ListFlags -> [String] -> IO () -list verbosity packageDBs repos comp progdb listFlags pats = do - matches <- getPkgList verbosity packageDBs repos comp progdb listFlags pats +list verbosity packageDBs repos mcompProgdb listFlags pats = do + matches <- getPkgList verbosity packageDBs repos mcompProgdb listFlags pats if simpleOutput then putStr $ unlines @@ -204,7 +216,7 @@ info verbosity packageDBs repoCtxt comp progdb (fromFlag $ globalWorldFile globalFlags) sourcePkgs' userTargets - pkgsinfo <- sequence + pkgsinfo <- sequenceA [ do pkginfo <- either (die' verbosity) return $ gatherPkgInfo prefs installedPkgIndex sourcePkgIndex @@ -330,16 +342,16 @@ showPackageSummaryInfo pkginfo = $+$ text "" where maybeShowST l s f - | ShortText.null l = empty + | ShortText.null l = Disp.empty | otherwise = text s <+> f (ShortText.fromShortText l) showPackageDetailedInfo :: PackageDisplayInfo -> String showPackageDetailedInfo pkginfo = renderStyle (style {lineLength = 80, ribbonsPerLine = 1}) $ char '*' <+> pretty (pkgName pkginfo) - Disp.<> maybe empty (\v -> char '-' Disp.<> pretty v) (selectedVersion pkginfo) + <<>> maybe Disp.empty (\v -> char '-' Disp.<> pretty v) (selectedVersion pkginfo) <+> text (replicate (16 - length (prettyShow (pkgName pkginfo))) ' ') - Disp.<> parens pkgkind + <<>> parens pkgkind $+$ (nest 4 $ vcat [ entryST "Synopsis" synopsis hideIfNull reflowParagraphs @@ -363,14 +375,14 @@ showPackageDetailedInfo pkginfo = , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep) , entry "Documentation" haddockHtml showIfInstalled text , entry "Cached" haveTarball alwaysShow dispYesNo - , if not (hasLib pkginfo) then empty else + , if not (hasLib pkginfo) then mempty else text "Modules:" $+$ nest 4 (vcat (map pretty . sort . modules $ pkginfo)) ]) $+$ text "" where entry fname field cond format = case cond (field pkginfo) of Nothing -> label <+> format (field pkginfo) - Just Nothing -> empty + Just Nothing -> mempty Just (Just other) -> label <+> text other where label = text fname Disp.<> char ':' Disp.<> padding @@ -407,7 +419,7 @@ showPackageDetailedInfo pkginfo = | hasLib pkginfo = text "library" | hasExes = text "programs" | hasExe pkginfo = text "program" - | otherwise = empty + | otherwise = mempty reflowParagraphs :: String -> Doc @@ -416,7 +428,7 @@ reflowParagraphs = . intersperse (text "") -- re-insert blank lines . map (fsep . map text . concatMap words) -- reflow paragraphs . filter (/= [""]) - . groupBy (\x y -> "" `notElem` [x,y]) -- break on blank lines + . L.groupBy (\x y -> "" `notElem` [x,y]) -- break on blank lines . lines reflowLines :: String -> Doc @@ -548,7 +560,7 @@ mergePackages installedPkgs sourcePkgs = collect (OnlyInRight (name,as)) = (name, [], as) groupOn :: Ord key => (a -> key) -> [a] -> [(key,[a])] -groupOn key = map (\xs -> (key (head xs), xs)) +groupOn key = map (\xs -> (key (head xs), toList xs)) . groupBy (equating key) . sortBy (comparing key) @@ -586,9 +598,12 @@ interestingVersions pref = . reorderTree (\(Node (v,_) _) -> pref (mkVersion v)) . reverseTree . mkTree - . map versionNumbers + . map (or0 . versionNumbers) where + or0 [] = 0 :| [] + or0 (x:xs) = x :| xs + swizzleTree = unfoldTree (spine []) where spine ts' (Node x []) = (x, ts') @@ -601,12 +616,17 @@ interestingVersions pref = reverseTree (Node x cs) = Node x (reverse (map reverseTree cs)) + mkTree :: forall a. Eq a => [NonEmpty a] -> Tree ([a], Bool) mkTree xs = unfoldTree step (False, [], xs) where + step :: (Bool, [a], [NonEmpty a]) -> (([a], Bool), [(Bool, [a], [NonEmpty a])]) step (node,ns,vs) = ( (reverse ns, node) - , [ (any null vs', n:ns, filter (not . null) vs') - | (n, vs') <- groups vs ] + , [ (any null vs', n:ns, mapMaybe nonEmpty (toList vs')) + | (n, vs') <- groups vs + ] ) - groups = map (\g -> (head (head g), map tail g)) + + groups :: [NonEmpty a] -> [(a, NonEmpty [a])] + groups = map (\g -> (head (head g), fmap tail g)) . groupBy (equating head) diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index aedd64d517a..de06cace55d 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -28,7 +28,7 @@ module Distribution.Client.Setup , installCommand, InstallFlags(..), installOptions, defaultInstallFlags , filterHaddockArgs, filterHaddockFlags, haddockOptions , defaultSolver, defaultMaxBackjumps - , listCommand, ListFlags(..) + , listCommand, ListFlags(..), listNeedsCompiler , updateCommand, UpdateFlags(..), defaultUpdateFlags , infoCommand, InfoFlags(..) , fetchCommand, FetchFlags(..) @@ -92,6 +92,10 @@ import qualified Distribution.Simple.Command as Command import Distribution.Simple.Configure ( configCompilerAuxEx, interpretPackageDbFlags, computeEffectiveProfiling ) import qualified Distribution.Simple.Setup as Cabal +import Distribution.Simple.Flag + ( Flag(..), toFlag, flagToMaybe, flagToList, maybeToFlag + , flagElim, fromFlagOrDefault + ) import Distribution.Simple.Setup ( ConfigFlags(..), BuildFlags(..), ReplFlags , TestFlags, BenchmarkFlags @@ -99,7 +103,6 @@ import Distribution.Simple.Setup , CleanFlags(..), DoctestFlags(..) , CopyFlags(..), RegisterFlags(..) , readPackageDbList, showPackageDbList - , Flag(..), toFlag, flagToMaybe, flagToList, maybeToFlag , BooleanFlag(..), optionVerbosity , boolOpt, boolOpt', trueArg, falseArg , optionNumJobs ) @@ -1519,22 +1522,25 @@ instance Semigroup GetFlags where -- * List flags -- ------------------------------------------------------------ -data ListFlags = ListFlags { - listInstalled :: Flag Bool, - listSimpleOutput :: Flag Bool, - listExactMatch :: Flag Bool, - listVerbosity :: Flag Verbosity, - listPackageDBs :: [Maybe PackageDB] - } deriving Generic +data ListFlags = ListFlags + { 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 = [] - } +defaultListFlags = ListFlags + { listInstalled = Flag False + , listSimpleOutput = Flag False + , listCaseInsensitive = Flag True + , listVerbosity = toFlag normal + , listPackageDBs = [] + , listHcPath = mempty + } listCommand :: CommandUI ListFlags listCommand = CommandUI { @@ -1553,35 +1559,47 @@ listCommand = CommandUI { commandUsage = usageAlternatives "list" [ "[FLAGS]" , "[FLAGS] STRINGS"], commandDefaultFlags = defaultListFlags, - commandOptions = \_ -> [ - optionVerbosity listVerbosity (\v flags -> flags { listVerbosity = v }) - - , option [] ["installed"] - "Only print installed packages" - listInstalled (\v flags -> flags { listInstalled = v }) - trueArg - - , option [] ["simple-output"] - "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 + commandOptions = const listOptions + } - , option "" ["package-db"] - ( "Append the given package database to the list of package" - ++ " databases used (to satisfy dependencies and register into)." - ++ " May be a specific file, 'global' or 'user'. The initial list" - ++ " is ['global'], ['global', 'user']," - ++ " depending on context. Use 'clear' to reset the list to empty." - ++ " See the user guide for details.") - listPackageDBs (\v flags -> flags { listPackageDBs = v }) - (reqArg' "DB" readPackageDbList showPackageDbList) +listOptions :: [OptionField ListFlags] +listOptions = + [ optionVerbosity listVerbosity (\v flags -> flags { listVerbosity = v }) - ] - } + , option [] ["installed"] + "Only print installed packages" + listInstalled (\v flags -> flags { listInstalled = v }) + trueArg + + , option [] ["simple-output"] + "Print in a easy-to-parse format" + listSimpleOutput (\v flags -> flags { listSimpleOutput = 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" + ++ " databases used (to satisfy dependencies and register into)." + ++ " May be a specific file, 'global' or 'user'. The initial list" + ++ " is ['global'], ['global', 'user']," + ++ " depending on context. Use 'clear' to reset the list to empty." + ++ " See the user guide for details.") + listPackageDBs (\v flags -> flags { listPackageDBs = v }) + (reqArg' "DB" readPackageDbList showPackageDbList) + + , option "w" ["with-compiler"] + "give the path to a particular compiler" + listHcPath (\v flags -> flags { listHcPath = v }) + (reqArgFlag "PATH") + ] + +listNeedsCompiler :: ListFlags -> Bool +listNeedsCompiler f = + flagElim False (const True) (listHcPath f) + || fromFlagOrDefault False (listInstalled f) instance Monoid ListFlags where mempty = gmempty diff --git a/cabal-install/Distribution/Solver/Types/PackageIndex.hs b/cabal-install/Distribution/Solver/Types/PackageIndex.hs index b37ee115802..8cc2206435c 100644 --- a/cabal-install/Distribution/Solver/Types/PackageIndex.hs +++ b/cabal-install/Distribution/Solver/Types/PackageIndex.hs @@ -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 diff --git a/cabal-install/bootstrap.sh b/cabal-install/bootstrap.sh index eadd9f39d5d..621aea7748c 100755 --- a/cabal-install/bootstrap.sh +++ b/cabal-install/bootstrap.sh @@ -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} diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 4a1236efe58..3bc1b551e83 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -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.* diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 039d087d4c8..b208a8be99a 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -45,7 +45,9 @@ 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.* diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 36cf9ebd378..6bdae63a749 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -33,7 +33,7 @@ import Distribution.Client.Setup , checkCommand , formatCommand , UpdateFlags(..), updateCommand - , ListFlags(..), listCommand + , ListFlags(..), listCommand, listNeedsCompiler , InfoFlags(..), infoCommand , UploadFlags(..), uploadCommand , ReportFlags(..), reportCommand @@ -705,18 +705,22 @@ listAction listFlags extraArgs globalFlags = do let verbosity = fromFlag (listVerbosity listFlags) config <- loadConfigOrSandboxConfig verbosity globalFlags let configFlags' = savedConfigureFlags config - configFlags = configFlags' { - configPackageDBs = configPackageDBs configFlags' + configFlags = configFlags' + { configPackageDBs = configPackageDBs configFlags' `mappend` listPackageDBs listFlags + , configHcPath = listHcPath listFlags } globalFlags' = savedGlobalFlags config `mappend` globalFlags - (comp, _, progdb) <- configCompilerAux' configFlags + compProgdb <- if listNeedsCompiler listFlags + then do + (comp, _, progdb) <- configCompilerAux' configFlags + return (Just (comp, progdb)) + else return Nothing withRepoContext verbosity globalFlags' $ \repoContext -> List.list verbosity (configPackageDB' configFlags) repoContext - comp - progdb + compProgdb listFlags extraArgs