Fix bug with isolated installation of not previously installed versions

It would error out trying to set the version.

app/ghcup/GHCup/OptParse.hs

@@ -113,8 +113,8 @@ data Command
 opts :: Parser Options
 opts =
   Options
-    <$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
+    <$> invertableSwitch "verbose" (Just 'v') False (help "Enable verbosity (default: disabled)")
-    <*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
+    <*> invertableSwitch "cache" (Just 'c') False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
     <*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
     <*> optional
           (option
@@ -127,7 +127,7 @@ opts =
             <> completer fileUri
             )
           )
-    <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
+    <*> (fmap . fmap) not (invertableSwitch "verify" (Just 'n') True (help "Disable tarball checksum verification (default: enabled)"))
     <*> optional (option
           (eitherReader keepOnParser)
           (  long "keep"
@@ -153,7 +153,7 @@ opts =
 #endif
           <> hidden
           ))
-    <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
+    <*> invertableSwitch "offline" (Just 'o') False (help "Don't do any network calls, trying cached assets and failing if missing.")
     <*> optional (option
           (eitherReader gpgParser)
           (  long "gpg"

app/ghcup/GHCup/OptParse/Common.hs

@@ -138,7 +138,7 @@ versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar
 -- the help is shown only for --no-recursive.
 invertableSwitch
     :: String              -- ^ long option
-    -> Char                -- ^ short option for the non-default option
+    -> Maybe Char          -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier
     -> Parser (Maybe Bool)
@@ -149,14 +149,14 @@ invertableSwitch longopt shortopt defv optmod = invertableSwitch' longopt shorto
 -- | Allows providing option modifiers for both --foo and --no-foo.
 invertableSwitch'
     :: String              -- ^ long option (eg "foo")
-    -> Char                -- ^ short option for the non-default option
+    -> Maybe Char          -- ^ short option for the non-default option
     -> Bool                -- ^ is switch enabled by default?
     -> Mod FlagFields Bool -- ^ option modifier for --foo
     -> Mod FlagFields Bool -- ^ option modifier for --no-foo
     -> Parser (Maybe Bool)
 invertableSwitch' longopt shortopt defv enmod dismod = optional
-    ( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt)
+    ( flag' True ( enmod <> long longopt <> if defv then mempty else maybe mempty short shortopt)
-    <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
+    <|> flag' False (dismod <> long nolongopt <> if defv then maybe mempty short shortopt else mempty)
     )
   where
     nolongopt = "no-" ++ longopt

app/ghcup/GHCup/OptParse/Compile.hs

@@ -234,12 +234,7 @@ ghcCompileOpts =
             )
           )
     <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
-    <*> flag
+    <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
-          False
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
             (eitherReader
@@ -300,12 +295,7 @@ hlsCompileOpts =
               <> (completer $ listCompleter $ fmap show ([1..12] :: [Int]))
             )
           )
-    <*> flag
+    <*> fmap (fromMaybe True) (invertableSwitch "set" Nothing True (help "Don't set as active version after install"))
-          False
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
             (eitherReader

app/ghcup/GHCup/OptParse/Install.hs

@@ -197,12 +197,8 @@ installOpts tool =
             )
         <|> pure (Nothing, Nothing)
         )
-    <*> flag
+    <*> fmap (fromMaybe setDefault) (invertableSwitch "set" Nothing setDefault
-          False
+      (help $ if not setDefault then "Set as active version after install" else "Don't set as active version after install"))
-          True
-          (long "set" <> help
-            "Set as active version after install"
-          )
     <*> optional
           (option
            (eitherReader isolateParser)
@@ -215,6 +211,11 @@ installOpts tool =
           )
     <*> switch
           (short 'f' <> long "force" <> help "Force install")
+ where
+  setDefault = case tool of
+    Nothing  -> False
+    Just GHC -> False
+    Just _   -> True
           
 
 
@@ -397,7 +398,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                      isolateDir
                      forceInstall
                    )
-                   $ when instSet $ void $ setGHC v SetGHCOnly Nothing
+                   $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
          pure vi
        Just uri -> do
          runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
@@ -408,7 +409,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                        isolateDir
                        forceInstall
                      )
-                     $ when instSet $ void $ setGHC v SetGHCOnly Nothing
+                     $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
            pure vi
       )
         >>= \case
@@ -468,7 +469,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                     v
                                     isolateDir
                                     forceInstall
-                                  ) $ when instSet $ void $ setCabal v
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
@@ -478,7 +479,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                       v
                                       isolateDir
                                       forceInstall
-                                    ) $ when instSet $ void $ setCabal v
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
            pure vi
       )
       >>= \case
@@ -519,7 +520,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                     v
                                     isolateDir
                                     forceInstall
-                                  ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
          pure vi
        Just uri -> do
          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
@@ -530,7 +531,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                       v
                                       isolateDir
                                       forceInstall
-                                    ) $ when instSet $ void $ setHLS v SetHLSOnly Nothing
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
            pure vi
       )
       >>= \case
@@ -579,7 +580,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                      v
                                      isolateDir
                                      forceInstall
-                                   ) $ when instSet $ void $ setStack v
+                                   ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
           pure vi
         Just uri -> do
           runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
@@ -589,7 +590,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
                                        v
                                        isolateDir
                                        forceInstall
-                                     ) $ when instSet $ void $ setStack v
+                                     ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
             pure vi
       )
       >>= \case

app/ghcup/GHCup/OptParse/Run.hs

@@ -35,6 +35,7 @@ import           Prelude                 hiding ( appendFile )
 import           System.Directory
 import           System.FilePath
 import           System.Environment
+import           System.IO.Temp
 import           System.Exit
 import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
@@ -216,20 +217,16 @@ run :: forall m.
    -> LeanAppState
    -> (ReaderT LeanAppState m () -> m ())
    -> m ExitCode
-run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
+run RunOptions{..} runAppState leanAppstate runLogger = do
-   toolchain <- Excepts resolveToolchain
    tmp <- case runBinDir of
-     Just bindir -> do
+     Just bdir -> do
-       liftIO $ createDirRecursive' bindir
+       liftIO $ createDirRecursive' bdir
-       liftIO $ canonicalizePath bindir
+       liftIO $ canonicalizePath bdir
-     Nothing -> do
+     Nothing -> liftIO (getTemporaryDirectory >>= \tmp -> createTempDirectory tmp "ghcup")
-       d <- liftIO $ predictableTmpDir toolchain
+   r <- do
-       liftIO $ createDirRecursive' d
+     addToolsToDir tmp
-       liftIO $ canonicalizePath d
+   case r of
-   Excepts $ installToolChain toolchain tmp
+     VRight _ -> do
-   pure tmp
-   ) >>= \case
-     VRight tmp -> do
        case runCOMMAND of
          [] -> do
            liftIO $ putStr tmp
@@ -256,78 +253,70 @@ run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
    isToolTag _           = False
 
    -- TODO: doesn't work for cross
-   resolveToolchain
+   addToolsToDir tmp
      | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
-         ghcVer <- forM runGHCVer $ \ver -> do
+         forM_ runGHCVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) GHC
-           pure v
+           installTool GHC v
-         cabalVer <- forM runCabalVer $ \ver -> do
+           setTool GHC v tmp
+         forM_ runCabalVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Cabal
-           pure v
+           installTool Cabal v
-         hlsVer <- forM runHLSVer $ \ver -> do
+           setTool Cabal v tmp
+         forM_ runHLSVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) HLS
-           pure v
+           installTool HLS v
-         stackVer <- forM runStackVer $ \ver -> do
+           setTool HLS v tmp
+         forM_ runStackVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Stack
-           pure v
+           installTool Stack v
-         pure Toolchain{..}
+           setTool Stack v tmp
      | otherwise = runLeanRUN leanAppstate $ do
-         ghcVer <- case runGHCVer of
+         case runGHCVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool GHC v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         cabalVer <- case runCabalVer of
+         case runCabalVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool Cabal v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         hlsVer <- case runHLSVer of
+         case runHLSVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool HLS v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         stackVer <- case runStackVer of
+         case runStackVer of
-            Just (ToolVersion v) -> pure $ Just v
+            Just (ToolVersion v) ->
-            Nothing -> pure Nothing
+              setTool Stack v tmp
+            Nothing -> pure ()
             _ -> fail "Internal error"
-         pure Toolchain{..}
 
-   installToolChain Toolchain{..} tmp
+   installTool tool v = do
-     | or (fmap (maybe False isToolTag) [runGHCVer, runCabalVer, runHLSVer, runStackVer]) || runInstTool' = runRUN runAppState $ do
+      isInstalled <- checkIfToolInstalled' tool v
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+      case tool of
-           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
+        GHC -> do
-           case mt of
+          unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
-             Just (GHC, v) -> do
+            (_tvVersion v)
-               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+            Nothing
-                 (_tvVersion v)
+            False
-                 Nothing
+        Cabal -> do
-                 False
+          unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
-               setTool GHC v tmp
+            (_tvVersion v)
-             Just (Cabal, v) -> do
+            Nothing
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+            False
-                 (_tvVersion v)
+        Stack -> do
-                 Nothing
+          unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
-                 False
+            (_tvVersion v)
-               setTool Cabal v tmp
+            Nothing
-             Just (Stack, v) -> do
+            False
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+        HLS -> do
-                 (_tvVersion v)
+          unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
-                 Nothing
+            (_tvVersion v)
-                 False
+            Nothing
-               setTool Stack v tmp
+            False
-             Just (HLS, v) -> do
+        GHCup -> pure ()
-               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
-                 (_tvVersion v)
-                 Nothing
-                 False
-               setTool HLS v tmp
-             _ -> pure ()
-     | otherwise = runLeanRUN leanAppstate $ do
-         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
-           case mt of
-             Just (GHC, v)   -> setTool GHC v tmp
-             Just (Cabal, v) -> setTool Cabal v tmp
-             Just (Stack, v) -> setTool Stack v tmp
-             Just (HLS, v)   -> setTool HLS v tmp
-             _ -> pure ()
 
    setTool tool v tmp =
       case tool of
@@ -371,30 +360,3 @@ run RunOptions{..} runAppState leanAppstate runLogger = runE @RunEffects ( do
         envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
     liftIO $ setEnv pathVar newPath
     return envWithNewPath
-
-   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
-     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
-   predictableTmpDir Toolchain{..} = do
-      tmp <- getTemporaryDirectory
-      pure $ tmp
-        </> ("ghcup"
-              <> maybe "" (("_ghc-"   <>) . T.unpack . tVerToText) ghcVer
-              <> maybe "" (("_cabal-" <>) . T.unpack . tVerToText) cabalVer
-              <> maybe "" (("_hls-"   <>) . T.unpack . tVerToText) hlsVer
-              <> maybe "" (("_stack-" <>) . T.unpack . tVerToText) stackVer
-            )
-
-
-
-    -------------------------
-    --[ Other local types ]--
-    -------------------------
-
-
-
-data Toolchain = Toolchain
-  { ghcVer     :: Maybe GHCTargetVersion
-  , cabalVer   :: Maybe GHCTargetVersion
-  , hlsVer     :: Maybe GHCTargetVersion
-  , stackVer   :: Maybe GHCTargetVersion
-  }

lib/GHCup.hs

@@ -468,10 +468,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                 -- regular install
       liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall
 
-      -- create symlink if this is the latest version for regular installs
-      cVers <- lift $ fmap rights getInstalledCabals
-      let lInstCabal = headMay . reverse . sort $ cVers
-      when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
       
 -- | Install an unpacked cabal distribution.Symbol
 installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
@@ -626,7 +622,6 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do
         liftE $ runBuildAction tmpUnpack Nothing $ installHLSUnpacked workdir inst ver
         liftE $ setHLS ver SetHLS_XYZ Nothing
 
-  liftE $ installHLSPostInst isoFilepath ver
 
 isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
                    -> IO Bool
@@ -696,19 +691,6 @@ installHLSUnpackedLegacy path inst mver' forceInstall = do
   lift $ chmod_755 destWrapperPath
 
 
-installHLSPostInst :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m, MonadCatch m, MonadMask m, MonadFail m, MonadUnliftIO m)
-                   => Maybe FilePath
-                   -> Version
-                   -> Excepts '[NotInstalled] m ()
-installHLSPostInst isoFilepath ver = 
-  case isoFilepath of
-    Just _ -> pure ()
-    Nothing -> do
-      -- create symlink if this is the latest version in a regular install
-      hlsVers <- lift $ fmap rights getInstalledHLSs
-      let lInstHLS = headMay . reverse . sort $ hlsVers
-      when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver SetHLSOnly Nothing
-
 
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
@@ -916,8 +898,6 @@ compileHLS targetHLS ghcs jobs ov isolateDir cabalProject cabalProjectLocal patc
           liftE $ installHLSUnpackedLegacy installDir binDir (Just installVer) True
     )
 
-  liftE $ installHLSPostInst isolateDir installVer
-
   pure installVer
 
 
@@ -1034,11 +1014,6 @@ installStackBindist dlinfo ver isoFilepath forceInstall = do
     Nothing -> do                     -- regular install
       liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall
 
-      -- create symlink if this is the latest version and a regular install
-      sVers <- lift $ fmap rights getInstalledStacks
-      let lInstStack = headMay . reverse . sort $ sVers
-      when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
-
 
 -- | Install an unpacked stack distribution.
 installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)