diff options
| -rw-r--r-- | compiler/main/DynFlags.hs | 9 | ||||
| -rw-r--r-- | compiler/main/Packages.hs | 6 | ||||
| -rw-r--r-- | compiler/utils/Maybes.hs | 10 |
3 files changed, 17 insertions, 8 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index ce51d3e066..2e8af7daa2 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1046,9 +1046,10 @@ opt_i dflags = sOpt_i (settings dflags) -- | The directory for this version of ghc in the user's app directory -- (typically something like @~/.ghc/x86_64-linux-7.6.3@) -- -versionedAppDir :: DynFlags -> IO FilePath +versionedAppDir :: DynFlags -> MaybeT IO FilePath versionedAppDir dflags = do - appdir <- getAppUserDataDirectory (programName dflags) + -- Make sure we handle the case the HOME isn't set (see #11678) + appdir <- tryMaybeT $ getAppUserDataDirectory (programName dflags) return $ appdir </> versionedFilePath dflags -- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when @@ -4334,7 +4335,7 @@ interpretPackageEnv dflags = do namedEnvPath :: String -> MaybeT IO FilePath namedEnvPath name = do - appdir <- liftMaybeT $ versionedAppDir dflags + appdir <- versionedAppDir dflags return $ appdir </> "environments" </> name probeEnvName :: String -> MaybeT IO FilePath @@ -4394,7 +4395,7 @@ interpretPackageEnv dflags = do findLocalEnvFile :: MaybeT IO FilePath findLocalEnvFile = do curdir <- liftMaybeT getCurrentDirectory - homedir <- liftMaybeT getHomeDirectory + homedir <- tryMaybeT getHomeDirectory let probe dir | isDrive dir || dir == homedir = mzero probe dir = do diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index decd7a1019..2655c451d8 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -384,11 +384,11 @@ resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig d -- NB: This logic is reimplemented in Cabal, so if you change it, -- make sure you update Cabal. (Or, better yet, dump it in the -- compiler info so Cabal can use the info.) -resolvePackageConfig dflags UserPkgConf = handleIO (\_ -> return Nothing) $ do +resolvePackageConfig dflags UserPkgConf = runMaybeT $ do dir <- versionedAppDir dflags let pkgconf = dir </> "package.conf.d" - exist <- doesDirectoryExist pkgconf - return $ if exist then Just pkgconf else Nothing + exist <- tryMaybeT $ doesDirectoryExist pkgconf + if exist then return pkgconf else mzero resolvePackageConfig _ (PkgConfFile name) = return $ Just name readPackageConfig :: DynFlags -> FilePath -> IO (FilePath, [PackageConfig]) diff --git a/compiler/utils/Maybes.hs b/compiler/utils/Maybes.hs index 83dc9b6864..a736e3dd2e 100644 --- a/compiler/utils/Maybes.hs +++ b/compiler/utils/Maybes.hs @@ -14,11 +14,13 @@ module Maybes ( whenIsJust, expectJust, - MaybeT(..), liftMaybeT + -- * MaybeT + MaybeT(..), liftMaybeT, tryMaybeT ) where import Control.Monad import Control.Monad.Trans.Maybe +import Control.Exception (catch, SomeException(..)) import Data.Maybe infixr 4 `orElse` @@ -65,6 +67,12 @@ orElse = flip fromMaybe liftMaybeT :: Monad m => m a -> MaybeT m a liftMaybeT act = MaybeT $ Just `liftM` act +-- | Try performing an 'IO' action, failing on error. +tryMaybeT :: IO a -> MaybeT IO a +tryMaybeT action = MaybeT $ catch (Just `fmap` action) handler + where + handler (SomeException _) = return Nothing + {- ************************************************************************ * * |