Commit 2908ae8d authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Handle unset HOME environment variable more gracefully

Test Plan:
  * Validate
  * try `env -i ghc`
  * try `env -i runghc HelloWorld.hs`

Reviewers: austin

Subscribers: thomie, ezyang

Differential Revision: https://phabricator.haskell.org/D1971

GHC Trac Issues: #11678
parent e764ede3
......@@ -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
......
......@@ -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])
......
......@@ -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
{-
************************************************************************
* *
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment