Fix bug where setting non-installed GHC unsets current one

lib/GHCup.hs

@@ -346,6 +346,8 @@ setGHC ver sghc = do
   let verBS = verToBS (_tvVersion ver)
   ghcdir                        <- lift $ ghcupGHCDir ver
 
+  whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
+
   -- symlink destination
   Settings { dirs = Dirs {..} } <- lift ask
   liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms binDir
@@ -617,43 +619,39 @@ rmGHCVer :: ( MonadReader Settings m
          -> Excepts '[NotInstalled] m ()
 rmGHCVer ver = do
   isSetGHC <- lift $ fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver)
-  dir      <- lift $ ghcupGHCDir ver
-  let d' = toFilePath dir
-  exists <- liftIO $ doesDirectoryExist dir
 
+  whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
+  dir <- lift $ ghcupGHCDir ver
 
-  if exists
+  -- this isn't atomic, order matters
-    then do
+  when isSetGHC $ do
-      -- this isn't atomic, order matters
+    lift $ $(logInfo) [i|Removing ghc symlinks|]
-      when isSetGHC $ do
+    liftE $ rmPlain (_tvTarget ver)
-        lift $ $(logInfo) [i|Removing ghc symlinks|]
-        liftE $ rmPlain (_tvTarget ver)
 
-      lift $ $(logInfo) [i|Removing directory recursively: #{d'}|]
+  lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
-      liftIO $ deleteDirRecursive dir
+  liftIO $ deleteDirRecursive dir
 
-      lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
+  lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
-      lift $ rmMinorSymlinks ver
+  lift $ rmMinorSymlinks ver
 
-      lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
+  lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
-      -- first remove
+  -- first remove
-      handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver
+  handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver
-      -- then fix them (e.g. with an earlier version)
+  -- then fix them (e.g. with an earlier version)
-      v' <-
+  v' <-
-        handle
+    handle
-          (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+      (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
-        $ fmap Just
+    $ fmap Just
-        $ getMajorMinorV (_tvVersion ver)
+    $ getMajorMinorV (_tvVersion ver)
-      forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
+  forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
-        >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
+    >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
 
-      Settings { dirs = Dirs {..} } <- lift ask
+  Settings { dirs = Dirs {..} } <- lift ask
 
-      liftIO
+  liftIO
-        $ hideError doesNotExistErrorType
+    $ hideError doesNotExistErrorType
-        $ deleteFile
+    $ deleteFile
-        $ (baseDir </> [rel|share|])
+    $ (baseDir </> [rel|share|])
-    else throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer))
 
 
 -- | Delete a cabal version. Will try to fix the @cabal@ symlink