642 lines
24 KiB
Haskell
642 lines
24 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
module GHCup.OptParse.Compile where
|
|
|
|
|
|
import GHCup
|
|
import qualified GHCup.GHC as GHC
|
|
import qualified GHCup.HLS as HLS
|
|
import GHCup.Errors
|
|
import GHCup.Types
|
|
import GHCup.Types.Optics
|
|
import GHCup.Utils
|
|
import GHCup.Prelude.Logger
|
|
import GHCup.Prelude.String.QQ
|
|
import GHCup.OptParse.Common
|
|
|
|
#if !MIN_VERSION_base(4,13,0)
|
|
import Control.Monad.Fail ( MonadFail )
|
|
#endif
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.Monad.Reader
|
|
import Control.Monad.Trans.Resource
|
|
import Data.Bifunctor
|
|
import Data.Functor
|
|
import Data.Maybe
|
|
import Data.Versions ( Version, prettyVer, version, pvp )
|
|
import qualified Data.Versions as V
|
|
import Data.Text ( Text )
|
|
import Haskus.Utils.Variant.Excepts
|
|
import Options.Applicative hiding ( style )
|
|
import Options.Applicative.Help.Pretty ( text, vsep )
|
|
import Prelude hiding ( appendFile )
|
|
import System.Exit
|
|
|
|
import URI.ByteString hiding ( uriParser )
|
|
import qualified Data.Text as T
|
|
import Control.Exception.Safe (MonadMask, displayException)
|
|
import System.FilePath (isPathSeparator)
|
|
import Text.Read (readEither)
|
|
|
|
|
|
|
|
|
|
----------------
|
|
--[ Commands ]--
|
|
----------------
|
|
|
|
|
|
data CompileCommand = CompileGHC GHCCompileOptions
|
|
| CompileHLS HLSCompileOptions
|
|
deriving (Eq, Show)
|
|
|
|
|
|
|
|
---------------
|
|
--[ Options ]--
|
|
---------------
|
|
|
|
|
|
data GHCCompileOptions = GHCCompileOptions
|
|
{ targetGhc :: GHC.GHCVer
|
|
, bootstrapGhc :: Either Version FilePath
|
|
, jobs :: Maybe Int
|
|
, buildConfig :: Maybe FilePath
|
|
, patches :: Maybe (Either FilePath [URI])
|
|
, crossTarget :: Maybe Text
|
|
, addConfArgs :: [Text]
|
|
, setCompile :: Bool
|
|
, overwriteVer :: Maybe [VersionPattern]
|
|
, buildFlavour :: Maybe String
|
|
, buildSystem :: Maybe BuildSystem
|
|
, isolateDir :: Maybe FilePath
|
|
} deriving (Eq, Show)
|
|
|
|
|
|
data HLSCompileOptions = HLSCompileOptions
|
|
{ targetHLS :: HLS.HLSVer
|
|
, jobs :: Maybe Int
|
|
, setCompile :: Bool
|
|
, updateCabal :: Bool
|
|
, overwriteVer :: Maybe [VersionPattern]
|
|
, isolateDir :: Maybe FilePath
|
|
, cabalProject :: Maybe (Either FilePath URI)
|
|
, cabalProjectLocal :: Maybe URI
|
|
, patches :: Maybe (Either FilePath [URI])
|
|
, targetGHCs :: [ToolVersion]
|
|
, cabalArgs :: [Text]
|
|
} deriving (Eq, Show)
|
|
|
|
|
|
|
|
|
|
---------------
|
|
--[ Parsers ]--
|
|
---------------
|
|
|
|
|
|
compileP :: Parser CompileCommand
|
|
compileP = subparser
|
|
( command
|
|
"ghc"
|
|
( CompileGHC
|
|
<$> info
|
|
(ghcCompileOpts <**> helper)
|
|
( progDesc "Compile GHC from source"
|
|
<> footerDoc (Just $ text compileFooter)
|
|
)
|
|
)
|
|
<> command
|
|
"hls"
|
|
( CompileHLS
|
|
<$> info
|
|
(hlsCompileOpts <**> helper)
|
|
( progDesc "Compile HLS from source"
|
|
<> footerDoc (Just $ text compileHLSFooter)
|
|
)
|
|
)
|
|
)
|
|
where
|
|
compileFooter = [s|Discussion:
|
|
Compiles and installs the specified GHC version into
|
|
a self-contained "~/.ghcup/ghc/<ghcver>" directory
|
|
and symlinks the ghc binaries to "~/.ghcup/bin/<binary>-<ghcver>".
|
|
|
|
This also allows building a cross-compiler. Consult the documentation
|
|
first: <https://gitlab.haskell.org/ghc/ghc/-/wikis/building/cross-compiling#configuring-the-build>
|
|
|
|
ENV variables:
|
|
Various toolchain variables will be passed onto the ghc build system,
|
|
such as: CC, LD, OBJDUMP, NM, AR, RANLIB.
|
|
|
|
Examples:
|
|
# compile from known version
|
|
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2
|
|
# compile from git commit/reference
|
|
ghcup compile ghc -j 4 -g master -b 8.2.2
|
|
# specify path to bootstrap ghc
|
|
ghcup compile ghc -j 4 -v 8.4.2 -b /usr/bin/ghc-8.2.2
|
|
# build cross compiler
|
|
ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
|
|
|
|
compileHLSFooter = [s|Discussion:
|
|
Compiles and installs the specified HLS version.
|
|
The --ghc arguments are necessary to specify which GHC version to build for/against.
|
|
These need to be available in PATH prior to compilation.
|
|
|
|
Examples:
|
|
# compile 1.7.0.0 from hackage for 8.10.7, running 'cabal update' before the build
|
|
ghcup compile hls --version 1.7.0.0 --ghc 8.10.7 --cabal-update
|
|
# compile from master for ghc 9.2.3, appending the short git commit hash to the version and ignore the pinned index state
|
|
ghcup compile hls -g master -o '%v-%h' --ghc 9.2.3 -- --index-state=@(date '+%s')
|
|
# compile a specific commit for ghc 9.2.3 and set a specific version for the binary name
|
|
ghcup compile hls -g a32db0b -o 1.7.0.0-p1 --ghc 9.2.3|]
|
|
|
|
|
|
ghcCompileOpts :: Parser GHCCompileOptions
|
|
ghcCompileOpts =
|
|
GHCCompileOptions
|
|
<$> ((GHC.SourceDist <$> option
|
|
(eitherReader
|
|
(first (const "Not a valid version") . version . T.pack)
|
|
)
|
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
|
"The tool version to compile"
|
|
<> (completer $ versionCompleter [] GHC)
|
|
)
|
|
) <|>
|
|
(GHC.GitDist <$> (GitBranch <$> option
|
|
str
|
|
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
|
"The git commit/branch/ref to build from"
|
|
) <*>
|
|
optional (option str (
|
|
short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to GHC upstream)"
|
|
<> completer (gitFileUri ["https://gitlab.haskell.org/ghc/ghc.git"])
|
|
))
|
|
))
|
|
<|>
|
|
(
|
|
GHC.RemoteDist <$> (option
|
|
(eitherReader uriParser)
|
|
(long "remote-source-dist" <> metavar "URI" <> help
|
|
"URI (https/http/file) to a GHC source distribution"
|
|
<> completer fileUri
|
|
)
|
|
)
|
|
)
|
|
)
|
|
<*> option
|
|
(eitherReader
|
|
(\x ->
|
|
(bimap (const "Not a valid version") Left . version . T.pack $ x) <|> (if isPathSeparator (head x) then pure $ Right x else Left "Not an absolute Path")
|
|
)
|
|
)
|
|
( short 'b'
|
|
<> long "bootstrap-ghc"
|
|
<> metavar "BOOTSTRAP_GHC"
|
|
<> help
|
|
"The GHC version (or full path) to bootstrap with (must be installed)"
|
|
<> (completer $ versionCompleter [] GHC)
|
|
)
|
|
<*> optional
|
|
(option
|
|
(eitherReader (readEither @Int))
|
|
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
|
|
"How many jobs to use for make"
|
|
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
str
|
|
(short 'c' <> long "config" <> metavar "CONFIG" <> help
|
|
"Absolute path to build config file"
|
|
<> completer (bashCompleter "file")
|
|
)
|
|
)
|
|
<*> (optional
|
|
(
|
|
(fmap Right $ many $ option
|
|
(eitherReader uriParser)
|
|
(long "patch" <> metavar "PATCH_URI" <> help
|
|
"URI to a patch (https/http/file)"
|
|
<> completer fileUri
|
|
)
|
|
)
|
|
<|>
|
|
(fmap Left $ option
|
|
str
|
|
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
|
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1. This order is determined by a quilt series file if it exists, or the patches are lexicographically ordered)"
|
|
<> completer (bashCompleter "directory")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
str
|
|
(short 'x' <> long "cross-target" <> metavar "CROSS_TARGET" <> help
|
|
"Build cross-compiler for this platform"
|
|
)
|
|
)
|
|
<*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to compile configure, prefix with '-- ' (longopts)"))
|
|
<*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
|
|
<*> optional
|
|
(option
|
|
(eitherReader overWriteVersionParser
|
|
)
|
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION"
|
|
<> helpDoc (Just $ vsep [ text "Overwrite the finally installed VERSION with a different one. Allows to specify patterns"
|
|
, text "%v version"
|
|
, text "%b branch name"
|
|
, text "%h short commit hash"
|
|
, text "%H long commit hash"
|
|
, text "%g 'git describe' output"
|
|
])
|
|
<> (completer $ versionCompleter [] GHC)
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
str
|
|
(short 'f' <> long "flavour" <> metavar "BUILD_FLAVOUR" <> help
|
|
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
|
)
|
|
)
|
|
<*> (
|
|
(\b -> if b then Just Hadrian else Nothing) <$> switch
|
|
(long "hadrian" <> help "Use the hadrian build system instead of make. Tries to detect by default."
|
|
)
|
|
<|>
|
|
(\b -> if b then Just Make else Nothing) <$> switch
|
|
(long "make" <> help "Use the make build system instead of hadrian. Tries to detect by default."
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
(eitherReader isolateParser)
|
|
( short 'i'
|
|
<> long "isolate"
|
|
<> metavar "DIR"
|
|
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
|
|
<> completer (bashCompleter "directory")
|
|
)
|
|
)
|
|
|
|
hlsCompileOpts :: Parser HLSCompileOptions
|
|
hlsCompileOpts =
|
|
HLSCompileOptions
|
|
<$> ((HLS.HackageDist <$> option
|
|
(eitherReader
|
|
((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack)
|
|
)
|
|
(short 'v' <> long "version" <> metavar "VERSION" <> help
|
|
"The version to compile (pulled from hackage)"
|
|
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
|
|
)
|
|
)
|
|
<|>
|
|
(HLS.GitDist <$> (GitBranch <$> option
|
|
str
|
|
(short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
|
|
"The git commit/branch/ref to build from (accepts anything 'git checkout' accepts)"
|
|
) <*>
|
|
optional (option str (short 'r' <> long "repository" <> metavar "GIT_REPOSITORY" <> help "The git repository to build from (defaults to HLS upstream)"
|
|
<> completer (gitFileUri ["https://github.com/haskell/haskell-language-server.git"])
|
|
))
|
|
))
|
|
<|>
|
|
(HLS.SourceDist <$> (option
|
|
(eitherReader
|
|
(first (const "Not a valid version") . version . T.pack)
|
|
)
|
|
(long "source-dist" <> metavar "VERSION" <> help
|
|
"The version to compile (pulled from packaged git sources)"
|
|
<> (completer $ versionCompleter [] HLS)
|
|
)
|
|
))
|
|
<|>
|
|
(
|
|
HLS.RemoteDist <$> (option
|
|
(eitherReader uriParser)
|
|
(long "remote-source-dist" <> metavar "URI" <> help
|
|
"URI (https/http/file) to a HLS source distribution"
|
|
<> completer fileUri
|
|
)
|
|
)
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
(eitherReader (readEither @Int))
|
|
(short 'j' <> long "jobs" <> metavar "JOBS" <> help
|
|
"How many jobs to use for make"
|
|
<> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
|
|
)
|
|
)
|
|
<*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
|
|
<*> switch (long "cabal-update" <> help "Run 'cabal update' before the build")
|
|
<*>
|
|
(
|
|
optional (option
|
|
(eitherReader overWriteVersionParser
|
|
)
|
|
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION"
|
|
<> helpDoc (Just $ vsep [ text "Overwrite the finally installed VERSION with a different one. Allows to specify patterns"
|
|
, text "%v version from cabal file"
|
|
, text "%b branch name"
|
|
, text "%h short commit hash"
|
|
, text "%H long commit hash"
|
|
, text "%g 'git describe' output"
|
|
])
|
|
<> (completer $ versionCompleter [] HLS)
|
|
)
|
|
)
|
|
<|>
|
|
((\b -> if b then Just [GitDescribe] else Nothing) <$> (switch
|
|
(long "git-describe-version"
|
|
<> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
|
|
<> internal
|
|
)
|
|
)
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
(eitherReader isolateParser)
|
|
( short 'i'
|
|
<> long "isolate"
|
|
<> metavar "DIR"
|
|
<> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
|
|
<> completer (bashCompleter "directory")
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
((fmap Right $ eitherReader uriParser) <|> (fmap Left str))
|
|
(long "cabal-project" <> metavar "CABAL_PROJECT" <> help
|
|
"If relative filepath, specifies the path to cabal.project inside the unpacked HLS tarball/checkout. Otherwise expects a full URI with https/http/file scheme."
|
|
<> completer fileUri
|
|
)
|
|
)
|
|
<*> optional
|
|
(option
|
|
(eitherReader uriParser)
|
|
(long "cabal-project-local" <> metavar "CABAL_PROJECT_LOCAL" <> help
|
|
"URI (https/http/file) to a cabal.project.local to be used for the build. Will be copied over."
|
|
<> completer fileUri
|
|
)
|
|
)
|
|
<*> (optional
|
|
(
|
|
(fmap Right $ many $ option
|
|
(eitherReader uriParser)
|
|
(long "patch" <> metavar "PATCH_URI" <> help
|
|
"URI to a patch (https/http/file)"
|
|
<> completer fileUri
|
|
)
|
|
)
|
|
<|>
|
|
(fmap Left $ option
|
|
str
|
|
(short 'p' <> long "patchdir" <> metavar "PATCH_DIR" <> help
|
|
"Absolute path to patch directory (applies all .patch and .diff files in order using -p1)"
|
|
<> completer (bashCompleter "directory")
|
|
)
|
|
)
|
|
)
|
|
)
|
|
<*> some (
|
|
option (eitherReader ghcVersionTagEither)
|
|
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
|
|
<> completer (tagCompleter GHC [])
|
|
<> completer (versionCompleter [] GHC))
|
|
)
|
|
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
|
|
|
|
|
|
|
|
|
|
|
|
---------------------------
|
|
--[ Effect interpreters ]--
|
|
---------------------------
|
|
|
|
|
|
type GHCEffects = '[ AlreadyInstalled
|
|
, BuildFailed
|
|
, DigestError
|
|
, ContentLengthError
|
|
, GPGError
|
|
, DownloadFailed
|
|
, GHCupSetError
|
|
, NoDownload
|
|
, NotFoundInPATH
|
|
, PatchFailed
|
|
, UnknownArchive
|
|
, TarDirDoesNotExist
|
|
, NotInstalled
|
|
, DirNotEmpty
|
|
, ArchiveResult
|
|
, FileDoesNotExistError
|
|
, HadrianNotFound
|
|
, InvalidBuildConfig
|
|
, ProcessError
|
|
, CopyError
|
|
, BuildFailed
|
|
, UninstallFailed
|
|
, MergeFileTreeError
|
|
]
|
|
type HLSEffects = '[ AlreadyInstalled
|
|
, BuildFailed
|
|
, DigestError
|
|
, ContentLengthError
|
|
, GPGError
|
|
, DownloadFailed
|
|
, GHCupSetError
|
|
, NoDownload
|
|
, NotFoundInPATH
|
|
, PatchFailed
|
|
, UnknownArchive
|
|
, TarDirDoesNotExist
|
|
, TagNotFound
|
|
, DayNotFound
|
|
, NextVerNotFound
|
|
, NoToolVersionSet
|
|
, NotInstalled
|
|
, DirNotEmpty
|
|
, ArchiveResult
|
|
, UninstallFailed
|
|
, MergeFileTreeError
|
|
]
|
|
|
|
|
|
|
|
runCompileGHC :: (MonadUnliftIO m, MonadIO m)
|
|
=> (ReaderT AppState m (VEither GHCEffects a) -> m (VEither GHCEffects a))
|
|
-> Excepts GHCEffects (ResourceT (ReaderT AppState m)) a
|
|
-> m (VEither GHCEffects a)
|
|
runCompileGHC runAppState =
|
|
runAppState
|
|
. runResourceT
|
|
. runE
|
|
@GHCEffects
|
|
|
|
runCompileHLS :: (MonadUnliftIO m, MonadIO m)
|
|
=> (ReaderT AppState m (VEither HLSEffects a) -> m (VEither HLSEffects a))
|
|
-> Excepts HLSEffects (ResourceT (ReaderT AppState m)) a
|
|
-> m (VEither HLSEffects a)
|
|
runCompileHLS runAppState =
|
|
runAppState
|
|
. runResourceT
|
|
. runE
|
|
@HLSEffects
|
|
|
|
|
|
|
|
------------------
|
|
--[ Entrypoint ]--
|
|
------------------
|
|
|
|
|
|
|
|
compile :: ( Monad m
|
|
, MonadMask m
|
|
, MonadUnliftIO m
|
|
, MonadFail m
|
|
)
|
|
=> CompileCommand
|
|
-> Settings
|
|
-> Dirs
|
|
-> (forall eff a . ReaderT AppState m (VEither eff a) -> m (VEither eff a))
|
|
-> (ReaderT LeanAppState m () -> m ())
|
|
-> m ExitCode
|
|
compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|
case compileCommand of
|
|
(CompileHLS HLSCompileOptions { .. }) -> do
|
|
runCompileHLS runAppState (do
|
|
case targetHLS of
|
|
HLS.SourceDist targetVer -> do
|
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
|
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
|
forM_ (_viPreInstall =<< vi) $ \msg -> do
|
|
lift $ logWarn msg
|
|
lift $ logWarn
|
|
"...waiting for 5 seconds, you can still abort..."
|
|
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
|
lift $ logWarn msg
|
|
lift $ logWarn
|
|
"...waiting for 5 seconds, you can still abort..."
|
|
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
|
_ -> pure ()
|
|
ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
|
|
targetVer <- liftE $ compileHLS
|
|
targetHLS
|
|
ghcs
|
|
jobs
|
|
overwriteVer
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
cabalProject
|
|
cabalProjectLocal
|
|
updateCabal
|
|
patches
|
|
cabalArgs
|
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
|
let vi = getVersionInfo (mkTVer targetVer) HLS dls
|
|
when setCompile $ void $ liftE $
|
|
setHLS targetVer SetHLSOnly Nothing
|
|
pure (vi, targetVer)
|
|
)
|
|
>>= \case
|
|
VRight (vi, tv) -> do
|
|
runLogger $ logInfo
|
|
"HLS successfully compiled and installed"
|
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
|
runLogger $ logInfo msg
|
|
liftIO $ putStr (T.unpack $ prettyVer tv)
|
|
pure ExitSuccess
|
|
VLeft err@(V (BuildFailed tmpdir _)) -> do
|
|
case keepDirs settings of
|
|
Never -> runLogger $ logError $ T.pack $ prettyHFError err
|
|
_ -> runLogger (logError $ T.pack (prettyHFError 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 9
|
|
VLeft e -> do
|
|
runLogger $ logError $ T.pack $ prettyHFError e
|
|
pure $ ExitFailure 9
|
|
(CompileGHC GHCCompileOptions {..}) ->
|
|
runCompileGHC runAppState (do
|
|
case targetGhc of
|
|
GHC.SourceDist targetVer -> do
|
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
|
let vi = getVersionInfo (mkTVer targetVer) GHC dls
|
|
forM_ (_viPreInstall =<< vi) $ \msg -> do
|
|
lift $ logWarn msg
|
|
lift $ logWarn
|
|
"...waiting for 5 seconds, you can still abort..."
|
|
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
|
forM_ (_viPreCompile =<< vi) $ \msg -> do
|
|
lift $ logWarn msg
|
|
lift $ logWarn
|
|
"...waiting for 5 seconds, you can still abort..."
|
|
liftIO $ threadDelay 5000000 -- for compilation, give the user a sec to intervene
|
|
_ -> pure ()
|
|
targetVer <- liftE $ compileGHC
|
|
targetGhc
|
|
crossTarget
|
|
overwriteVer
|
|
bootstrapGhc
|
|
jobs
|
|
buildConfig
|
|
patches
|
|
addConfArgs
|
|
buildFlavour
|
|
buildSystem
|
|
(maybe GHCupInternal IsolateDir isolateDir)
|
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
|
let vi = getVersionInfo targetVer GHC dls
|
|
when setCompile $ void $ liftE $
|
|
setGHC targetVer SetGHCOnly Nothing
|
|
pure (vi, targetVer)
|
|
)
|
|
>>= \case
|
|
VRight (vi, tv) -> do
|
|
runLogger $ logInfo
|
|
"GHC successfully compiled and installed"
|
|
forM_ (_viPostInstall =<< vi) $ \msg ->
|
|
runLogger $ logInfo msg
|
|
liftIO $ putStr (T.unpack $ tVerToText tv)
|
|
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 err@(V (BuildFailed tmpdir _)) -> do
|
|
case keepDirs settings of
|
|
Never -> runLogger $ logError $ T.pack $ prettyHFError err
|
|
_ -> runLogger (logError $ T.pack (prettyHFError 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 9
|
|
VLeft e -> do
|
|
runLogger $ logError $ T.pack $ prettyHFError e
|
|
pure $ ExitFailure 9
|