636 lines
26 KiB
Haskell
636 lines
26 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
module GHCup.OptParse.Install where
|
|
|
|
|
|
|
|
|
|
import GHCup.OptParse.Common
|
|
|
|
import GHCup
|
|
import GHCup.Errors
|
|
import GHCup.Types
|
|
import GHCup.Utils.Dirs
|
|
import GHCup.Prelude.Logger
|
|
import GHCup.Prelude.String.QQ
|
|
|
|
import Codec.Archive
|
|
#if !MIN_VERSION_base(4,13,0)
|
|
import Control.Monad.Fail ( MonadFail )
|
|
#endif
|
|
import Control.Monad.Reader
|
|
import Control.Monad.Trans.Resource
|
|
import Data.Either
|
|
import Data.Functor
|
|
import Data.Maybe
|
|
import Data.Versions hiding ( str )
|
|
import Haskus.Utils.Variant.Excepts
|
|
import Options.Applicative hiding ( style )
|
|
import Options.Applicative.Help.Pretty ( text )
|
|
import Prelude hiding ( appendFile )
|
|
import System.Exit
|
|
import Text.PrettyPrint.HughesPJClass ( prettyShow )
|
|
import URI.ByteString hiding ( uriParser )
|
|
|
|
import qualified Data.Text as T
|
|
|
|
|
|
|
|
|
|
----------------
|
|
--[ Commands ]--
|
|
----------------
|
|
|
|
|
|
data InstallCommand = InstallGHC InstallOptions
|
|
| InstallCabal InstallOptions
|
|
| InstallHLS InstallOptions
|
|
| InstallStack InstallOptions
|
|
|
|
|
|
|
|
|
|
---------------
|
|
--[ Options ]--
|
|
---------------
|
|
|
|
|
|
data InstallOptions = InstallOptions
|
|
{ instVer :: Maybe ToolVersion
|
|
, instPlatform :: Maybe PlatformRequest
|
|
, instBindist :: Maybe URI
|
|
, instSet :: Bool
|
|
, isolateDir :: Maybe FilePath
|
|
, forceInstall :: Bool
|
|
}
|
|
|
|
|
|
|
|
---------------
|
|
--[ Footers ]--
|
|
---------------
|
|
|
|
installCabalFooter :: String
|
|
installCabalFooter = [s|Discussion:
|
|
Installs the specified cabal-install version (or a recommended default one)
|
|
into "~/.ghcup/bin", so it can be overwritten by later
|
|
"cabal install cabal-install", which installs into "~/.cabal/bin" by
|
|
default. Make sure to set up your PATH appropriately, so the cabal
|
|
installation takes precedence.|]
|
|
|
|
|
|
|
|
---------------
|
|
--[ Parsers ]--
|
|
---------------
|
|
|
|
installParser :: Parser (Either InstallCommand InstallOptions)
|
|
installParser =
|
|
(Left <$> subparser
|
|
( command
|
|
"ghc"
|
|
( InstallGHC
|
|
<$> info
|
|
(installOpts (Just GHC) <**> helper)
|
|
( progDesc "Install GHC"
|
|
<> footerDoc (Just $ text installGHCFooter)
|
|
)
|
|
)
|
|
<> command
|
|
"cabal"
|
|
( InstallCabal
|
|
<$> info
|
|
(installOpts (Just Cabal) <**> helper)
|
|
( progDesc "Install Cabal"
|
|
<> footerDoc (Just $ text installCabalFooter)
|
|
)
|
|
)
|
|
<> command
|
|
"hls"
|
|
( InstallHLS
|
|
<$> info
|
|
(installOpts (Just HLS) <**> helper)
|
|
( progDesc "Install haskell-language-server"
|
|
<> footerDoc (Just $ text installHLSFooter)
|
|
)
|
|
)
|
|
<> command
|
|
"stack"
|
|
( InstallStack
|
|
<$> info
|
|
(installOpts (Just Stack) <**> helper)
|
|
( progDesc "Install stack"
|
|
<> footerDoc (Just $ text installStackFooter)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
<|> (Right <$> installOpts Nothing)
|
|
where
|
|
installHLSFooter :: String
|
|
installHLSFooter = [s|Discussion:
|
|
Installs haskell-language-server binaries and wrapper
|
|
into "~/.ghcup/bin"
|
|
|
|
Examples:
|
|
# install recommended HLS
|
|
ghcup install hls|]
|
|
|
|
installStackFooter :: String
|
|
installStackFooter = [s|Discussion:
|
|
Installs stack binaries into "~/.ghcup/bin"
|
|
|
|
Examples:
|
|
# install recommended Stack
|
|
ghcup install stack|]
|
|
|
|
installGHCFooter :: String
|
|
installGHCFooter = [s|Discussion:
|
|
Installs the specified GHC version (or a recommended default one) into
|
|
a self-contained "~/.ghcup/ghc/<ghcver>" directory
|
|
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
|
|
|
|
Examples:
|
|
# install recommended GHC
|
|
ghcup install ghc
|
|
|
|
# install latest GHC
|
|
ghcup install ghc latest
|
|
|
|
# install GHC 8.10.2
|
|
ghcup install ghc 8.10.2
|
|
|
|
# install GHC head fedora bindist
|
|
ghcup install ghc -u https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27 head|]
|
|
|
|
|
|
installOpts :: Maybe Tool -> Parser InstallOptions
|
|
installOpts tool =
|
|
(\p (u, v) b is f -> InstallOptions v p u b is f)
|
|
<$> optional
|
|
(option
|
|
(eitherReader platformParser)
|
|
( short 'p'
|
|
<> long "platform"
|
|
<> metavar "PLATFORM"
|
|
<> help
|
|
"Override for platform (triple matching ghc tarball names), e.g. x86_64-fedora27-linux"
|
|
)
|
|
)
|
|
<*> ( ( (,)
|
|
<$> optional
|
|
(option
|
|
(eitherReader uriParser)
|
|
(short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
|
|
"Install the specified version from this bindist"
|
|
<> completer (toolDlCompleter (fromMaybe GHC tool))
|
|
)
|
|
)
|
|
<*> (Just <$> toolVersionArgument Nothing tool)
|
|
)
|
|
<|> pure (Nothing, Nothing)
|
|
)
|
|
<*> 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)
|
|
( short 'i'
|
|
<> long "isolate"
|
|
<> metavar "DIR"
|
|
<> help "install in an isolated dir instead of the default one"
|
|
<> completer (bashCompleter "directory")
|
|
)
|
|
)
|
|
<*> switch
|
|
(short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)")
|
|
where
|
|
setDefault = case tool of
|
|
Nothing -> False
|
|
Just GHC -> False
|
|
Just _ -> True
|
|
|
|
|
|
|
|
|
|
--------------
|
|
--[ Footer ]--
|
|
--------------
|
|
|
|
|
|
installToolFooter :: String
|
|
installToolFooter = [s|Discussion:
|
|
Installs GHC or cabal. When no command is given, installs GHC
|
|
with the specified version/tag.
|
|
It is recommended to always specify a subcommand (ghc/cabal/hls/stack).|]
|
|
|
|
|
|
|
|
|
|
---------------------------
|
|
--[ Effect interpreters ]--
|
|
---------------------------
|
|
|
|
type InstallEffects = '[ AlreadyInstalled
|
|
, UnknownArchive
|
|
, ArchiveResult
|
|
, FileDoesNotExistError
|
|
, CopyError
|
|
, NotInstalled
|
|
, DirNotEmpty
|
|
, NoDownload
|
|
, NotInstalled
|
|
, BuildFailed
|
|
, TagNotFound
|
|
, DigestError
|
|
, GPGError
|
|
, DownloadFailed
|
|
, TarDirDoesNotExist
|
|
, NextVerNotFound
|
|
, NoToolVersionSet
|
|
, FileAlreadyExistsError
|
|
, ProcessError
|
|
, UninstallFailed
|
|
, MergeFileTreeError
|
|
|
|
, (AlreadyInstalled, ())
|
|
, (UnknownArchive, ())
|
|
, (ArchiveResult, ())
|
|
, (FileDoesNotExistError, ())
|
|
, (CopyError, ())
|
|
, (NotInstalled, ())
|
|
, (UninstallFailed, ())
|
|
, (MergeFileTreeError, ())
|
|
, (DirNotEmpty, ())
|
|
, (NoDownload, ())
|
|
, (BuildFailed, ())
|
|
, (TagNotFound, ())
|
|
, (DigestError, ())
|
|
, (GPGError, ())
|
|
, (DownloadFailed, ())
|
|
, (TarDirDoesNotExist, ())
|
|
, (NextVerNotFound, ())
|
|
, (NoToolVersionSet, ())
|
|
, (FileAlreadyExistsError, ())
|
|
, (ProcessError, ())
|
|
|
|
, (AlreadyInstalled, NotInstalled)
|
|
, (UnknownArchive, NotInstalled)
|
|
, (ArchiveResult, NotInstalled)
|
|
, (FileDoesNotExistError, NotInstalled)
|
|
, (CopyError, NotInstalled)
|
|
, (NotInstalled, NotInstalled)
|
|
, (DirNotEmpty, NotInstalled)
|
|
, (NoDownload, NotInstalled)
|
|
, (NotInstalled, NotInstalled)
|
|
, (UninstallFailed, NotInstalled)
|
|
, (MergeFileTreeError, NotInstalled)
|
|
, (BuildFailed, NotInstalled)
|
|
, (TagNotFound, NotInstalled)
|
|
, (DigestError, NotInstalled)
|
|
, (GPGError, NotInstalled)
|
|
, (DownloadFailed, NotInstalled)
|
|
, (TarDirDoesNotExist, NotInstalled)
|
|
, (NextVerNotFound, NotInstalled)
|
|
, (NoToolVersionSet, NotInstalled)
|
|
, (FileAlreadyExistsError, NotInstalled)
|
|
, (ProcessError, NotInstalled)
|
|
|
|
, ((), NotInstalled)
|
|
]
|
|
|
|
|
|
runInstTool :: AppState
|
|
-> Maybe PlatformRequest
|
|
-> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
|
|
-> IO (VEither InstallEffects a)
|
|
runInstTool appstate' mInstPlatform =
|
|
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
|
|
. runResourceT
|
|
. runE
|
|
@InstallEffects
|
|
|
|
|
|
type InstallGHCEffects = '[ TagNotFound
|
|
, NextVerNotFound
|
|
, NoToolVersionSet
|
|
, BuildFailed
|
|
, DirNotEmpty
|
|
, AlreadyInstalled
|
|
, UninstallFailed
|
|
, MergeFileTreeError
|
|
|
|
, (AlreadyInstalled, NotInstalled)
|
|
, (UnknownArchive, NotInstalled)
|
|
, (ArchiveResult, NotInstalled)
|
|
, (FileDoesNotExistError, NotInstalled)
|
|
, (CopyError, NotInstalled)
|
|
, (NotInstalled, NotInstalled)
|
|
, (DirNotEmpty, NotInstalled)
|
|
, (NoDownload, NotInstalled)
|
|
, (UninstallFailed, NotInstalled)
|
|
, (MergeFileTreeError, NotInstalled)
|
|
, (BuildFailed, NotInstalled)
|
|
, (TagNotFound, NotInstalled)
|
|
, (DigestError, NotInstalled)
|
|
, (GPGError, NotInstalled)
|
|
, (DownloadFailed, NotInstalled)
|
|
, (TarDirDoesNotExist, NotInstalled)
|
|
, (NextVerNotFound, NotInstalled)
|
|
, (NoToolVersionSet, NotInstalled)
|
|
, (FileAlreadyExistsError, NotInstalled)
|
|
, (ProcessError, NotInstalled)
|
|
|
|
, (AlreadyInstalled, ())
|
|
, (UnknownArchive, ())
|
|
, (ArchiveResult, ())
|
|
, (FileDoesNotExistError, ())
|
|
, (CopyError, ())
|
|
, (NotInstalled, ())
|
|
, (DirNotEmpty, ())
|
|
, (NoDownload, ())
|
|
, (UninstallFailed, ())
|
|
, (MergeFileTreeError, ())
|
|
, (BuildFailed, ())
|
|
, (TagNotFound, ())
|
|
, (DigestError, ())
|
|
, (GPGError, ())
|
|
, (DownloadFailed, ())
|
|
, (TarDirDoesNotExist, ())
|
|
, (NextVerNotFound, ())
|
|
, (NoToolVersionSet, ())
|
|
, (FileAlreadyExistsError, ())
|
|
, (ProcessError, ())
|
|
|
|
, ((), NotInstalled)
|
|
]
|
|
|
|
runInstGHC :: AppState
|
|
-> Maybe PlatformRequest
|
|
-> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
|
|
-> IO (VEither InstallGHCEffects a)
|
|
runInstGHC appstate' mInstPlatform =
|
|
flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
|
|
. runResourceT
|
|
. runE
|
|
@InstallGHCEffects
|
|
|
|
|
|
-------------------
|
|
--[ Entrypoints ]--
|
|
-------------------
|
|
|
|
|
|
install :: Either InstallCommand InstallOptions -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
|
|
install installCommand settings getAppState' runLogger = case installCommand of
|
|
(Right iopts) -> do
|
|
runLogger (logWarn "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
|
|
installGHC iopts
|
|
(Left (InstallGHC iopts)) -> installGHC iopts
|
|
(Left (InstallCabal iopts)) -> installCabal iopts
|
|
(Left (InstallHLS iopts)) -> installHLS iopts
|
|
(Left (InstallStack iopts)) -> installStack iopts
|
|
where
|
|
installGHC :: InstallOptions -> IO ExitCode
|
|
installGHC InstallOptions{..} = do
|
|
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
|
(case instBindist of
|
|
Nothing -> runInstGHC s' instPlatform $ do
|
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
|
void $ liftE $ sequenceE (installGHCBin
|
|
(_tvVersion v)
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
)
|
|
$ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
|
|
pure vi
|
|
Just uri -> do
|
|
runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
|
|
(v, vi) <- liftE $ fromVersion instVer GHC
|
|
void $ liftE $ sequenceE (installGHCBindist
|
|
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
|
|
(_tvVersion v)
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
)
|
|
$ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
|
|
pure vi
|
|
)
|
|
>>= \case
|
|
VRight vi -> do
|
|
runLogger $ logInfo "GHC installation successful"
|
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
|
runLogger $ logInfo msg
|
|
pure ExitSuccess
|
|
|
|
VLeft (V (AlreadyInstalled _ v, ())) -> do
|
|
runLogger $ logWarn $
|
|
"GHC ver " <> prettyVer v <> " already installed, remove it first to reinstall"
|
|
pure ExitSuccess
|
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
|
runLogger $ logWarn $
|
|
"GHC ver " <> prettyVer v <> " already installed, remove it first to reinstall"
|
|
pure ExitSuccess
|
|
|
|
VLeft (V (DirNotEmpty fp)) -> do
|
|
runLogger $ logError $
|
|
"Install directory " <> T.pack fp <> " is not empty."
|
|
pure $ ExitFailure 3
|
|
VLeft (V (DirNotEmpty fp, ())) -> do
|
|
runLogger $ logError $
|
|
"Install directory " <> T.pack fp <> " is not empty."
|
|
pure $ ExitFailure 3
|
|
|
|
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
|
case keepDirs settings of
|
|
Never -> runLogger (logError $ T.pack $ prettyShow err)
|
|
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
|
|
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
|
|
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
|
pure $ ExitFailure 3
|
|
VLeft err@(V (BuildFailed tmpdir _, ())) -> do
|
|
case keepDirs settings of
|
|
Never -> runLogger (logError $ T.pack $ prettyShow err)
|
|
_ -> runLogger (logError $ T.pack (prettyShow err) <> "\n" <>
|
|
"Check the logs at " <> T.pack (fromGHCupPath logsDir) <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
|
|
"Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
|
|
pure $ ExitFailure 3
|
|
|
|
VLeft e -> do
|
|
runLogger $ do
|
|
logError $ T.pack $ prettyShow e
|
|
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
|
pure $ ExitFailure 3
|
|
|
|
|
|
installCabal :: InstallOptions -> IO ExitCode
|
|
installCabal InstallOptions{..} = do
|
|
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
|
(case instBindist of
|
|
Nothing -> runInstTool s' instPlatform $ do
|
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
|
void $ liftE $ sequenceE (installCabalBin
|
|
v
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
|
|
pure vi
|
|
Just uri -> do
|
|
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
|
|
void $ liftE $ sequenceE (installCabalBindist
|
|
(DownloadInfo uri Nothing "")
|
|
v
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
|
|
pure vi
|
|
)
|
|
>>= \case
|
|
VRight vi -> do
|
|
runLogger $ logInfo "Cabal installation successful"
|
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
|
runLogger $ logInfo msg
|
|
pure ExitSuccess
|
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
|
runLogger $ logWarn $
|
|
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
|
|
pure ExitSuccess
|
|
VLeft (V (FileAlreadyExistsError fp)) -> do
|
|
runLogger $ logWarn $
|
|
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
|
pure $ ExitFailure 3
|
|
VLeft (V (AlreadyInstalled _ v, ())) -> do
|
|
runLogger $ logWarn $
|
|
"Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
|
|
pure ExitSuccess
|
|
VLeft (V (FileAlreadyExistsError fp, ())) -> do
|
|
runLogger $ logWarn $
|
|
"File " <> T.pack fp <> " already exists. Use 'ghcup install cabal --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
|
pure $ ExitFailure 3
|
|
VLeft e -> do
|
|
runLogger $ do
|
|
logError $ T.pack $ prettyShow e
|
|
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
|
pure $ ExitFailure 4
|
|
|
|
installHLS :: InstallOptions -> IO ExitCode
|
|
installHLS InstallOptions{..} = do
|
|
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
|
(case instBindist of
|
|
Nothing -> runInstTool s' instPlatform $ do
|
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
|
void $ liftE $ sequenceE (installHLSBin
|
|
v
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
|
|
pure vi
|
|
Just uri -> do
|
|
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
|
|
-- TODO: support legacy
|
|
void $ liftE $ sequenceE (installHLSBindist
|
|
(DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
|
|
v
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
|
|
pure vi
|
|
)
|
|
>>= \case
|
|
VRight vi -> do
|
|
runLogger $ logInfo "HLS installation successful"
|
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
|
runLogger $ logInfo msg
|
|
pure ExitSuccess
|
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
|
runLogger $ logWarn $
|
|
"HLS ver "
|
|
<> prettyVer v
|
|
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
|
|
<> prettyVer v
|
|
<> "'"
|
|
pure ExitSuccess
|
|
VLeft (V (FileAlreadyExistsError fp)) -> do
|
|
runLogger $ logWarn $
|
|
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
|
pure $ ExitFailure 3
|
|
VLeft (V (AlreadyInstalled _ v, ())) -> do
|
|
runLogger $ logWarn $
|
|
"HLS ver "
|
|
<> prettyVer v
|
|
<> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
|
|
<> prettyVer v
|
|
<> "'"
|
|
pure ExitSuccess
|
|
VLeft (V (FileAlreadyExistsError fp, ())) -> do
|
|
runLogger $ logWarn $
|
|
"File " <> T.pack fp <> " already exists. Use 'ghcup install hls --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
|
pure $ ExitFailure 3
|
|
VLeft e -> do
|
|
runLogger $ do
|
|
logError $ T.pack $ prettyShow e
|
|
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
|
pure $ ExitFailure 4
|
|
|
|
installStack :: InstallOptions -> IO ExitCode
|
|
installStack InstallOptions{..} = do
|
|
s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
|
|
(case instBindist of
|
|
Nothing -> runInstTool s' instPlatform $ do
|
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
|
void $ liftE $ sequenceE (installStackBin
|
|
v
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
|
|
pure vi
|
|
Just uri -> do
|
|
runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
|
|
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
|
|
void $ liftE $ sequenceE (installStackBindist
|
|
(DownloadInfo uri Nothing "")
|
|
v
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
forceInstall
|
|
) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
|
|
pure vi
|
|
)
|
|
>>= \case
|
|
VRight vi -> do
|
|
runLogger $ logInfo "Stack installation successful"
|
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
|
runLogger $ logInfo msg
|
|
pure ExitSuccess
|
|
VLeft (V (AlreadyInstalled _ v)) -> do
|
|
runLogger $ logWarn $
|
|
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
|
|
pure ExitSuccess
|
|
VLeft (V (FileAlreadyExistsError fp)) -> do
|
|
runLogger $ logWarn $
|
|
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
|
pure $ ExitFailure 3
|
|
VLeft (V (AlreadyInstalled _ v, ())) -> do
|
|
runLogger $ logWarn $
|
|
"Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
|
|
pure ExitSuccess
|
|
VLeft (V (FileAlreadyExistsError fp, ())) -> do
|
|
runLogger $ logWarn $
|
|
"File " <> T.pack fp <> " already exists. Use 'ghcup install stack --isolate " <> T.pack fp <> " --force ..." <> "' if you want to overwrite."
|
|
pure $ ExitFailure 3
|
|
VLeft e -> do
|
|
runLogger $ do
|
|
logError $ T.pack $ prettyShow e
|
|
logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
|
|
pure $ ExitFailure 4
|
|
|