hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into optparse-test-suite

Browse Source
This commit is contained in:
Lei Zhu 2023-08-05 13:08:41 +08:00
commit bcb498de20
15 changed files with 399 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
.github/scripts/cross.sh vendored Normal file
View 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
View 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

1
app/ghcup/BrickMain.hs
View File

@ -218,7 +218,6 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printNotes ListResult {..} =
(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)
++ (case lReleaseDay of
Nothing -> mempty

14
app/ghcup/GHCup/OptParse/Compile.hs
View File

@ -77,7 +77,7 @@ data GHCCompileOptions = GHCCompileOptions
, setCompile :: Bool
, ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String
, hadrian :: Bool
, buildSystem :: Maybe BuildSystem
, isolateDir :: Maybe FilePath
} deriving (Eq, Show)
@ -269,8 +269,14 @@ ghcCompileOpts =
"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
(option
@ -578,7 +584,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches
addConfArgs
buildFlavour
hadrian
buildSystem
(maybe GHCupInternal IsolateDir isolateDir)
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls

1
app/ghcup/GHCup/OptParse/List.hs
View File

@ -180,7 +180,6 @@ printListResult no_color raw lr = do
then [color Green "hls-powered"]
else mempty
)
++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color Yellow "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty

2
docs/guide.md
View File

@ -205,7 +205,7 @@ url-source:
### 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`.
To add the nightly channel, run:

23
lib/GHCup.hs
View File

@ -134,15 +134,24 @@ rmTool :: ( MonadReader env m
=> ListResult
-> Excepts '[NotInstalled, UninstallFailed] m ()
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
GHC ->
GHC -> do
let ghcTargetVersion = GHCTargetVersion lCross lVer
in rmGHCVer ghcTargetVersion
HLS -> rmHLSVer lVer
Cabal -> liftE $ rmCabalVer lVer
Stack -> liftE $ rmStackVer lVer
GHCup -> lift rmGhcup
logInfo $ "removing " <> T.pack (show lTool) <> " version " <> tVerToText ghcTargetVersion
rmGHCVer ghcTargetVersion
HLS -> do
printRmTool
rmHLSVer lVer
Cabal -> do
printRmTool
liftE $ rmCabalVer lVer
Stack -> do
printRmTool
liftE $ rmStackVer lVer
GHCup -> do
printRmTool
lift rmGhcup
rmGhcupDirs :: ( MonadReader env m

4
lib/GHCup/Download.hs
View File

@ -296,7 +296,7 @@ getDownloadInfo' :: ( MonadReader env m
m
DownloadInfo
getDownloadInfo' t v = do
(PlatformRequest a p mv) <- lift getPlatformReq
pfreq@(PlatformRequest a p mv) <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let distro_preview f g =
@ -317,7 +317,7 @@ getDownloadInfo' t v = do
without_distro = distro_preview (set _Linux UnknownLinux) (const Nothing)
maybe
(throwE NoDownload)
(throwE $ NoDownload v t (Just pfreq))
pure
(case p of
-- non-musl won't work on alpine

20
lib/GHCup/Errors.hs
View File

@ -206,12 +206,26 @@ instance HFErrorProject NoCompatiblePlatform where
eDesc _ = "No compatible platform could be found"
-- | Unable to find a download for the requested version/distro.
data NoDownload = NoDownload
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
| NoDownload' GlobalTool
deriving Show
instance Pretty NoDownload where
pPrint NoDownload =
text (eDesc (Proxy :: Proxy NoDownload))
pPrint (NoDownload tver@(GHCTargetVersion mtarget vv) tool mpfreq)
| (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
eBase _ = 10

173
lib/GHCup/GHC.hs
View File

@ -126,7 +126,7 @@ testGHCVer ver addMakeArgs = do
dlInfo <-
preview (ix GHC % ix ver % viTestDL % _Just) dls
?? NoDownload
?? NoDownload ver GHC Nothing
liftE $ testGHCBindist dlInfo ver addMakeArgs
@ -261,7 +261,7 @@ fetchGHCSrc v mfp = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <-
preview (ix GHC % ix v % viSourceDL % _Just) dls
?? NoDownload
?? NoDownload v GHC Nothing
liftE $ downloadCached' dlInfo Nothing mfp
@ -434,11 +434,7 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
-- Windows bindists are relocatable and don't need
-- to run configure.
-- We also must make sure to preserve mtime to not confuse ghc-pkg.
liftE $ mergeFileTree path 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
liftE $ mergeGHCFileTree path inst tver forceInstall
| otherwise = do
PlatformRequest {..} <- lift getPlatformReq
@ -460,7 +456,36 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
tmpInstallDest <- lift withGHCupTmpDir
lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "install"] (Just $ fromGHCupPath path)
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
GHC
tver
@ -469,8 +494,6 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
install f t (not forceInstall)
forM_ mtime $ setModificationTime t)
pure ()
-- | Installs GHC into @~\/.ghcup\/ghc/\<ver\>@ and places the
-- following symlinks in @~\/.ghcup\/bin@:
@ -709,7 +732,7 @@ rmGHCVer ver = do
Just files -> do
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> dir </> dropDrive f))
removeEmptyDirsRecursive dir
hideError UnsatisfiedConstraints $ removeEmptyDirsRecursive dir
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
f <- recordedInstallationFile GHC ver
lift $ recycleFile f
@ -765,7 +788,7 @@ compileGHC :: ( MonadMask m
-> Maybe (Either FilePath [URI]) -- ^ patches
-> [Text] -- ^ additional args to ./configure
-> Maybe String -- ^ build flavour
-> Bool
-> Maybe BuildSystem
-> InstallDir
-> Excepts
'[ AlreadyInstalled
@ -794,9 +817,9 @@ compileGHC :: ( MonadMask m
]
m
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
PlatformRequest { .. } <- lift getPlatformReq
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
(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
-- download source tarball
let tver = mkTVer ver
dlInfo <-
preview (ix GHC % ix (mkTVer ver) % viSourceDL % _Just) dls
?? NoDownload
preview (ix GHC % ix tver % viSourceDL % _Just) dls
?? NoDownload tver GHC (Just pfreq)
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack
@ -906,7 +930,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
-- compiled version, so the user can overwrite it
installVer <- if | Just ov' <- ov -> pure (GHCTargetVersion crossTarget 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"
| otherwise -> fail "No GHC version given and couldn't detect version. Giving up..."
alreadyInstalled <- lift $ ghcInstalled 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
GHCupInternal -> GHCupDir <$> lift (ghcupGHCDir installVer)
(mBindist, bmk) <- liftE $ runBuildAction
mBindist <- liftE $ runBuildAction
tmpUnpack
(do
b <- if hadrian
-- prefer 'tver', because the real version carries out compatibility checks
-- 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)
pure (b, bmk)
let doHadrian = compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
doMake = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir
case buildSystem of
Just Hadrian -> do
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
@ -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.
[]
liftIO $ B.writeFile (fromInstallDir ghcdir </> ghcUpSrcBuiltFile) bmk
case installDir of
-- set and make symlinks for regular (non-isolated) installs
GHCupInternal -> do
@ -978,8 +1015,17 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
=> GHCupPath
-> Excepts '[ProcessError, ParseError] m Version
getGHCVer tmpUnpack = do
lEM $ execWithGhcEnv "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
lEM $ execWithGhcEnv "sh" ["./configure"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
lEM $ execLogged "python3" ["./boot"] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap" Nothing
lEM $ configureWithGhcBoot Nothing [] (Just $ fromGHCupPath tmpUnpack) "ghc-bootstrap"
let versionFile = fromGHCupPath tmpUnpack </> "VERSION"
hasVersionFile <- liftIO $ doesFileExist versionFile
if hasVersionFile
then do
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
@ -1021,12 +1067,13 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
lift $ logInfo "Building (this may take a while)..."
hadrian_build <- liftE $ findHadrianFile workdir
lEM $ execWithGhcEnv hadrian_build
lEM $ execLogged hadrian_build
( maybe [] (\j -> ["-j" <> show j] ) jobs
++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
++ ["binary-dist"]
)
(Just workdir) "ghc-make"
Nothing
[tar] <- liftIO $ findFiles
(workdir </> "_build" </> "bindist")
(makeRegexOpts compExtended
@ -1059,6 +1106,9 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
, HasLog env
, MonadIO m
, MonadFail m
, MonadMask m
, MonadUnliftIO m
, MonadResource m
)
=> GHCTargetVersion
-> FilePath
@ -1070,6 +1120,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
, PatchFailed
, ProcessError
, NotFoundInPATH
, MergeFileTreeError
, CopyError]
m
(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
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
| otherwise -> do
lift $ logInfo "Creating bindist..."
@ -1209,11 +1262,8 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
()
configureBindist tver workdir (fromInstallDir -> ghcdir) = do
lift $ logInfo [s|configuring build|]
if | _tvVersion tver >= [vver|8.8.0|] -> do
lEM $ execWithGhcEnv
"sh"
("./configure" : maybe mempty
lEM $ configureWithGhcBoot (Just tver)
(maybe mempty
(\x -> ["--target=" <> T.unpack x])
(_tvTarget tver)
++ ["--prefix=" <> ghcdir]
@ -1222,51 +1272,40 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build
)
(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 ()
execWithGhcEnv :: ( MonadReader env m
configureWithGhcBoot :: ( MonadReader env m
, HasSettings env
, HasDirs env
, HasLog env
, MonadIO m
, MonadThrow m)
=> FilePath -- ^ thing to execute
-> [String] -- ^ args for the thing
=> Maybe GHCTargetVersion
-> [String] -- ^ args for configure
-> Maybe FilePath -- ^ optionally chdir into this
-> FilePath -- ^ log filename (opened in append mode)
-> m (Either ProcessError ())
execWithGhcEnv fp args dir logf = do
env <- ghcEnv
execLogged fp args dir logf (Just env)
configureWithGhcBoot mtver args dir logf = do
let execNew = execLogged
"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
Right g -> Right g
Left bver -> Left ("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)
Right g -> g
Left bver -> "ghc-" <> (T.unpack . prettyVer $ bver) <> exeExt

4
lib/GHCup/HLS.hs
View File

@ -355,7 +355,7 @@ compileHLS :: ( MonadMask m
, NotInstalled
] m Version
compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal updateCabal patches cabalArgs = do
PlatformRequest { .. } <- lift getPlatformReq
pfreq@PlatformRequest { .. } <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
Dirs { .. } <- lift getDirs
@ -371,7 +371,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
-- download source tarball
dlInfo <-
preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls
?? NoDownload
?? NoDownload (mkTVer tver) HLS (Just pfreq)
dl <- liftE $ downloadCached dlInfo Nothing
-- unpack

11
lib/GHCup/List.hs
View File

@ -76,7 +76,6 @@ data ListResult = ListResult
, lTag :: [Tag]
, lInstalled :: Bool
, lSet :: Bool -- ^ currently active version
, fromSrc :: Bool -- ^ compiled from source
, lStray :: Bool -- ^ not in download info
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
, hlsPowered :: Bool
@ -169,7 +168,6 @@ listVersions lt' criteria hideOld showNightly days = do
Just _ -> pure Nothing
Nothing -> do
lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
pure $ Just $ ListResult
{ lTool = GHC
@ -213,7 +211,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
@ -248,7 +245,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
@ -284,7 +280,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lInstalled = True
, lStray = isNothing (Map.lookup ver avTools)
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
@ -306,7 +301,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
, lCross = Nothing
, lTool = GHCup
, fromSrc = False
, lStray = isNothing listVer
, lSet = True
, lInstalled = True
@ -340,7 +334,6 @@ listVersions lt' criteria hideOld showNightly days = do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo' GHC tver
lSet <- fmap (== Just tver) $ ghcSet (_tvTarget tver)
lInstalled <- ghcInstalled tver
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem tver) (fmap mkTVer <$> hlsGHCVersions)
pure ListResult { lVer = _tvVersion tver , lCross = _tvTarget tver , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
Cabal -> do
@ -351,7 +344,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lCross = Nothing
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
@ -364,7 +356,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lTag = _viTags
, lCross = Nothing
, lTool = t
, fromSrc = False
, lStray = False
, lNoBindist = False
, hlsPowered = False
@ -379,7 +370,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lCross = Nothing
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
@ -393,7 +383,6 @@ listVersions lt' criteria hideOld showNightly days = do
, lCross = Nothing
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay

7
lib/GHCup/Types.hs
View File

@ -132,6 +132,9 @@ data GlobalTool = ShimGen
instance NFData GlobalTool
instance Pretty GlobalTool where
pPrint ShimGen = text "shimgen"
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
@ -720,4 +723,6 @@ instance Pretty ToolVersion where
data BuildSystem = Hadrian
| Make
deriving (Show, Eq)

14
lib/GHCup/Utils.hs
View File

@ -288,13 +288,6 @@ ghcInstalled ver = do
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.
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> 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
-- | 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.
make :: ( MonadThrow m
@ -1224,7 +1212,7 @@ ensureGlobalTools
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
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
void $ (\DigestError{} -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."

2
scripts/bootstrap/bootstrap-haskell.ps1
View File

@ -459,7 +459,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
Print-Msg -msg 'Processing MSYS2 bash for first time use...'
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...'
Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'