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

More cross fixes to install bindist

Browse Source
This commit is contained in:
Julian Ospald
2023-07-07 16:41:58 +08:00
parent 4361ef7a72
commit a43fa7d63e
17 changed files with 163 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
app/ghcup/GHCup/OptParse/Common.hs
View File

@@ -5,6 +5,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.OptParse.Common where
@@ -693,52 +694,52 @@ fromVersion' :: ( HasLog env
] m (GHCTargetVersion, Maybe VersionInfo)
fromVersion' SetRecommended tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool
second Just <$> getRecommended dls tool
?? TagNotFound Recommended tool
fromVersion' (SetGHCVersion v) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion v) tool dls
let vi = getVersionInfo v tool dls
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi)
Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> do
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion (_tvTarget v) v', Just vi')
pure (GHCTargetVersion mt v', Just vi')
Nothing -> pure (v, vi)
fromVersion' (SetToolVersion v) tool = do
fromVersion' (SetToolVersion (mkTVer -> v)) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo v tool dls
case pvp $ prettyVer v of -- need to be strict here
Left _ -> pure (mkTVer v, vi)
case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
Left _ -> pure (v, vi)
Right pvpIn ->
lift (getLatestToolFor tool pvpIn dls) >>= \case
Just (pvp_, vi') -> do
lift (getLatestToolFor tool (_tvTarget v) pvpIn dls) >>= \case
Just (pvp_, vi', mt) -> do
v' <- lift $ pvpToVersion pvp_ ""
when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mempty v', Just vi')
Nothing -> pure (mkTVer v, vi)
when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
pure (GHCTargetVersion mt v', Just vi')
Nothing -> pure (v, vi)
fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
bimap id Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolDay day) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> case getByReleaseDay dls tool day of
bimap id Just <$> case getByReleaseDay dls tool day of
Left ad -> throwE $ DayNotFound day tool ad
Right v -> pure v
fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
bimap id Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
fromVersion' (SetToolTag LatestNightly) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
bimap id Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
bimap id Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
fromVersion' (SetToolTag (Base pvp'')) GHC = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
bimap id Just <$> getLatestBaseVersion dls pvp'' ?? TagNotFound (Base pvp'') GHC
fromVersion' SetNext tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
next <- case tool of
@@ -783,7 +784,7 @@ fromVersion' SetNext tool = do
. sort
$ stacks) ?? NoToolVersionSet tool
GHCup -> fail "GHCup cannot be set"
let vi = getVersionInfo (_tvVersion next) tool dls
let vi = getVersionInfo next tool dls
pure (next, vi)
fromVersion' (SetToolTag t') tool =
throwE $ TagNotFound t' tool
@@ -799,15 +800,15 @@ checkForUpdates :: ( MonadReader env m
, MonadIO m
, MonadFail m
)
=> m [(Tool, Version)]
=> m [(Tool, GHCTargetVersion)]
checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
let latestInstalled tool = (fmap (\lr -> GHCTargetVersion (lCross lr) (lVer lr)) . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do
ghcup <- forMM (getLatest dls GHCup) $ \(GHCTargetVersion _ l, _) -> do
(Right ghcup_ver) <- pure $ version $ prettyPVP ghcUpVer
if (l > ghcup_ver) then pure $ Just (GHCup, l) else pure Nothing
if (l > ghcup_ver) then pure $ Just (GHCup, mkTVer l) else pure Nothing
otherTools <- forM [GHC, Cabal, HLS, Stack] $ \t ->
forMM (getLatest dls t) $ \(l, _) -> do

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

@@ -77,6 +77,7 @@ data GHCCompileOptions = GHCCompileOptions
, ovewrwiteVer :: Maybe Version
, buildFlavour :: Maybe String
, hadrian :: Bool
, bignum :: Maybe String
, isolateDir :: Maybe FilePath
}
@@ -271,6 +272,13 @@ ghcCompileOpts =
<*> switch
(long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
)
<*> optional
(option
str
(long "bignum" <> metavar "INTEGER_BACKEND" <> help
"Set the integer backend. This value differs between make ('integer-gmp' and 'integer-simple') and hadrian ('gmp' and 'native')"
)
)
<*> optional
(option
(eitherReader isolateParser)
@@ -511,7 +519,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
case targetHLS of
HLS.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
let vi = getVersionInfo (mkTVer targetVer) HLS dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
@@ -531,7 +539,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches
cabalArgs
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
let vi = getVersionInfo (mkTVer targetVer) HLS dls
when setCompile $ void $ liftE $
setHLS targetVer SetHLSOnly Nothing
pure (vi, targetVer)
@@ -560,7 +568,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
case targetGhc of
GHC.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls
let vi = getVersionInfo (mkTVer targetVer) GHC dls
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
@@ -577,10 +585,11 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
patches
addConfArgs
buildFlavour
bignum
hadrian
(maybe GHCupInternal IsolateDir isolateDir)
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo (_tvVersion targetVer) GHC dls
let vi = getVersionInfo targetVer GHC dls
when setCompile $ void $ liftE $
setGHC targetVer SetGHCOnly Nothing
pure (vi, targetVer)

4
app/ghcup/GHCup/OptParse/Install.hs
View File

@@ -324,7 +324,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
Nothing -> runInstGHC s' $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBin
(_tvVersion v)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs
@@ -336,7 +336,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
(_tvVersion v)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
addConfArgs

2
app/ghcup/GHCup/OptParse/Prefetch.hs
View File

@@ -195,7 +195,7 @@ prefetch prefetchCommand runAppState runLogger =
forM_ pfCacheDir (liftIO . createDirRecursive')
(v, _) <- liftE $ fromVersion mt GHC
if pfGHCSrc
then liftE $ fetchGHCSrc (_tvVersion v) pfCacheDir
then liftE $ fetchGHCSrc v pfCacheDir
else liftE $ fetchToolBindist (_tvVersion v) GHC pfCacheDir
PrefetchCabal PrefetchOptions {pfCacheDir} mt -> do
forM_ pfCacheDir (liftIO . createDirRecursive')

8
app/ghcup/GHCup/OptParse/Rm.hs
View File

@@ -170,7 +170,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmGHCVer ghcVer
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo (_tvVersion ghcVer) GHC dls)
pure (getVersionInfo ghcVer GHC dls)
)
>>= \case
VRight vi -> do
@@ -186,7 +186,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmCabalVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Cabal dls)
pure (getVersionInfo (mkTVer tv) Cabal dls)
)
>>= \case
VRight vi -> do
@@ -201,7 +201,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmHLSVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv HLS dls)
pure (getVersionInfo (mkTVer tv) HLS dls)
)
>>= \case
VRight vi -> do
@@ -216,7 +216,7 @@ rm rmCommand runAppState runLogger = case rmCommand of
liftE $
rmStackVer tv
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
pure (getVersionInfo tv Stack dls)
pure (getVersionInfo (mkTVer tv) Stack dls)
)
>>= \case
VRight vi -> do

2
app/ghcup/GHCup/OptParse/Run.hs
View File

@@ -360,7 +360,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
Just v -> do
isInstalled <- lift $ checkIfToolInstalled' GHC v
unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
(_tvVersion v)
v
GHCupInternal
False
[]

4
app/ghcup/GHCup/OptParse/Test.hs
View File

@@ -169,12 +169,12 @@ test testCommand settings getAppState' runLogger = case testCommand of
(case testBindist of
Nothing -> runTestGHC s' $ do
(v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCVer (_tvVersion v) addMakeArgs
liftE $ testGHCVer v addMakeArgs
pure vi
Just uri -> do
runTestGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) (_tvVersion v) addMakeArgs
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) v addMakeArgs
pure vi
)
>>= \case