Move towards using XDG directories.

haskell · May 9, 2021 · 2333f30 · 2333f30
1 parent 4f8aeb2
commit 2333f30
Show file tree

Hide file tree

Showing 4 changed files with 19 additions and 30 deletions.
diff --git a/Cabal-tests/tests/HackageTests.hs b/Cabal-tests/tests/HackageTests.hs
@@ -20,12 +20,13 @@ import Data.Foldable                               (traverse_)
 import Data.List                                   (isPrefixOf, isSuffixOf)
 import Data.Maybe                                  (mapMaybe)
 import Data.Monoid                                 (Sum (..))
+import Distribution.Client.Config                  (getConfigFilePath)
 import Distribution.PackageDescription.Check       (PackageCheck (..), checkPackage)
 import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription)
 import Distribution.PackageDescription.Quirks      (patchQuirks)
 import Distribution.Simple.Utils                   (fromUTF8BS, toUTF8BS)
 import Numeric                                     (showFFloat)
-import System.Directory                            (getAppUserDataDirectory)
+import System.Directory                            (getXdgDirectory, XdgDirectory(XdgData))
 import System.Environment                          (lookupEnv)
 import System.Exit                                 (exitFailure)
 import System.FilePath                             ((</>))
@@ -63,23 +64,15 @@ import Data.TreeDiff.Pretty          (ansiWlEditExprCompact)
 parseIndex :: (Monoid a, NFData a) => (FilePath -> Bool)
            -> (FilePath -> B.ByteString -> IO a) -> IO a
 parseIndex predicate action = do
-    cabalDir   <- getAppUserDataDirectory "cabal"
-    configPath <- getCabalConfigPath cabalDir
+    configPath <- getConfigFilePath
     cfg        <- B.readFile configPath
     cfgFields  <- either (fail . show) pure $ Parsec.readFields cfg
+    repoCache  <- case lookupInConfig "remote-repo-cache" cfgFields of
+                    []        -> defaultCacheDir   -- Default
+                    (rrc : _) -> return rrc        -- User-specified
     let repos        = reposFromConfig cfgFields
-        repoCache    = case lookupInConfig "remote-repo-cache" cfgFields of
-            []        -> cabalDir </> "packages"  -- Default
-            (rrc : _) -> rrc                      -- User-specified
         tarName repo = repoCache </> repo </> "01-index.tar"
     mconcat <$> traverse (parseIndex' predicate action . tarName) repos
-  where
-    getCabalConfigPath cabalDir = do
-        mx <- lookupEnv "CABAL_CONFIG"
-        case mx of
-            Just x  -> return x
-            Nothing -> return (cabalDir </> "config")
-
 
 parseIndex'
     :: (Monoid a, NFData a)

diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs
@@ -1801,7 +1801,7 @@ pkgRoot verbosity lbi = pkgRoot'
       let ghcjsProg = fromMaybe (error "GHCJS.pkgRoot: no ghcjs program") $ lookupProgram ghcjsProgram (withPrograms lbi)
       in  fmap takeDirectory (getGlobalPackageDB verbosity ghcjsProg)
     pkgRoot' UserPackageDB = do
-      appDir <- getAppUserDataDirectory "ghcjs"
+      appDir <- getXdgDirectory XdgData "ghcjs"
       -- fixme correct this version
       let ver      = compilerVersion (compiler lbi)
           subdir   = System.Info.arch ++ '-':System.Info.os

diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs
@@ -130,7 +130,7 @@ import Text.PrettyPrint
 import Text.PrettyPrint.HughesPJ
          ( text, Doc )
 import System.Directory
-         ( createDirectoryIfMissing, getAppUserDataDirectory, renameFile )
+         ( createDirectoryIfMissing, getAppUserDataDirectory, getXdgDirectory, XdgDirectory(XdgCache, XdgConfig), renameFile )
 import Network.URI
          ( URI(..), URIAuth(..), parseURI )
 import System.FilePath
@@ -595,25 +595,21 @@ getCabalDir = do
     Just dir -> return dir
 
 defaultConfigFile :: IO FilePath
-defaultConfigFile = do
-  dir <- getCabalDir
-  return $ dir </> "config"
+defaultConfigFile =
+  getXdgDirectory XdgConfig $ "cabal" </> "config"
 
 defaultCacheDir :: IO FilePath
-defaultCacheDir = do
-  dir <- getCabalDir
-  return $ dir </> "packages"
+defaultCacheDir =
+  getXdgDirectory XdgCache $ "cabal" </> "packages"
 
 defaultLogsDir :: IO FilePath
-defaultLogsDir = do
-  dir <- getCabalDir
-  return $ dir </> "logs"
+defaultLogsDir =
+  getXdgDirectory XdgCache $ "cabal" </> "logs"
 
 -- | Default position of the world file
 defaultWorldFile :: IO FilePath
-defaultWorldFile = do
-  dir <- getCabalDir
-  return $ dir </> "world"
+defaultWorldFile =
+  getXdgDirectory XdgCache $ "cabal" </> "world"
 
 defaultExtraPath :: IO [FilePath]
 defaultExtraPath = do

diff --git a/doc/installing-packages.rst b/doc/installing-packages.rst
@@ -51,8 +51,8 @@ Various environment variables affect ``cabal-install``.
 
 ``CABAL_DIR``
    Default content directory for ``cabal-install`` files.
-   Default value is ``getAppUserDataDirectory "cabal"``, which is
-   ``$HOME/.cabal`` on unix systems and ``%APPDATA%\cabal`` in Windows.
+   Default value is ``getXdgDirectory XdgCache "cabal"``, which is
+   ``$XDG_CACHE_HOME/cabal`` on unix systems and ``%APPDATA%\cabal`` in Windows.
 
    .. note::
 
@@ -244,4 +244,4 @@ dependencies in a single step. To do this, run:
 
 To browse the list of available packages, visit the `Hackage`_ web site.
 
-.. _Hackage: https://hackage.haskell.org/
+.. _Hackage: https://hackage.haskell.org/