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

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) ...@@ -1046,9 +1046,10 @@ opt_i dflags = sOpt_i (settings dflags)
-- | The directory for this version of ghc in the user's app directory -- | The directory for this version of ghc in the user's app directory
-- (typically something like @~/.ghc/x86_64-linux-7.6.3@) -- (typically something like @~/.ghc/x86_64-linux-7.6.3@)
-- --
versionedAppDir :: DynFlags -> IO FilePath versionedAppDir :: DynFlags -> MaybeT IO FilePath
versionedAppDir dflags = do 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 return $ appdir </> versionedFilePath dflags
-- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when -- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when
...@@ -4334,7 +4335,7 @@ interpretPackageEnv dflags = do ...@@ -4334,7 +4335,7 @@ interpretPackageEnv dflags = do
namedEnvPath :: String -> MaybeT IO FilePath namedEnvPath :: String -> MaybeT IO FilePath
namedEnvPath name = do namedEnvPath name = do
appdir <- liftMaybeT $ versionedAppDir dflags appdir <- versionedAppDir dflags
return $ appdir </> "environments" </> name return $ appdir </> "environments" </> name
probeEnvName :: String -> MaybeT IO FilePath probeEnvName :: String -> MaybeT IO FilePath
...@@ -4394,7 +4395,7 @@ interpretPackageEnv dflags = do ...@@ -4394,7 +4395,7 @@ interpretPackageEnv dflags = do
findLocalEnvFile :: MaybeT IO FilePath findLocalEnvFile :: MaybeT IO FilePath
findLocalEnvFile = do findLocalEnvFile = do
curdir <- liftMaybeT getCurrentDirectory curdir <- liftMaybeT getCurrentDirectory
homedir <- liftMaybeT getHomeDirectory homedir <- tryMaybeT getHomeDirectory
let probe dir | isDrive dir || dir == homedir let probe dir | isDrive dir || dir == homedir
= mzero = mzero
probe dir = do probe dir = do
......
...@@ -384,11 +384,11 @@ resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig d ...@@ -384,11 +384,11 @@ resolvePackageConfig dflags GlobalPkgConf = return $ Just (systemPackageConfig d
-- NB: This logic is reimplemented in Cabal, so if you change it, -- NB: This logic is reimplemented in Cabal, so if you change it,
-- make sure you update Cabal. (Or, better yet, dump it in the -- make sure you update Cabal. (Or, better yet, dump it in the
-- compiler info so Cabal can use the info.) -- compiler info so Cabal can use the info.)
resolvePackageConfig dflags UserPkgConf = handleIO (\_ -> return Nothing) $ do resolvePackageConfig dflags UserPkgConf = runMaybeT $ do
dir <- versionedAppDir dflags dir <- versionedAppDir dflags
let pkgconf = dir </> "package.conf.d" let pkgconf = dir </> "package.conf.d"
exist <- doesDirectoryExist pkgconf exist <- tryMaybeT $ doesDirectoryExist pkgconf
return $ if exist then Just pkgconf else Nothing if exist then return pkgconf else mzero
resolvePackageConfig _ (PkgConfFile name) = return $ Just name resolvePackageConfig _ (PkgConfFile name) = return $ Just name
readPackageConfig :: DynFlags -> FilePath -> IO (FilePath, [PackageConfig]) readPackageConfig :: DynFlags -> FilePath -> IO (FilePath, [PackageConfig])
......
...@@ -14,11 +14,13 @@ module Maybes ( ...@@ -14,11 +14,13 @@ module Maybes (
whenIsJust, whenIsJust,
expectJust, expectJust,
MaybeT(..), liftMaybeT -- * MaybeT
MaybeT(..), liftMaybeT, tryMaybeT
) where ) where
import Control.Monad import Control.Monad
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Control.Exception (catch, SomeException(..))
import Data.Maybe import Data.Maybe
infixr 4 `orElse` infixr 4 `orElse`
...@@ -65,6 +67,12 @@ orElse = flip fromMaybe ...@@ -65,6 +67,12 @@ orElse = flip fromMaybe
liftMaybeT :: Monad m => m a -> MaybeT m a liftMaybeT :: Monad m => m a -> MaybeT m a
liftMaybeT act = MaybeT $ Just `liftM` act 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