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
* proper subcommands: ghcup install ghc
* better logs
* better debug-output
* download progress
* upgrade Upgrade this script in-place

View File

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

View File

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