Merge branch 'issue-1019'

This commit is contained in:
Julian Ospald 2024-03-11 21:44:49 +08:00
commit e5c941b4d7
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
4 changed files with 30 additions and 2 deletions

View File

@ -32,7 +32,7 @@ constraints: http-io-streams -brotli,
any.hsc2hs ==0.68.8,
bzlib-conduit >= 0.3.0.3,
bz2 >= 1.0.1.1,
bzlib >= 0.5.2.0
bzlib >= 0.5.2.0,
directory >= 1.3.8.3,
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0

View File

@ -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

View File

@ -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

View File

@ -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