This commit is contained in:
Julian Ospald 2020-02-24 15:09:38 +01:00
parent b3eac9bf54
commit 30ed7f0226
3 changed files with 32 additions and 16 deletions

View File

@ -2,6 +2,8 @@
## New
* download progress
* Downloads from URL
* set Set currently active GHC version
* list Show available GHCs and other tools

View File

@ -35,7 +35,7 @@ import System.Exit
data Options = Options
{ optVerbose :: Bool
, optCache :: Bool
, optCache :: Bool
, optCommand :: Command
}
@ -44,13 +44,11 @@ data Command
| InstallCabal InstallCabalOptions
data InstallGHCOptions = InstallGHCOptions
{
ghcVer :: Maybe Version
{ ghcVer :: Maybe Version
}
data InstallCabalOptions = InstallCabalOptions
{
cabalVer :: Maybe Version
{ cabalVer :: Maybe Version
}
@ -120,17 +118,27 @@ main = do
>>= \opt@Options {..} -> do
let settings = toSettings opt
-- wrapper to run effects with settings
let
runInstTool =
runLogger
. flip runReaderT settings
. runE
@'[FileError, ArchiveError, ProcessError, URLException, PlatformResultError, NoDownload, NoCompatibleArch, DistroNotFound, TagNotFound, AlreadyInstalled]
let runInstTool =
runLogger
. flip runReaderT settings
. runE
@'[ FileError
, ArchiveError
, ProcessError
, URLException
, PlatformResultError
, NoDownload
, NoCompatibleArch
, DistroNotFound
, TagNotFound
, AlreadyInstalled
, NotInstalled
]
case optCommand of
InstallGHC (InstallGHCOptions {..}) ->
void
$ (runInstTool $ do
$ (runInstTool $ do
v <- maybe
( getRecommended availableDownloads GHC
?? TagNotFound Recommended GHC
@ -142,7 +150,7 @@ main = do
(OwnSpec availableDownloads)
)
>>= \case
VRight _ -> pure ()
VRight _ -> runLogger $ $(logInfo) ([s|GHC installation successful|])
VLeft (V (AlreadyInstalled treq)) ->
runLogger $ $(logWarn)
(T.pack (show treq) <> [s| already installed|])
@ -161,7 +169,7 @@ main = do
(OwnSpec availableDownloads)
)
>>= \case
VRight _ -> pure ()
VRight _ -> runLogger $ $(logInfo) ([s|Cabal installation successful|])
VLeft (V (AlreadyInstalled treq)) ->
runLogger $ $(logWarn)
(T.pack (show treq) <> [s| already installed|])

View File

@ -556,6 +556,7 @@ installTool :: ( MonadThrow m
, MonadLogger m
, MonadCatch m
, MonadIO m
, MonadFail m
)
=> ToolRequest
-> Maybe PlatformRequest -- ^ if Nothing, looks up current host platform
@ -570,6 +571,7 @@ installTool :: ( MonadThrow m
, NoDownload
, NoCompatibleArch
, DistroNotFound
, NotInstalled
]
m
()
@ -607,7 +609,9 @@ installTool treq mpfReq urlSource = do
-- TODO: test if tool is already installed
case treq of
(ToolRequest GHC ver) -> liftE $ installGHC archiveSubdir ghcdir
(ToolRequest GHC ver) -> do
liftE $ installGHC archiveSubdir ghcdir
liftE $ setGHC ver SetGHCOnly
(ToolRequest Cabal ver) -> liftE $ installCabal archiveSubdir bindir
pure ()
@ -619,7 +623,7 @@ toolAlreadyInstalled ToolRequest {..} = case _tool of
-- | Install an unpacked GHC distribution.
-- | Install an unpacked GHC distribution. This only deals with the GHC build system and nothing else.
installGHC :: (MonadLogger m, MonadIO m)
=> Path Abs -- ^ Path to the unpacked GHC bindist (where the configure script resides)
-> Path Abs -- ^ Path to install to
@ -642,6 +646,7 @@ installCabal :: (MonadLogger m, MonadCatch m, MonadIO m)
installCabal path inst = do
lift $ $(logInfo) ([s|Installing cabal|])
let cabalFile = [rel|cabal|] :: Path Rel
liftIO $ createDirIfMissing newDirPerms inst
handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile)
(inst </> cabalFile)
@ -667,6 +672,7 @@ setGHC ver sghc = do
-- symlink destination
destdir <- liftIO $ ghcupBinDir
liftIO $ createDirIfMissing newDirPerms destdir
-- for ghc tools (ghc, ghci, haddock, ...)
verfiles <- ghcToolFiles ghcdir