hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'issue-330'

Browse Source
This commit is contained in:
Julian Ospald
2022-03-14 11:49:40 +01:00
parent c1e0baedd3 604a6fc92b
commit 4c0160bb28
5 changed files with 25 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
app/ghcup/GHCup/OptParse/Common.hs
View File

@@ -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

14
app/ghcup/GHCup/OptParse/Compile.hs
View File

@@ -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

29
app/ghcup/GHCup/OptParse/Install.hs
View File

@@ -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
@@ -397,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
@@ -408,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
@@ -468,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
@@ -478,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
@@ -519,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
@@ -530,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
@@ -579,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
@@ -589,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