Fix cleaning up directories of compiled tools
'fromSrc' doesn't work well anyway.
This commit is contained in:
parent
09d72e7c97
commit
5170baf074
8
.github/scripts/cross.sh
vendored
8
.github/scripts/cross.sh
vendored
@ -51,6 +51,14 @@ 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}" ]
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -947,33 +947,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
|
||||
-- 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
|
||||
b <- 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
|
||||
bmk <- liftIO $ handleIO (\_ -> pure "") $ B.readFile (build_mk $ fromGHCupPath workdir)
|
||||
pure (b, bmk)
|
||||
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
|
||||
@ -993,8 +991,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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user