diff --git a/lib-opt/GHCup/OptParse/GC.hs b/lib-opt/GHCup/OptParse/GC.hs index 2072287..dc4b8e3 100644 --- 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 index b3351cb..780a9c1 100644 --- 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 index aea524e..476f9a7 100644 --- 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