Avoid metadata download when possible

app/ghcup/GHCup/OptParse/Run.hs

@@ -161,6 +161,16 @@ type RunEffects = '[ AlreadyInstalled
                    , ProcessError
                    ]
 
+runLeanRUN :: (MonadUnliftIO m, MonadIO m)
+           => LeanAppState
+           -> Excepts RunEffects (ReaderT LeanAppState m) a
+           -> m (VEither RunEffects a)
+runLeanRUN leanAppstate =
+    -- Don't use runLeanAppState here, which is disabled on windows.
+    -- This is the only command on all platforms that doesn't need full appstate.
+    flip runReaderT leanAppstate
+    . runE
+      @RunEffects
 
 runRUN :: MonadUnliftIO m
       => (ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
@@ -189,18 +199,18 @@ run :: forall m.
        )
    => RunOptions
    -> (forall a. ReaderT AppState m (VEither RunEffects a) -> m (VEither RunEffects a))
+   -> LeanAppState
    -> (ReaderT LeanAppState m () -> m ())
    -> m ExitCode
-run RunOptions{..} runAppState runLogger = runRUN runAppState (do
+run RunOptions{..} runAppState leanAppstate runLogger = do
    tmp <- case runBinDir of
      Just bdir -> do
        liftIO $ createDirRecursive' bdir
        liftIO $ canonicalizePath bdir
      Nothing -> liftIO (getTemporaryDirectory >>= \tmp -> createTempDirectory tmp "ghcup")
-   forM_ runGHCVer   $ addToolToDir tmp GHC
-   forM_ runCabalVer $ addToolToDir tmp Cabal
-   forM_ runHLSVer   $ addToolToDir tmp HLS
-   forM_ runStackVer $ addToolToDir tmp Stack
+   r <- addToolsToDir tmp
+   case r of
+     VRight _ -> do
        case runCOMMAND of
          [] -> liftIO $ putStr tmp
          (cmd:args) -> do
@@ -210,17 +220,57 @@ run RunOptions{..} runAppState runLogger = runRUN runAppState (do
 #else
            liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
 #endif
-   pure ()
-   ) >>= \case
-            VRight _ -> do
        pure ExitSuccess
      VLeft e -> do
        runLogger $ logError $ T.pack $ prettyShow e
        pure $ ExitFailure 27
   where
+   isToolTag :: ToolVersion -> Bool
+   isToolTag (ToolTag _) = True
+   isToolTag _           = False
+
    -- TODO: doesn't work for cross
-   addToolToDir tmp tool ver = do
-     (v, _) <- liftE $ fromVersion (Just ver) tool
+   addToolsToDir tmp
+     | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
+         forM_ runGHCVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) GHC
+           installTool GHC v
+           setTool GHC v tmp
+         forM_ runCabalVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) Cabal
+           installTool Cabal v
+           setTool Cabal v tmp
+         forM_ runHLSVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) HLS
+           installTool HLS v
+           setTool HLS v tmp
+         forM_ runStackVer $ \ver -> do
+           (v, _) <- liftE $ fromVersion (Just ver) Stack
+           installTool Stack v
+           setTool Stack v tmp
+     | otherwise = runLeanRUN leanAppstate $ do
+         case runGHCVer of
+            Just (ToolVersion v) ->
+              setTool GHC v tmp
+            Nothing -> pure ()
+            _ -> fail "Internal error"
+         case runCabalVer of
+            Just (ToolVersion v) ->
+              setTool Cabal v tmp
+            Nothing -> pure ()
+            _ -> fail "Internal error"
+         case runHLSVer of
+            Just (ToolVersion v) ->
+              setTool HLS v tmp
+            Nothing -> pure ()
+            _ -> fail "Internal error"
+         case runStackVer of
+            Just (ToolVersion v) ->
+              setTool Stack v tmp
+            Nothing -> pure ()
+            _ -> fail "Internal error"
+
+   installTool tool v = do
       isInstalled <- checkIfToolInstalled' tool v
       case tool of
         GHC -> do
@@ -228,36 +278,41 @@ run RunOptions{..} runAppState runLogger = runRUN runAppState (do
             (_tvVersion v)
             Nothing
             False
-         void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
-         void $ liftE $ setGHC v SetGHCOnly (Just tmp)
-         pure ()
         Cabal -> do
           unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
             (_tvVersion v)
             Nothing
             False
-         bin  <- liftE $ whereIsTool Cabal v
-         cbin <- liftIO $ canonicalizePath bin
-         lift $ createLink (relativeSymlink tmp cbin) (tmp </> "cabal")
-         pure ()
         Stack -> do
           unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
             (_tvVersion v)
             Nothing
             False
-         bin  <- liftE $ whereIsTool Stack v
-         cbin <- liftIO $ canonicalizePath bin
-         lift $ createLink (relativeSymlink tmp cbin) (tmp </> "stack")
-         pure ()
         HLS -> do
           unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
             (_tvVersion v)
             Nothing
             False
+        GHCup -> pure ()
+
+   setTool tool v tmp =
+      case tool of
+        GHC -> do
+          void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
+          void $ liftE $ setGHC v SetGHCOnly (Just tmp)
+        Cabal -> do
+          bin  <- liftE $ whereIsTool Cabal v
+          cbin <- liftIO $ canonicalizePath bin
+          lift $ createLink (relativeSymlink tmp cbin) (tmp </> "cabal")
+        Stack -> do
+          bin  <- liftE $ whereIsTool Stack v
+          cbin <- liftIO $ canonicalizePath bin
+          lift $ createLink (relativeSymlink tmp cbin) (tmp </> "stack")
+        HLS -> do
           liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
           liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
-         pure ()
         GHCup -> pure ()
+       
    addToPath path = do
     cEnv <- Map.fromList <$> getEnvironment
     let paths          = ["PATH", "Path"]

app/ghcup/Main.hs

@@ -313,7 +313,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
             Nuke                     -> nuke appState runLogger
             Prefetch pfCom           -> prefetch pfCom runAppState runLogger
             GC gcOpts                -> gc gcOpts runAppState runLogger
-            Run runCommand           -> run runCommand runAppState runLogger
+            Run runCommand           -> run runCommand runAppState leanAppstate runLogger
 
           case res of
             ExitSuccess        -> pure ()