Compare commits
19 Commits
retry-cach
...
issue-440
| Author | SHA1 | Date | |
|---|---|---|---|
|
e116a2392e
|
|||
|
7dd6f1f4a4
|
|||
|
4d82c37539
|
|||
|
801b1edfa7
|
|||
|
c1b67e1787
|
|||
|
70dd106549
|
|||
|
b098aa4e65
|
|||
|
74b784fcfb
|
|||
|
673db344d6
|
|||
|
5594a19c02
|
|||
|
|
a5bc13fe50 | ||
|
a5f2067d76
|
|||
|
be8fa57be1
|
|||
|
6ad9963889
|
|||
|
bcddb05b1d
|
|||
|
f7d2033e25
|
|||
|
6ce7649cfe
|
|||
|
cb0d8b80c3
|
|||
|
e8586cf993
|
16
.github/scripts/common.sh
vendored
16
.github/scripts/common.sh
vendored
@@ -167,13 +167,15 @@ install_ghcup() {
|
|||||||
strip_binary() {
|
strip_binary() {
|
||||||
(
|
(
|
||||||
set -e
|
set -e
|
||||||
binary=$1
|
local binary=$1
|
||||||
if [ "${RUNNER_OS}" = "macOS" ] ; then
|
case "$(uname -s)" in
|
||||||
strip "${binary}"
|
"Darwin"|"darwin")
|
||||||
else
|
;;
|
||||||
if [ "${RUNNER_OS}" != "Windows" ] ; then
|
MSYS_*|MINGW*)
|
||||||
|
;;
|
||||||
|
*)
|
||||||
strip -s "${binary}"
|
strip -s "${binary}"
|
||||||
fi
|
;;
|
||||||
fi
|
esac
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|||||||
8
.github/workflows/release.yaml
vendored
8
.github/workflows/release.yaml
vendored
@@ -311,9 +311,9 @@ jobs:
|
|||||||
|
|
||||||
- if: matrix.ARCH == 'ARM'
|
- if: matrix.ARCH == 'ARM'
|
||||||
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
|
||||||
name: Run build (armv7 linux)
|
name: Run test (armv7 linux)
|
||||||
with:
|
with:
|
||||||
run: sh .github/scripts/test.sh
|
args: sh .github/scripts/test.sh
|
||||||
env:
|
env:
|
||||||
ARTIFACT: ${{ matrix.ARTIFACT }}
|
ARTIFACT: ${{ matrix.ARTIFACT }}
|
||||||
ARCH: ${{ matrix.ARCH }}
|
ARCH: ${{ matrix.ARCH }}
|
||||||
@@ -322,9 +322,9 @@ jobs:
|
|||||||
|
|
||||||
- if: matrix.ARCH == 'ARM64'
|
- if: matrix.ARCH == 'ARM64'
|
||||||
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
|
||||||
name: Run build (aarch64 linux)
|
name: Run test (aarch64 linux)
|
||||||
with:
|
with:
|
||||||
run: sh .github/scripts/test.sh
|
args: sh .github/scripts/test.sh
|
||||||
env:
|
env:
|
||||||
ARTIFACT: ${{ matrix.ARTIFACT }}
|
ARTIFACT: ${{ matrix.ARTIFACT }}
|
||||||
ARCH: ${{ matrix.ARCH }}
|
ARCH: ${{ matrix.ARCH }}
|
||||||
|
|||||||
@@ -13,6 +13,7 @@ import GHCup.Errors
|
|||||||
import GHCup.Types.Optics ( getDirs )
|
import GHCup.Types.Optics ( getDirs )
|
||||||
import GHCup.Types hiding ( LeanAppState(..) )
|
import GHCup.Types hiding ( LeanAppState(..) )
|
||||||
import GHCup.Utils
|
import GHCup.Utils
|
||||||
|
import GHCup.OptParse.Common (logGHCPostRm)
|
||||||
import GHCup.Prelude ( decUTF8Safe )
|
import GHCup.Prelude ( decUTF8Safe )
|
||||||
import GHCup.Prelude.File
|
import GHCup.Prelude.File
|
||||||
import GHCup.Prelude.Logger
|
import GHCup.Prelude.Logger
|
||||||
@@ -554,6 +555,7 @@ del' _ (_, ListResult {..}) = do
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
|
logGHCPostRm (mkTVer lVer)
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
logInfo msg
|
logInfo msg
|
||||||
pure $ Right ()
|
pure $ Right ()
|
||||||
|
|||||||
@@ -67,13 +67,13 @@ import URI.ByteString
|
|||||||
import qualified Data.ByteString.UTF8 as UTF8
|
import qualified Data.ByteString.UTF8 as UTF8
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data Options = Options
|
data Options = Options
|
||||||
{
|
{
|
||||||
-- global options
|
-- global options
|
||||||
optVerbose :: Maybe Bool
|
optVerbose :: Maybe Bool
|
||||||
, optCache :: Maybe Bool
|
, optCache :: Maybe Bool
|
||||||
, optMetaCache :: Maybe Integer
|
, optMetaCache :: Maybe Integer
|
||||||
|
, optMetaMode :: Maybe MetaMode
|
||||||
, optPlatform :: Maybe PlatformRequest
|
, optPlatform :: Maybe PlatformRequest
|
||||||
, optUrlSource :: Maybe URI
|
, optUrlSource :: Maybe URI
|
||||||
, optNoVerify :: Maybe Bool
|
, optNoVerify :: Maybe Bool
|
||||||
@@ -116,7 +116,8 @@ opts =
|
|||||||
Options
|
Options
|
||||||
<$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
|
<$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
|
||||||
<*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
|
<*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
|
||||||
<*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
|
<*> optional (option auto (long "metadata-caching" <> metavar "SEC" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable"))
|
||||||
|
<*> optional (option auto (long "metadata-fetching-mode" <> metavar "<Strict|Lax>" <> help "Whether to fail on metadata download failure (Strict) or fall back to cached version (Lax (default))"))
|
||||||
<*> optional
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader platformParser)
|
(eitherReader platformParser)
|
||||||
|
|||||||
@@ -25,6 +25,7 @@ import Control.DeepSeq
|
|||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Concurrent.Async
|
import Control.Concurrent.Async
|
||||||
import Control.Exception.Safe
|
import Control.Exception.Safe
|
||||||
|
import Control.Monad.Identity (Identity(..))
|
||||||
#if !MIN_VERSION_base(4,13,0)
|
#if !MIN_VERSION_base(4,13,0)
|
||||||
import Control.Monad.Fail ( MonadFail )
|
import Control.Monad.Fail ( MonadFail )
|
||||||
#endif
|
#endif
|
||||||
@@ -64,6 +65,7 @@ import qualified Text.Megaparsec as MP
|
|||||||
import qualified System.FilePath.Posix as FP
|
import qualified System.FilePath.Posix as FP
|
||||||
import GHCup.Version
|
import GHCup.Version
|
||||||
import Control.Exception (evaluate)
|
import Control.Exception (evaluate)
|
||||||
|
import qualified Cabal.Config as CC
|
||||||
|
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
@@ -789,3 +791,12 @@ checkForUpdates = do
|
|||||||
pure $ catMaybes (ghcup:otherTools)
|
pure $ catMaybes (ghcup:otherTools)
|
||||||
where
|
where
|
||||||
forMM a f = fmap join $ forM a f
|
forMM a f = fmap join $ forM a f
|
||||||
|
|
||||||
|
|
||||||
|
logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
|
||||||
|
logGHCPostRm ghcVer = do
|
||||||
|
cabalStore <- liftIO $ handleIO (\_ -> if isWindows then pure "C:\\cabal\\store" else pure "~/.cabal/store")
|
||||||
|
(runIdentity . CC.cfgStoreDir <$> CC.readConfig)
|
||||||
|
let storeGhcDir = cabalStore </> ("ghc-" <> T.unpack (prettyVer $ _tvVersion ghcVer))
|
||||||
|
logInfo $ T.pack $ "After removing GHC you might also want to clean up your cabal store at: " <> storeGhcDir
|
||||||
|
|
||||||
|
|||||||
@@ -59,7 +59,7 @@ data ConfigCommand
|
|||||||
--[ Parsers ]--
|
--[ Parsers ]--
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|
||||||
configP :: Parser ConfigCommand
|
configP :: Parser ConfigCommand
|
||||||
configP = subparser
|
configP = subparser
|
||||||
( command "init" initP
|
( command "init" initP
|
||||||
@@ -124,6 +124,7 @@ updateSettings :: UserSettings -> Settings -> Settings
|
|||||||
updateSettings UserSettings{..} Settings{..} =
|
updateSettings UserSettings{..} Settings{..} =
|
||||||
let cache' = fromMaybe cache uCache
|
let cache' = fromMaybe cache uCache
|
||||||
metaCache' = fromMaybe metaCache uMetaCache
|
metaCache' = fromMaybe metaCache uMetaCache
|
||||||
|
metaMode' = fromMaybe metaMode uMetaMode
|
||||||
noVerify' = fromMaybe noVerify uNoVerify
|
noVerify' = fromMaybe noVerify uNoVerify
|
||||||
keepDirs' = fromMaybe keepDirs uKeepDirs
|
keepDirs' = fromMaybe keepDirs uKeepDirs
|
||||||
downloader' = fromMaybe downloader uDownloader
|
downloader' = fromMaybe downloader uDownloader
|
||||||
@@ -132,7 +133,7 @@ updateSettings UserSettings{..} Settings{..} =
|
|||||||
noNetwork' = fromMaybe noNetwork uNoNetwork
|
noNetwork' = fromMaybe noNetwork uNoNetwork
|
||||||
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
gpgSetting' = fromMaybe gpgSetting uGPGSetting
|
||||||
platformOverride' = uPlatformOverride <|> platformOverride
|
platformOverride' = uPlatformOverride <|> platformOverride
|
||||||
in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
|
in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -188,9 +189,15 @@ config configCommand settings keybindings runLogger = case configCommand of
|
|||||||
AddSource xs -> do
|
AddSource xs -> do
|
||||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
|
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
_ -> do
|
GHCupURL -> do
|
||||||
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
OwnSource xs -> do
|
||||||
|
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
|
||||||
|
pure ExitSuccess
|
||||||
|
OwnSpec spec -> do
|
||||||
|
doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
|
||||||
|
pure ExitSuccess
|
||||||
|
|
||||||
where
|
where
|
||||||
doConfig :: MonadIO m => UserSettings -> m ()
|
doConfig :: MonadIO m => UserSettings -> m ()
|
||||||
|
|||||||
@@ -175,8 +175,8 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
runLogger $ logGHCPostRm ghcVer
|
||||||
runLogger $ logInfo msg
|
postRmLog vi
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ logError $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
@@ -191,8 +191,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
postRmLog vi
|
||||||
runLogger $ logInfo msg
|
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ logError $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
@@ -207,8 +206,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
postRmLog vi
|
||||||
runLogger $ logInfo msg
|
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ logError $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
@@ -223,10 +221,12 @@ rm rmCommand runAppState runLogger = case rmCommand of
|
|||||||
)
|
)
|
||||||
>>= \case
|
>>= \case
|
||||||
VRight vi -> do
|
VRight vi -> do
|
||||||
forM_ (_viPostRemove =<< vi) $ \msg ->
|
postRmLog vi
|
||||||
runLogger $ logInfo msg
|
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
VLeft e -> do
|
VLeft e -> do
|
||||||
runLogger $ logError $ T.pack $ prettyShow e
|
runLogger $ logError $ T.pack $ prettyShow e
|
||||||
pure $ ExitFailure 15
|
pure $ ExitFailure 15
|
||||||
|
|
||||||
|
postRmLog vi =
|
||||||
|
forM_ (_viPostRemove =<< vi) $ \msg ->
|
||||||
|
runLogger $ logInfo msg
|
||||||
|
|||||||
@@ -79,6 +79,7 @@ toSettings options = do
|
|||||||
mergeConf Options{..} UserSettings{..} noColor =
|
mergeConf Options{..} UserSettings{..} noColor =
|
||||||
let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
|
let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
|
||||||
metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
|
metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
|
||||||
|
metaMode = fromMaybe (fromMaybe (Types.metaMode defaultSettings) uMetaMode) optMetaMode
|
||||||
noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
|
noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
|
||||||
verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
|
verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
|
||||||
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
|
||||||
@@ -253,7 +254,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
|||||||
logWarn ("New "
|
logWarn ("New "
|
||||||
<> T.pack (prettyShow t)
|
<> T.pack (prettyShow t)
|
||||||
<> " version available. "
|
<> " version available. "
|
||||||
<> "To upgrade, run 'ghcup install "
|
<> "If you want to install this latest version, run 'ghcup install "
|
||||||
<> T.pack (prettyShow t)
|
<> T.pack (prettyShow t)
|
||||||
<> " "
|
<> " "
|
||||||
<> prettyVer l
|
<> prettyVer l
|
||||||
|
|||||||
@@ -40,6 +40,12 @@ key-bindings:
|
|||||||
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
|
# of the file. These usually are in '~/.ghcup/cache/ghcup-<ver>.yaml'.
|
||||||
meta-cache: 300 # in seconds
|
meta-cache: 300 # in seconds
|
||||||
|
|
||||||
|
# When trying to download ghcup metadata, this option decides what to do
|
||||||
|
# when the download fails:
|
||||||
|
# 1. Lax: use existing ~/.ghcup/cache/ghcup-<ver>.yaml as fallback (default)
|
||||||
|
# 2. Strict: fail hard
|
||||||
|
meta-mode: Lax # Strict | Lax
|
||||||
|
|
||||||
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation
|
||||||
# check the 'URLSource' type in the code.
|
# check the 'URLSource' type in the code.
|
||||||
url-source:
|
url-source:
|
||||||
|
|||||||
@@ -48,6 +48,10 @@ The following distro packages are required: `build-essential curl libffi-dev lib
|
|||||||
|
|
||||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
||||||
|
|
||||||
|
### Linux Mageia
|
||||||
|
|
||||||
|
The following distro packages are required: `curl gcc gcc-c++ gmp libffi-devel libffi7 libgmp-devel libgmp10 make libncurses-devel libncurses5 xz perl`
|
||||||
|
|
||||||
### Linux CentOS
|
### Linux CentOS
|
||||||
|
|
||||||
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
The following distro packages are required: `gcc gcc-c++ gmp gmp-devel make ncurses ncurses-compat-libs xz perl`
|
||||||
|
|||||||
@@ -247,6 +247,7 @@ executable ghcup
|
|||||||
, base >=4.12 && <5
|
, base >=4.12 && <5
|
||||||
, bytestring >=0.10 && <0.12
|
, bytestring >=0.10 && <0.12
|
||||||
, cabal-plan ^>=0.7.2
|
, cabal-plan ^>=0.7.2
|
||||||
|
, cabal-install-parsers >=0.4.5
|
||||||
, containers ^>=0.6
|
, containers ^>=0.6
|
||||||
, deepseq ^>=1.4
|
, deepseq ^>=1.4
|
||||||
, directory ^>=1.3.6.0
|
, directory ^>=1.3.6.0
|
||||||
|
|||||||
@@ -162,17 +162,21 @@ getBase :: ( MonadReader env m
|
|||||||
, MonadMask m
|
, MonadMask m
|
||||||
)
|
)
|
||||||
=> URI
|
=> URI
|
||||||
-> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
|
-> Excepts '[DownloadFailed, GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
|
||||||
getBase uri = do
|
getBase uri = do
|
||||||
Settings { noNetwork, downloader } <- lift getSettings
|
Settings { noNetwork, downloader, metaMode } <- lift getSettings
|
||||||
|
|
||||||
-- try to download yaml... usually this writes it into cache dir,
|
-- try to download yaml... usually this writes it into cache dir,
|
||||||
-- but in some cases not (e.g. when using file://), so we honour
|
-- but in some cases not (e.g. when using file://), so we honour
|
||||||
-- the return filepath, if any
|
-- the return filepath, if any
|
||||||
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
|
mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
|
||||||
then pure Nothing
|
then pure Nothing
|
||||||
else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
|
else handleIO (\e -> case metaMode of
|
||||||
. catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
|
Strict -> throwIO e
|
||||||
|
Lax -> lift (warnCache (displayException e) downloader) >> pure Nothing)
|
||||||
|
. catchE @_ @_ @'[DownloadFailed] (\e@(DownloadFailed _) -> case metaMode of
|
||||||
|
Strict -> throwE e
|
||||||
|
Lax -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
|
||||||
. fmap Just
|
. fmap Just
|
||||||
. smartDl
|
. smartDl
|
||||||
$ uri
|
$ uri
|
||||||
|
|||||||
@@ -676,7 +676,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
(view dlSubdir dlInfo)
|
(view dlSubdir dlInfo)
|
||||||
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
liftE $ applyAnyPatch patches (fromGHCupPath workdir)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, tver)
|
pure (workdir, tmpUnpack, Just tver)
|
||||||
|
|
||||||
RemoteDist uri -> do
|
RemoteDist uri -> do
|
||||||
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)
|
||||||
@@ -694,12 +694,13 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
execBlank
|
execBlank
|
||||||
regex
|
regex
|
||||||
)
|
)
|
||||||
tver <- liftE $ getGHCVer (appendGHCupPath tmpUnpack (takeDirectory bootFile))
|
tver <- liftE $ catchAllE @_ @'[ProcessError, ParseError] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer
|
||||||
|
(appendGHCupPath tmpUnpack (takeDirectory bootFile))
|
||||||
pure (bootFile, tver)
|
pure (bootFile, tver)
|
||||||
|
|
||||||
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)
|
||||||
|
|
||||||
pure (workdir, tmpUnpack, mkTVer tver)
|
pure (workdir, tmpUnpack, mkTVer <$> tver)
|
||||||
|
|
||||||
-- clone from git
|
-- clone from git
|
||||||
GitDist GitBranch{..} -> do
|
GitDist GitBranch{..} -> do
|
||||||
@@ -745,20 +746,23 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
|
liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)
|
||||||
|
|
||||||
-- bootstrap
|
-- bootstrap
|
||||||
tver <- liftE $ getGHCVer tmpUnpack
|
tver <- liftE $ catchAllE @_ @'[ProcessError, ParseError] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer
|
||||||
|
tmpUnpack
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
|
||||||
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n " <>
|
||||||
"GHC version (from Makefile): " <> prettyVer tver <>
|
"GHC version (from Makefile): " <> T.pack (show (prettyVer <$> tver)) <>
|
||||||
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
|
(if not shallow_clone then "\n " <> "'git describe' output: " <> fromJust git_describe else mempty) <>
|
||||||
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
(if isCommitHash ref then mempty else "\n " <> "commit hash: " <> chash)
|
||||||
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
liftIO $ threadDelay 5000000 -- give the user a sec to intervene
|
||||||
|
|
||||||
pure tver
|
pure tver
|
||||||
|
|
||||||
pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
|
pure (tmpUnpack, tmpUnpack, mkTVer <$> tver)
|
||||||
-- the version that's installed may differ from the
|
-- the version that's installed may differ from the
|
||||||
-- compiled version, so the user can overwrite it
|
-- compiled version, so the user can overwrite it
|
||||||
let installVer = maybe tver (\ov' -> tver { _tvVersion = ov' }) ov
|
installVer <- if | Just ov' <- ov -> pure (mkTVer ov')
|
||||||
|
| Just tver' <- tver -> pure tver'
|
||||||
|
| otherwise -> fail "Newer GHCs don't support discovering the version in git. Complain to GHC devs: https://gitlab.haskell.org/ghc/ghc/-/issues/22322"
|
||||||
|
|
||||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||||
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
||||||
@@ -781,8 +785,10 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
tmpUnpack
|
tmpUnpack
|
||||||
(do
|
(do
|
||||||
b <- if hadrian
|
b <- if hadrian
|
||||||
then compileHadrianBindist tver (fromGHCupPath workdir) ghcdir
|
-- prefer 'tver', because the real version carries out compatibility checks
|
||||||
else compileMakeBindist tver (fromGHCupPath workdir) ghcdir
|
-- we don't want the user to do funny things with it
|
||||||
|
then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
|
else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
|
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
|
||||||
pure (b, bmk)
|
pure (b, bmk)
|
||||||
)
|
)
|
||||||
@@ -826,14 +832,14 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
|
|||||||
, MonadThrow m
|
, MonadThrow m
|
||||||
)
|
)
|
||||||
=> GHCupPath
|
=> GHCupPath
|
||||||
-> Excepts '[ProcessError] m Version
|
-> Excepts '[ProcessError, ParseError] m Version
|
||||||
getGHCVer tmpUnpack = do
|
getGHCVer tmpUnpack = do
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||||
CapturedProcess {..} <- lift $ makeOut
|
CapturedProcess {..} <- lift $ makeOut
|
||||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||||
case _exitCode of
|
case _exitCode of
|
||||||
ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
||||||
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
||||||
|
|
||||||
defaultConf =
|
defaultConf =
|
||||||
|
|||||||
@@ -297,10 +297,16 @@ instance NFData URLSource
|
|||||||
instance NFData (URIRef Absolute) where
|
instance NFData (URIRef Absolute) where
|
||||||
rnf (URI !_ !_ !_ !_ !_) = ()
|
rnf (URI !_ !_ !_ !_ !_) = ()
|
||||||
|
|
||||||
|
data MetaMode = Strict
|
||||||
|
| Lax
|
||||||
|
deriving (Show, Read, Eq, GHC.Generic)
|
||||||
|
|
||||||
|
instance NFData MetaMode
|
||||||
|
|
||||||
data UserSettings = UserSettings
|
data UserSettings = UserSettings
|
||||||
{ uCache :: Maybe Bool
|
{ uCache :: Maybe Bool
|
||||||
, uMetaCache :: Maybe Integer
|
, uMetaCache :: Maybe Integer
|
||||||
|
, uMetaMode :: Maybe MetaMode
|
||||||
, uNoVerify :: Maybe Bool
|
, uNoVerify :: Maybe Bool
|
||||||
, uVerbose :: Maybe Bool
|
, uVerbose :: Maybe Bool
|
||||||
, uKeepDirs :: Maybe KeepDirs
|
, uKeepDirs :: Maybe KeepDirs
|
||||||
@@ -314,13 +320,14 @@ data UserSettings = UserSettings
|
|||||||
deriving (Show, GHC.Generic)
|
deriving (Show, GHC.Generic)
|
||||||
|
|
||||||
defaultUserSettings :: UserSettings
|
defaultUserSettings :: UserSettings
|
||||||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||||
|
|
||||||
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
|
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
|
||||||
fromSettings Settings{..} Nothing =
|
fromSettings Settings{..} Nothing =
|
||||||
UserSettings {
|
UserSettings {
|
||||||
uCache = Just cache
|
uCache = Just cache
|
||||||
, uMetaCache = Just metaCache
|
, uMetaCache = Just metaCache
|
||||||
|
, uMetaMode = Just metaMode
|
||||||
, uNoVerify = Just noVerify
|
, uNoVerify = Just noVerify
|
||||||
, uVerbose = Just verbose
|
, uVerbose = Just verbose
|
||||||
, uKeepDirs = Just keepDirs
|
, uKeepDirs = Just keepDirs
|
||||||
@@ -346,6 +353,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
|
|||||||
in UserSettings {
|
in UserSettings {
|
||||||
uCache = Just cache
|
uCache = Just cache
|
||||||
, uMetaCache = Just metaCache
|
, uMetaCache = Just metaCache
|
||||||
|
, uMetaMode = Just metaMode
|
||||||
, uNoVerify = Just noVerify
|
, uNoVerify = Just noVerify
|
||||||
, uVerbose = Just verbose
|
, uVerbose = Just verbose
|
||||||
, uKeepDirs = Just keepDirs
|
, uKeepDirs = Just keepDirs
|
||||||
@@ -426,6 +434,7 @@ instance NFData LeanAppState
|
|||||||
data Settings = Settings
|
data Settings = Settings
|
||||||
{ cache :: Bool
|
{ cache :: Bool
|
||||||
, metaCache :: Integer
|
, metaCache :: Integer
|
||||||
|
, metaMode :: MetaMode
|
||||||
, noVerify :: Bool
|
, noVerify :: Bool
|
||||||
, keepDirs :: KeepDirs
|
, keepDirs :: KeepDirs
|
||||||
, downloader :: Downloader
|
, downloader :: Downloader
|
||||||
@@ -442,7 +451,7 @@ defaultMetaCache :: Integer
|
|||||||
defaultMetaCache = 300 -- 5 minutes
|
defaultMetaCache = 300 -- 5 minutes
|
||||||
|
|
||||||
defaultSettings :: Settings
|
defaultSettings :: Settings
|
||||||
defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False Nothing
|
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
|
||||||
|
|
||||||
instance NFData Settings
|
instance NFData Settings
|
||||||
|
|
||||||
|
|||||||
@@ -43,6 +43,7 @@ import qualified Text.Megaparsec as MP
|
|||||||
import qualified Text.Megaparsec.Char as MPC
|
import qualified Text.Megaparsec.Char as MPC
|
||||||
|
|
||||||
|
|
||||||
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMode
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
|
||||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
|
||||||
|
|||||||
@@ -38,9 +38,13 @@ param (
|
|||||||
# Specify the cabal root directory (default: '$InstallDir\cabal')
|
# Specify the cabal root directory (default: '$InstallDir\cabal')
|
||||||
[string]$CabalDir,
|
[string]$CabalDir,
|
||||||
# Whether to disable use of curl.exe
|
# Whether to disable use of curl.exe
|
||||||
[switch]$DisableCurl
|
[switch]$DisableCurl,
|
||||||
|
# The Msys2 version to download (e.g. 20221216)
|
||||||
|
[string]$Msys2Version
|
||||||
)
|
)
|
||||||
|
|
||||||
|
$DefaultMsys2Version = "20221216"
|
||||||
|
|
||||||
$Silent = !$Interactive
|
$Silent = !$Interactive
|
||||||
|
|
||||||
function Print-Msg {
|
function Print-Msg {
|
||||||
@@ -423,12 +427,15 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
Start-Sleep -s 5
|
Start-Sleep -s 5
|
||||||
|
|
||||||
# Download the archive
|
# Download the archive
|
||||||
Print-Msg -msg 'Downloading Msys2 archive...'
|
if (!($Msys2Version)) {
|
||||||
$archive = 'msys2-x86_64-latest.sfx.exe'
|
$Msys2Version = $DefaultMsys2Version
|
||||||
|
}
|
||||||
|
Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
|
||||||
|
$archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
|
||||||
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
$archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
|
||||||
|
|
||||||
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
|
||||||
Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/{0}' -f "$archive")
|
Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
|
||||||
} else {
|
} else {
|
||||||
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
|
||||||
}
|
}
|
||||||
@@ -603,7 +610,7 @@ if ($DisableCurl) {
|
|||||||
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
|
if ((Get-Process -ID $PID).ProcessName.StartsWith("bootstrap-haskell") -Or $InBash) {
|
||||||
Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
|
Exec "$Bash" '-lc' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
|
||||||
} else {
|
} else {
|
||||||
Exec "$Msys2Shell" '-mingw64' '-mintty' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
|
Exec "$Msys2Shell" '-mingw64' '-mintty' '-shell' 'bash' '-c' ('{4} {6} {7} {8} {9} {10} [ -n ''{1}'' ] && export GHCUP_MSYS2=$(cygpath -m ''{1}'') ; [ -n ''{2}'' ] && export GHCUP_INSTALL_BASE_PREFIX=$(cygpath -m ''{2}/'') ; export PATH=$(cygpath -u ''{3}/bin''):$PATH ; export CABAL_DIR=''{5}'' ; trap ''echo Press any key to exit && read -n 1 && exit'' 2 ; [[ ''{0}'' = https* ]] && {11} {0} | bash || cat $(cygpath -m ''{0}'') | bash ; echo ''Press any key to exit'' && read -n 1' -f $BootstrapUrl, $MsysDir, $GhcupBasePrefix, $GhcupDir, $SilentExport, $CabalDirFull, $StackInstallExport, $HLSInstallExport, $AdjustCabalConfigExport, $MinimalExport, $BootstrapDownloader, $DownloadScript)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user