This commit is contained in:
Julian Ospald 2020-03-01 12:54:46 +01:00
parent 12da293100
commit d598c42d19
3 changed files with 73 additions and 56 deletions

View File

@ -2,7 +2,8 @@
## New ## New
* proper subcommands: ghcup install ghc * better logs
* better debug-output
* download progress * download progress
* upgrade Upgrade this script in-place * upgrade Upgrade this script in-place

View File

@ -41,15 +41,17 @@ import qualified Data.Text as T
data Options = Options data Options = Options
{ optVerbose :: Bool {
-- global options
optVerbose :: Bool
, optCache :: Bool , optCache :: Bool
, optUrlSource :: Maybe URI , optUrlSource :: Maybe URI
-- commands
, optCommand :: Command , optCommand :: Command
} }
data Command data Command
= InstallGHC InstallGHCOptions = Install InstallCommand
| InstallCabal InstallCabalOptions
| SetGHC SetGHCOptions | SetGHC SetGHCOptions
| List ListOptions | List ListOptions
| Rm RmOptions | Rm RmOptions
@ -59,12 +61,11 @@ data ToolVersion = ToolVersion Version
| ToolTag Tag | ToolTag Tag
data InstallGHCOptions = InstallGHCOptions data InstallCommand = InstallGHC InstallOptions
{ ghcVer :: Maybe ToolVersion | InstallCabal InstallOptions
}
data InstallCabalOptions = InstallCabalOptions data InstallOptions = InstallOptions
{ cabalVer :: Maybe ToolVersion { instVer :: Maybe ToolVersion
} }
data SetGHCOptions = SetGHCOptions data SetGHCOptions = SetGHCOptions
@ -106,27 +107,12 @@ opts =
bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s') bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s')
com :: Parser Command com :: Parser Command
com = subparser com =
subparser
( command ( command
"install-ghc" "install"
( InstallGHC ( Install
<$> (info (installGHCOpts <**> helper) <$> (info (installP <**> helper) (progDesc "Install GHC or cabal"))
(progDesc "Install a GHC version")
)
)
<> command
"install-cabal"
( InstallCabal
<$> (info (installCabalOpts <**> helper)
(progDesc "Install a cabal-install version")
)
)
<> command
"set-ghc"
( SetGHC
<$> (info (setGHCOpts <**> helper)
(progDesc "Set the currently active GHC version")
)
) )
<> command <> command
"list" "list"
@ -135,24 +121,54 @@ com = subparser
(progDesc "Show available GHCs and other tools") (progDesc "Show available GHCs and other tools")
) )
) )
<> commandGroup "Main commands:"
)
<|> subparser
( command
"set"
( SetGHC
<$> (info (setGHCOpts <**> helper)
(progDesc "Set the currently active GHC version")
)
)
<> command <> command
"rm" "rm"
( Rm ( Rm
<$> (info (rmOpts <**> helper) <$> (info
(rmOpts <**> helper)
(progDesc "Remove a GHC version installed by ghcup") (progDesc "Remove a GHC version installed by ghcup")
) )
) )
<> command <> commandGroup "GHC commands:"
<> hidden
)
<|> subparser
( command
"debug-info" "debug-info"
((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info"))) ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info")))
<> commandGroup "Other commands:"
<> hidden
) )
installGHCOpts :: Parser InstallGHCOptions
installGHCOpts = InstallGHCOptions <$> optional toolVersionParser
installP :: Parser InstallCommand
installP = subparser
( command
"ghc"
( InstallGHC
<$> (info (installOpts <**> helper) (progDesc "Install a GHC version"))
)
<> command
"cabal"
( InstallCabal
<$> (info (installOpts <**> helper)
(progDesc "Install or update a Cabal version")
)
)
)
installCabalOpts :: Parser InstallCabalOptions installOpts :: Parser InstallOptions
installCabalOpts = InstallCabalOptions <$> optional toolVersionParser installOpts = InstallOptions <$> optional toolVersionParser
setGHCOpts :: Parser SetGHCOptions setGHCOpts :: Parser SetGHCOptions
setGHCOpts = SetGHCOptions <$> optional toolVersionParser setGHCOpts = SetGHCOptions <$> optional toolVersionParser
@ -195,7 +211,8 @@ rmOpts =
versionParser :: Parser Version versionParser :: Parser Version
versionParser = option versionParser = option
(eitherReader (bimap (const "Not a valid version") id . version . T.pack)) (eitherReader (bimap (const "Not a valid version") id . version . T.pack))
(short 'v' <> long "version" <> metavar "VERSION") (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
)
toolVersionParser :: Parser ToolVersion toolVersionParser :: Parser ToolVersion
@ -212,7 +229,7 @@ toolVersionParser = verP <|> toolP
other -> Left ([i|Unknown tag #{other}|]) other -> Left ([i|Unknown tag #{other}|])
) )
) )
(short 't' <> long "tag" <> metavar "TAG") (short 't' <> long "tag" <> metavar "TAG" <> help "The target tag")
) )
@ -297,11 +314,11 @@ main = do
@'[PlatformResultError , NoCompatibleArch , DistroNotFound] @'[PlatformResultError , NoCompatibleArch , DistroNotFound]
case optCommand of case optCommand of
InstallGHC (InstallGHCOptions {..}) -> Install (InstallGHC InstallOptions {..}) ->
void void
$ (runInstTool $ do $ (runInstTool $ do
av <- liftE getDownloads av <- liftE getDownloads
v <- liftE $ fromVersion av ghcVer GHC v <- liftE $ fromVersion av instVer GHC
liftE $ installTool (ToolRequest GHC v) Nothing liftE $ installTool (ToolRequest GHC v) Nothing
) )
>>= \case >>= \case
@ -312,11 +329,11 @@ main = do
(T.pack (show treq) <> [s| already installed|]) (T.pack (show treq) <> [s| already installed|])
VLeft e -> VLeft e ->
runLogger ($(logError) [i|#{e}|]) >> exitFailure runLogger ($(logError) [i|#{e}|]) >> exitFailure
InstallCabal (InstallCabalOptions {..}) -> Install (InstallGHC InstallOptions {..}) ->
void void
$ (runInstTool $ do $ (runInstTool $ do
av <- liftE getDownloads av <- liftE getDownloads
v <- liftE $ fromVersion av cabalVer Cabal v <- liftE $ fromVersion av instVer Cabal
liftE $ installTool (ToolRequest Cabal v) Nothing liftE $ installTool (ToolRequest Cabal v) Nothing
) )
>>= \case >>= \case

View File

@ -196,8 +196,7 @@ mkGhcupTmpDir = do
parseAbs tmp parseAbs tmp
withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
=> m (Path Abs)
withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive