Warn on all tools when shadowed
This commit is contained in:
parent
b8b3a16589
commit
9375255452
@ -437,7 +437,7 @@ install' _ (_, ListResult {..}) = do
|
||||
, TarDirDoesNotExist
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, GHCupShadowed
|
||||
, ToolShadowed
|
||||
, UninstallFailed
|
||||
, MergeFileTreeError
|
||||
]
|
||||
|
@ -94,7 +94,7 @@ type UpgradeEffects = '[ DigestError
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, DownloadFailed
|
||||
, GHCupShadowed
|
||||
, ToolShadowed
|
||||
]
|
||||
|
||||
|
||||
|
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 ()
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user