diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index f1fb54d..3640811 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -437,7 +437,7 @@ install' _ (_, ListResult {..}) = do , TarDirDoesNotExist , FileAlreadyExistsError , ProcessError - , GHCupShadowed + , ToolShadowed , UninstallFailed , MergeFileTreeError ] diff --git a/app/ghcup/GHCup/OptParse/Upgrade.hs b/app/ghcup/GHCup/OptParse/Upgrade.hs index 193d178..d15492f 100644 --- a/app/ghcup/GHCup/OptParse/Upgrade.hs +++ b/app/ghcup/GHCup/OptParse/Upgrade.hs @@ -94,7 +94,7 @@ type UpgradeEffects = '[ DigestError , FileDoesNotExistError , CopyError , DownloadFailed - , GHCupShadowed + , ToolShadowed ] diff --git a/lib/GHCup.hs b/lib/GHCup.hs index ffeca3a..1d5c295 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -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 diff --git a/lib/GHCup/Cabal.hs b/lib/GHCup/Cabal.hs index 9f6fe67..9da4f54 100644 --- a/lib/GHCup/Cabal.hs +++ b/lib/GHCup/Cabal.hs @@ -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 diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index 6dd405f..a0fd111 100644 --- a/lib/GHCup/Errors.hs +++ b/lib/GHCup/Errors.hs @@ -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 diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs index 0e8ea65..f3a3420 100644 --- a/lib/GHCup/GHC.hs +++ b/lib/GHCup/GHC.hs @@ -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 diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs index 0f4f131..b99cf2f 100644 --- a/lib/GHCup/HLS.hs +++ b/lib/GHCup/HLS.hs @@ -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 diff --git a/lib/GHCup/Stack.hs b/lib/GHCup/Stack.hs index cfc7587..ee4dfba 100644 --- a/lib/GHCup/Stack.hs +++ b/lib/GHCup/Stack.hs @@ -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 ()