Fix bug where setting non-installed GHC unsets current one

CHANGELOG.md

@@ -2,12 +2,13 @@
 
 ## 0.1.9 -- yyyy-mm-dd
 
+* Fix bug when uninstalling all cabal versions
 * Use yaml instead of generated json for download info for ease of adding new GHC versions #44
 * Allow pre-release versions of GHC/cabal
 * Add XDG dirs support (set `GHCUP_USE_XDG_DIRS`) wrt #39
 * Allow to specify regex for tarball subdir (e.g. `ghc-.*`)
 * Allow installing arbitrary bindists more seamlessly:
-  - e.g. installing GHC HEAD: `ghcup -c -n install ghc -u '{"dlHash": "", "dlSubdir": { "RegexDir": "ghc-.*"}, "dlUri": "https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27" }' head`
+  - e.g. installing GHC HEAD: `ghcup -n install ghc -u '{"dlHash": "", "dlSubdir": { "RegexDir": "ghc-.*"}, "dlUri": "https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27" }' head`
 * Avoid duplicate edits to .bashrc/.zshrc wrt #43
 
 ## 0.1.8 -- 2020-07-21

README.md

@@ -97,7 +97,7 @@ For distributions with non-standard locations of cross toolchain and
 libraries, this may need some tweaking of `build.mk` or configure args.
 See `ghcup compile ghc --help` for further information.
 
-### Cross support
+### XDG support
 
 To enable XDG style directories, set the environment variable `GHCUP_USE_XDG_DIRS` to anything.
 

ghcup-0.0.2.yaml

@@ -1,4 +1,3 @@
-# !!! if you use RegexDir, then the version must be bumped !!!
 ---
 toolRequirements:
   GHC:

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
-    then do
-      -- this isn't atomic, order matters
-      when isSetGHC $ do
-        lift $ $(logInfo) [i|Removing ghc symlinks|]
-        liftE $ rmPlain (_tvTarget ver)
+  -- this isn't atomic, order matters
+  when isSetGHC $ do
+    lift $ $(logInfo) [i|Removing ghc symlinks|]
+    liftE $ rmPlain (_tvTarget ver)
 
-      lift $ $(logInfo) [i|Removing directory recursively: #{d'}|]
-      liftIO $ deleteDirRecursive dir
+  lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
+  liftIO $ deleteDirRecursive dir
 
-      lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
-      lift $ rmMinorSymlinks ver
+  lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
+  lift $ rmMinorSymlinks ver
 
-      lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
-      -- first remove
-      handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver
-      -- then fix them (e.g. with an earlier version)
-      v' <-
-        handle
-          (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
-        $ fmap Just
-        $ getMajorMinorV (_tvVersion ver)
-      forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
-        >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
+  lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
+  -- first remove
+  handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver
+  -- then fix them (e.g. with an earlier version)
+  v' <-
+    handle
+      (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+    $ fmap Just
+    $ getMajorMinorV (_tvVersion ver)
+  forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
+    >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
 
-      Settings { dirs = Dirs {..} } <- lift ask
+  Settings { dirs = Dirs {..} } <- lift ask
 
-      liftIO
-        $ hideError doesNotExistErrorType
-        $ deleteFile
-        $ (baseDir </> [rel|share|])
-    else throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer))
+  liftIO
+    $ hideError doesNotExistErrorType
+    $ deleteFile
+    $ (baseDir </> [rel|share|])
 
 
 -- | Delete a cabal version. Will try to fix the @cabal@ symlink