Re-enable upgrade functionality for all configurations
Adds a --fail-if-shadowed switch.
This commit is contained in:
@@ -437,6 +437,7 @@ install' _ (_, ListResult {..}) = do
|
||||
, TarDirDoesNotExist
|
||||
, FileAlreadyExistsError
|
||||
, ProcessError
|
||||
, GHCupShadowed
|
||||
]
|
||||
|
||||
run (do
|
||||
@@ -452,7 +453,7 @@ install' _ (_, ListResult {..}) = do
|
||||
liftE $ installCabalBin lVer Nothing False $> (vi, dirs, ce)
|
||||
GHCup -> do
|
||||
let vi = snd <$> getLatest dls GHCup
|
||||
liftE $ upgradeGHCup Nothing False $> (vi, dirs, ce)
|
||||
liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
|
||||
HLS -> do
|
||||
let vi = getVersionInfo lVer HLS dls
|
||||
liftE $ installHLSBin lVer Nothing False $> (vi, dirs, ce)
|
||||
|
||||
@@ -96,7 +96,7 @@ data Command
|
||||
| Config ConfigCommand
|
||||
| Whereis WhereisOptions WhereisCommand
|
||||
#ifndef DISABLE_UPGRADE
|
||||
| Upgrade UpgradeOpts Bool
|
||||
| Upgrade UpgradeOpts Bool Bool
|
||||
#endif
|
||||
| ToolRequirements ToolReqOpts
|
||||
| ChangeLog ChangeLogOptions
|
||||
@@ -222,18 +222,18 @@ com =
|
||||
(info (List <$> listOpts <**> helper)
|
||||
(progDesc "Show available GHCs and other tools")
|
||||
)
|
||||
#ifndef DISABLE_UPGRADE
|
||||
<> command
|
||||
"upgrade"
|
||||
(info
|
||||
( (Upgrade <$> upgradeOptsP <*> switch
|
||||
(short 'f' <> long "force" <> help "Force update")
|
||||
<*> switch
|
||||
(long "fail-if-shadowed" <> help "Fails after upgrading if the upgraded ghcup binary is shadowed by something else in PATH (useful for CI)")
|
||||
)
|
||||
<**> helper
|
||||
)
|
||||
(progDesc "Upgrade ghcup")
|
||||
)
|
||||
#endif
|
||||
<> command
|
||||
"compile"
|
||||
( Compile
|
||||
|
||||
@@ -59,15 +59,16 @@ data UpgradeOpts = UpgradeInplace
|
||||
--[ Parsers ]--
|
||||
---------------
|
||||
|
||||
|
||||
|
||||
upgradeOptsP :: Parser UpgradeOpts
|
||||
upgradeOptsP =
|
||||
flag'
|
||||
UpgradeInplace
|
||||
(short 'i' <> long "inplace" <> help
|
||||
"Upgrade ghcup in-place (wherever it's at)"
|
||||
"Upgrade ghcup in-place"
|
||||
)
|
||||
<|> ( UpgradeAt
|
||||
<|>
|
||||
( UpgradeAt
|
||||
<$> option
|
||||
str
|
||||
(short 't' <> long "target" <> metavar "TARGET_DIR" <> help
|
||||
@@ -92,6 +93,7 @@ type UpgradeEffects = '[ DigestError
|
||||
, FileDoesNotExistError
|
||||
, CopyError
|
||||
, DownloadFailed
|
||||
, GHCupShadowed
|
||||
]
|
||||
|
||||
|
||||
@@ -120,18 +122,19 @@ upgrade :: ( Monad m
|
||||
)
|
||||
=> UpgradeOpts
|
||||
-> Bool
|
||||
-> Bool
|
||||
-> Dirs
|
||||
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
|
||||
-> (ReaderT LeanAppState m () -> m ())
|
||||
-> m ExitCode
|
||||
upgrade uOpts force' Dirs{..} runAppState runLogger = do
|
||||
upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
|
||||
target <- case uOpts of
|
||||
UpgradeInplace -> Just <$> liftIO getExecutablePath
|
||||
(UpgradeAt p) -> pure $ Just p
|
||||
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
|
||||
|
||||
runUpgrade runAppState (do
|
||||
v' <- liftE $ upgradeGHCup target force'
|
||||
v' <- liftE $ upgradeGHCup target force' fatal
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
pure (v', dls)
|
||||
) >>= \case
|
||||
|
||||
@@ -141,9 +141,7 @@ main = do
|
||||
)
|
||||
let listCommands = infoOption
|
||||
("install set rm install-cabal list"
|
||||
#ifndef DISABLE_UPGRADE
|
||||
<> " upgrade"
|
||||
#endif
|
||||
<> " compile debug-info tool-requirements changelog"
|
||||
)
|
||||
( long "list-commands"
|
||||
@@ -245,14 +243,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
alreadyInstalling' <- alreadyInstalling optCommand newTool
|
||||
when (not alreadyInstalling') $
|
||||
case t of
|
||||
#ifdef DISABLE_UPGRADE
|
||||
GHCup -> pure ()
|
||||
#else
|
||||
GHCup -> runLogger $
|
||||
logWarn ("New GHCup version available: "
|
||||
<> prettyVer l
|
||||
<> ". To upgrade, run 'ghcup upgrade'")
|
||||
#endif
|
||||
_ -> runLogger $
|
||||
logWarn ("New "
|
||||
<> T.pack (prettyShow t)
|
||||
@@ -296,26 +290,24 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
s' <- appState
|
||||
liftIO $ brickMain s' >> pure ExitSuccess
|
||||
#endif
|
||||
Install installCommand -> install installCommand settings appState runLogger
|
||||
InstallCabalLegacy iopts -> install (Left (InstallCabal iopts)) settings appState runLogger
|
||||
Set setCommand -> set setCommand runAppState runLeanAppState runLogger
|
||||
UnSet unsetCommand -> unset unsetCommand runLeanAppState runLogger
|
||||
List lo -> list lo no_color runAppState
|
||||
Rm rmCommand -> rm rmCommand runAppState runLogger
|
||||
DInfo -> dinfo runAppState runLogger
|
||||
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
|
||||
Config configCommand -> config configCommand settings keybindings runLogger
|
||||
Install installCommand -> install installCommand settings appState runLogger
|
||||
InstallCabalLegacy iopts -> install (Left (InstallCabal iopts)) settings appState runLogger
|
||||
Set setCommand -> set setCommand runAppState runLeanAppState runLogger
|
||||
UnSet unsetCommand -> unset unsetCommand runLeanAppState runLogger
|
||||
List lo -> list lo no_color runAppState
|
||||
Rm rmCommand -> rm rmCommand runAppState runLogger
|
||||
DInfo -> dinfo runAppState runLogger
|
||||
Compile compileCommand -> compile compileCommand settings dirs runAppState runLogger
|
||||
Config configCommand -> config configCommand settings keybindings runLogger
|
||||
Whereis whereisOptions
|
||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||
#ifndef DISABLE_UPGRADE
|
||||
Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
|
||||
#endif
|
||||
ToolRequirements topts -> toolRequirements topts runAppState runLogger
|
||||
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
|
||||
Nuke -> nuke appState runLogger
|
||||
Prefetch pfCom -> prefetch pfCom runAppState runLogger
|
||||
GC gcOpts -> gc gcOpts runAppState runLogger
|
||||
Run runCommand -> run runCommand appState leanAppstate runLogger
|
||||
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
|
||||
Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger
|
||||
ToolRequirements topts -> toolRequirements topts runAppState runLogger
|
||||
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
|
||||
Nuke -> nuke appState runLogger
|
||||
Prefetch pfCom -> prefetch pfCom runAppState runLogger
|
||||
GC gcOpts -> gc gcOpts runAppState runLogger
|
||||
Run runCommand -> run runCommand appState leanAppstate runLogger
|
||||
|
||||
case res of
|
||||
ExitSuccess -> pure ()
|
||||
@@ -353,9 +345,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
|
||||
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
|
||||
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
|
||||
#ifndef DISABLE_UPGRADE
|
||||
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
|
||||
#endif
|
||||
alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
|
||||
alreadyInstalling _ _ = pure False
|
||||
|
||||
cmp' :: ( HasLog env
|
||||
|
||||
Reference in New Issue
Block a user