From 4164aaa037289d71147dd08112d3144e728164eb Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 7 Mar 2025 16:41:18 +0800 Subject: [PATCH 1/2] Expose getPath --- .github/workflows/build.yml | 6 ++-- System/Directory.hs | 7 +++++ System/Directory/Internal/Posix.hsc | 8 +++--- System/Directory/Internal/Windows.hsc | 40 +++++++++++++++------------ System/Directory/OsPath.hs | 4 +++ directory.cabal | 2 +- 6 files changed, 41 insertions(+), 26 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index ac8e8ee0..22e08d46 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -22,9 +22,9 @@ jobs: - { os: ubuntu-latest, ghc: 9.4.3, cabal: 3.8.1.0 } # TODO: Unpin cabal from 3.12.10 after https://github.com/haskell/cabal/issues/10718 is fixed. - { os: ubuntu-latest, ghc: latest, cabal: 3.12.1.0, cabal-package-flags: +os-string, ghc-flags: -Werror=deprecations } - - { os: windows-latest, stack: lts-15.3, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.13.3.0", overrides: "before_prepare() { sed -i.bak -e /CreateSymbolicLinkW/d -e /GetFinalPathNameByHandleW/d configure.ac; }" } - - { os: windows-latest, stack: lts-17.5, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.13.3.0" } - - { os: windows-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, file-io-0.1.4, filepath-1.5.2.0, os-string-2.0.2, time-1.14, Win32-2.14.0.0", stack-package-flags: "{directory: {os-string: true}, file-io: {os-string: true}, Win32: {os-string: true}}", ghc-flags: -Werror=deprecations } + - { os: windows-latest, stack: lts-15.3, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.14.1.0", overrides: "before_prepare() { sed -i.bak -e /CreateSymbolicLinkW/d -e /GetFinalPathNameByHandleW/d configure.ac; }" } + - { os: windows-latest, stack: lts-17.5, stack-extra-deps: "bytestring-0.11.3.0, file-io-0.1.4, filepath-1.4.100.0, time-1.9.3, Win32-2.14.1.0" } + - { os: windows-latest, stack: lts-22.7, stack-extra-deps: "bytestring-0.11.5.3, file-io-0.1.4, filepath-1.5.2.0, os-string-2.0.2, time-1.14, Win32-2.14.1.0", stack-package-flags: "{directory: {os-string: true}, file-io: {os-string: true}, Win32: {os-string: true}}", ghc-flags: -Werror=deprecations } runs-on: ${{ matrix.os }} env: CABAL_PACKAGE_FLAGS: ${{ matrix.cabal-package-flags }} diff --git a/System/Directory.hs b/System/Directory.hs index dbabdb44..e060cb61 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -40,6 +40,9 @@ module System.Directory , getUserDocumentsDirectory , getTemporaryDirectory + -- * PATH + , System.Directory.getPath + -- * Actions on files , removeFile , renameFile @@ -1337,3 +1340,7 @@ The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO FilePath getTemporaryDirectory = D.getTemporaryDirectory >>= decodeFS + +-- | Get the contents of the @PATH@ environment variable. +getPath :: IO [FilePath] +getPath = D.getPath >>= (`for` decodeFS) diff --git a/System/Directory/Internal/Posix.hsc b/System/Directory/Internal/Posix.hsc index 374fa6f4..96b1c868 100644 --- a/System/Directory/Internal/Posix.hsc +++ b/System/Directory/Internal/Posix.hsc @@ -148,6 +148,10 @@ findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary = path <- getPath pure (findExecutablesInDirectoriesLazy path binary) +-- | Get the contents of the @PATH@ environment variable. +getPath :: IO [OsPath] +getPath = splitSearchPath <$> getEnvOs (os "PATH") + exeExtensionInternal :: OsString exeExtensionInternal = exeExtension @@ -391,10 +395,6 @@ getEnvOs name = do Nothing Just value -> pure value --- | Get the contents of the @PATH@ environment variable. -getPath :: IO [OsPath] -getPath = splitSearchPath <$> getEnvOs (os "PATH") - -- | $HOME is preferred, because the user has control over it. However, POSIX -- doesn't define it as a mandatory variable, so fall back to `getpwuid_r`. getHomeDirectoryInternal :: IO OsPath diff --git a/System/Directory/Internal/Windows.hsc b/System/Directory/Internal/Windows.hsc index 4a8d7ded..3e923f4b 100644 --- a/System/Directory/Internal/Windows.hsc +++ b/System/Directory/Internal/Windows.hsc @@ -29,6 +29,7 @@ import System.OsPath , pack , pathSeparator , splitDirectories + , splitSearchPath , takeExtension , toChar , unpack @@ -41,6 +42,7 @@ import qualified System.Win32.WindowsString.Info as Win32 import qualified System.Win32.WindowsString.Shell as Win32 import qualified System.Win32.WindowsString.Time as Win32 import qualified System.Win32.WindowsString.Types as Win32 +import qualified System.Win32.WindowsString.Console as Win32 type RawHandle = OsPath @@ -53,6 +55,26 @@ openRaw _ dir path = pure (pathAt dir path) closeRaw :: RawHandle -> IO () closeRaw _ = pure () +lookupEnvOs :: OsString -> IO (Maybe OsString) +lookupEnvOs (OsString name) = (OsString <$>) <$> Win32.getEnv name + +getEnvOs :: OsString -> IO OsString +getEnvOs name = do + env <- lookupEnvOs name + case env of + Nothing -> + throwIO $ + mkIOError + doesNotExistErrorType + ("env var " <> show name <> " not found") + Nothing + Nothing + Just value -> pure value + +-- | Get the contents of the @PATH@ environment variable. +getPath :: IO [OsPath] +getPath = splitSearchPath <$> getEnvOs (os "PATH") + createDirectoryInternal :: OsPath -> IO () createDirectoryInternal path = (`ioeSetOsPath` path) `modifyIOError` do @@ -666,24 +688,6 @@ setAccessPermissions :: OsPath -> Permissions -> IO () setAccessPermissions path Permissions{writable = w} = do setFilePermissions path (setWriteMode w 0) -lookupEnvOs :: OsString -> IO (Maybe OsString) -lookupEnvOs (OsString name) = do - result <- - Win32.withTString name $ \ pName -> - peekTStringWith 256 $ \ pBuffer size -> - c_GetEnvironmentVariable pName pBuffer size - case result of - Left errCode | errCode == win32_eRROR_ENVVAR_NOT_FOUND -> pure Nothing - | otherwise -> Win32.failWith "GetEnvironmentVariable" errCode - Right value -> pure (Just (OsString value)) - -foreign import WINAPI unsafe "windows.h GetEnvironmentVariableW" - c_GetEnvironmentVariable - :: Win32.LPWSTR - -> Win32.LPWSTR - -> Win32.DWORD - -> IO Win32.DWORD - getFolderPath :: Win32.CSIDL -> IO OsPath getFolderPath what = OsString <$> Win32.sHGetFolderPath nullPtr what nullPtr 0 diff --git a/System/Directory/OsPath.hs b/System/Directory/OsPath.hs index c39ecd6b..3aac64c1 100644 --- a/System/Directory/OsPath.hs +++ b/System/Directory/OsPath.hs @@ -42,6 +42,9 @@ module System.Directory.OsPath , getUserDocumentsDirectory , getTemporaryDirectory + -- * PATH + , getPath + -- * Actions on files , removeFile , renameFile @@ -1653,3 +1656,4 @@ The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO OsPath getTemporaryDirectory = getTemporaryDirectoryInternal + diff --git a/directory.cabal b/directory.cabal index bb6c6b77..49902643 100644 --- a/directory.cabal +++ b/directory.cabal @@ -63,7 +63,7 @@ Library file-io >= 0.1.4 && < 0.2, time >= 1.8.0 && < 1.15, if os(windows) - build-depends: Win32 >= 2.13.3 && < 2.15 + build-depends: Win32 >= 2.14.1.0 && < 2.15 else build-depends: unix >= 2.8.0 && < 2.9 From 812696a3bccbe6104ee796a8ec3ce8d0f636c492 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 8 Mar 2025 16:19:06 +0800 Subject: [PATCH 2/2] Bump to 1.3.10.0 --- changelog.md | 4 ++++ directory.cabal | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/changelog.md b/changelog.md index 51df3478..9765b369 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,10 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.10.0 (XXX 2025) + + * Add `getPath` wrt [#198](https://github.com/haskell/directory/pull/198) + ## 1.3.9.0 (Oct 2024) * Rely on `file-io` for file I/O. diff --git a/directory.cabal b/directory.cabal index 49902643..c438c64c 100644 --- a/directory.cabal +++ b/directory.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: directory -version: 1.3.9.0 +version: 1.3.10.0 license: BSD-3-Clause license-file: LICENSE maintainer: libraries@haskell.org