From 80dc2bc48c2b2c65f8227cee5368693c7680e0f2 Mon Sep 17 00:00:00 2001
From: Phil Ruffwind <rf@rufflewind.com>
Date: Fri, 26 Jan 2018 18:33:38 -0500
Subject: [PATCH] Implement getXdgDirectoryList
Fixes #78.
---
System/Directory.hs | 45 +++++++++++++++++++++++++++
System/Directory/Internal/Windows.hsc | 3 ++
changelog.md | 5 ++-
directory.cabal | 3 +-
tests/Main.hs | 2 ++
tests/Xdg.hs | 30 ++++++++++++++++++
6 files changed, 86 insertions(+), 2 deletions(-)
create mode 100644 tests/Xdg.hs
diff --git a/System/Directory.hs b/System/Directory.hs
index 596fb037..1f2ca37f 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 34acea05..db6f57b0 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 afd160b8..5f66d4ae 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 d1bbc0df..a09df47d 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 52cf0fb3..5d09a45b 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 00000000..060e581b
--- /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 ()
--
GitLab