Warn on all tools when shadowed
This commit is contained in:
15
lib/GHCup.hs
15
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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user