diff --git a/System/Directory.hs b/System/Directory.hs --- a/System/Directory.hs +++ b/System/Directory.hs @@ -123,6 +123,7 @@ , joinPath , makeRelative , splitDirectories + , splitSearchPath , takeDirectory ) import Data.Time (UTCTime) @@ -1504,9 +1505,11 @@ -- Compared with 'getAppUserDataDirectory', this function provides a more -- fine-grained hierarchy as well as greater flexibility for the user. -- --- It also works on Windows, although in that case 'XdgData' and 'XdgConfig' --- will map to the same directory. +-- On Windows, 'XdgData' and 'XdgConfig' usually map to the same directory +-- unless overridden. -- +-- Refer to the docs of 'XdgDirectory' for more details. +-- -- The second argument is usually the name of the application. Since it -- will be integrated into the path, it must consist of valid path -- characters. Note: if the second argument is an absolute path, it will @@ -1523,15 +1526,32 @@ -> IO FilePath getXdgDirectory xdgDir suffix = (`ioeAddLocation` "getXdgDirectory") `modifyIOError` do - simplify . ( suffix) <$> getXdgDirectoryInternal getHomeDirectory xdgDir + simplify . ( suffix) <$> do + env <- lookupEnv $ case xdgDir of + XdgData -> "XDG_DATA_HOME" + XdgConfig -> "XDG_CONFIG_HOME" + XdgCache -> "XDG_CACHE_HOME" + case env of + Nothing -> getXdgDirectoryFallback getHomeDirectory xdgDir + Just path -> pure path -- | Similar to 'getXdgDirectory' but retrieves the entire list of XDG -- directories. +-- +-- On Windows, 'XdgDataDirs' and 'XdgConfigDirs' usually map to the same list +-- of directories unless overridden. +-- +-- Refer to the docs of 'XdgDirectoryList' for more details. getXdgDirectoryList :: XdgDirectoryList -- ^ which special directory list -> IO [FilePath] getXdgDirectoryList xdgDirs = (`ioeAddLocation` "getXdgDirectoryList") `modifyIOError` do - getXdgDirectoryListInternal xdgDirs + env <- lookupEnv $ case xdgDirs of + XdgDataDirs -> "XDG_DATA_DIRS" + XdgConfigDirs -> "XDG_CONFIG_DIRS" + case env of + Nothing -> getXdgDirectoryListFallback xdgDirs + Just paths -> pure (splitSearchPath paths) -- | Obtain the path to a special directory for storing user-specific -- application data (traditional Unix location). Newer applications may diff --git a/System/Directory/Internal/Common.hs b/System/Directory/Internal/Common.hs --- a/System/Directory/Internal/Common.hs +++ b/System/Directory/Internal/Common.hs @@ -242,53 +242,59 @@ go buffer -- | Special directories for storing user-specific application data, --- configuration, and cache files, as specified by the --- . +-- configuration, and cache files, as specified by the +-- . -- --- Note: On Windows, 'XdgData' and 'XdgConfig' map to the same directory. +-- Note: On Windows, 'XdgData' and 'XdgConfig' usually map to the same +-- directory. -- --- @since 1.2.3.0 +-- @since 1.2.3.0 data XdgDirectory = XdgData -- ^ For data files (e.g. images). - -- Defaults to @~\/.local\/share@ and can be - -- overridden by the @XDG_DATA_HOME@ environment variable. - -- On Windows, it is @%APPDATA%@ - -- (e.g. @C:\/Users\//\/\/AppData\/Roaming@). - -- Can be considered as the user-specific equivalent of @\/usr\/share@. + -- It uses the @XDG_DATA_HOME@ environment variable. + -- On non-Windows systems, the default is @~\/.local\/share@. + -- On Windows, the default is @%APPDATA%@ + -- (e.g. @C:\/Users\//\/\/AppData\/Roaming@). + -- Can be considered as the user-specific equivalent of @\/usr\/share@. | XdgConfig -- ^ For configuration files. - -- Defaults to @~\/.config@ and can be - -- overridden by the @XDG_CONFIG_HOME@ environment variable. - -- On Windows, it is @%APPDATA%@ - -- (e.g. @C:\/Users\//\/\/AppData\/Roaming@). - -- Can be considered as the user-specific equivalent of @\/etc@. + -- It uses the @XDG_CONFIG_HOME@ environment variable. + -- On non-Windows systems, the default is @~\/.config@. + -- On Windows, the default is @%APPDATA%@ + -- (e.g. @C:\/Users\//\/\/AppData\/Roaming@). + -- Can be considered as the user-specific equivalent of @\/etc@. | XdgCache -- ^ For non-essential files (e.g. cache). - -- Defaults to @~\/.cache@ and can be - -- overridden by the @XDG_CACHE_HOME@ environment variable. - -- On Windows, it is @%LOCALAPPDATA%@ - -- (e.g. @C:\/Users\//\/\/AppData\/Local@). - -- Can be considered as the user-specific equivalent of @\/var\/cache@. + -- It uses the @XDG_CACHE_HOME@ environment variable. + -- On non-Windows systems, the default is @~\/.cache@. + -- On Windows, the default is @%LOCALAPPDATA%@ + -- (e.g. @C:\/Users\//\/\/AppData\/Local@). + -- Can be considered as the user-specific equivalent of @\/var\/cache@. deriving (Bounded, Enum, Eq, Ord, Read, Show) -- | Search paths for various application data, as specified by the --- . +-- . -- --- Note: On Windows, 'XdgDataDirs' and 'XdgConfigDirs' yield the same result. +-- The list of paths is split using 'System.FilePath.searchPathSeparator', +-- which on Windows is a semicolon. -- --- @since 1.3.2.0 +-- Note: On Windows, 'XdgDataDirs' and 'XdgConfigDirs' usually yield the same +-- result. +-- +-- @since 1.3.2.0 data XdgDirectoryList = XdgDataDirs -- ^ For data files (e.g. images). - -- Defaults to @/usr/local/share/@ and @/usr/share/@ and can be - -- overridden by the @XDG_DATA_DIRS@ environment variable. - -- On Windows, it is @%PROGRAMDATA%@ or @%ALLUSERSPROFILE%@ - -- (e.g. @C:\/ProgramData@). + -- It uses the @XDG_DATA_DIRS@ environment variable. + -- On non-Windows systems, the default is @\/usr\/local\/share\/@ and + -- @\/usr\/share\/@. + -- On Windows, the default is @%PROGRAMDATA%@ or @%ALLUSERSPROFILE%@ + -- (e.g. @C:\/ProgramData@). | XdgConfigDirs -- ^ For configuration files. - -- Defaults to @/etc/xdg@ and can be - -- overridden by the @XDG_CONFIG_DIRS@ environment variable. - -- On Windows, it is @%PROGRAMDATA%@ or @%ALLUSERSPROFILE%@ - -- (e.g. @C:\/ProgramData@). + -- It uses the @XDG_CONFIG_DIRS@ environment variable. + -- On non-Windows systems, the default is @\/etc\/xdg@. + -- On Windows, the default is @%PROGRAMDATA%@ or @%ALLUSERSPROFILE%@ + -- (e.g. @C:\/ProgramData@). deriving (Bounded, Enum, Eq, Ord, Read, Show) diff --git a/System/Directory/Internal/Posix.hsc b/System/Directory/Internal/Posix.hsc --- a/System/Directory/Internal/Posix.hsc +++ b/System/Directory/Internal/Posix.hsc @@ -283,30 +283,18 @@ getHomeDirectoryInternal :: IO FilePath getHomeDirectoryInternal = getEnv "HOME" -getXdgDirectoryInternal :: IO FilePath -> XdgDirectory -> IO FilePath -getXdgDirectoryInternal getHomeDirectory xdgDir = do - case xdgDir of - XdgData -> get "XDG_DATA_HOME" ".local/share" - XdgConfig -> get "XDG_CONFIG_HOME" ".config" - XdgCache -> get "XDG_CACHE_HOME" ".cache" - where - get name fallback = do - env <- lookupEnv name - case env of - Nothing -> ( fallback) <$> getHomeDirectory - Just path -> pure path +getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath +getXdgDirectoryFallback getHomeDirectory xdgDir = do + (<$> getHomeDirectory) $ flip () $ case xdgDir of + XdgData -> ".local/share" + XdgConfig -> ".config" + XdgCache -> ".cache" -getXdgDirectoryListInternal :: XdgDirectoryList -> IO [FilePath] -getXdgDirectoryListInternal xdgDirs = - case xdgDirs of - XdgDataDirs -> get "XDG_DATA_DIRS" ["/usr/local/share/", "/usr/share/"] - XdgConfigDirs -> get "XDG_CONFIG_DIRS" ["/etc/xdg"] - where - get name fallback = do - env <- lookupEnv name - case env of - Nothing -> pure fallback - Just paths -> pure (splitSearchPath paths) +getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath] +getXdgDirectoryListFallback xdgDirs = + pure $ case xdgDirs of + XdgDataDirs -> ["/usr/local/share/", "/usr/share/"] + XdgConfigDirs -> ["/etc/xdg"] getAppUserDataDirectoryInternal :: FilePath -> IO FilePath getAppUserDataDirectoryInternal appName = diff --git a/System/Directory/Internal/Windows.hsc b/System/Directory/Internal/Windows.hsc --- a/System/Directory/Internal/Windows.hsc +++ b/System/Directory/Internal/Windows.hsc @@ -646,21 +646,21 @@ getFolderPath Win32.cSIDL_PROFILE `catchIOError` \ _ -> getFolderPath Win32.cSIDL_WINDOWS -getXdgDirectoryInternal :: IO FilePath -> XdgDirectory -> IO FilePath -getXdgDirectoryInternal _ xdgDir = do +getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath +getXdgDirectoryFallback _ xdgDir = do case xdgDir of XdgData -> getFolderPath Win32.cSIDL_APPDATA XdgConfig -> getFolderPath Win32.cSIDL_APPDATA XdgCache -> getFolderPath win32_cSIDL_LOCAL_APPDATA -getXdgDirectoryListInternal :: XdgDirectoryList -> IO [FilePath] -getXdgDirectoryListInternal _ = +getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath] +getXdgDirectoryListFallback _ = pure <$> getFolderPath win32_cSIDL_COMMON_APPDATA getAppUserDataDirectoryInternal :: FilePath -> IO FilePath getAppUserDataDirectoryInternal appName = (\ appData -> appData <> ('\\' : appName)) - <$> getXdgDirectoryInternal getHomeDirectoryInternal XdgData + <$> getXdgDirectoryFallback getHomeDirectoryInternal XdgData getUserDocumentsDirectoryInternal :: IO FilePath getUserDocumentsDirectoryInternal = getFolderPath Win32.cSIDL_PERSONAL diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,12 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.4.0 (July 2019) + + * `getXdgDirectory` and `getXdgDirectoryList` on Windows will now respect + the XDG environment variables if present. + ([#95](https://github.com/haskell/directory/issues/95)) + ## 1.3.3.2 (January 2019) * `getXdgDirectory` will no longer reject environment variables containing diff --git a/directory.cabal b/directory.cabal --- a/directory.cabal +++ b/directory.cabal @@ -1,5 +1,5 @@ name: directory -version: 1.3.3.2 +version: 1.3.4.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE @@ -55,7 +55,7 @@ include-dirs: . build-depends: - base >= 4.5 && < 4.13, + base >= 4.5 && < 4.14, time >= 1.4 && < 1.10, filepath >= 1.3 && < 1.5 if os(windows) diff --git a/tests/Xdg.hs b/tests/Xdg.hs --- a/tests/Xdg.hs +++ b/tests/Xdg.hs @@ -1,7 +1,9 @@ {-# LANGUAGE CPP #-} module Xdg where -#if !defined(mingw32_HOST_OS) && MIN_VERSION_base(4, 7, 0) +#if MIN_VERSION_base(4, 7, 0) +import qualified Data.List as List import System.Environment (setEnv, unsetEnv) +import System.FilePath ((), searchPathSeparator) #endif #include "util.inl" @@ -14,20 +16,35 @@ T(expect) () True -- avoid warnings about redundant imports -#if !defined(mingw32_HOST_OS) && MIN_VERSION_base(4, 7, 0) - unsetEnv "XDG_DATA_DIRS" + -- setEnv, unsetEnv require base 4.7.0.0+ +#if MIN_VERSION_base(4, 7, 0) +#if !defined(mingw32_HOST_OS) + unsetEnv "XDG_CONFIG_HOME" + home <- getHomeDirectory + T(expectEq) () (home ".config/mow") =<< getXdgDirectory XdgConfig "mow" +#endif + + setEnv "XDG_DATA_HOME" "ar" + setEnv "XDG_CONFIG_HOME" "aw" + setEnv "XDG_CACHE_HOME" "ba" + T(expectEq) () ("ar" "ff") =<< getXdgDirectory XdgData "ff" + T(expectEq) () ("aw" "oo") =<< getXdgDirectory XdgConfig "oo" + T(expectEq) () ("ba" "rk") =<< getXdgDirectory XdgCache "rk" + unsetEnv "XDG_CONFIG_DIRS" - T(expectEq) () ["/usr/local/share/", "/usr/share/"] =<< - getXdgDirectoryList XdgDataDirs - T(expectEq) () ["/etc/xdg"] =<< getXdgDirectoryList XdgConfigDirs + unsetEnv "XDG_DATA_DIRS" + _xdgConfigDirs <- getXdgDirectoryList XdgConfigDirs + _xdgDataDirs <- getXdgDirectoryList XdgDataDirs - setEnv "XDG_DATA_DIRS" "/a:/b:/c" - setEnv "XDG_CONFIG_DIRS" "/d:/e:/f" - T(expectEq) () ["/a", "/b", "/c"] =<< getXdgDirectoryList XdgDataDirs - T(expectEq) () ["/d", "/e", "/f"] =<< getXdgDirectoryList XdgConfigDirs +#if !defined(mingw32_HOST_OS) + T(expectEq) () ["/etc/xdg"] _xdgConfigDirs + T(expectEq) () ["/usr/local/share/", "/usr/share/"] _xdgDataDirs +#endif - setEnv "XDG_CACHE_HOME" "g" - T(expectEq) () "g/h" =<< getXdgDirectory XdgCache "h" + setEnv "XDG_DATA_DIRS" (List.intercalate [searchPathSeparator] ["/a", "/b"]) + setEnv "XDG_CONFIG_DIRS" (List.intercalate [searchPathSeparator] ["/c", "/d"]) + T(expectEq) () ["/a", "/b"] =<< getXdgDirectoryList XdgDataDirs + T(expectEq) () ["/c", "/d"] =<< getXdgDirectoryList XdgConfigDirs #endif return ()