Merge branch 'master' into optparse-test-suite
This commit is contained in:
commit
bcb498de20
74
.github/scripts/cross.sh
vendored
Normal file
74
.github/scripts/cross.sh
vendored
Normal file
@ -0,0 +1,74 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
set -ex
|
||||||
|
|
||||||
|
. .github/scripts/common.sh
|
||||||
|
|
||||||
|
run() {
|
||||||
|
"$@"
|
||||||
|
}
|
||||||
|
|
||||||
|
if [ "${OS}" = "Windows" ] ; then
|
||||||
|
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
|
||||||
|
else
|
||||||
|
GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
|
||||||
|
fi
|
||||||
|
|
||||||
|
git_describe
|
||||||
|
|
||||||
|
rm -rf "${GHCUP_DIR}"
|
||||||
|
mkdir -p "${GHCUP_BIN}"
|
||||||
|
|
||||||
|
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
|
||||||
|
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
|
||||||
|
chmod +x "$GHCUP_BIN/ghcup${ext}"
|
||||||
|
chmod +x "ghcup-test${ext}"
|
||||||
|
|
||||||
|
"$GHCUP_BIN/ghcup${ext}" --version
|
||||||
|
eghcup --version
|
||||||
|
sha_sum "$GHCUP_BIN/ghcup${ext}"
|
||||||
|
sha_sum "$(raw_eghcup --offline whereis ghcup)"
|
||||||
|
|
||||||
|
|
||||||
|
### cross build
|
||||||
|
|
||||||
|
eghcup --numeric-version
|
||||||
|
|
||||||
|
eghcup install ghc "${GHC_VER}"
|
||||||
|
eghcup set ghc "${GHC_VER}"
|
||||||
|
eghcup install cabal "${CABAL_VER}"
|
||||||
|
|
||||||
|
cabal --version
|
||||||
|
|
||||||
|
eghcup debug-info
|
||||||
|
|
||||||
|
ecabal update
|
||||||
|
|
||||||
|
"${WRAPPER}" "$GHCUP_BIN/ghcup${ext}" -c -s "file://$CI_PROJECT_DIR/data/metadata/ghcup-${JSON_VERSION}.yaml" -v \
|
||||||
|
compile ghc \
|
||||||
|
$(if [ -n "${HADRIAN_FLAVOUR}" ] ; then printf "%s" "--flavour=${HADRIAN_FLAVOUR}" ; else true ; fi) \
|
||||||
|
-j "$(nproc)" \
|
||||||
|
-v "${GHC_TARGET_VERSION}" \
|
||||||
|
-b "${GHC_VER}" \
|
||||||
|
-x "${CROSS}" \
|
||||||
|
-- ${BUILD_CONF_ARGS}
|
||||||
|
eghcup set ghc "${CROSS}-${GHC_TARGET_VERSION}"
|
||||||
|
|
||||||
|
[ "$($(eghcup whereis ghc "${CROSS}-${GHC_TARGET_VERSION}") --numeric-version)" = "${GHC_TARGET_VERSION}" ]
|
||||||
|
|
||||||
|
# test that doing fishy symlinks into GHCup dir doesn't cause weird stuff on 'ghcup nuke'
|
||||||
|
mkdir no_nuke/
|
||||||
|
mkdir no_nuke/bar
|
||||||
|
echo 'foo' > no_nuke/file
|
||||||
|
echo 'bar' > no_nuke/bar/file
|
||||||
|
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/cache/no_nuke
|
||||||
|
ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/logs/no_nuke
|
||||||
|
|
||||||
|
# nuke
|
||||||
|
eghcup nuke
|
||||||
|
[ ! -e "${GHCUP_DIR}" ]
|
||||||
|
|
||||||
|
# make sure nuke doesn't resolve symlinks
|
||||||
|
[ -e "$CI_PROJECT_DIR"/no_nuke/file ]
|
||||||
|
[ -e "$CI_PROJECT_DIR"/no_nuke/bar/file ]
|
||||||
|
|
140
.github/workflows/cross.yaml
vendored
Normal file
140
.github/workflows/cross.yaml
vendored
Normal file
@ -0,0 +1,140 @@
|
|||||||
|
name: Test cross bindists
|
||||||
|
|
||||||
|
on:
|
||||||
|
push:
|
||||||
|
branches:
|
||||||
|
- master
|
||||||
|
tags:
|
||||||
|
- 'v*'
|
||||||
|
pull_request:
|
||||||
|
branches:
|
||||||
|
- master
|
||||||
|
schedule:
|
||||||
|
- cron: '0 2 * * *'
|
||||||
|
|
||||||
|
env:
|
||||||
|
CABAL_CACHE_DISABLE: ${{ vars.CABAL_CACHE_DISABLE }}
|
||||||
|
CABAL_CACHE_NONFATAL: yes
|
||||||
|
|
||||||
|
jobs:
|
||||||
|
build:
|
||||||
|
name: Build linux binary
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
env:
|
||||||
|
CABAL_VER: 3.10.1.0
|
||||||
|
JSON_VERSION: "0.0.7"
|
||||||
|
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
|
||||||
|
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
|
||||||
|
S3_HOST: ${{ secrets.S3_HOST }}
|
||||||
|
ARTIFACT: "x86_64-linux-ghcup"
|
||||||
|
GHC_VER: 8.10.7
|
||||||
|
ARCH: 64
|
||||||
|
steps:
|
||||||
|
- name: Checkout code
|
||||||
|
uses: actions/checkout@v3
|
||||||
|
with:
|
||||||
|
submodules: 'true'
|
||||||
|
|
||||||
|
- name: Run build
|
||||||
|
uses: docker://hasufell/alpine-haskell:3.12
|
||||||
|
with:
|
||||||
|
args: sh .github/scripts/build.sh
|
||||||
|
env:
|
||||||
|
ARTIFACT: ${{ env.ARTIFACT }}
|
||||||
|
ARCH: ${{ env.ARCH }}
|
||||||
|
GHC_VER: ${{ env.GHC_VER }}
|
||||||
|
DISTRO: Alpine
|
||||||
|
AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
|
||||||
|
AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
|
||||||
|
S3_HOST: ${{ env.S3_HOST }}
|
||||||
|
|
||||||
|
- if: always()
|
||||||
|
name: Upload artifact
|
||||||
|
uses: actions/upload-artifact@v3
|
||||||
|
with:
|
||||||
|
name: artifacts
|
||||||
|
path: |
|
||||||
|
./out/*
|
||||||
|
|
||||||
|
test-cross-linux:
|
||||||
|
name: Test linux cross
|
||||||
|
needs: "build"
|
||||||
|
runs-on: [self-hosted, Linux, X64]
|
||||||
|
container:
|
||||||
|
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
|
||||||
|
options: --user root
|
||||||
|
env:
|
||||||
|
CABAL_VER: 3.6.2.0
|
||||||
|
BUILD_CONF_ARGS: "--enable-unregisterised"
|
||||||
|
HADRIAN_FLAVOUR: ""
|
||||||
|
JSON_VERSION: "0.0.7"
|
||||||
|
GHC_VER: 8.10.6
|
||||||
|
GHC_TARGET_VERSION: "8.10.7"
|
||||||
|
ARCH: 64
|
||||||
|
DISTRO: Debian
|
||||||
|
ARTIFACT: "x86_64-linux-ghcup"
|
||||||
|
CROSS: "arm-linux-gnueabihf"
|
||||||
|
WRAPPER: "run"
|
||||||
|
steps:
|
||||||
|
- name: Checkout code
|
||||||
|
uses: actions/checkout@v3
|
||||||
|
with:
|
||||||
|
submodules: 'true'
|
||||||
|
|
||||||
|
- uses: actions/download-artifact@v3
|
||||||
|
with:
|
||||||
|
name: artifacts
|
||||||
|
path: ./out
|
||||||
|
|
||||||
|
- name: Run test (64 bit linux)
|
||||||
|
run: |
|
||||||
|
sudo apt-get update -y
|
||||||
|
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
|
||||||
|
sudo apt-get install -y gcc-arm-linux-gnueabihf
|
||||||
|
sudo dpkg --add-architecture armhf
|
||||||
|
sudo apt-get update -y
|
||||||
|
sudo apt-get install -y libncurses-dev:armhf
|
||||||
|
sh .github/scripts/cross.sh
|
||||||
|
|
||||||
|
test-cross-js:
|
||||||
|
name: Test GHC JS cross
|
||||||
|
needs: "build"
|
||||||
|
runs-on: [self-hosted, Linux, X64]
|
||||||
|
container:
|
||||||
|
image: registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:8d0224e6b2a08157649651e69302380b2bd24e11
|
||||||
|
options: --user root
|
||||||
|
env:
|
||||||
|
CABAL_VER: 3.6.2.0
|
||||||
|
BUILD_CONF_ARGS: ""
|
||||||
|
HADRIAN_FLAVOUR: "default+native_bignum"
|
||||||
|
JSON_VERSION: "0.0.7"
|
||||||
|
GHC_VER: 9.6.2
|
||||||
|
GHC_TARGET_VERSION: "9.6.2"
|
||||||
|
ARCH: 64
|
||||||
|
DISTRO: Debian
|
||||||
|
ARTIFACT: "x86_64-linux-ghcup"
|
||||||
|
CROSS: "javascript-unknown-ghcjs"
|
||||||
|
WRAPPER: "emconfigure"
|
||||||
|
steps:
|
||||||
|
- name: Checkout code
|
||||||
|
uses: actions/checkout@v3
|
||||||
|
with:
|
||||||
|
submodules: 'true'
|
||||||
|
|
||||||
|
- uses: actions/download-artifact@v3
|
||||||
|
with:
|
||||||
|
name: artifacts
|
||||||
|
path: ./out
|
||||||
|
|
||||||
|
- name: Run test (64 bit linux)
|
||||||
|
run: |
|
||||||
|
sudo apt-get update -y
|
||||||
|
sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
|
||||||
|
git clone https://github.com/emscripten-core/emsdk.git
|
||||||
|
cd emsdk
|
||||||
|
./emsdk install latest
|
||||||
|
./emsdk activate latest
|
||||||
|
. ./emsdk_env.sh
|
||||||
|
cd ..
|
||||||
|
bash .github/scripts/cross.sh
|
||||||
|
|
@ -218,7 +218,6 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
|
|||||||
printNotes ListResult {..} =
|
printNotes ListResult {..} =
|
||||||
(if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
|
(if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
|
||||||
)
|
)
|
||||||
++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
|
|
||||||
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
|
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
|
||||||
++ (case lReleaseDay of
|
++ (case lReleaseDay of
|
||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
|
@ -77,7 +77,7 @@ data GHCCompileOptions = GHCCompileOptions
|
|||||||
, setCompile :: Bool
|
, setCompile :: Bool
|
||||||
, ovewrwiteVer :: Maybe Version
|
, ovewrwiteVer :: Maybe Version
|
||||||
, buildFlavour :: Maybe String
|
, buildFlavour :: Maybe String
|
||||||
, hadrian :: Bool
|
, buildSystem :: Maybe BuildSystem
|
||||||
, isolateDir :: Maybe FilePath
|
, isolateDir :: Maybe FilePath
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
@ -269,9 +269,15 @@ ghcCompileOpts =
|
|||||||
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
"Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
<*> switch
|
<*> (
|
||||||
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
|
(\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
|
<*> optional
|
||||||
(option
|
(option
|
||||||
(eitherReader isolateParser)
|
(eitherReader isolateParser)
|
||||||
@ -578,7 +584,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
|
|||||||
patches
|
patches
|
||||||
addConfArgs
|
addConfArgs
|
||||||
buildFlavour
|
buildFlavour
|
||||||
hadrian
|
buildSystem
|
||||||
(maybe GHCupInternal IsolateDir isolateDir)
|
(maybe GHCupInternal IsolateDir isolateDir)
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
let vi = getVersionInfo targetVer GHC dls
|
let vi = getVersionInfo targetVer GHC dls
|
||||||
|
@ -180,7 +180,6 @@ printListResult no_color raw lr = do
|
|||||||
then [color Green "hls-powered"]
|
then [color Green "hls-powered"]
|
||||||
else mempty
|
else mempty
|
||||||
)
|
)
|
||||||
++ (if fromSrc then [color Blue "compiled"] else mempty)
|
|
||||||
++ (if lStray then [color Yellow "stray"] else mempty)
|
++ (if lStray then [color Yellow "stray"] else mempty)
|
||||||
++ (case lReleaseDay of
|
++ (case lReleaseDay of
|
||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
|
@ -205,7 +205,7 @@ url-source:
|
|||||||
|
|
||||||
### Nightlies
|
### Nightlies
|
||||||
|
|
||||||
Nightlies are just a nother release channel. Currently, only GHC supports nightlies, which are binary releases
|
Nightlies are just another release channel. Currently, only GHC supports nightlies, which are binary releases
|
||||||
that are built every night from `master`.
|
that are built every night from `master`.
|
||||||
|
|
||||||
To add the nightly channel, run:
|
To add the nightly channel, run:
|
||||||
|
23
lib/GHCup.hs
23
lib/GHCup.hs
@ -134,15 +134,24 @@ rmTool :: ( MonadReader env m
|
|||||||
=> ListResult
|
=> ListResult
|
||||||
-> Excepts '[NotInstalled, UninstallFailed] m ()
|
-> Excepts '[NotInstalled, UninstallFailed] m ()
|
||||||
rmTool ListResult {lVer, lTool, lCross} = do
|
rmTool ListResult {lVer, lTool, lCross} = do
|
||||||
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
|
let printRmTool = logInfo $ "removing " <> T.pack (show lTool) <> " version " <> prettyVer lVer
|
||||||
case lTool of
|
case lTool of
|
||||||
GHC ->
|
GHC -> do
|
||||||
let ghcTargetVersion = GHCTargetVersion lCross lVer
|
let ghcTargetVersion = GHCTargetVersion lCross lVer
|
||||||
in rmGHCVer ghcTargetVersion
|
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> tVerToText ghcTargetVersion
|
||||||
HLS -> rmHLSVer lVer
|
rmGHCVer ghcTargetVersion
|
||||||
Cabal -> liftE $ rmCabalVer lVer
|
HLS -> do
|
||||||
Stack -> liftE $ rmStackVer lVer
|
printRmTool
|
||||||
GHCup -> lift rmGhcup
|
rmHLSVer lVer
|
||||||
|
Cabal -> do
|
||||||
|
printRmTool
|
||||||
|
liftE $ rmCabalVer lVer
|
||||||
|
Stack -> do
|
||||||
|
printRmTool
|
||||||
|
liftE $ rmStackVer lVer
|
||||||
|
GHCup -> do
|
||||||
|
printRmTool
|
||||||
|
lift rmGhcup
|
||||||
|
|
||||||
|
|
||||||
rmGhcupDirs :: ( MonadReader env m
|
rmGhcupDirs :: ( MonadReader env m
|
||||||
|
@ -296,7 +296,7 @@ getDownloadInfo' :: ( MonadReader env m
|
|||||||
m
|
m
|
||||||
DownloadInfo
|
DownloadInfo
|
||||||
getDownloadInfo' t v = do
|
getDownloadInfo' t v = do
|
||||||
(PlatformRequest a p mv) <- lift getPlatformReq
|
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
let distro_preview f g =
|
let distro_preview f g =
|
||||||
@ -317,7 +317,7 @@ getDownloadInfo' t v = do
|
|||||||
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
|
||||||
|
|
||||||
maybe
|
maybe
|
||||||
(throwE NoDownload)
|
(throwE $ NoDownload v t (Just pfreq))
|
||||||
pure
|
pure
|
||||||
(case p of
|
(case p of
|
||||||
-- non-musl won't work on alpine
|
-- non-musl won't work on alpine
|
||||||
|
@ -206,12 +206,26 @@ instance HFErrorProject NoCompatiblePlatform where
|
|||||||
eDesc _ = "No compatible platform could be found"
|
eDesc _ = "No compatible platform could be found"
|
||||||
|
|
||||||
-- | Unable to find a download for the requested version/distro.
|
-- | Unable to find a download for the requested version/distro.
|
||||||
data NoDownload = NoDownload
|
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
|
||||||
|
| NoDownload' GlobalTool
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Pretty NoDownload where
|
instance Pretty NoDownload where
|
||||||
pPrint NoDownload =
|
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
|
||||||
text (eDesc (Proxy :: Proxy NoDownload))
|
| (Just target) <- mtarget
|
||||||
|
, target `elem` (T.pack . prettyShow <$> enumFromTo (minBound :: Tool) (maxBound :: Tool))
|
||||||
|
= text $ "Unable to find a download for "
|
||||||
|
<> show tool
|
||||||
|
<> " version '"
|
||||||
|
<> T.unpack (tVerToText tver)
|
||||||
|
<> maybe "'\n" (\pfreq -> "' on detected platform " <> pfReqToString pfreq <> "\n") mpfreq
|
||||||
|
<> "Perhaps you meant: 'ghcup <command> "
|
||||||
|
<> T.unpack target
|
||||||
|
<> " "
|
||||||
|
<> T.unpack (prettyVer vv)
|
||||||
|
<> "'"
|
||||||
|
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
|
||||||
|
pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
|
||||||
|
|
||||||
instance HFErrorProject NoDownload where
|
instance HFErrorProject NoDownload where
|
||||||
eBase _ = 10
|
eBase _ = 10
|
||||||
|
219
lib/GHCup/GHC.hs
219
lib/GHCup/GHC.hs
@ -126,7 +126,7 @@ testGHCVer ver addMakeArgs = do
|
|||||||
|
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
preview (ix GHC % ix ver % viTestDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload ver GHC Nothing
|
||||||
|
|
||||||
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
liftE $ testGHCBindist dlInfo ver addMakeArgs
|
||||||
|
|
||||||
@ -261,7 +261,7 @@ fetchGHCSrc v mfp = do
|
|||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
preview (ix GHC % ix v % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload v GHC Nothing
|
||||||
liftE $ downloadCached' dlInfo Nothing mfp
|
liftE $ downloadCached' dlInfo Nothing mfp
|
||||||
|
|
||||||
|
|
||||||
@ -434,11 +434,7 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
|
|||||||
-- Windows bindists are relocatable and don't need
|
-- Windows bindists are relocatable and don't need
|
||||||
-- to run configure.
|
-- to run configure.
|
||||||
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
|
||||||
liftE $ mergeFileTree path inst GHC tver $ \source dest -> do
|
liftE $ mergeGHCFileTree path inst tver forceInstall
|
||||||
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
|
|
||||||
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
|
|
||||||
liftIO $ moveFilePortable source dest
|
|
||||||
forM_ mtime $ liftIO . setModificationTime dest
|
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
PlatformRequest {..} <- lift getPlatformReq
|
PlatformRequest {..} <- lift getPlatformReq
|
||||||
|
|
||||||
@ -460,7 +456,36 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
|
|||||||
tmpInstallDest <- lift withGHCupTmpDir
|
tmpInstallDest <- lift withGHCupTmpDir
|
||||||
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
|
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
|
||||||
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
|
liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
|
||||||
liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
|
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst)) inst tver forceInstall
|
||||||
|
pure ()
|
||||||
|
|
||||||
|
|
||||||
|
mergeGHCFileTree :: ( MonadReader env m
|
||||||
|
, HasPlatformReq env
|
||||||
|
, HasDirs env
|
||||||
|
, HasSettings env
|
||||||
|
, MonadThrow m
|
||||||
|
, HasLog env
|
||||||
|
, MonadIO m
|
||||||
|
, MonadUnliftIO m
|
||||||
|
, MonadMask m
|
||||||
|
, MonadResource m
|
||||||
|
, MonadFail m
|
||||||
|
)
|
||||||
|
=> GHCupPath -- ^ Path to the root of the tree
|
||||||
|
-> InstallDirResolved -- ^ Path to install to
|
||||||
|
-> GHCTargetVersion -- ^ The GHC version
|
||||||
|
-> Bool -- ^ Force install
|
||||||
|
-> Excepts '[MergeFileTreeError] m ()
|
||||||
|
mergeGHCFileTree root inst tver forceInstall
|
||||||
|
| isWindows = do
|
||||||
|
liftE $ mergeFileTree root inst GHC tver $ \source dest -> do
|
||||||
|
mtime <- liftIO $ ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source)
|
||||||
|
when forceInstall $ hideError doesNotExistErrorType $ hideError InappropriateType $ recycleFile dest
|
||||||
|
liftIO $ moveFilePortable source dest
|
||||||
|
forM_ mtime $ liftIO . setModificationTime dest
|
||||||
|
| otherwise = do
|
||||||
|
liftE $ mergeFileTree root
|
||||||
inst
|
inst
|
||||||
GHC
|
GHC
|
||||||
tver
|
tver
|
||||||
@ -469,8 +494,6 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
|
|||||||
install f t (not forceInstall)
|
install f t (not forceInstall)
|
||||||
forM_ mtime $ setModificationTime t)
|
forM_ mtime $ setModificationTime t)
|
||||||
|
|
||||||
pure ()
|
|
||||||
|
|
||||||
|
|
||||||
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
|
||||||
-- following symlinks in @~\/.ghcup\/bin@:
|
-- following symlinks in @~\/.ghcup\/bin@:
|
||||||
@ -709,7 +732,7 @@ rmGHCVer ver = do
|
|||||||
Just files -> do
|
Just files -> do
|
||||||
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
|
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
|
||||||
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
|
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
|
||||||
removeEmptyDirsRecursive dir
|
hideError UnsatisfiedConstraints $ removeEmptyDirsRecursive dir
|
||||||
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
|
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
|
||||||
f <- recordedInstallationFile GHC ver
|
f <- recordedInstallationFile GHC ver
|
||||||
lift $ recycleFile f
|
lift $ recycleFile f
|
||||||
@ -765,7 +788,7 @@ compileGHC :: ( MonadMask m
|
|||||||
-> Maybe (Either FilePath [URI]) -- ^ patches
|
-> Maybe (Either FilePath [URI]) -- ^ patches
|
||||||
-> [Text] -- ^ additional args to ./configure
|
-> [Text] -- ^ additional args to ./configure
|
||||||
-> Maybe String -- ^ build flavour
|
-> Maybe String -- ^ build flavour
|
||||||
-> Bool
|
-> Maybe BuildSystem
|
||||||
-> InstallDir
|
-> InstallDir
|
||||||
-> Excepts
|
-> Excepts
|
||||||
'[ AlreadyInstalled
|
'[ AlreadyInstalled
|
||||||
@ -794,9 +817,9 @@ compileGHC :: ( MonadMask m
|
|||||||
]
|
]
|
||||||
m
|
m
|
||||||
GHCTargetVersion
|
GHCTargetVersion
|
||||||
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour hadrian installDir
|
compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs buildFlavour buildSystem installDir
|
||||||
= do
|
= do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
|
|
||||||
(workdir, tmpUnpack, tver) <- case targetGhc of
|
(workdir, tmpUnpack, tver) <- case targetGhc of
|
||||||
@ -805,9 +828,10 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
lift $ logDebug $ "Requested to compile: " <> prettyVer ver <> " with " <> either prettyVer T.pack bstrap
|
||||||
|
|
||||||
-- download source tarball
|
-- download source tarball
|
||||||
|
let tver = mkTVer ver
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix GHC % ix (mkTVer ver) % viSourceDL % _Just) dls
|
preview (ix GHC % ix tver % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload tver GHC (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
@ -906,7 +930,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
-- compiled version, so the user can overwrite it
|
-- compiled version, so the user can overwrite it
|
||||||
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget ov')
|
||||||
| Just tver' <- tver -> pure tver'
|
| 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"
|
| otherwise -> fail "No GHC version given and couldn't detect version. Giving up..."
|
||||||
|
|
||||||
alreadyInstalled <- lift $ ghcInstalled installVer
|
alreadyInstalled <- lift $ ghcInstalled installVer
|
||||||
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
alreadySet <- fmap (== Just installVer) $ lift $ ghcSet (_tvTarget installVer)
|
||||||
@ -925,16 +949,31 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
IsolateDir isoDir -> pure $ IsolateDirResolved isoDir
|
||||||
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
|
||||||
|
|
||||||
(mBindist, bmk) <- liftE $ runBuildAction
|
mBindist <- liftE $ runBuildAction
|
||||||
tmpUnpack
|
tmpUnpack
|
||||||
(do
|
(do
|
||||||
b <- if hadrian
|
-- prefer 'tver', because the real version carries out compatibility checks
|
||||||
-- prefer 'tver', because the real version carries out compatibility checks
|
-- we don't want the user to do funny things with it
|
||||||
-- we don't want the user to do funny things with it
|
let doHadrian = compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
then compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
doMake = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
||||||
else compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
|
case buildSystem of
|
||||||
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
|
Just Hadrian -> do
|
||||||
pure (b, bmk)
|
lift $ logInfo "Requested to use Hadrian"
|
||||||
|
liftE doHadrian
|
||||||
|
Just Make -> do
|
||||||
|
lift $ logInfo "Requested to use Make"
|
||||||
|
doMake
|
||||||
|
Nothing -> do
|
||||||
|
supportsHadrian <- liftE $ catchE @HadrianNotFound @'[HadrianNotFound] @'[] (\_ -> return False)
|
||||||
|
$ fmap (const True)
|
||||||
|
$ findHadrianFile (fromGHCupPath workdir)
|
||||||
|
if supportsHadrian
|
||||||
|
then do
|
||||||
|
lift $ logInfo "Detected Hadrian"
|
||||||
|
liftE doHadrian
|
||||||
|
else do
|
||||||
|
lift $ logInfo "Detected Make"
|
||||||
|
doMake
|
||||||
)
|
)
|
||||||
|
|
||||||
case installDir of
|
case installDir of
|
||||||
@ -954,8 +993,6 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
False -- not a force install, since we already overwrite when compiling.
|
False -- not a force install, since we already overwrite when compiling.
|
||||||
[]
|
[]
|
||||||
|
|
||||||
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
|
|
||||||
|
|
||||||
case installDir of
|
case installDir of
|
||||||
-- set and make symlinks for regular (non-isolated) installs
|
-- set and make symlinks for regular (non-isolated) installs
|
||||||
GHCupInternal -> do
|
GHCupInternal -> do
|
||||||
@ -978,13 +1015,22 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
=> GHCupPath
|
=> GHCupPath
|
||||||
-> Excepts '[ProcessError, ParseError] m Version
|
-> Excepts '[ProcessError, ParseError] m Version
|
||||||
getGHCVer tmpUnpack = do
|
getGHCVer tmpUnpack = do
|
||||||
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ execLogged "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap" Nothing
|
||||||
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
lEM $ configureWithGhcBoot Nothing [] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
|
||||||
CapturedProcess {..} <- lift $ makeOut
|
let versionFile = fromGHCupPath tmpUnpack </> "VERSION"
|
||||||
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
hasVersionFile <- liftIO $ doesFileExist versionFile
|
||||||
case _exitCode of
|
if hasVersionFile
|
||||||
ExitSuccess -> either (throwE . ParseError . show) pure . MP.parse ghcProjectVersion "" . T.pack . stripNewlineEnd . T.unpack . decUTF8Safe' $ _stdOut
|
then do
|
||||||
ExitFailure c -> throwE $ NonZeroExit c "make" ["show!", "--quiet", "VALUE=ProjectVersion" ]
|
lift $ logDebug "Detected VERSION file, trying to extract"
|
||||||
|
contents <- liftIO $ readFile versionFile
|
||||||
|
either (throwE . ParseError . show) pure . MP.parse version' "" . T.pack . stripNewlineEnd $ contents
|
||||||
|
else do
|
||||||
|
lift $ logDebug "Didn't detect VERSION file, trying to extract via legacy 'make'"
|
||||||
|
CapturedProcess {..} <- lift $ makeOut
|
||||||
|
["show!", "--quiet", "VALUE=ProjectVersion" ] (Just $ fromGHCupPath tmpUnpack)
|
||||||
|
case _exitCode of
|
||||||
|
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" ]
|
||||||
|
|
||||||
defaultConf =
|
defaultConf =
|
||||||
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
let cross_mk = $(LitE . StringL <$> (qAddDependentFile "data/build_mk/cross" >> runIO (readFile "data/build_mk/cross")))
|
||||||
@ -1021,12 +1067,13 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
|
|
||||||
lift $ logInfo "Building (this may take a while)..."
|
lift $ logInfo "Building (this may take a while)..."
|
||||||
hadrian_build <- liftE $ findHadrianFile workdir
|
hadrian_build <- liftE $ findHadrianFile workdir
|
||||||
lEM $ execWithGhcEnv hadrian_build
|
lEM $ execLogged hadrian_build
|
||||||
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
( maybe [] (\j -> ["-j" <> show j] ) jobs
|
||||||
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
|
||||||
++ ["binary-dist"]
|
++ ["binary-dist"]
|
||||||
)
|
)
|
||||||
(Just workdir) "ghc-make"
|
(Just workdir) "ghc-make"
|
||||||
|
Nothing
|
||||||
[tar] <- liftIO $ findFiles
|
[tar] <- liftIO $ findFiles
|
||||||
(workdir </> "_build" </> "bindist")
|
(workdir </> "_build" </> "bindist")
|
||||||
(makeRegexOpts compExtended
|
(makeRegexOpts compExtended
|
||||||
@ -1059,6 +1106,9 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadFail m
|
, MonadFail m
|
||||||
|
, MonadMask m
|
||||||
|
, MonadUnliftIO m
|
||||||
|
, MonadResource m
|
||||||
)
|
)
|
||||||
=> GHCTargetVersion
|
=> GHCTargetVersion
|
||||||
-> FilePath
|
-> FilePath
|
||||||
@ -1070,6 +1120,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
, PatchFailed
|
, PatchFailed
|
||||||
, ProcessError
|
, ProcessError
|
||||||
, NotFoundInPATH
|
, NotFoundInPATH
|
||||||
|
, MergeFileTreeError
|
||||||
, CopyError]
|
, CopyError]
|
||||||
m
|
m
|
||||||
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
(Maybe FilePath) -- ^ output path of bindist, None for cross
|
||||||
@ -1091,7 +1142,9 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
|
|
||||||
if | isCross tver -> do
|
if | isCross tver -> do
|
||||||
lift $ logInfo "Installing cross toolchain..."
|
lift $ logInfo "Installing cross toolchain..."
|
||||||
lEM $ make ["install"] (Just workdir)
|
tmpInstallDest <- lift withGHCupTmpDir
|
||||||
|
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just workdir)
|
||||||
|
liftE $ mergeGHCFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir ghcdir)) ghcdir tver True
|
||||||
pure Nothing
|
pure Nothing
|
||||||
| otherwise -> do
|
| otherwise -> do
|
||||||
lift $ logInfo "Creating bindist..."
|
lift $ logInfo "Creating bindist..."
|
||||||
@ -1209,64 +1262,50 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
|
|||||||
()
|
()
|
||||||
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
|
||||||
lift $ logInfo [s|configuring build|]
|
lift $ logInfo [s|configuring build|]
|
||||||
|
lEM $ configureWithGhcBoot (Just tver)
|
||||||
if | _tvVersion tver >= [vver|8.8.0|] -> do
|
(maybe mempty
|
||||||
lEM $ execWithGhcEnv
|
(\x -> ["--target=" <> T.unpack x])
|
||||||
"sh"
|
(_tvTarget tver)
|
||||||
("./configure" : maybe mempty
|
++ ["--prefix=" <> ghcdir]
|
||||||
(\x -> ["--target=" <> T.unpack x])
|
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
||||||
(_tvTarget tver)
|
++ fmap T.unpack aargs
|
||||||
++ ["--prefix=" <> ghcdir]
|
)
|
||||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
(Just workdir)
|
||||||
++ fmap T.unpack aargs
|
"ghc-conf"
|
||||||
)
|
|
||||||
(Just workdir)
|
|
||||||
"ghc-conf"
|
|
||||||
| otherwise -> do
|
|
||||||
lEM $ execLogged
|
|
||||||
"sh"
|
|
||||||
( [ "./configure", "--with-ghc=" <> either id id bghc
|
|
||||||
]
|
|
||||||
++ maybe mempty
|
|
||||||
(\x -> ["--target=" <> T.unpack x])
|
|
||||||
(_tvTarget tver)
|
|
||||||
++ ["--prefix=" <> ghcdir]
|
|
||||||
++ (if isWindows then ["--enable-tarballs-autodownload"] else [])
|
|
||||||
++ fmap T.unpack aargs
|
|
||||||
)
|
|
||||||
(Just workdir)
|
|
||||||
"ghc-conf"
|
|
||||||
Nothing
|
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
execWithGhcEnv :: ( MonadReader env m
|
configureWithGhcBoot :: ( MonadReader env m
|
||||||
, HasSettings env
|
, HasSettings env
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
, HasLog env
|
, HasLog env
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadThrow m)
|
, MonadThrow m)
|
||||||
=> FilePath -- ^ thing to execute
|
=> Maybe GHCTargetVersion
|
||||||
-> [String] -- ^ args for the thing
|
-> [String] -- ^ args for configure
|
||||||
-> Maybe FilePath -- ^ optionally chdir into this
|
-> Maybe FilePath -- ^ optionally chdir into this
|
||||||
-> FilePath -- ^ log filename (opened in append mode)
|
-> FilePath -- ^ log filename (opened in append mode)
|
||||||
-> m (Either ProcessError ())
|
-> m (Either ProcessError ())
|
||||||
execWithGhcEnv fp args dir logf = do
|
configureWithGhcBoot mtver args dir logf = do
|
||||||
env <- ghcEnv
|
let execNew = execLogged
|
||||||
execLogged fp args dir logf (Just env)
|
"sh"
|
||||||
|
("./configure" : ("GHC=" <> bghc) : args)
|
||||||
|
dir
|
||||||
|
logf
|
||||||
|
Nothing
|
||||||
|
execOld = execLogged
|
||||||
|
"sh"
|
||||||
|
("./configure" : ("--with-ghc=" <> bghc) : args)
|
||||||
|
dir
|
||||||
|
logf
|
||||||
|
Nothing
|
||||||
|
if | Just tver <- mtver
|
||||||
|
, _tvVersion tver >= [vver|8.8.0|] -> execNew
|
||||||
|
| Nothing <- mtver -> execNew -- need some default for git checkouts where we don't know yet
|
||||||
|
| otherwise -> execOld
|
||||||
|
|
||||||
bghc = case bstrap of
|
bghc = case bstrap of
|
||||||
Right g -> Right g
|
Right g -> g
|
||||||
Left bver -> Left ("ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt)
|
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt
|
||||||
|
|
||||||
ghcEnv :: (MonadThrow m, MonadIO m) => m [(String, String)]
|
|
||||||
ghcEnv = do
|
|
||||||
cEnv <- liftIO getEnvironment
|
|
||||||
bghcPath <- case bghc of
|
|
||||||
Right ghc' -> pure ghc'
|
|
||||||
Left bver -> do
|
|
||||||
spaths <- liftIO getSearchPath
|
|
||||||
throwMaybeM (NotFoundInPATH bver) $ liftIO (searchPath spaths bver)
|
|
||||||
pure (("GHC", bghcPath) : cEnv)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -355,7 +355,7 @@ compileHLS :: ( MonadMask m
|
|||||||
, NotInstalled
|
, NotInstalled
|
||||||
] m Version
|
] m Version
|
||||||
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
|
||||||
PlatformRequest { .. } <- lift getPlatformReq
|
pfreq@PlatformRequest { .. } <- lift getPlatformReq
|
||||||
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
|
||||||
Dirs { .. } <- lift getDirs
|
Dirs { .. } <- lift getDirs
|
||||||
|
|
||||||
@ -371,7 +371,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
|
|||||||
-- download source tarball
|
-- download source tarball
|
||||||
dlInfo <-
|
dlInfo <-
|
||||||
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
|
||||||
?? NoDownload
|
?? NoDownload (mkTVer tver) HLS (Just pfreq)
|
||||||
dl <- liftE $ downloadCached dlInfo Nothing
|
dl <- liftE $ downloadCached dlInfo Nothing
|
||||||
|
|
||||||
-- unpack
|
-- unpack
|
||||||
|
@ -76,7 +76,6 @@ data ListResult = ListResult
|
|||||||
, lTag :: [Tag]
|
, lTag :: [Tag]
|
||||||
, lInstalled :: Bool
|
, lInstalled :: Bool
|
||||||
, lSet :: Bool -- ^ currently active version
|
, lSet :: Bool -- ^ currently active version
|
||||||
, fromSrc :: Bool -- ^ compiled from source
|
|
||||||
, lStray :: Bool -- ^ not in download info
|
, lStray :: Bool -- ^ not in download info
|
||||||
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
|
||||||
, hlsPowered :: Bool
|
, hlsPowered :: Bool
|
||||||
@ -169,7 +168,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
Just _ -> pure Nothing
|
Just _ -> pure Nothing
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
|
||||||
fromSrc <- ghcSrcInstalled tver
|
|
||||||
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
|
||||||
pure $ Just $ ListResult
|
pure $ Just $ ListResult
|
||||||
{ lTool = GHC
|
{ lTool = GHC
|
||||||
@ -213,7 +211,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
, lReleaseDay = Nothing
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
@ -248,7 +245,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
, lReleaseDay = Nothing
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
@ -284,7 +280,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
, lStray = isNothing (Map.lookup ver avTools)
|
, lStray = isNothing (Map.lookup ver avTools)
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, fromSrc = False -- actually, we don't know :>
|
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
, lReleaseDay = Nothing
|
, lReleaseDay = Nothing
|
||||||
, ..
|
, ..
|
||||||
@ -306,7 +301,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTool = GHCup
|
, lTool = GHCup
|
||||||
, fromSrc = False
|
|
||||||
, lStray = isNothing listVer
|
, lStray = isNothing listVer
|
||||||
, lSet = True
|
, lSet = True
|
||||||
, lInstalled = True
|
, lInstalled = True
|
||||||
@ -340,7 +334,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
|
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
|
||||||
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
|
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
|
||||||
lInstalled <- ghcInstalled tver
|
lInstalled <- ghcInstalled tver
|
||||||
fromSrc <- ghcSrcInstalled tver
|
|
||||||
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
|
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
|
||||||
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
|
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
|
||||||
Cabal -> do
|
Cabal -> do
|
||||||
@ -351,7 +344,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = _viTags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
, lReleaseDay = _viReleaseDay
|
, lReleaseDay = _viReleaseDay
|
||||||
@ -364,7 +356,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lTag = _viTags
|
, lTag = _viTags
|
||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, lNoBindist = False
|
, lNoBindist = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
@ -379,7 +370,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = _viTags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
, lReleaseDay = _viReleaseDay
|
, lReleaseDay = _viReleaseDay
|
||||||
@ -393,7 +383,6 @@ listVersions lt' criteria hideOld showNightly days = do
|
|||||||
, lCross = Nothing
|
, lCross = Nothing
|
||||||
, lTag = _viTags
|
, lTag = _viTags
|
||||||
, lTool = t
|
, lTool = t
|
||||||
, fromSrc = False
|
|
||||||
, lStray = False
|
, lStray = False
|
||||||
, hlsPowered = False
|
, hlsPowered = False
|
||||||
, lReleaseDay = _viReleaseDay
|
, lReleaseDay = _viReleaseDay
|
||||||
|
@ -132,6 +132,9 @@ data GlobalTool = ShimGen
|
|||||||
|
|
||||||
instance NFData GlobalTool
|
instance NFData GlobalTool
|
||||||
|
|
||||||
|
instance Pretty GlobalTool where
|
||||||
|
pPrint ShimGen = text "shimgen"
|
||||||
|
|
||||||
|
|
||||||
-- | All necessary information of a tool version, including
|
-- | All necessary information of a tool version, including
|
||||||
-- source download and per-architecture downloads.
|
-- source download and per-architecture downloads.
|
||||||
@ -720,4 +723,6 @@ instance Pretty ToolVersion where
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
data BuildSystem = Hadrian
|
||||||
|
| Make
|
||||||
|
deriving (Show, Eq)
|
||||||
|
@ -288,13 +288,6 @@ ghcInstalled ver = do
|
|||||||
liftIO $ doesDirectoryExist (fromGHCupPath ghcdir)
|
liftIO $ doesDirectoryExist (fromGHCupPath ghcdir)
|
||||||
|
|
||||||
|
|
||||||
-- | Whether the given GHC version is installed from source.
|
|
||||||
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
|
|
||||||
ghcSrcInstalled ver = do
|
|
||||||
ghcdir <- ghcupGHCDir ver
|
|
||||||
liftIO $ doesFileExist (fromGHCupPath ghcdir </> ghcUpSrcBuiltFile)
|
|
||||||
|
|
||||||
|
|
||||||
-- | Whether the given GHC version is set as the current.
|
-- | Whether the given GHC version is set as the current.
|
||||||
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
|
||||||
=> Maybe Text -- ^ the target of the GHC version, if any
|
=> Maybe Text -- ^ the target of the GHC version, if any
|
||||||
@ -975,11 +968,6 @@ ghcToolFiles ver = do
|
|||||||
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
|
||||||
|
|
||||||
|
|
||||||
-- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
|
|
||||||
-- this GHC was built from source. It contains the build config.
|
|
||||||
ghcUpSrcBuiltFile :: FilePath
|
|
||||||
ghcUpSrcBuiltFile = ".ghcup_src_built"
|
|
||||||
|
|
||||||
|
|
||||||
-- | Calls gmake if it exists in PATH, otherwise make.
|
-- | Calls gmake if it exists in PATH, otherwise make.
|
||||||
make :: ( MonadThrow m
|
make :: ( MonadThrow m
|
||||||
@ -1224,7 +1212,7 @@ ensureGlobalTools
|
|||||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||||
dirs <- lift getDirs
|
dirs <- lift getDirs
|
||||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
||||||
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
|
$ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
|
||||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||||
void $ (\DigestError{} -> do
|
void $ (\DigestError{} -> do
|
||||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||||
|
@ -459,7 +459,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
|
|||||||
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
|
||||||
Exec "$Bash" '-lc' 'exit'
|
Exec "$Bash" '-lc' 'exit'
|
||||||
|
|
||||||
Exec "$env:windir\system32\taskkill.exe" /F /FI `"MODULES eq msys-2.0.dll`"
|
Exec "$env:windir\system32\taskkill.exe" /F /FI "MODULES eq msys-2.0.dll"
|
||||||
|
|
||||||
Print-Msg -msg 'Upgrading full system...'
|
Print-Msg -msg 'Upgrading full system...'
|
||||||
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
|
||||||
|
Loading…
Reference in New Issue
Block a user