Fix GC with XDG dirs, fixes #810

This commit is contained in:
Julian Ospald 2023-03-18 22:04:37 +08:00
parent 7ae952c82e
commit c28de19faa
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F

View File

@ -279,7 +279,7 @@ ghcupCacheDir
Nothing -> do Nothing -> do
home <- liftIO getHomeDirectory home <- liftIO getHomeDirectory
pure (home </> ".cache") pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup")) pure (GHCupPath (bdir </> "ghcup" </> "cache"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache")) else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
@ -308,19 +308,7 @@ ghcupLogsDir
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything), -- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec. -- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
ghcupDbDir :: IO GHCupPath ghcupDbDir :: IO GHCupPath
ghcupDbDir ghcupDbDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
| isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup" </> "db"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
-- | '~/.ghcup/trash'. -- | '~/.ghcup/trash'.