From 8c205fd18c1923cd3b075f8e30948f94a9844a6b Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sun, 13 Mar 2022 22:48:45 +0100 Subject: [PATCH 1/2] Add `--no-set` to install commands, fixes #330 This also slightly changes the default for 'ghcup install cabal/stack/hls'... instead of only setting the installed version if it's the latest, we always set it. So the default is `--set`. For GHC, the default is `--no-set`. --- app/ghcup/GHCup/OptParse.hs | 8 ++++---- app/ghcup/GHCup/OptParse/Common.hs | 8 ++++---- app/ghcup/GHCup/OptParse/Compile.hs | 14 ++------------ app/ghcup/GHCup/OptParse/Install.hs | 13 +++++++------ lib/GHCup.hs | 25 ------------------------- 5 files changed, 17 insertions(+), 51 deletions(-) diff --git a/app/ghcup/GHCup/OptParse.hs b/app/ghcup/GHCup/OptParse.hs index ebe48ed..3dad2bc 100644 --- a/app/ghcup/GHCup/OptParse.hs +++ b/app/ghcup/GHCup/OptParse.hs @@ -113,8 +113,8 @@ data Command opts :: Parser Options opts = Options - <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)") - <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)") + <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)") + <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)") <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal)) <*> optional (option @@ -127,7 +127,7 @@ opts = <> completer fileUri ) ) - <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)")) + <*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)")) <*> optional (option (eitherReader keepOnParser) ( long "keep" @@ -153,7 +153,7 @@ opts = #endif <> hidden )) - <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.") + <*> invertableSwitch "offline" (Just 'o') False (help "Don't do any network calls, trying cached assets and failing if missing.") <*> optional (option (eitherReader gpgParser) ( long "gpg" diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs index cbe4cbc..35867c7 100644 --- a/app/ghcup/GHCup/OptParse/Common.hs +++ b/app/ghcup/GHCup/OptParse/Common.hs @@ -138,7 +138,7 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar -- the help is shown only for --no-recursive. invertableSwitch :: String -- ^ long option - -> Char -- ^ short option for the non-default option + -> Maybe Char -- ^ short option for the non-default option -> Bool -- ^ is switch enabled by default? -> Mod FlagFields Bool -- ^ option modifier -> Parser (Maybe Bool) @@ -149,14 +149,14 @@ invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shorto -- | Allows providing option modifiers for both --foo and --no-foo. invertableSwitch' :: String -- ^ long option (eg "foo") - -> Char -- ^ short option for the non-default option + -> Maybe Char -- ^ short option for the non-default option -> Bool -- ^ is switch enabled by default? -> Mod FlagFields Bool -- ^ option modifier for --foo -> Mod FlagFields Bool -- ^ option modifier for --no-foo -> Parser (Maybe Bool) invertableSwitch' longopt shortopt defv enmod dismod = optional - ( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt) - <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty) + ( flag' True ( enmod <> long longopt <> if defv then mempty else maybe mempty short shortopt) + <|> flag' False (dismod <> long nolongopt <> if defv then maybe mempty short shortopt else mempty) ) where nolongopt = "no-" ++ longopt diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs index 67da670..2308472 100644 --- a/app/ghcup/GHCup/OptParse/Compile.hs +++ b/app/ghcup/GHCup/OptParse/Compile.hs @@ -234,12 +234,7 @@ ghcCompileOpts = ) ) <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)")) - <*> flag - False - True - (long "set" <> help - "Set as active version after install" - ) + <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install")) <*> optional (option (eitherReader @@ -300,12 +295,7 @@ hlsCompileOpts = <> (completer $ listCompleter $ fmap show ([1..12] :: [Int])) ) ) - <*> flag - False - True - (long "set" <> help - "Set as active version after install" - ) + <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install")) <*> optional (option (eitherReader diff --git a/app/ghcup/GHCup/OptParse/Install.hs b/app/ghcup/GHCup/OptParse/Install.hs index 3a2aaab..d7a010b 100644 --- a/app/ghcup/GHCup/OptParse/Install.hs +++ b/app/ghcup/GHCup/OptParse/Install.hs @@ -197,12 +197,8 @@ installOpts tool = ) <|> pure (Nothing, Nothing) ) - <*> flag - False - True - (long "set" <> help - "Set as active version after install" - ) + <*> fmap (fromMaybe setDefault) (invertableSwitch "set" Nothing setDefault + (help $ if not setDefault then "Set as active version after install" else "Don't set as active version after install")) <*> optional (option (eitherReader isolateParser) @@ -215,6 +211,11 @@ installOpts tool = ) <*> switch (short 'f' <> long "force" <> help "Force install") + where + setDefault = case tool of + Nothing -> False + Just GHC -> False + Just _ -> True diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 49bd93a..abf860f 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -468,10 +468,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do Nothing -> do -- regular install liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall - -- create symlink if this is the latest version for regular installs - cVers <- lift $ fmap rights getInstalledCabals - let lInstCabal = headMay . reverse . sort $ cVers - when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver -- | Install an unpacked cabal distribution.Symbol installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m) @@ -626,7 +622,6 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver liftE $ setHLS ver SetHLS_XYZ Nothing - liftE $ installHLSPostInst isoFilepath ver isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist -> IO Bool @@ -696,19 +691,6 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do lift $ chmod_755 destWrapperPath -installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m) - => Maybe FilePath - -> Version - -> Excepts '[NotInstalled] m () -installHLSPostInst isoFilepath ver = - case isoFilepath of - Just _ -> pure () - Nothing -> do - -- create symlink if this is the latest version in a regular install - hlsVers <- lift $ fmap rights getInstalledHLSs - let lInstHLS = headMay . reverse . sort $ hlsVers - when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly Nothing - -- | Installs hls binaries @haskell-language-server-\@ -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. @@ -916,8 +898,6 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True ) - liftE $ installHLSPostInst isolateDir installVer - pure installVer @@ -1034,11 +1014,6 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do Nothing -> do -- regular install liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall - -- create symlink if this is the latest version and a regular install - sVers <- lift $ fmap rights getInstalledStacks - let lInstStack = headMay . reverse . sort $ sVers - when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver - -- | Install an unpacked stack distribution. installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) From 604a6fc92b932d1b931ac8c11065111126f37ab0 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Mon, 14 Mar 2022 00:36:08 +0100 Subject: [PATCH 2/2] Fix bug with isolated installation of not previously installed versions It would error out trying to set the version. --- app/ghcup/GHCup/OptParse/Install.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/app/ghcup/GHCup/OptParse/Install.hs b/app/ghcup/GHCup/OptParse/Install.hs index d7a010b..5f479fb 100644 --- a/app/ghcup/GHCup/OptParse/Install.hs +++ b/app/ghcup/GHCup/OptParse/Install.hs @@ -398,7 +398,7 @@ install installCommand settings getAppState' runLogger = case installCommand of isolateDir forceInstall ) - $ when instSet $ void $ setGHC v SetGHCOnly Nothing + $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing pure vi Just uri -> do runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do @@ -409,7 +409,7 @@ install installCommand settings getAppState' runLogger = case installCommand of isolateDir forceInstall ) - $ when instSet $ void $ setGHC v SetGHCOnly Nothing + $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing pure vi ) >>= \case @@ -469,7 +469,7 @@ install installCommand settings getAppState' runLogger = case installCommand of v isolateDir forceInstall - ) $ when instSet $ void $ setCabal v + ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v pure vi Just uri -> do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do @@ -479,7 +479,7 @@ install installCommand settings getAppState' runLogger = case installCommand of v isolateDir forceInstall - ) $ when instSet $ void $ setCabal v + ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v pure vi ) >>= \case @@ -520,7 +520,7 @@ install installCommand settings getAppState' runLogger = case installCommand of v isolateDir forceInstall - ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing + ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing pure vi Just uri -> do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do @@ -531,7 +531,7 @@ install installCommand settings getAppState' runLogger = case installCommand of v isolateDir forceInstall - ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing + ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing pure vi ) >>= \case @@ -580,7 +580,7 @@ install installCommand settings getAppState' runLogger = case installCommand of v isolateDir forceInstall - ) $ when instSet $ void $ setStack v + ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v pure vi Just uri -> do runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do @@ -590,7 +590,7 @@ install installCommand settings getAppState' runLogger = case installCommand of v isolateDir forceInstall - ) $ when instSet $ void $ setStack v + ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v pure vi ) >>= \case