Oh yeah
This commit is contained in:
parent
b3eac9bf54
commit
30ed7f0226
2
TODO.md
2
TODO.md
@ -2,6 +2,8 @@
|
||||
|
||||
## New
|
||||
|
||||
* download progress
|
||||
|
||||
* Downloads from URL
|
||||
* set Set currently active GHC version
|
||||
* list Show available GHCs and other tools
|
||||
|
36
app/Main.hs
36
app/Main.hs
@ -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|])
|
||||
|
10
lib/GHCup.hs
10
lib/GHCup.hs
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user