Merge branch 'reenable-upgrade'
This commit is contained in:
commit
0f052c3465
@ -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
|
||||
|
@ -57,6 +57,13 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro)
|
||||
and make sure your bashrc sources the startup script
|
||||
(`/usr/share/bash-completion/bash_completion` on some distros).
|
||||
|
||||
## Portability
|
||||
|
||||
`ghcup` is very portable. There are a few exceptions though:
|
||||
|
||||
1. `ghcup tui` is only available on non-windows platforms
|
||||
2. legacy subcommands `ghcup install` (without a tool identifier) and `ghcup install-cabal` may be removed in the future
|
||||
|
||||
# Configuration
|
||||
|
||||
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file
|
||||
|
13
ghcup.cabal
13
ghcup.cabal
@ -48,13 +48,6 @@ flag no-exe
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag disable-upgrade
|
||||
description:
|
||||
Disable upgrade functionality. This is mainly to support brew packagers.
|
||||
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
GHCup
|
||||
@ -204,6 +197,7 @@ executable ghcup
|
||||
GHCup.OptParse.Set
|
||||
GHCup.OptParse.ToolRequirements
|
||||
GHCup.OptParse.UnSet
|
||||
GHCup.OptParse.Upgrade
|
||||
GHCup.OptParse.Whereis
|
||||
|
||||
hs-source-dirs: app/ghcup
|
||||
@ -277,11 +271,6 @@ executable ghcup
|
||||
if flag(no-exe)
|
||||
buildable: False
|
||||
|
||||
if flag(disable-upgrade)
|
||||
cpp-options: -DDISABLE_UPGRADE
|
||||
|
||||
else
|
||||
other-modules: GHCup.OptParse.Upgrade
|
||||
|
||||
test-suite ghcup-test
|
||||
type: exitcode-stdio-1.0
|
||||
|
25
lib/GHCup.hs
25
lib/GHCup.hs
@ -2587,6 +2587,7 @@ upgradeGHCup :: ( MonadMask m
|
||||
=> Maybe FilePath -- ^ full file destination to write ghcup into
|
||||
-> Bool -- ^ whether to force update regardless
|
||||
-- of currently installed version
|
||||
-> Bool -- ^ whether to throw an error if ghcup is shadowed
|
||||
-> Excepts
|
||||
'[ CopyError
|
||||
, DigestError
|
||||
@ -2595,10 +2596,11 @@ upgradeGHCup :: ( MonadMask m
|
||||
, DownloadFailed
|
||||
, NoDownload
|
||||
, NoUpdate
|
||||
, GHCupShadowed
|
||||
]
|
||||
m
|
||||
Version
|
||||
upgradeGHCup mtarget force' = do
|
||||
upgradeGHCup mtarget force' fatal = do
|
||||
Dirs {..} <- lift getDirs
|
||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||
|
||||
@ -2625,15 +2627,18 @@ upgradeGHCup mtarget force' = do
|
||||
lift $ logWarn $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
|
||||
liftIO (isShadowed destFile) >>= \case
|
||||
Nothing -> pure ()
|
||||
Just pa -> 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 (takeFileName pa)
|
||||
<> " in PATH."
|
||||
Just pa
|
||||
| fatal -> throwE (GHCupShadowed 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."
|
||||
|
||||
pure latestVer
|
||||
|
||||
|
@ -27,6 +27,7 @@ import Data.CaseInsensitive ( CI )
|
||||
import Data.Text ( Text )
|
||||
import Data.Versions
|
||||
import Haskus.Utils.Variant
|
||||
import System.FilePath
|
||||
import Text.PrettyPrint hiding ( (<>) )
|
||||
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
|
||||
import URI.ByteString
|
||||
@ -291,6 +292,24 @@ instance Pretty HadrianNotFound where
|
||||
pPrint HadrianNotFound =
|
||||
text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
|
||||
|
||||
data GHCupShadowed = GHCupShadowed
|
||||
FilePath -- shadow binary
|
||||
FilePath -- upgraded binary
|
||||
Version -- upgraded version
|
||||
deriving Show
|
||||
|
||||
instance Pretty GHCupShadowed where
|
||||
pPrint (GHCupShadowed sh up _) =
|
||||
text ("ghcup is shadowed by "
|
||||
<> sh
|
||||
<> ". The upgrade will not be in effect, unless you remove "
|
||||
<> sh
|
||||
<> " or make sure "
|
||||
<> takeDirectory up
|
||||
<> " comes before "
|
||||
<> takeDirectory sh
|
||||
<> " in PATH."
|
||||
)
|
||||
|
||||
-------------------------
|
||||
--[ High-level errors ]--
|
||||
|
Loading…
Reference in New Issue
Block a user