diff --git a/System/Directory.hs b/System/Directory.hs index 596fb037f5f1dbc40a40acd5997d82a1a28a761e..1f2ca37fe93a272c6e86dde6f7b4a67e08bc54ee 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -42,6 +42,8 @@ module System.Directory , getHomeDirectory , XdgDirectory(..) , getXdgDirectory + , XdgDirectoryList(..) + , getXdgDirectoryList , getAppUserDataDirectory , getUserDocumentsDirectory , getTemporaryDirectory @@ -1825,7 +1827,50 @@ getXdgDirectory xdgDir suffix = Just path | isRelative path -> fallback' | otherwise -> return path where fallback' = (</> fallback) <$> getHomeDirectory +#endif + +-- | Search paths for various application data, as specified by the +-- <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html XDG Base Directory Specification>. +-- +-- Note: On Windows, 'XdgDataDirs' and 'XdgConfigDirs' 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@). + | 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@). + deriving (Bounded, Enum, Eq, Ord, Read, Show) + +getXdgDirectoryList :: XdgDirectoryList -- ^ which special directory list + -> IO [FilePath] +getXdgDirectoryList xdgDir = + modifyIOError (`ioeAddLocation` "getXdgDirectoryList") $ + case xdgDir of + XdgDataDirs -> get "XDG_DATA_DIRS" ["/usr/local/share/", "/usr/share/"] + XdgConfigDirs -> get "XDG_CONFIG_DIRS" ["/etc/xdg"] + where +#if defined(mingw32_HOST_OS) + get _ _ = + return <$> Win32.sHGetFolderPath nullPtr win32_cSIDL_COMMON_APPDATA + nullPtr 0 +#else + get name fallback = do + env <- lookupEnv name + case env of + Nothing -> return fallback + Just paths -> return (splitSearchPath paths) +#endif +#if !defined(mingw32_HOST_OS) -- | Return the value of an environment variable, or 'Nothing' if there is no -- such value. (Equivalent to "lookupEnv" from base-4.6.) lookupEnv :: String -> IO (Maybe String) diff --git a/System/Directory/Internal/Windows.hsc b/System/Directory/Internal/Windows.hsc index 34acea054497dd33808f5491364f5b4237479fdb..db6f57b089ea97911ba620453e51e765b1e188c0 100644 --- a/System/Directory/Internal/Windows.hsc +++ b/System/Directory/Internal/Windows.hsc @@ -32,6 +32,9 @@ win32_cSIDL_LOCAL_APPDATA = Win32.cSIDL_LOCAL_APPDATA win32_cSIDL_LOCAL_APPDATA = (#const CSIDL_LOCAL_APPDATA) #endif +win32_cSIDL_COMMON_APPDATA :: Win32.CSIDL +win32_cSIDL_COMMON_APPDATA = (#const CSIDL_COMMON_APPDATA) + win32_eRROR_INVALID_FUNCTION :: Win32.ErrCode win32_eRROR_INVALID_FUNCTION = 0x1 diff --git a/changelog.md b/changelog.md index afd160b8046365cd5e47b83807e54605f9cceb79..5f66d4ae6b257258cb4b2a9ea170d52591574f7a 100644 --- a/changelog.md +++ b/changelog.md @@ -1,10 +1,13 @@ Changelog for the [`directory`][1] package ========================================== -## 1.3.1.6 (January 2018) +## 1.3.2.0 (January 2018) * Relax `time` version bounds to support 1.9. + * Implement `getXdgDirectoryList` and `XdgDirectoryList`. + ([#78](https://github.com/haskell/directory/issues/78)) + ## 1.3.1.5 (October 2017) * Rename the internal header `windows.h` to avoid GHC#14312. diff --git a/directory.cabal b/directory.cabal index d1bbc0df68217b64fa86a126043661187a461035..a09df47dc49ee06a8bb5254973929aec1419e114 100644 --- a/directory.cabal +++ b/directory.cabal @@ -1,5 +1,5 @@ name: directory -version: 1.3.1.6 +version: 1.3.2.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE @@ -109,4 +109,5 @@ test-suite test Safe T8482 WithCurrentDirectory + Xdg -- test-modules-end diff --git a/tests/Main.hs b/tests/Main.hs index 52cf0fb359e93eb130164faeb33958a0a9498195..5d09a45b36980670b6c7985b07718e066b94e8d9 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -28,6 +28,7 @@ import qualified RenamePath import qualified Safe import qualified T8482 import qualified WithCurrentDirectory +import qualified Xdg main :: IO () main = T.testMain $ \ _t -> do @@ -59,3 +60,4 @@ main = T.testMain $ \ _t -> do T.isolatedRun _t "Safe" Safe.main T.isolatedRun _t "T8482" T8482.main T.isolatedRun _t "WithCurrentDirectory" WithCurrentDirectory.main + T.isolatedRun _t "Xdg" Xdg.main diff --git a/tests/Xdg.hs b/tests/Xdg.hs new file mode 100644 index 0000000000000000000000000000000000000000..060e581bf2ea35b5302a5de5ec1e47b1f09ec45f --- /dev/null +++ b/tests/Xdg.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +module Xdg where +#if !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,7,0) +import System.Environment (setEnv, unsetEnv) +#endif +#include "util.inl" + +main :: TestEnv -> IO () +main _t = do + + -- smoke tests + _ <- getXdgDirectoryList XdgDataDirs + _ <- getXdgDirectoryList XdgConfigDirs + + T(expect) () True -- avoid warnings about redundant imports + +#if !defined(mingw32_HOST_OS) && MIN_VERSION_base(4,7,0) + unsetEnv "XDG_DATA_DIRS" + unsetEnv "XDG_CONFIG_DIRS" + T(expectEq) () ["/usr/local/share/", "/usr/share/"] =<< + getXdgDirectoryList XdgDataDirs + T(expectEq) () ["/etc/xdg"] =<< getXdgDirectoryList XdgConfigDirs + + 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 +#endif + + return ()