Alert user if upgraded ghcup is shadowed by old ghcup
Also alerts if the binary is not in PATH at all. Fixes #111
This commit is contained in:
parent
1a995a5d63
commit
20338f7d14
@ -1325,6 +1325,13 @@ upgradeGHCup dls mtarget force pfreq = do
|
||||
destFile
|
||||
Overwrite
|
||||
lift $ chmod_755 destFile
|
||||
|
||||
liftIO (isInPath destFile) >>= \b -> when (not b) $
|
||||
lift $ $(logWarn) [i|"#{toFilePath (dirname destFile)}" is not in PATH! You have to add it in order to use ghcup.|]
|
||||
liftIO (isShadowed destFile) >>= \case
|
||||
Nothing -> pure ()
|
||||
Just pa -> lift $ $(logWarn) [i|ghcup is shadowed by "#{toFilePath pa}". The upgrade will not be in effect, unless you remove "#{toFilePath pa}" or make sure "#{toFilePath destDir}" comes before "#{toFilePath (dirname pa)}" in PATH.|]
|
||||
|
||||
pure latestVer
|
||||
|
||||
|
||||
|
@ -407,6 +407,32 @@ searchPath paths needle = go paths
|
||||
else pure False
|
||||
|
||||
|
||||
-- | Check wether a binary is shadowed by another one that comes before
|
||||
-- it in PATH. Returns the path to said binary, if any.
|
||||
isShadowed :: Path Abs -> IO (Maybe (Path Abs))
|
||||
isShadowed p = do
|
||||
let dir = dirname p
|
||||
fn <- basename p
|
||||
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
|
||||
if dir `elem` spaths
|
||||
then do
|
||||
let shadowPaths = takeWhile (/= dir) spaths
|
||||
searchPath shadowPaths fn
|
||||
else pure Nothing
|
||||
|
||||
|
||||
-- | Check whether the binary is in PATH. This returns only `True`
|
||||
-- if the directory containing the binary is part of PATH.
|
||||
isInPath :: Path Abs -> IO Bool
|
||||
isInPath p = do
|
||||
let dir = dirname p
|
||||
fn <- basename p
|
||||
spaths <- catMaybes . fmap parseAbs <$> (liftIO getSearchPath)
|
||||
if dir `elem` spaths
|
||||
then isJust <$> searchPath [dir] fn
|
||||
else pure False
|
||||
|
||||
|
||||
findFiles :: Path Abs -> Regex -> IO [Path Rel]
|
||||
findFiles path regex = do
|
||||
dirStream <- openDirStream (toFilePath path)
|
||||
|
Loading…
Reference in New Issue
Block a user