Allow to remove all unset versions, fixes #1019

haskell · Mar 11, 2024 · 5eaae99 · 5eaae99
1 parent 5d0a7b7
commit 5eaae99
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 1 deletion.
diff --git a/lib-opt/GHCup/OptParse/GC.hs b/lib-opt/GHCup/OptParse/GC.hs
@@ -47,6 +47,7 @@ data GCOptions = GCOptions
   , gcHLSNoGHC :: Bool
   , gcCache :: Bool
   , gcTmp :: Bool
+  , gcUnset :: Bool
   } deriving (Eq, Show)
 
 
@@ -77,6 +78,9 @@ gcP =
   <*>
     switch
       (short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
+  <*>
+    switch
+      (short 'u' <> long "unset" <> help "Remove all tool versions that are not 'set'")
 
 
 
@@ -134,6 +138,7 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
   liftE $ when gcHLSNoGHC rmHLSNoGHC
   lift $ when gcCache rmCache
   lift $ when gcTmp rmTmp
+  liftE $ when gcUnset rmUnsetTools
    ) >>= \case
             VRight _ -> do
                   pure ExitSuccess

diff --git a/lib/GHCup.hs b/lib/GHCup.hs
@@ -542,6 +542,26 @@ rmOldGHC = do
   forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
 
 
+rmUnsetTools :: ( MonadReader env m
+                , HasGHCupInfo env
+                , HasPlatformReq env
+                , HasDirs env
+                , HasLog env
+                , MonadIO m
+                , MonadFail m
+                , MonadMask m
+                , MonadUnliftIO m
+                )
+             => Excepts '[NotInstalled, UninstallFailed] m ()
+rmUnsetTools = do
+  vers <- lift $ listVersions Nothing [ListInstalled True, ListSet False] False True (Nothing, Nothing)
+  forM_ vers $ \ListResult{..} -> case lTool of
+    GHC   -> liftE $ rmGHCVer (GHCTargetVersion lCross lVer)
+    HLS   -> liftE $ rmHLSVer lVer
+    Cabal -> liftE $ rmCabalVer lVer
+    Stack -> liftE $ rmStackVer lVer
+    GHCup -> pure ()
+
 
 rmProfilingLibs :: ( MonadReader env m
                    , HasDirs env

diff --git a/test/optparse-test/GCTest.hs b/test/optparse-test/GCTest.hs
@@ -17,6 +17,7 @@ defaultOptions =
     False
     False
     False
+    False
 
 gcCheckList :: [(String, GCOptions)]
 gcCheckList =
@@ -33,7 +34,9 @@ gcCheckList =
   , ("gc --cache", defaultOptions{gcCache = True})
   , ("gc -t", defaultOptions{gcTmp = True})
   , ("gc --tmpdirs", defaultOptions{gcTmp = True})
-  , ("gc -o -p -s -h -c -t", GCOptions True True True True True True)
+  , ("gc -u", defaultOptions{gcUnset = True})
+  , ("gc --unset", defaultOptions{gcUnset = True})
+  , ("gc -o -p -s -h -c -t -u", GCOptions True True True True True True True)
   ]
 
 gcParseWith :: [String] -> IO GCOptions