From 88d944916993621adc8a0e6cb8b013290424eae6 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 20 Jun 2024 16:50:43 +0800 Subject: [PATCH] Return Maybe PkgConfigDb rather than PkgConfigDb --- .../src/Distribution/Solver/Modular.hs | 2 +- .../src/Distribution/Solver/Modular/Solver.hs | 2 +- .../Distribution/Solver/Modular/Validate.hs | 4 +- .../Solver/Types/DependencyResolver.hs | 2 +- .../Distribution/Solver/Types/PkgConfigDb.hs | 46 ++++++++----------- .../src/Distribution/Client/Configure.hs | 2 +- .../src/Distribution/Client/Dependency.hs | 2 +- .../src/Distribution/Client/Fetch.hs | 2 +- .../src/Distribution/Client/Freeze.hs | 2 +- .../src/Distribution/Client/Install.hs | 4 +- .../Distribution/Client/ProjectPlanning.hs | 12 ++--- .../Distribution/Solver/Modular/DSL.hs | 2 +- .../Solver/Modular/DSL/TestCaseUtils.hs | 4 +- .../Distribution/Solver/Modular/QuickCheck.hs | 2 +- 14 files changed, 39 insertions(+), 49 deletions(-) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs index 2aac240318f..9111b2d78d0 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs @@ -116,7 +116,7 @@ modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns solve' :: SolverConfig -> CompilerInfo -> Index - -> PkgConfigDb + -> Maybe PkgConfigDb -> (PN -> PackagePreferences) -> Map PN [LabeledPackageConstraint] -> Set PN diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs index 39bd7bf4690..b57f55af1fc 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs @@ -91,7 +91,7 @@ newtype PruneAfterFirstSuccess = PruneAfterFirstSuccess Bool solve :: SolverConfig -- ^ solver parameters -> CompilerInfo -> Index -- ^ all available packages as an index - -> PkgConfigDb -- ^ available pkg-config pkgs + -> Maybe PkgConfigDb -- ^ available pkg-config pkgs -> (PN -> PackagePreferences) -- ^ preferences -> M.Map PN [LabeledPackageConstraint] -- ^ global constraints -> S.Set PN -- ^ global goals diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index cbe6282b6d0..c757efe48e1 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -561,7 +561,7 @@ extendRequiredComponents eqpn available = foldM extendSingle -- | Interface. -validateTree :: CompilerInfo -> Index -> PkgConfigDb -> Tree d c -> Tree d c +validateTree :: CompilerInfo -> Index -> Maybe PkgConfigDb -> Tree d c -> Tree d c validateTree cinfo idx pkgConfigDb t = runValidate (validate t) VS { supportedExt = maybe (const True) -- if compiler has no list of extensions, we assume everything is supported (\ es -> let s = S.fromList es in \ x -> S.member x s) @@ -569,7 +569,7 @@ validateTree cinfo idx pkgConfigDb t = runValidate (validate t) VS { , supportedLang = maybe (const True) (flip L.elem) -- use list lookup because language list is small and no Ord instance (compilerInfoLanguages cinfo) - , presentPkgs = pkgConfigPkgIsPresent pkgConfigDb + , presentPkgs = maybe (\_pn _pvr -> False) pkgConfigPkgIsPresent pkgConfigDb , index = idx , saved = M.empty , pa = PA M.empty M.empty M.empty diff --git a/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs b/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs index e773492ae74..139a6d2b33d 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/DependencyResolver.hs @@ -30,7 +30,7 @@ type DependencyResolver loc = Platform -> CompilerInfo -> InstalledPackageIndex -> PackageIndex (SourcePackage loc) - -> PkgConfigDb + -> Maybe PkgConfigDb -> (PackageName -> PackagePreferences) -> [LabeledPackageConstraint] -> Set PackageName diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs b/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs index 21845eafdec..98ef5bcd0b0 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs @@ -46,25 +46,28 @@ import Distribution.Types.PkgconfigVersion import Distribution.Types.PkgconfigVersionRange import Distribution.Verbosity (Verbosity) --- | The list of packages installed in the system visible to --- @pkg-config@. This is an opaque datatype, to be constructed with --- `readPkgConfigDb` and queried with `pkgConfigPkgPresent`. -data PkgConfigDb = PkgConfigDb (M.Map PkgconfigName (Maybe PkgconfigVersion)) - -- ^ If an entry is `Nothing`, this means that the - -- package seems to be present, but we don't know the - -- exact version (because parsing of the version - -- number failed). - | NoPkgConfigDb - -- ^ For when we could not run pkg-config successfully. +newtype PkgConfigDb = PkgConfigDb (M.Map PkgconfigName (Maybe PkgconfigVersion)) deriving (Show, Generic, Typeable) +-- -- | The list of packages installed in the system visible to +-- -- @pkg-config@. This is an opaque datatype, to be constructed with +-- -- `readPkgConfigDb` and queried with `pkgConfigPkgPresent`. +-- data PkgConfigDb = PkgConfigDb (M.Map PkgconfigName (Maybe PkgconfigVersion)) +-- -- ^ If an entry is `Nothing`, this means that the +-- -- package seems to be present, but we don't know the +-- -- exact version (because parsing of the version +-- -- number failed). +-- | NoPkgConfigDb +-- -- ^ For when we could not run pkg-config successfully. +-- deriving (Show, Generic, Typeable) + instance Binary PkgConfigDb instance Structured PkgConfigDb -- | Query pkg-config for the list of installed packages, together -- with their versions. Return a `PkgConfigDb` encapsulating this -- information. -readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb +readPkgConfigDb :: Verbosity -> ProgramDb -> IO (Maybe PkgConfigDb) readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do mpkgConfig <- needProgram verbosity pkgConfigProgram progdb case mpkgConfig of @@ -106,7 +109,7 @@ readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do (programInvocation pkgConfig ("--modversion" : pkgNames)) let pkgVersions = lines outs if exitCode == ExitSuccess && length pkgVersions == length pkgNames - then (return . pkgConfigDbFromList . zip pkgNames) pkgVersions + then (return . Just . pkgConfigDbFromList . zip pkgNames) pkgVersions else -- if there's a single broken pc file the above fails, so we fall back -- into calling it individually @@ -116,7 +119,7 @@ readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do -- requested one, we fall back to querying one by one. do info verbosity ("call to pkg-config --modversion on all packages failed. Falling back to querying pkg-config individually on each package") - pkgConfigDbFromList . catMaybes <$> mapM (getIndividualVersion pkgConfig) pkgNames + Just . pkgConfigDbFromList . catMaybes <$> mapM (getIndividualVersion pkgConfig) pkgNames where -- For when pkg-config invocation fails (possibly because of a -- too long command line). @@ -124,9 +127,9 @@ readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do info verbosity ("Failed to query pkg-config, Cabal will continue" ++ " without solving for pkg-config constraints: " ++ extra) - return NoPkgConfigDb + return Nothing - ioErrorHandler :: IOException -> IO PkgConfigDb + ioErrorHandler :: IOException -> IO (Maybe PkgConfigDb) ioErrorHandler e = noPkgConfig (show e) getIndividualVersion :: ConfiguredProgram -> String -> IO (Maybe (String, String)) @@ -162,13 +165,6 @@ pkgConfigPkgIsPresent (PkgConfigDb db) pn vr = Nothing -> False -- Package not present in the DB. Just Nothing -> True -- Package present, but version unknown. Just (Just v) -> withinPkgconfigVersionRange v vr --- If we could not read the pkg-config database successfully we fail. --- The plan found by the solver can't be executed later, because pkg-config itself --- is going to be called in the build phase to get the library location for linking --- so even if there is a library, it would need to be passed manual flags anyway. -pkgConfigPkgIsPresent NoPkgConfigDb _ _ = False - - -- | Query the version of a package in the @pkg-config@ database. -- @Nothing@ indicates the package is not in the database, while @@ -176,12 +172,6 @@ pkgConfigPkgIsPresent NoPkgConfigDb _ _ = False -- but its version is not known. pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion) pkgConfigDbPkgVersion (PkgConfigDb db) pn = M.lookup pn db --- NB: Since the solver allows solving to succeed if there is --- NoPkgConfigDb, we should report that we *guess* that there --- is a matching pkg-config configuration, but that we just --- don't know about it. -pkgConfigDbPkgVersion NoPkgConfigDb _ = Just Nothing - -- | Query pkg-config for the locations of pkg-config's package files. Use this -- to monitor for changes in the pkg-config DB. diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs index fc7ea49fe31..0586a362dd2 100644 --- a/cabal-install/src/Distribution/Client/Configure.hs +++ b/cabal-install/src/Distribution/Client/Configure.hs @@ -390,7 +390,7 @@ planLocalPackage -> ConfigExFlags -> InstalledPackageIndex -> SourcePackageDb - -> PkgConfigDb + -> Maybe PkgConfigDb -> IO (Progress String String SolverInstallPlan) planLocalPackage verbosity diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index 3f6a7fea32a..f489b97a88d 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -764,7 +764,7 @@ runSolver = modularResolver resolveDependencies :: Platform -> CompilerInfo - -> PkgConfigDb + -> Maybe PkgConfigDb -> DepResolverParams -> Progress String String SolverInstallPlan resolveDependencies platform comp pkgConfigDB params = diff --git a/cabal-install/src/Distribution/Client/Fetch.hs b/cabal-install/src/Distribution/Client/Fetch.hs index 54db5ae607b..f09ae4d772e 100644 --- a/cabal-install/src/Distribution/Client/Fetch.hs +++ b/cabal-install/src/Distribution/Client/Fetch.hs @@ -161,7 +161,7 @@ planPackages -> FetchFlags -> InstalledPackageIndex -> SourcePackageDb - -> PkgConfigDb + -> Maybe PkgConfigDb -> [PackageSpecifier UnresolvedSourcePackage] -> IO [UnresolvedSourcePackage] planPackages diff --git a/cabal-install/src/Distribution/Client/Freeze.hs b/cabal-install/src/Distribution/Client/Freeze.hs index 9bc4e3234b5..92f590bb772 100644 --- a/cabal-install/src/Distribution/Client/Freeze.hs +++ b/cabal-install/src/Distribution/Client/Freeze.hs @@ -199,7 +199,7 @@ planPackages -> FreezeFlags -> InstalledPackageIndex -> SourcePackageDb - -> PkgConfigDb + -> Maybe PkgConfigDb -> [PackageSpecifier UnresolvedSourcePackage] -> IO [SolverPlanPackage] planPackages diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index a31e4d2ce62..9cf80d3858c 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -381,7 +381,7 @@ install type InstallContext = ( InstalledPackageIndex , SourcePackageDb - , PkgConfigDb + , Maybe PkgConfigDb , [UserTarget] , [PackageSpecifier UnresolvedSourcePackage] , HttpTransport @@ -567,7 +567,7 @@ planPackages -> InstallFlags -> InstalledPackageIndex -> SourcePackageDb - -> PkgConfigDb + -> Maybe PkgConfigDb -> [PackageSpecifier UnresolvedSourcePackage] -> Progress String String SolverInstallPlan planPackages diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index efc4ebbd1e4..c494aa9279d 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -662,7 +662,7 @@ rebuildInstallPlan -> (Compiler, Platform, ProgramDb) -> [PackageSpecifier UnresolvedSourcePackage] -> InstalledPackageIndex - -> Rebuild (SolverInstallPlan, PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos) + -> Rebuild (SolverInstallPlan, Maybe PkgConfigDb, IndexUtils.TotalIndexState, IndexUtils.ActiveRepos) phaseRunSolver projectConfig@ProjectConfig { projectConfigShared @@ -774,7 +774,7 @@ rebuildInstallPlan phaseElaboratePlan :: ProjectConfig -> (Compiler, Platform, ProgramDb) - -> PkgConfigDb + -> Maybe PkgConfigDb -> SolverInstallPlan -> [PackageSpecifier (SourcePackage (PackageLocation loc))] -> Rebuild @@ -1008,7 +1008,7 @@ getSourcePackages verbosity withRepoCtx idxState activeRepos = do $ repos return sourcePkgDbWithTIS -getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild PkgConfigDb +getPkgConfigDb :: Verbosity -> ProgramDb -> Rebuild (Maybe PkgConfigDb) getPkgConfigDb verbosity progdb = do dirs <- liftIO $ getPkgConfigDbDirs verbosity progdb -- Just monitor the dirs so we'll notice new .pc files. @@ -1208,7 +1208,7 @@ planPackages -> SolverSettings -> InstalledPackageIndex -> SourcePackageDb - -> PkgConfigDb + -> Maybe PkgConfigDb -> [PackageSpecifier UnresolvedSourcePackage] -> Map PackageName (Map OptionalStanza Bool) -> Progress String String SolverInstallPlan @@ -1531,7 +1531,7 @@ elaborateInstallPlan -> Platform -> Compiler -> ProgramDb - -> PkgConfigDb + -> Maybe PkgConfigDb -> DistDirLayout -> StoreDirLayout -> SolverInstallPlan @@ -1930,7 +1930,7 @@ elaborateInstallPlan ++ " from " ++ prettyShow (elabPkgSourceId elab0) ) - (pkgConfigDbPkgVersion pkgConfigDB pn) + (pkgConfigDB >>= \db -> pkgConfigDbPkgVersion db pn) ) | PkgconfigDependency pn _ <- PD.pkgconfigDepends diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 991c5cafa0e..08e1d7fb141 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -783,7 +783,7 @@ exResolve -> Maybe [Extension] -- List of languages supported by the compiler, or Nothing if unknown. -> Maybe [Language] - -> PC.PkgConfigDb + -> Maybe PC.PkgConfigDb -> [ExamplePkgName] -> Maybe Int -> CountConflicts diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs index 91ec541f976..afd1419d30c 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs @@ -130,7 +130,7 @@ data SolverTest = SolverTest , testDb :: ExampleDb , testSupportedExts :: Maybe [Extension] , testSupportedLangs :: Maybe [Language] - , testPkgConfigDb :: PkgConfigDb + , testPkgConfigDb :: Maybe PkgConfigDb , testEnableAllTests :: EnableAllTests } @@ -233,7 +233,7 @@ mkTestExtLangPC exts langs mPkgConfigDb db label targets result = , testDb = db , testSupportedExts = exts , testSupportedLangs = langs - , testPkgConfigDb = maybe NoPkgConfigDb pkgConfigDbFromList mPkgConfigDb + , testPkgConfigDb = pkgConfigDbFromList <$> mPkgConfigDb , testEnableAllTests = EnableAllTests False } diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs index 114db775f21..1a2bc97224f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs @@ -227,7 +227,7 @@ solve enableBj fineGrainedConflicts reorder countConflicts indep prefOldest goal (unTestDb (testDb test)) Nothing Nothing - (pkgConfigDbFromList []) + (Just $ pkgConfigDbFromList []) (map unPN (testTargets test)) -- The backjump limit prevents individual tests from using -- too much time and memory.