Merge branch 'issue-1019'
This commit is contained in:
commit
e5c941b4d7
@ -32,7 +32,7 @@ constraints: http-io-streams -brotli,
|
|||||||
any.hsc2hs ==0.68.8,
|
any.hsc2hs ==0.68.8,
|
||||||
bzlib-conduit >= 0.3.0.3,
|
bzlib-conduit >= 0.3.0.3,
|
||||||
bz2 >= 1.0.1.1,
|
bz2 >= 1.0.1.1,
|
||||||
bzlib >= 0.5.2.0
|
bzlib >= 0.5.2.0,
|
||||||
directory >= 1.3.8.3,
|
directory >= 1.3.8.3,
|
||||||
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
|
filepath == 1.4.101.0 || == 1.4.300.1 || >= 1.5.2.0
|
||||||
|
|
||||||
|
@ -47,6 +47,7 @@ data GCOptions = GCOptions
|
|||||||
, gcHLSNoGHC :: Bool
|
, gcHLSNoGHC :: Bool
|
||||||
, gcCache :: Bool
|
, gcCache :: Bool
|
||||||
, gcTmp :: Bool
|
, gcTmp :: Bool
|
||||||
|
, gcUnset :: Bool
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
@ -77,6 +78,9 @@ gcP =
|
|||||||
<*>
|
<*>
|
||||||
switch
|
switch
|
||||||
(short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
|
(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
|
liftE $ when gcHLSNoGHC rmHLSNoGHC
|
||||||
lift $ when gcCache rmCache
|
lift $ when gcCache rmCache
|
||||||
lift $ when gcTmp rmTmp
|
lift $ when gcTmp rmTmp
|
||||||
|
liftE $ when gcUnset rmUnsetTools
|
||||||
) >>= \case
|
) >>= \case
|
||||||
VRight _ -> do
|
VRight _ -> do
|
||||||
pure ExitSuccess
|
pure ExitSuccess
|
||||||
|
20
lib/GHCup.hs
20
lib/GHCup.hs
@ -542,6 +542,26 @@ rmOldGHC = do
|
|||||||
forM_ ghcs $ \ghc -> when (ghc `elem` oldGHCs) $ rmGHCVer ghc
|
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
|
rmProfilingLibs :: ( MonadReader env m
|
||||||
, HasDirs env
|
, HasDirs env
|
||||||
|
@ -17,6 +17,7 @@ defaultOptions =
|
|||||||
False
|
False
|
||||||
False
|
False
|
||||||
False
|
False
|
||||||
|
False
|
||||||
|
|
||||||
gcCheckList :: [(String, GCOptions)]
|
gcCheckList :: [(String, GCOptions)]
|
||||||
gcCheckList =
|
gcCheckList =
|
||||||
@ -33,7 +34,9 @@ gcCheckList =
|
|||||||
, ("gc --cache", defaultOptions{gcCache = True})
|
, ("gc --cache", defaultOptions{gcCache = True})
|
||||||
, ("gc -t", defaultOptions{gcTmp = True})
|
, ("gc -t", defaultOptions{gcTmp = True})
|
||||||
, ("gc --tmpdirs", 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
|
gcParseWith :: [String] -> IO GCOptions
|
||||||
|
Loading…
Reference in New Issue
Block a user