Return Maybe PkgConfigDb rather than PkgConfigDb

haskell · Jun 20, 2024 · 88d9449 · 88d9449
1 parent e1f73a4
commit 88d9449
Show file tree

Hide file tree

Showing 14 changed files with 39 additions and 49 deletions.
diff --git 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
@@ -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
@@ -561,15 +561,15 @@ 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)
                                 (compilerInfoExtensions cinfo)
   , 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
@@ -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
@@ -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,17 +119,17 @@ 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).
     noPkgConfig extra = 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,26 +165,13 @@ 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
 -- @Just Nothing@ indicates that the package is in the database,
 -- 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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.