diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 711a4fe..d3b5ee2 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -472,19 +472,19 @@ install' _ (_, ListResult {..}) = do dirs <- lift getDirs case lTool of GHC -> do - let vi = getVersionInfo lVer GHC dls - liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce) + let vi = getVersionInfo (GHCTargetVersion lCross lVer) GHC dls + liftE $ installGHCBin (GHCTargetVersion lCross lVer) GHCupInternal False [] $> (vi, dirs, ce) Cabal -> do - let vi = getVersionInfo lVer Cabal dls + let vi = getVersionInfo (GHCTargetVersion lCross lVer) Cabal dls liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce) GHCup -> do let vi = snd <$> getLatest dls GHCup liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce) HLS -> do - let vi = getVersionInfo lVer HLS dls + let vi = getVersionInfo (GHCTargetVersion lCross lVer) HLS dls liftE $ installHLSBin lVer GHCupInternal False $> (vi, dirs, ce) Stack -> do - let vi = getVersionInfo lVer Stack dls + let vi = getVersionInfo (GHCTargetVersion lCross lVer) Stack dls liftE $ installStackBin lVer GHCupInternal False $> (vi, dirs, ce) ) >>= \case @@ -565,7 +565,7 @@ del' _ (_, ListResult {..}) = do let run = runE @'[NotInstalled, UninstallFailed] run (do - let vi = getVersionInfo lVer lTool dls + let vi = getVersionInfo (GHCTargetVersion lCross lVer) lTool dls case lTool of GHC -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer) $> vi Cabal -> liftE $ rmCabalVer lVer $> vi diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs index ad05c34..37e7c6c 100644 --- a/app/ghcup/GHCup/OptParse/Common.hs +++ b/app/ghcup/GHCup/OptParse/Common.hs @@ -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 diff --git a/app/ghcup/GHCup/OptParse/Compile.hs b/app/ghcup/GHCup/OptParse/Compile.hs index ead9263..bec9ec7 100644 --- a/app/ghcup/GHCup/OptParse/Compile.hs +++ b/app/ghcup/GHCup/OptParse/Compile.hs @@ -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) diff --git a/app/ghcup/GHCup/OptParse/Install.hs b/app/ghcup/GHCup/OptParse/Install.hs index 868828e..e13f740 100644 --- a/app/ghcup/GHCup/OptParse/Install.hs +++ b/app/ghcup/GHCup/OptParse/Install.hs @@ -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 diff --git a/app/ghcup/GHCup/OptParse/Prefetch.hs b/app/ghcup/GHCup/OptParse/Prefetch.hs index 3f4596f..0839dd0 100644 --- a/app/ghcup/GHCup/OptParse/Prefetch.hs +++ b/app/ghcup/GHCup/OptParse/Prefetch.hs @@ -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') diff --git a/app/ghcup/GHCup/OptParse/Rm.hs b/app/ghcup/GHCup/OptParse/Rm.hs index 615c319..bfacb40 100644 --- a/app/ghcup/GHCup/OptParse/Rm.hs +++ b/app/ghcup/GHCup/OptParse/Rm.hs @@ -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 diff --git a/app/ghcup/GHCup/OptParse/Run.hs b/app/ghcup/GHCup/OptParse/Run.hs index fb0b0a5..0d9ad03 100644 --- a/app/ghcup/GHCup/OptParse/Run.hs +++ b/app/ghcup/GHCup/OptParse/Run.hs @@ -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 [] diff --git a/app/ghcup/GHCup/OptParse/Test.hs b/app/ghcup/GHCup/OptParse/Test.hs index 409f539..bfa3cee 100644 --- a/app/ghcup/GHCup/OptParse/Test.hs +++ b/app/ghcup/GHCup/OptParse/Test.hs @@ -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 diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 8c7ff1f..1d75c20 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -249,7 +249,7 @@ Report bugs at |] case t of GHCup -> runLogger $ logWarn ("New GHCup version available: " - <> prettyVer l + <> tVerToText l <> ". To upgrade, run 'ghcup upgrade'") _ -> runLogger $ logWarn ("New " @@ -258,7 +258,7 @@ Report bugs at |] <> "If you want to install this latest version, run 'ghcup install " <> T.pack (prettyShow t) <> " " - <> prettyVer l + <> tVerToText l <> "'") Just _ -> pure () @@ -332,7 +332,7 @@ Report bugs at |] , MonadCatch m ) => Command - -> (Tool, Version) + -> (Tool, GHCTargetVersion) -> Excepts '[ TagNotFound , DayNotFound @@ -368,7 +368,7 @@ Report bugs at |] ) => Tool -> Maybe ToolVersion - -> Version + -> GHCTargetVersion -> Excepts '[ TagNotFound , DayNotFound @@ -377,4 +377,4 @@ Report bugs at |] ] m Bool cmp' tool instVer ver = do (v, _) <- liftE $ fromVersion instVer tool - pure (v == mkTVer ver) + pure (v == ver) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index a00550f..443f3c5 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -303,7 +303,7 @@ upgradeGHCup mtarget force' fatal = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo lift $ logInfo "Upgrading GHCup..." - let latestVer = fst (fromJust (getLatest dls GHCup)) + let latestVer = _tvVersion $ fst (fromJust (getLatest dls GHCup)) (Just ghcupPVPVer) <- pure $ pvpToVersion ghcUpVer "" when (not force' && (latestVer <= ghcupPVPVer)) $ throwE NoUpdate dli <- liftE $ getDownloadInfo GHCup latestVer @@ -492,7 +492,7 @@ rmOldGHC :: ( MonadReader env m => Excepts '[NotInstalled, UninstallFailed] m () rmOldGHC = do GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo - let oldGHCs = mkTVer <$> toListOf (ix GHC % getTagged Old % to fst) dls + let oldGHCs = toListOf (ix GHC % getTagged Old % to fst) dls ghcs <- lift $ fmap rights getInstalledGHCs forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 71319a3..9b5e549 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -271,7 +271,6 @@ getBase uri = do pure f - getDownloadInfo :: ( MonadReader env m , HasPlatformReq env , HasGHCupInfo env @@ -283,7 +282,20 @@ getDownloadInfo :: ( MonadReader env m '[NoDownload] m DownloadInfo -getDownloadInfo t v = do +getDownloadInfo t v = getDownloadInfo' t (mkTVer v) + +getDownloadInfo' :: ( MonadReader env m + , HasPlatformReq env + , HasGHCupInfo env + ) + => Tool + -> GHCTargetVersion + -- ^ tool version + -> Excepts + '[NoDownload] + m + DownloadInfo +getDownloadInfo' t v = do (PlatformRequest a p mv) <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs index 32e35e5..f0e1aa8 100644 --- a/lib/GHCup/GHC.hs +++ b/lib/GHCup/GHC.hs @@ -105,7 +105,7 @@ testGHCVer :: ( MonadFail m , MonadIO m , MonadUnliftIO m ) - => Version + => GHCTargetVersion -> [T.Text] -> Excepts '[ DigestError @@ -145,7 +145,7 @@ testGHCBindist :: ( MonadFail m , MonadUnliftIO m ) => DownloadInfo - -> Version + -> GHCTargetVersion -> [T.Text] -> Excepts '[ DigestError @@ -182,7 +182,7 @@ testPackedGHC :: ( MonadMask m ) => FilePath -- ^ Path to the packed GHC bindist -> Maybe TarDir -- ^ Subdir of the archive - -> Version -- ^ The GHC version + -> GHCTargetVersion -- ^ The GHC version -> [T.Text] -- ^ additional make args -> Excepts '[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m () @@ -208,19 +208,21 @@ testUnpackedGHC :: ( MonadReader env m , MonadIO m ) => GHCupPath -- ^ Path to the unpacked GHC bindist (where the make file resides) - -> Version -- ^ The GHC version + -> GHCTargetVersion -- ^ The GHC version -> [T.Text] -- ^ additional configure args for bindist -> Excepts '[ProcessError] m () -testUnpackedGHC path ver addMakeArgs = do - lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!" - ghcDir <- lift $ ghcupGHCDir (mkTVer ver) +testUnpackedGHC path tver addMakeArgs = do + lift $ logInfo $ "Testing GHC version " <> tVerToText tver <> "!" + ghcDir <- lift $ ghcupGHCDir tver let ghcBinDir = fromGHCupPath ghcDir "bin" env <- liftIO $ addToPath ghcBinDir False lEM $ make' (fmap T.unpack addMakeArgs) (Just $ fromGHCupPath path) "ghc-test" - (Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env) + (Just $ ("STAGE1_GHC", maybe "" (T.unpack . (<> "-")) (_tvTarget tver) + <> "ghc-" + <> T.unpack (prettyVer $ _tvVersion tver)) : env) pure () @@ -243,7 +245,7 @@ fetchGHCSrc :: ( MonadFail m , MonadIO m , MonadUnliftIO m ) - => Version + => GHCTargetVersion -> Maybe FilePath -> Excepts '[ DigestError @@ -283,7 +285,7 @@ installGHCBindist :: ( MonadFail m , MonadUnliftIO m ) => DownloadInfo -- ^ where/how to download - -> Version -- ^ the version to install + -> GHCTargetVersion -- ^ the version to install -> InstallDir -> Bool -- ^ Force install -> [T.Text] -- ^ additional configure args for bindist @@ -306,10 +308,8 @@ installGHCBindist :: ( MonadFail m ] m () -installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do - let tver = mkTVer ver - - lift $ logDebug $ "Requested to install GHC with " <> prettyVer ver +installGHCBindist dlinfo tver installDir forceInstall addConfArgs = do + lift $ logDebug $ "Requested to install GHC with " <> tVerToText tver regularGHCInstalled <- lift $ ghcInstalled tver @@ -317,7 +317,7 @@ installGHCBindist dlinfo ver installDir forceInstall addConfArgs = do | not forceInstall , regularGHCInstalled , GHCupInternal <- installDir -> do - throwE $ AlreadyInstalled GHC ver + throwE $ AlreadyInstalled GHC (_tvVersion tver) | forceInstall , regularGHCInstalled @@ -451,7 +451,7 @@ installUnpackedGHC path inst tver forceInstall addConfArgs lift $ logInfo "Installing GHC (this may take a while)" lEM $ execLogged "sh" ("./configure" : ("--prefix=" <> fromInstallDir inst) - : (ldOverride <> (T.unpack <$> addConfArgs)) + : (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver) <> ldOverride <> (T.unpack <$> addConfArgs)) ) (Just $ fromGHCupPath path) "ghc-configure" @@ -489,7 +489,7 @@ installGHCBin :: ( MonadFail m , MonadIO m , MonadUnliftIO m ) - => Version -- ^ the version to install + => GHCTargetVersion -- ^ the version to install -> InstallDir -> Bool -- ^ force install -> [T.Text] -- ^ additional configure args for bindist @@ -512,9 +512,9 @@ installGHCBin :: ( MonadFail m ] m () -installGHCBin ver installDir forceInstall addConfArgs = do - dlinfo <- liftE $ getDownloadInfo GHC ver - liftE $ installGHCBindist dlinfo ver installDir forceInstall addConfArgs +installGHCBin tver installDir forceInstall addConfArgs = do + dlinfo <- liftE $ getDownloadInfo' GHC tver + liftE $ installGHCBindist dlinfo tver installDir forceInstall addConfArgs @@ -764,6 +764,7 @@ compileGHC :: ( MonadMask m -> Maybe (Either FilePath [URI]) -- ^ patches -> [Text] -- ^ additional args to ./configure -> Maybe String -- ^ build flavour + -> Maybe String -- ^ bignum -> Bool -> InstallDir -> Excepts @@ -793,7 +794,7 @@ 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 bignum hadrian installDir = do PlatformRequest { .. } <- lift getPlatformReq GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo @@ -805,7 +806,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build -- download source tarball dlInfo <- - preview (ix GHC % ix ver % viSourceDL % _Just) dls + preview (ix GHC % ix (mkTVer ver) % viSourceDL % _Just) dls ?? NoDownload dl <- liftE $ downloadCached dlInfo Nothing @@ -1023,6 +1024,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build lEM $ execWithGhcEnv hadrian_build ( maybe [] (\j -> ["-j" <> show j] ) jobs ++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour + ++ maybe [] (\bn -> ["--bignum=" <> bn]) bignum ++ ["binary-dist"] ) (Just workdir) "ghc-make" @@ -1081,7 +1083,7 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build (FileDoesNotExistError bc) (liftIO $ copyFile bc (build_mk workdir) False) Nothing -> - liftIO $ T.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf) + liftIO $ T.writeFile (build_mk workdir) (addBigNumToConf $ addBuildFlavourToConf defaultConf) liftE $ checkBuildConfig (build_mk workdir) @@ -1179,6 +1181,10 @@ compileGHC targetGhc crossTarget ov bstrap jobs mbuildConfig patches aargs build Just bf -> "BuildFlavour = " <> T.pack bf <> "\n" <> bc Nothing -> bc + addBigNumToConf bc = case bignum of + Just bn -> bc <> "\nINTEGER_LIBRARY = " <> T.pack bn + Nothing -> bc + isCross :: GHCTargetVersion -> Bool isCross = isJust . _tvTarget diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs index 8d39478..744ba54 100644 --- a/lib/GHCup/HLS.hs +++ b/lib/GHCup/HLS.hs @@ -369,7 +369,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda -- download source tarball dlInfo <- - preview (ix HLS % ix tver % viSourceDL % _Just) dls + preview (ix HLS % ix (mkTVer tver) % viSourceDL % _Just) dls ?? NoDownload dl <- liftE $ downloadCached dlInfo Nothing diff --git a/lib/GHCup/List.hs b/lib/GHCup/List.hs index 4acf01d..679d018 100644 --- a/lib/GHCup/List.hs +++ b/lib/GHCup/List.hs @@ -86,7 +86,7 @@ data ListResult = ListResult -- | Extract all available tool versions and their tags. -availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo +availableToolVersions :: GHCupDownloads -> Tool -> Map.Map GHCTargetVersion VersionInfo availableToolVersions av tool = view (at tool % non Map.empty) av @@ -134,13 +134,13 @@ listVersions lt' criteria hideOld showNightly days = do slr <- strayGHCs avTools pure (sort (slr ++ lr)) Cabal -> do - slr <- strayCabals avTools cSet cabals + slr <- strayCabals (Map.mapKeys _tvVersion avTools) cSet cabals pure (sort (slr ++ lr)) HLS -> do - slr <- strayHLS avTools hlsSet' hlses + slr <- strayHLS (Map.mapKeys _tvVersion avTools) hlsSet' hlses pure (sort (slr ++ lr)) Stack -> do - slr <- strayStacks avTools sSet stacks + slr <- strayStacks (Map.mapKeys _tvVersion avTools) sSet stacks pure (sort (slr ++ lr)) GHCup -> do let cg = maybeToList $ currentGHCup avTools @@ -159,13 +159,13 @@ listVersions lt' criteria hideOld showNightly days = do , HasLog env , MonadIO m ) - => Map.Map Version VersionInfo + => Map.Map GHCTargetVersion VersionInfo -> m [ListResult] strayGHCs avTools = do ghcs <- getInstalledGHCs fmap catMaybes $ forM ghcs $ \case Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do - case Map.lookup _tvVersion avTools of + case Map.lookup tver avTools of Just _ -> pure Nothing Nothing -> do lSet <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing @@ -177,7 +177,7 @@ listVersions lt' criteria hideOld showNightly days = do , lCross = Nothing , lTag = [] , lInstalled = True - , lStray = isNothing (Map.lookup _tvVersion avTools) + , lStray = isNothing (Map.lookup tver avTools) , lNoBindist = False , lReleaseDay = Nothing , .. @@ -192,7 +192,7 @@ listVersions lt' criteria hideOld showNightly days = do , lCross = _tvTarget , lTag = [] , lInstalled = True - , lStray = True -- NOTE: cross currently cannot be installed via bindist + , lStray = isNothing (Map.lookup tver avTools) , lNoBindist = False , lReleaseDay = Nothing , .. @@ -309,15 +309,15 @@ listVersions lt' criteria hideOld showNightly days = do $ "Could not parse version of stray directory" <> T.pack e pure Nothing - currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult + currentGHCup :: Map.Map GHCTargetVersion VersionInfo -> Maybe ListResult currentGHCup av = - let currentVer = fromJust $ pvpToVersion ghcUpVer "" + let currentVer = mkTVer $ fromJust $ pvpToVersion ghcUpVer "" listVer = Map.lookup currentVer av latestVer = fst <$> headOf (getTagged Latest) av recommendedVer = fst <$> headOf (getTagged Latest) av isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer in if | Map.member currentVer av -> Nothing - | otherwise -> Just $ ListResult { lVer = currentVer + | otherwise -> Just $ ListResult { lVer = _tvVersion currentVer , lTag = maybe (if isOld then [Old] else []) _viTags listVer , lCross = Nothing , lTool = GHCup @@ -346,18 +346,18 @@ listVersions lt' criteria hideOld showNightly days = do -> [Either FilePath Version] -> Maybe Version -> [Either FilePath Version] - -> (Version, VersionInfo) + -> (GHCTargetVersion, VersionInfo) -> m ListResult - toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, VersionInfo{..}) = do + toListResult t cSet cabals hlsSet' hlses stackSet' stacks (tver, VersionInfo{..}) = do + let v = _tvVersion tver case t of GHC -> do - lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v - let tver = mkTVer v - lSet <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing + 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 v) hlsGHCVersions - pure ListResult { lVer = v, lCross = Nothing , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. } + 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 lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v let lSet = cSet == Just v diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index e68175f..e67e720 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -104,7 +104,7 @@ instance NFData Requirements -- | Description of all binary and source downloads. This is a tree -- of nested maps. type GHCupDownloads = Map Tool ToolVersionSpec -type ToolVersionSpec = Map Version VersionInfo +type ToolVersionSpec = Map GHCTargetVersion VersionInfo type ArchitectureSpec = Map Architecture PlatformSpec type PlatformSpec = Map Platform PlatformVersionSpec type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo @@ -593,7 +593,9 @@ data GHCTargetVersion = GHCTargetVersion { _tvTarget :: Maybe Text , _tvVersion :: Version } - deriving (Ord, Eq, Show) + deriving (Ord, Eq, Show, GHC.Generic) + +instance NFData GHCTargetVersion data GitBranch = GitBranch { ref :: String diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs index b1c9a7e..40bbb10 100644 --- a/lib/GHCup/Types/JSON.hs +++ b/lib/GHCup/Types/JSON.hs @@ -95,13 +95,29 @@ instance FromJSON URI where Right x -> pure x Left e -> fail . show $ e +instance ToJSON GHCTargetVersion where + toJSON = toJSON . tVerToText + +instance FromJSON GHCTargetVersion where + parseJSON = withText "GHCTargetVersion" $ \t -> case MP.parse ghcTargetVerP "" t of + Right x -> pure x + Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e + +instance ToJSONKey GHCTargetVersion where + toJSONKey = toJSONKeyText $ \x -> tVerToText x + +instance FromJSONKey GHCTargetVersion where + fromJSONKey = FromJSONKeyTextParser $ \t -> case MP.parse ghcTargetVerP "" t of + Right x -> pure x + Left e -> fail $ "Failure in GHCTargetVersion (FromJSONKey)" <> show e + instance ToJSON Versioning where toJSON = toJSON . prettyV instance FromJSON Versioning where parseJSON = withText "Versioning" $ \t -> case versioning t of Right x -> pure x - Left e -> fail $ "Failure in Version (FromJSON)" <> show e + Left e -> fail $ "Failure in GHCTargetVersion (FromJSON)" <> show e instance ToJSONKey Versioning where toJSONKey = toJSONKeyText $ \x -> prettyV x diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 90db19a..475ea6f 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -62,7 +62,6 @@ import Control.Monad.Trans.Resource hiding ( throwM ) import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) ) import Data.Char ( isHexDigit ) -import Data.Bifunctor ( first ) import Data.ByteString ( ByteString ) import Data.Either import Data.Foldable @@ -774,13 +773,16 @@ getGHCForPVP' pvpIn ghcs' mt = do -- Just (PVP {_pComponents = 8 :| [8,4]}) getLatestToolFor :: MonadThrow m => Tool + -> Maybe Text -> PVP -> GHCupDownloads - -> m (Maybe (PVP, VersionInfo)) -getLatestToolFor tool pvpIn dls = do - let ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls - let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls - pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps + -> m (Maybe (PVP, VersionInfo, Maybe Text)) +getLatestToolFor tool target pvpIn dls = do + let ls :: [(GHCTargetVersion, VersionInfo)] + ls = fromMaybe [] $ preview (ix tool % to Map.toDescList) dls + let ps :: [((PVP, Text), VersionInfo, Maybe Text)] + ps = catMaybes $ fmap (\(v, vi) -> (,vi, _tvTarget v) <$> versionToPVP (_tvVersion v)) ls + pure . fmap (\((pv', _), vi, mt) -> (pv', vi, mt)) . headMay . filter (\((v, _), _, t) -> matchPVPrefix pvpIn v && t == target) $ ps @@ -885,12 +887,12 @@ intoSubdir bdir tardir = case tardir of -- | Get the tool version that has this tag. If multiple have it, -- picks the greatest version. getTagged :: Tag - -> Fold (Map.Map Version VersionInfo) (Version, VersionInfo) + -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo) getTagged tag = to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags)) % folding id -getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (Version, VersionInfo) +getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (GHCTargetVersion, VersionInfo) getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m -> maybe m (\d -> let diff = diffDays d day @@ -902,24 +904,24 @@ getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av | absDiff == 0 -> Right (k, vi) | otherwise -> Left (Just (addDays diff day)) -getByReleaseDayFold :: Day -> Fold (Map.Map Version VersionInfo) (Version, VersionInfo) +getByReleaseDayFold :: Day -> Fold (Map.Map GHCTargetVersion VersionInfo) (GHCTargetVersion, VersionInfo) getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id -getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) +getLatest :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo) getLatest av tool = headOf (ix tool % getTagged Latest) av -getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) +getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo) getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av -getLatestNightly :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) +getLatestNightly :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo) getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av -getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo) +getRecommended :: GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo) getRecommended av tool = headOf (ix tool % getTagged Recommended) av -- | Gets the latest GHC with a given base version. -getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo) +getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (GHCTargetVersion, VersionInfo) getLatestBaseVersion av pvpVer = headOf (ix GHC % getTagged (Base pvpVer)) av @@ -1101,9 +1103,9 @@ darwinNotarization _ _ = pure $ Right () getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI -getChangeLog dls tool (GHCVersion (_tvVersion -> v')) = +getChangeLog dls tool (GHCVersion v') = preview (ix tool % ix v' % viChangeLog % _Just) dls -getChangeLog dls tool (ToolVersion v') = +getChangeLog dls tool (ToolVersion (mkTVer -> v')) = preview (ix tool % ix v' % viChangeLog % _Just) dls getChangeLog dls tool (ToolTag tag) = preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls @@ -1192,7 +1194,7 @@ rmBDir dir = withRunInIO (\run -> run $ $ rmPathForcibly dir) -getVersionInfo :: Version +getVersionInfo :: GHCTargetVersion -> Tool -> GHCupDownloads -> Maybe VersionInfo