Handle different exception type

haskell · Jan 15, 2024 · 2900ecd · 2900ecd
1 parent e724111
commit 2900ecd
Showing 1 changed file with 9 additions and 3 deletions.
diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs b/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE LambdaCase         #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Solver.Types.PkgConfigDb
@@ -23,7 +24,7 @@ module Distribution.Solver.Types.PkgConfigDb
 import Distribution.Solver.Compat.Prelude
 import Prelude ()
 
-import           Control.Exception        (handle)
+import           Control.Exception        (handle, handleJust)
 import           Control.Monad            (mapM)
 import           Data.ByteString          (ByteString)
 import qualified Data.ByteString.Lazy     as LBS
@@ -36,11 +37,12 @@ import           System.FilePath          (splitSearchPath)
 import Distribution.Compat.Environment          (lookupEnv)
 import Distribution.Package                     (PkgconfigName, mkPkgconfigName)
 import Distribution.Parsec
+import Distribution.Simple.Errors               (CabalException(..))
 import Distribution.Simple.Program
        (ProgramDb, getProgramOutput, pkgConfigProgram, needProgram, ConfiguredProgram)
 import Distribution.Simple.Program.Run
        (getProgramInvocationOutputAndErrors, programInvocation, getProgramInvocationLBS)
-import Distribution.Simple.Utils                (info)
+import Distribution.Simple.Utils                (info, VerboseException(..))
 import Distribution.Types.PkgconfigVersion
 import Distribution.Types.PkgconfigVersionRange
 import Distribution.Verbosity                   (Verbosity)
@@ -72,7 +74,11 @@ readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do
         -- To prevent malformed Unicode in the descriptions from crashing cabal,
         -- read without interpreting any encoding first. (#9608)
         pkgList <- LBS.split (fromIntegral (ord '\n')) <$>
-                     getProgramInvocationLBS verbosity (programInvocation pkgConfig ["--list-all"])
+                     handleJust
+                       (\case e@(VerboseException _ _ _ GetProgramInvocationLBSException{}) -> Just e
+                              _ -> Nothing)
+                       (ioError . userError . show)
+                       (getProgramInvocationLBS verbosity (programInvocation pkgConfig ["--list-all"]))
         -- Now decode the package *names* to a String. The ones where decoding
         -- failed end up in 'failedPkgNames'.
         let (failedPkgNames, pkgNames) =