Warn on all tools when shadowed

This commit is contained in:
Julian Ospald 2022-05-23 16:48:29 +02:00
parent b8b3a16589
commit 9375255452
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
8 changed files with 34 additions and 19 deletions

View File

@ -437,7 +437,7 @@ install' _ (_, ListResult {..}) = do
, TarDirDoesNotExist
, FileAlreadyExistsError
, ProcessError
, GHCupShadowed
, ToolShadowed
, UninstallFailed
, MergeFileTreeError
]

View File

@ -94,7 +94,7 @@ type UpgradeEffects = '[ DigestError
, FileDoesNotExistError
, CopyError
, DownloadFailed
, GHCupShadowed
, ToolShadowed
]

View File

@ -77,6 +77,7 @@ import Text.Regex.Posix
import qualified Data.Text as T
import qualified Streamly.Prelude as S
import Text.PrettyPrint.HughesPJClass (prettyShow)
@ -291,7 +292,7 @@ upgradeGHCup :: ( MonadMask m
, DownloadFailed
, NoDownload
, NoUpdate
, GHCupShadowed
, ToolShadowed
]
m
Version
@ -322,17 +323,9 @@ upgradeGHCup mtarget force' fatal = do
liftIO (isShadowed destFile) >>= \case
Nothing -> pure ()
Just pa
| fatal -> throwE (GHCupShadowed pa destFile latestVer)
| fatal -> throwE (ToolShadowed GHCup pa destFile latestVer)
| otherwise ->
lift $ logWarn $ "ghcup is shadowed by "
<> T.pack pa
<> ". The upgrade will not be in effect, unless you remove "
<> T.pack pa
<> " or make sure "
<> T.pack destDir
<> " comes before "
<> T.pack (takeDirectory pa)
<> " in PATH."
lift $ logWarn $ T.pack $ prettyShow (ToolShadowed GHCup pa destFile latestVer)
pure latestVer

View File

@ -50,6 +50,7 @@ import System.FilePath
import System.IO.Error
import qualified Data.Text as T
import Text.PrettyPrint.HughesPJClass (prettyShow)
@ -230,6 +231,10 @@ setCabal ver = do
let destL = targetFile
lift $ createLink destL cabalbin
liftIO (isShadowed cabalbin) >>= \case
Nothing -> pure ()
Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed Cabal pa cabalbin ver)
pure ()
unsetCabal :: ( MonadMask m

View File

@ -308,19 +308,21 @@ instance Pretty HadrianNotFound where
pPrint HadrianNotFound =
text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
data GHCupShadowed = GHCupShadowed
data ToolShadowed = ToolShadowed
Tool
FilePath -- shadow binary
FilePath -- upgraded binary
Version -- upgraded version
deriving Show
instance Pretty GHCupShadowed where
pPrint (GHCupShadowed sh up _) =
text ("ghcup is shadowed by "
instance Pretty ToolShadowed where
pPrint (ToolShadowed tool sh up _) =
text (prettyShow tool
<> " is shadowed by "
<> sh
<> ". The upgrade will not be in effect, unless you remove "
<> ".\nThe upgrade will not be in effect, unless you remove "
<> sh
<> " or make sure "
<> "\nor make sure "
<> takeDirectory up
<> " comes before "
<> takeDirectory sh

View File

@ -442,6 +442,11 @@ setGHC ver sghc mBinDir = do
destL <- binarySymLinkDestination binDir fileWithExt
lift $ createLink destL fullF
when (targetFile == "ghc") $
liftIO (isShadowed fullF) >>= \case
Nothing -> pure ()
Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed GHC pa fullF (_tvVersion ver))
when (isNothing mBinDir) $ do
-- create symlink for share dir
when (isNothing . _tvTarget $ ver) $ lift $ symlinkShareDir (fromGHCupPath ghcdir) verS

View File

@ -68,6 +68,7 @@ import qualified Data.List.NonEmpty as NE
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
import Text.PrettyPrint.HughesPJClass (prettyShow)
@ -549,6 +550,10 @@ setHLS ver shls mBinDir = do
when (isNothing mBinDir) $
lift warnAboutHlsCompatibility
liftIO (isShadowed wrapper) >>= \case
Nothing -> pure ()
Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed HLS pa wrapper ver)
unsetHLS :: ( MonadMask m
, MonadReader env m

View File

@ -50,6 +50,7 @@ import System.FilePath
import System.IO.Error
import qualified Data.Text as T
import Text.PrettyPrint.HughesPJClass (prettyShow)
@ -229,6 +230,10 @@ setStack ver = do
lift $ createLink targetFile stackbin
liftIO (isShadowed stackbin) >>= \case
Nothing -> pure ()
Just pa -> lift $ logWarn $ T.pack $ prettyShow (ToolShadowed Cabal pa stackbin ver)
pure ()