diff --git a/.github/scripts/cross.sh b/.github/scripts/cross.sh new file mode 100644 index 0000000..c6bbb80 --- /dev/null +++ b/.github/scripts/cross.sh @@ -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 ] + diff --git a/.github/workflows/cross.yaml b/.github/workflows/cross.yaml new file mode 100644 index 0000000..c540373 --- /dev/null +++ b/.github/workflows/cross.yaml @@ -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 + diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index e6f8921..49baa81 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -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 diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs index 5d4a957..b6cd6cb 100644 --- a/app/ghcup/GHCup/OptParse/Compile.hs +++ b/app/ghcup/GHCup/OptParse/Compile.hs @@ -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,9 +269,15 @@ 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 (eitherReader isolateParser) @@ -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 diff --git a/app/ghcup/GHCup/OptParse/List.hs b/app/ghcup/GHCup/OptParse/List.hs index 3989adc..4de0f9d 100644 --- a/app/ghcup/GHCup/OptParse/List.hs +++ b/app/ghcup/GHCup/OptParse/List.hs @@ -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 diff --git a/docs/guide.md b/docs/guide.md index f9f1fd8..1fd6910 100644 --- a/docs/guide.md +++ b/docs/guide.md @@ -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: diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 443f3c5..74c55e8 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -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 diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 9b5e549..418beb5 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -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 diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index 4fb29b2..72ba7d3 100644 --- a/lib/GHCup/Errors.hs +++ b/lib/GHCup/Errors.hs @@ -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 " + <> 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 diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs index 764a4aa..7349302 100644 --- a/lib/GHCup/GHC.hs +++ b/lib/GHCup/GHC.hs @@ -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/\@ 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) + -- prefer 'tver', because the real version carries out compatibility checks + -- we don't want the user to do funny things with it + 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,13 +1015,22 @@ 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" - 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" ] + 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 + 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 = 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)..." 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,64 +1262,50 @@ 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 - (\x -> ["--target=" <> T.unpack x]) - (_tvTarget tver) - ++ ["--prefix=" <> ghcdir] - ++ (if isWindows then ["--enable-tarballs-autodownload"] else []) - ++ fmap T.unpack aargs - ) - (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 + lEM $ configureWithGhcBoot (Just tver) + (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" pure () - execWithGhcEnv :: ( MonadReader env m - , HasSettings env - , HasDirs env - , HasLog env - , MonadIO m - , MonadThrow m) - => FilePath -- ^ thing to execute - -> [String] -- ^ args for the thing - -> 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 :: ( MonadReader env m + , HasSettings env + , HasDirs env + , HasLog env + , MonadIO m + , MonadThrow m) + => Maybe GHCTargetVersion + -> [String] -- ^ args for configure + -> Maybe FilePath -- ^ optionally chdir into this + -> FilePath -- ^ log filename (opened in append mode) + -> m (Either ProcessError ()) + 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 diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs index da451ef..ba33018 100644 --- a/lib/GHCup/HLS.hs +++ b/lib/GHCup/HLS.hs @@ -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 diff --git a/lib/GHCup/List.hs b/lib/GHCup/List.hs index afe1d6d..d7418a1 100644 --- a/lib/GHCup/List.hs +++ b/lib/GHCup/List.hs @@ -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 diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index eff9d0d..b13f108 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -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) diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 475ea6f..16259b9 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -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\/\\/@ 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..." diff --git a/scripts/bootstrap/bootstrap-haskell.ps1 b/scripts/bootstrap/bootstrap-haskell.ps1 index 5ab08fc..f199b5c 100644 --- a/scripts/bootstrap/bootstrap-haskell.ps1 +++ b/scripts/bootstrap/bootstrap-haskell.ps1 @@ -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'