More cross fixes to install bindist

2023-07-07 16:41:58 +08:00
parent 4361ef7a72
commit a43fa7d63e
17 changed files with 163 additions and 115 deletions
--- 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
--- 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
--- 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)
--- 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
--- 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')
--- 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
--- 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
               []
--- 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
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@@ -249,7 +249,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                               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 <https://github.com/haskell/ghcup-hs/issues>|]
                                          <> "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 <https://github.com/haskell/ghcup-hs/issues>|]
                       , MonadCatch m
                       )
                    => Command
-                    -> (Tool, Version)
+                    -> (Tool, GHCTargetVersion)
                    -> Excepts
                         '[ TagNotFound
                          , DayNotFound
@@ -368,7 +368,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
          )
       => Tool
       -> Maybe ToolVersion
-       -> Version
+       -> GHCTargetVersion
       -> Excepts
            '[ TagNotFound
             , DayNotFound
@@ -377,4 +377,4 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
             ] m Bool
  cmp' tool instVer ver = do
    (v, _) <- liftE $ fromVersion instVer tool
-    pure (v == mkTVer ver)
+    pure (v == ver)