directory 1.3.7.1 → 1.3.8.0
raw patch · 34 files changed
+2388/−986 lines, 34 filesdep ~Win32dep ~basedep ~filepathPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: Win32, base, filepath, time, unix
API changes (from Hackage documentation)
- System.Directory.Internal: copyFileToHandle :: FilePath -> Handle -> IO ()
- System.Directory.Internal: posix_accessTimeHiRes :: FileStatus -> POSIXTime
- System.Directory.Internal: posix_modificationTimeHiRes :: FileStatus -> POSIXTime
+ System.Directory.Internal: createHardLink :: OsPath -> OsPath -> IO ()
+ System.Directory.Internal: data OsString
+ System.Directory.Internal: defaultFlags :: OpenFileFlags
+ System.Directory.Internal: filesAlwaysRemovable :: Bool
+ System.Directory.Internal: getEnvOs :: OsString -> IO OsString
+ System.Directory.Internal: ioeSetOsPath :: IOError -> OsPath -> IOError
+ System.Directory.Internal: lookupEnvOs :: OsString -> IO (Maybe OsString)
+ System.Directory.Internal: openFileForRead :: OsPath -> IO Handle
+ System.Directory.Internal: openFileForWrite :: OsPath -> IO Handle
+ System.Directory.Internal: os :: String -> OsString
+ System.Directory.Internal: rightOrError :: Exception e => Either e a -> a
+ System.Directory.Internal: so :: OsString -> String
+ System.Directory.Internal: type OsPath = OsString
+ System.Directory.Internal: withBinaryHandle :: IO Handle -> (Handle -> IO r) -> IO r
+ System.Directory.OsPath: XdgCache :: XdgDirectory
+ System.Directory.OsPath: XdgConfig :: XdgDirectory
+ System.Directory.OsPath: XdgConfigDirs :: XdgDirectoryList
+ System.Directory.OsPath: XdgData :: XdgDirectory
+ System.Directory.OsPath: XdgDataDirs :: XdgDirectoryList
+ System.Directory.OsPath: XdgState :: XdgDirectory
+ System.Directory.OsPath: canonicalizePath :: OsPath -> IO OsPath
+ System.Directory.OsPath: copyFile :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: copyFileWithMetadata :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: copyPermissions :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: createDirectory :: OsPath -> IO ()
+ System.Directory.OsPath: createDirectoryIfMissing :: Bool -> OsPath -> IO ()
+ System.Directory.OsPath: createDirectoryLink :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: createFileLink :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: data Permissions
+ System.Directory.OsPath: data XdgDirectory
+ System.Directory.OsPath: data XdgDirectoryList
+ System.Directory.OsPath: doesDirectoryExist :: OsPath -> IO Bool
+ System.Directory.OsPath: doesFileExist :: OsPath -> IO Bool
+ System.Directory.OsPath: doesPathExist :: OsPath -> IO Bool
+ System.Directory.OsPath: emptyPermissions :: Permissions
+ System.Directory.OsPath: exeExtension :: OsString
+ System.Directory.OsPath: executable :: Permissions -> Bool
+ System.Directory.OsPath: findExecutable :: OsString -> IO (Maybe OsPath)
+ System.Directory.OsPath: findExecutables :: OsString -> IO [OsPath]
+ System.Directory.OsPath: findExecutablesInDirectories :: [OsPath] -> OsString -> IO [OsPath]
+ System.Directory.OsPath: findFile :: [OsPath] -> OsString -> IO (Maybe OsPath)
+ System.Directory.OsPath: findFileWith :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> IO (Maybe OsPath)
+ System.Directory.OsPath: findFiles :: [OsPath] -> OsString -> IO [OsPath]
+ System.Directory.OsPath: findFilesWith :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> IO [OsPath]
+ System.Directory.OsPath: getAccessTime :: OsPath -> IO UTCTime
+ System.Directory.OsPath: getAppUserDataDirectory :: OsPath -> IO OsPath
+ System.Directory.OsPath: getCurrentDirectory :: IO OsPath
+ System.Directory.OsPath: getDirectoryContents :: OsPath -> IO [OsPath]
+ System.Directory.OsPath: getFileSize :: OsPath -> IO Integer
+ System.Directory.OsPath: getHomeDirectory :: IO OsPath
+ System.Directory.OsPath: getModificationTime :: OsPath -> IO UTCTime
+ System.Directory.OsPath: getPermissions :: OsPath -> IO Permissions
+ System.Directory.OsPath: getSymbolicLinkTarget :: OsPath -> IO OsPath
+ System.Directory.OsPath: getTemporaryDirectory :: IO OsPath
+ System.Directory.OsPath: getUserDocumentsDirectory :: IO OsPath
+ System.Directory.OsPath: getXdgDirectory :: XdgDirectory -> OsPath -> IO OsPath
+ System.Directory.OsPath: getXdgDirectoryList :: XdgDirectoryList -> IO [OsPath]
+ System.Directory.OsPath: listDirectory :: OsPath -> IO [OsPath]
+ System.Directory.OsPath: makeAbsolute :: OsPath -> IO OsPath
+ System.Directory.OsPath: makeRelativeToCurrentDirectory :: OsPath -> IO OsPath
+ System.Directory.OsPath: pathIsSymbolicLink :: OsPath -> IO Bool
+ System.Directory.OsPath: readable :: Permissions -> Bool
+ System.Directory.OsPath: removeDirectory :: OsPath -> IO ()
+ System.Directory.OsPath: removeDirectoryLink :: OsPath -> IO ()
+ System.Directory.OsPath: removeDirectoryRecursive :: OsPath -> IO ()
+ System.Directory.OsPath: removeFile :: OsPath -> IO ()
+ System.Directory.OsPath: removePathForcibly :: OsPath -> IO ()
+ System.Directory.OsPath: renameDirectory :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: renameFile :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: renamePath :: OsPath -> OsPath -> IO ()
+ System.Directory.OsPath: searchable :: Permissions -> Bool
+ System.Directory.OsPath: setAccessTime :: OsPath -> UTCTime -> IO ()
+ System.Directory.OsPath: setCurrentDirectory :: OsPath -> IO ()
+ System.Directory.OsPath: setModificationTime :: OsPath -> UTCTime -> IO ()
+ System.Directory.OsPath: setOwnerExecutable :: Bool -> Permissions -> Permissions
+ System.Directory.OsPath: setOwnerReadable :: Bool -> Permissions -> Permissions
+ System.Directory.OsPath: setOwnerSearchable :: Bool -> Permissions -> Permissions
+ System.Directory.OsPath: setOwnerWritable :: Bool -> Permissions -> Permissions
+ System.Directory.OsPath: setPermissions :: OsPath -> Permissions -> IO ()
+ System.Directory.OsPath: withCurrentDirectory :: OsPath -> IO a -> IO a
+ System.Directory.OsPath: writable :: Permissions -> Bool
- System.Directory.Internal: canonicalizePathSimplify :: FilePath -> IO FilePath
+ System.Directory.Internal: canonicalizePathSimplify :: OsPath -> IO OsPath
- System.Directory.Internal: canonicalizePathWith :: ((FilePath -> IO FilePath) -> FilePath -> IO FilePath) -> FilePath -> IO FilePath
+ System.Directory.Internal: canonicalizePathWith :: ((OsPath -> IO OsPath) -> OsPath -> IO OsPath) -> OsPath -> IO OsPath
- System.Directory.Internal: copyFileContents :: FilePath -> FilePath -> IO ()
+ System.Directory.Internal: copyFileContents :: OsPath -> OsPath -> IO ()
- System.Directory.Internal: copyFileWithMetadataInternal :: (Metadata -> FilePath -> IO ()) -> (Metadata -> FilePath -> IO ()) -> FilePath -> FilePath -> IO ()
+ System.Directory.Internal: copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ()) -> (Metadata -> OsPath -> IO ()) -> OsPath -> OsPath -> IO ()
- System.Directory.Internal: copyGroupFromStatus :: FileStatus -> FilePath -> IO ()
+ System.Directory.Internal: copyGroupFromStatus :: FileStatus -> OsPath -> IO ()
- System.Directory.Internal: copyOwnerFromStatus :: FileStatus -> FilePath -> IO ()
+ System.Directory.Internal: copyOwnerFromStatus :: FileStatus -> OsPath -> IO ()
- System.Directory.Internal: createDirectoryInternal :: FilePath -> IO ()
+ System.Directory.Internal: createDirectoryInternal :: OsPath -> IO ()
- System.Directory.Internal: createSymbolicLink :: Bool -> FilePath -> FilePath -> IO ()
+ System.Directory.Internal: createSymbolicLink :: Bool -> OsPath -> OsPath -> IO ()
- System.Directory.Internal: emptyToCurDir :: FilePath -> FilePath
+ System.Directory.Internal: emptyToCurDir :: OsPath -> OsPath
- System.Directory.Internal: exeExtensionInternal :: String
+ System.Directory.Internal: exeExtensionInternal :: OsString
- System.Directory.Internal: expandDots :: [FilePath] -> [FilePath]
+ System.Directory.Internal: expandDots :: [OsPath] -> [OsPath]
- System.Directory.Internal: findExecutablesLazyInternal :: ([FilePath] -> String -> ListT IO FilePath) -> String -> ListT IO FilePath
+ System.Directory.Internal: findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath) -> OsString -> ListT IO OsPath
- System.Directory.Internal: getAccessPermissions :: FilePath -> IO Permissions
+ System.Directory.Internal: getAccessPermissions :: OsPath -> IO Permissions
- System.Directory.Internal: getAppUserDataDirectoryInternal :: FilePath -> IO FilePath
+ System.Directory.Internal: getAppUserDataDirectoryInternal :: OsPath -> IO OsPath
- System.Directory.Internal: getCurrentDirectoryInternal :: IO FilePath
+ System.Directory.Internal: getCurrentDirectoryInternal :: IO OsPath
- System.Directory.Internal: getDirectoryContentsInternal :: FilePath -> IO [FilePath]
+ System.Directory.Internal: getDirectoryContentsInternal :: OsPath -> IO [OsPath]
- System.Directory.Internal: getFileMetadata :: FilePath -> IO Metadata
+ System.Directory.Internal: getFileMetadata :: OsPath -> IO Metadata
- System.Directory.Internal: getHomeDirectoryInternal :: IO FilePath
+ System.Directory.Internal: getHomeDirectoryInternal :: IO OsPath
- System.Directory.Internal: getPath :: IO [FilePath]
+ System.Directory.Internal: getPath :: IO [OsPath]
- System.Directory.Internal: getSymbolicLinkMetadata :: FilePath -> IO Metadata
+ System.Directory.Internal: getSymbolicLinkMetadata :: OsPath -> IO Metadata
- System.Directory.Internal: getTemporaryDirectoryInternal :: IO FilePath
+ System.Directory.Internal: getTemporaryDirectoryInternal :: IO OsPath
- System.Directory.Internal: getUserDocumentsDirectoryInternal :: IO FilePath
+ System.Directory.Internal: getUserDocumentsDirectoryInternal :: IO OsPath
- System.Directory.Internal: getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath
+ System.Directory.Internal: getXdgDirectoryFallback :: IO OsPath -> XdgDirectory -> IO OsPath
- System.Directory.Internal: getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath]
+ System.Directory.Internal: getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsPath]
- System.Directory.Internal: normalisePathSeps :: FilePath -> FilePath
+ System.Directory.Internal: normalisePathSeps :: OsPath -> OsPath
- System.Directory.Internal: normaliseTrailingSep :: FilePath -> FilePath
+ System.Directory.Internal: normaliseTrailingSep :: OsPath -> OsPath
- System.Directory.Internal: prependCurrentDirectory :: FilePath -> IO FilePath
+ System.Directory.Internal: prependCurrentDirectory :: OsPath -> IO OsPath
- System.Directory.Internal: readSymbolicLink :: FilePath -> IO FilePath
+ System.Directory.Internal: readSymbolicLink :: OsPath -> IO OsPath
- System.Directory.Internal: removePathInternal :: Bool -> FilePath -> IO ()
+ System.Directory.Internal: removePathInternal :: Bool -> OsPath -> IO ()
- System.Directory.Internal: renamePathInternal :: FilePath -> FilePath -> IO ()
+ System.Directory.Internal: renamePathInternal :: OsPath -> OsPath -> IO ()
- System.Directory.Internal: setAccessPermissions :: FilePath -> Permissions -> IO ()
+ System.Directory.Internal: setAccessPermissions :: OsPath -> Permissions -> IO ()
- System.Directory.Internal: setCurrentDirectoryInternal :: FilePath -> IO ()
+ System.Directory.Internal: setCurrentDirectoryInternal :: OsPath -> IO ()
- System.Directory.Internal: setFileMode :: FilePath -> Mode -> IO ()
+ System.Directory.Internal: setFileMode :: OsPath -> Mode -> IO ()
- System.Directory.Internal: setFilePermissions :: FilePath -> Mode -> IO ()
+ System.Directory.Internal: setFilePermissions :: OsPath -> Mode -> IO ()
- System.Directory.Internal: setTimes :: FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
+ System.Directory.Internal: setTimes :: OsPath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
- System.Directory.Internal: simplify :: FilePath -> FilePath
+ System.Directory.Internal: simplify :: OsPath -> OsPath
- System.Directory.Internal: simplifyPosix :: FilePath -> FilePath
+ System.Directory.Internal: simplifyPosix :: OsPath -> OsPath
- System.Directory.Internal: simplifyWindows :: FilePath -> FilePath
+ System.Directory.Internal: simplifyWindows :: OsPath -> OsPath
- System.Directory.Internal: tryCopyOwnerAndGroupFromStatus :: FileStatus -> FilePath -> IO ()
+ System.Directory.Internal: tryCopyOwnerAndGroupFromStatus :: FileStatus -> OsPath -> IO ()
Files
- System/Directory.hs +88/−442
- System/Directory/Internal/Common.hs +89/−64
- System/Directory/Internal/Config.hs +3/−2
- System/Directory/Internal/Posix.hsc +155/−107
- System/Directory/Internal/Prelude.hs +6/−56
- System/Directory/Internal/Windows.hsc +236/−200
- System/Directory/OsPath.hs +1652/−0
- changelog.md +18/−0
- directory.cabal +10/−11
- tests/CanonicalizePath.hs +5/−4
- tests/CopyFile001.hs +4/−3
- tests/CopyFile002.hs +3/−2
- tests/CopyFileWithMetadata.hs +2/−1
- tests/CreateDirectoryIfMissing001.hs +5/−4
- tests/DoesPathExist.hs +15/−0
- tests/FindFile001.hs +5/−4
- tests/GetDirContents001.hs +4/−3
- tests/GetFileSize.hs +2/−4
- tests/LongPaths.hs +1/−1
- tests/Main.hs +0/−2
- tests/MakeAbsolute.hs +8/−7
- tests/MinimizeNameConflicts.hs +2/−2
- tests/RemoveDirectoryRecursive001.hs +6/−5
- tests/RemovePathForcibly.hs +17/−6
- tests/RenameFile001.hs +3/−2
- tests/RenamePath.hs +3/−2
- tests/Safe.hs +0/−7
- tests/Simplify.hs +1/−1
- tests/T8482.hs +4/−3
- tests/TestUtils.hs +21/−7
- tests/Util.hs +13/−25
- tests/WithCurrentDirectory.hs +4/−3
- tests/Xdg.hs +1/−5
- tests/util.inl +2/−1
System/Directory.hs view
@@ -1,10 +1,3 @@-{-# LANGUAGE CPP #-}--#if !MIN_VERSION_base(4, 8, 0)--- In base-4.8.0 the Foreign module became Safe-{-# LANGUAGE Trustworthy #-}-#endif- ----------------------------------------------------------------------------- -- | -- Module : System.Directory@@ -15,7 +8,7 @@ -- Stability : stable -- Portability : portable ----- System-independent interface to directory manipulation.+-- System-independent interface to directory manipulation (FilePath API). -- ----------------------------------------------------------------------------- @@ -113,21 +106,9 @@ import Prelude () import System.Directory.Internal import System.Directory.Internal.Prelude-import System.FilePath- ( (<.>)- , (</>)- , addTrailingPathSeparator- , dropTrailingPathSeparator- , hasTrailingPathSeparator- , isAbsolute- , joinPath- , makeRelative- , splitDirectories- , splitSearchPath- , takeDirectory- ) import Data.Time (UTCTime)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import System.OsPath (decodeFS, encodeFS)+import qualified System.Directory.OsPath as D {- $intro A directory contains a series of entries, each of which is a named@@ -221,9 +202,7 @@ -- -- * 'isDoesNotExistError' if the file or directory does not exist. getPermissions :: FilePath -> IO Permissions-getPermissions path =- (`ioeAddLocation` "getPermissions") `modifyIOError` do- getAccessPermissions (emptyToCurDir path)+getPermissions = encodeFS >=> D.getPermissions -- | Set the permissions of a file or directory. --@@ -240,9 +219,7 @@ -- -- * 'isDoesNotExistError' if the file or directory does not exist. setPermissions :: FilePath -> Permissions -> IO ()-setPermissions path p =- (`ioeAddLocation` "setPermissions") `modifyIOError` do- setAccessPermissions (emptyToCurDir path) p+setPermissions path p = encodeFS path >>= (`D.setPermissions` p) -- | Copy the permissions of one file to another. This reproduces the -- permissions more accurately than using 'getPermissions' followed by@@ -252,16 +229,11 @@ -- -- On POSIX systems, this is equivalent to @stat@ followed by @chmod@. copyPermissions :: FilePath -> FilePath -> IO ()-copyPermissions src dst =- (`ioeAddLocation` "copyPermissions") `modifyIOError` do- m <- getFileMetadata src- copyPermissionsFromMetadata m dst+copyPermissions src dst = do+ src' <- encodeFS src+ dst' <- encodeFS dst+ D.copyPermissions src' dst' -copyPermissionsFromMetadata :: Metadata -> FilePath -> IO ()-copyPermissionsFromMetadata m dst = do- -- instead of setFileMode, setFilePermissions is used here- -- this is to retain backward compatibility in copyPermissions- setFilePermissions dst (modeFromMetadata m) ----------------------------------------------------------------------------- -- Implementation@@ -304,7 +276,7 @@ -} createDirectory :: FilePath -> IO ()-createDirectory = createDirectoryInternal+createDirectory = encodeFS >=> D.createDirectory -- | @'createDirectoryIfMissing' parents dir@ creates a new directory -- @dir@ if it doesn\'t exist. If the first argument is 'True'@@ -312,45 +284,7 @@ createDirectoryIfMissing :: Bool -- ^ Create its parents too? -> FilePath -- ^ The path to the directory you want to make -> IO ()-createDirectoryIfMissing create_parents path0- | create_parents = createDirs (parents path0)- | otherwise = createDirs (take 1 (parents path0))- where- parents = reverse . scanl1 (</>) . splitDirectories . simplify-- createDirs [] = pure ()- createDirs (dir:[]) = createDir dir ioError- createDirs (dir:dirs) =- createDir dir $ \_ -> do- createDirs dirs- createDir dir ioError-- createDir dir notExistHandler = do- r <- tryIOError (createDirectory dir)- case r of- Right () -> pure ()- Left e- | isDoesNotExistError e -> notExistHandler e- -- createDirectory (and indeed POSIX mkdir) does not distinguish- -- between a dir already existing and a file already existing. So we- -- check for it here. Unfortunately there is a slight race condition- -- here, but we think it is benign. It could report an exception in- -- the case that the dir did exist but another process deletes the- -- directory and creates a file in its place before we can check- -- that the directory did indeed exist.- -- We also follow this path when we get a permissions error, as- -- trying to create "." when in the root directory on Windows- -- fails with- -- CreateDirectory ".": permission denied (Access is denied.)- -- This caused GHCi to crash when loading a module in the root- -- directory.- | isAlreadyExistsError e- || isPermissionError e -> do- canIgnore <- pathIsDirectory dir- `catchIOError` \ _ ->- pure (isAlreadyExistsError e)- unless canIgnore (ioError e)- | otherwise -> ioError e+createDirectoryIfMissing cp = encodeFS >=> D.createDirectoryIfMissing cp {- | @'removeDirectory' dir@ removes an existing directory /dir/. The@@ -395,7 +329,7 @@ -} removeDirectory :: FilePath -> IO ()-removeDirectory = removePathInternal True+removeDirectory = encodeFS >=> D.removeDirectory -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ -- together with its contents and subdirectories. Within this directory,@@ -406,45 +340,7 @@ -- This operation is reported to be flaky on Windows so retry logic may -- be advisable. See: https://github.com/haskell/directory/pull/108 removeDirectoryRecursive :: FilePath -> IO ()-removeDirectoryRecursive path =- (`ioeAddLocation` "removeDirectoryRecursive") `modifyIOError` do- m <- getSymbolicLinkMetadata path- case fileTypeFromMetadata m of- Directory ->- removeContentsRecursive path- DirectoryLink ->- ioError (err `ioeSetErrorString` "is a directory symbolic link")- _ ->- ioError (err `ioeSetErrorString` "not a directory")- where err = mkIOError InappropriateType "" Nothing (Just path)---- | @removePathRecursive path@ removes an existing file or directory at--- /path/ together with its contents and subdirectories. Symbolic links are--- removed without affecting their the targets.------ This operation is reported to be flaky on Windows so retry logic may--- be advisable. See: https://github.com/haskell/directory/pull/108-removePathRecursive :: FilePath -> IO ()-removePathRecursive path =- (`ioeAddLocation` "removePathRecursive") `modifyIOError` do- m <- getSymbolicLinkMetadata path- case fileTypeFromMetadata m of- Directory -> removeContentsRecursive path- DirectoryLink -> removeDirectory path- _ -> removeFile path---- | @removeContentsRecursive dir@ removes the contents of the directory--- /dir/ recursively. Symbolic links are removed without affecting their the--- targets.------ This operation is reported to be flaky on Windows so retry logic may--- be advisable. See: https://github.com/haskell/directory/pull/108-removeContentsRecursive :: FilePath -> IO ()-removeContentsRecursive path =- (`ioeAddLocation` "removeContentsRecursive") `modifyIOError` do- cont <- listDirectory path- traverse_ removePathRecursive [path </> x | x <- cont]- removeDirectory path+removeDirectoryRecursive = encodeFS >=> D.removeDirectoryRecursive -- | Removes a file or directory at /path/ together with its contents and -- subdirectories. Symbolic links are removed without affecting their@@ -465,31 +361,7 @@ -- -- @since 1.2.7.0 removePathForcibly :: FilePath -> IO ()-removePathForcibly path =- (`ioeAddLocation` "removePathForcibly") `modifyIOError` do- makeRemovable path `catchIOError` \ _ -> pure ()- ignoreDoesNotExistError $ do- m <- getSymbolicLinkMetadata path- case fileTypeFromMetadata m of- DirectoryLink -> removeDirectory path- Directory -> do- names <- listDirectory path- sequenceWithIOErrors_ $- [ removePathForcibly (path </> name) | name <- names ] ++- [ removeDirectory path ]- _ -> removeFile path- where-- ignoreDoesNotExistError :: IO () -> IO ()- ignoreDoesNotExistError action =- () <$ tryIOErrorType isDoesNotExistError action-- makeRemovable :: FilePath -> IO ()- makeRemovable p = do- perms <- getPermissions p- setPermissions path perms{ readable = True- , searchable = True- , writable = True }+removePathForcibly = encodeFS >=> D.removePathForcibly {- |'removeFile' /file/ removes the directory entry for an existing file /file/, where /file/ is not itself a directory. The@@ -526,7 +398,7 @@ -} removeFile :: FilePath -> IO ()-removeFile = removePathInternal False+removeFile = encodeFS >=> D.removeFile {- |@'renameDirectory' old new@ changes the name of an existing directory from /old/ to /new/. If the /new/ directory@@ -578,14 +450,10 @@ -} renameDirectory :: FilePath -> FilePath -> IO ()-renameDirectory opath npath =- (`ioeAddLocation` "renameDirectory") `modifyIOError` do- -- XXX this test isn't performed atomically with the following rename- isDir <- pathIsDirectory opath- when (not isDir) $ do- ioError . (`ioeSetErrorString` "not a directory") $- (mkIOError InappropriateType "renameDirectory" Nothing (Just opath))- renamePath opath npath+renameDirectory opath npath = do+ opath' <- encodeFS opath+ npath' <- encodeFS npath+ D.renameDirectory opath' npath' {- |@'renameFile' old new@ changes the name of an existing file system object from /old/ to /new/. If the /new/ object already exists, it is@@ -637,26 +505,10 @@ -} renameFile :: FilePath -> FilePath -> IO ()-renameFile opath npath =- (`ioeAddLocation` "renameFile") `modifyIOError` do- -- XXX the tests are not performed atomically with the rename- checkNotDir opath- renamePath opath npath- -- The underlying rename implementation can throw odd exceptions when the- -- destination is a directory. For example, Windows typically throws a- -- permission error, while POSIX systems may throw a resource busy error- -- if one of the paths refers to the current directory. In these cases,- -- we check if the destination is a directory and, if so, throw an- -- InappropriateType error.- `catchIOError` \ err -> do- checkNotDir npath- ioError err- where checkNotDir path = do- m <- tryIOError (getSymbolicLinkMetadata path)- case fileTypeIsDirectory . fileTypeFromMetadata <$> m of- Right True -> ioError . (`ioeSetErrorString` "is a directory") $- mkIOError InappropriateType "" Nothing (Just path)- _ -> pure ()+renameFile opath npath = do+ opath' <- encodeFS opath+ npath' <- encodeFS npath+ D.renameFile opath' npath' -- | Rename a file or directory. If the destination path already exists, it -- is replaced atomically. The destination path must not point to an existing@@ -703,9 +555,10 @@ renamePath :: FilePath -- ^ Old path -> FilePath -- ^ New path -> IO ()-renamePath opath npath =- (`ioeAddLocation` "renamePath") `modifyIOError` do- renamePathInternal opath npath+renamePath opath npath = do+ opath' <- encodeFS opath+ npath' <- encodeFS npath+ D.renamePath opath' npath' -- | Copy a file with its permissions. If the destination file already exists, -- it is replaced atomically. Neither path may refer to an existing@@ -714,45 +567,10 @@ copyFile :: FilePath -- ^ Source filename -> FilePath -- ^ Destination filename -> IO ()-copyFile fromFPath toFPath =- (`ioeAddLocation` "copyFile") `modifyIOError` do- atomicCopyFileContents fromFPath toFPath- (ignoreIOExceptions . copyPermissions fromFPath)---- | Copy the contents of a source file to a destination file, replacing the--- destination file atomically via @withReplacementFile@, resetting the--- attributes of the destination file to the defaults.-atomicCopyFileContents :: FilePath -- ^ Source filename- -> FilePath -- ^ Destination filename- -> (FilePath -> IO ()) -- ^ Post-action- -> IO ()-atomicCopyFileContents fromFPath toFPath postAction =- (`ioeAddLocation` "atomicCopyFileContents") `modifyIOError` do- withReplacementFile toFPath postAction $ \ hTo -> do- copyFileToHandle fromFPath hTo---- | A helper function useful for replacing files in an atomic manner. The--- function creates a temporary file in the directory of the destination file,--- opens it, performs the main action with its handle, closes it, performs the--- post-action with its path, and finally replaces the destination file with--- the temporary file. If an error occurs during any step of this process,--- the temporary file is removed and the destination file remains untouched.-withReplacementFile :: FilePath -- ^ Destination file- -> (FilePath -> IO ()) -- ^ Post-action- -> (Handle -> IO a) -- ^ Main action- -> IO a-withReplacementFile path postAction action =- (`ioeAddLocation` "withReplacementFile") `modifyIOError` do- mask $ \ restore -> do- (tmpFPath, hTmp) <- openBinaryTempFile (takeDirectory path)- ".copyFile.tmp"- (`onException` ignoreIOExceptions (removeFile tmpFPath)) $ do- r <- (`onException` ignoreIOExceptions (hClose hTmp)) $ do- restore (action hTmp)- hClose hTmp- restore (postAction tmpFPath)- renameFile tmpFPath path- pure r+copyFile fromFPath toFPath = do+ fromFPath' <- encodeFS fromFPath+ toFPath' <- encodeFS toFPath+ D.copyFile fromFPath' toFPath' -- | Copy a file with its associated metadata. If the destination file -- already exists, it is overwritten. There is no guarantee of atomicity in@@ -775,18 +593,11 @@ copyFileWithMetadata :: FilePath -- ^ Source file -> FilePath -- ^ Destination file -> IO ()-copyFileWithMetadata src dst =- (`ioeAddLocation` "copyFileWithMetadata") `modifyIOError`- copyFileWithMetadataInternal copyPermissionsFromMetadata- copyTimesFromMetadata- src- dst+copyFileWithMetadata src dst = do+ src' <- encodeFS src+ dst' <- encodeFS dst+ D.copyFileWithMetadata src' dst' -copyTimesFromMetadata :: Metadata -> FilePath -> IO ()-copyTimesFromMetadata st dst = do- let atime = accessTimeFromMetadata st- let mtime = modificationTimeFromMetadata st- setFileTimes dst (Just atime, Just mtime) -- | Make a path absolute, normalize the path, and remove as many indirections -- from it as possible. Any trailing path separators are discarded via@@ -852,73 +663,7 @@ -- are now performed on Windows. -- canonicalizePath :: FilePath -> IO FilePath-canonicalizePath = \ path ->- ((`ioeAddLocation` "canonicalizePath") .- (`ioeSetFileName` path)) `modifyIOError` do- -- simplify does more stuff, like upper-casing the drive letter- dropTrailingPathSeparator . simplify <$>- (canonicalizePathWith attemptRealpath =<< prependCurrentDirectory path)- where-- -- allow up to 64 cycles before giving up- attemptRealpath realpath =- attemptRealpathWith (64 :: Int) Nothing realpath- <=< canonicalizePathSimplify-- -- n is a counter to make sure we don't run into an infinite loop; we- -- don't try to do any cycle detection here because an adversary could DoS- -- any arbitrarily clever algorithm- attemptRealpathWith n mFallback realpath path =- case mFallback of- -- too many indirections ... giving up.- Just fallback | n <= 0 -> pure fallback- -- either mFallback == Nothing (first attempt)- -- or n > 0 (still have some attempts left)- _ -> realpathPrefix (reverse (zip prefixes suffixes))-- where-- segments = splitDirectories path- prefixes = scanl1 (</>) segments- suffixes = tail (scanr (</>) "" segments)-- -- try to call realpath on the largest possible prefix- realpathPrefix candidates =- case candidates of- [] -> pure path- (prefix, suffix) : rest -> do- exist <- doesPathExist prefix- if not exist- -- never call realpath on an inaccessible path- -- (to avoid bugs in system realpath implementations)- -- try a smaller prefix instead- then realpathPrefix rest- else do- mp <- tryIOError (realpath prefix)- case mp of- -- realpath failed: try a smaller prefix instead- Left _ -> realpathPrefix rest- -- realpath succeeded: fine-tune the result- Right p -> realpathFurther (p </> suffix) p suffix-- -- by now we have a reasonable fallback value that we can use if we- -- run into too many indirections; the fallback value is the same- -- result that we have been returning in versions prior to 1.3.1.0- -- (this is essentially the fix to #64)- realpathFurther fallback p suffix =- case splitDirectories suffix of- [] -> pure fallback- next : restSuffix -> do- -- see if the 'next' segment is a symlink- mTarget <- tryIOError (getSymbolicLinkTarget (p </> next))- case mTarget of- Left _ -> pure fallback- Right target -> do- -- if so, dereference it and restart the whole cycle- let mFallback' = Just (fromMaybe fallback mFallback)- path' <- canonicalizePathSimplify- (p </> target </> joinPath restSuffix)- attemptRealpathWith (n - 1) mFallback' realpath path'+canonicalizePath = encodeFS >=> D.canonicalizePath >=> decodeFS -- | Convert a path into an absolute path. If the given path is relative, the -- current directory is prepended and then the combined result is normalized.@@ -932,27 +677,15 @@ -- @since 1.2.2.0 -- makeAbsolute :: FilePath -> IO FilePath-makeAbsolute path =- ((`ioeAddLocation` "makeAbsolute") .- (`ioeSetFileName` path)) `modifyIOError` do- matchTrailingSeparator path . simplify <$> prependCurrentDirectory path---- | Add or remove the trailing path separator in the second path so as to--- match its presence in the first path.------ (internal API)-matchTrailingSeparator :: FilePath -> FilePath -> FilePath-matchTrailingSeparator path- | hasTrailingPathSeparator path = addTrailingPathSeparator- | otherwise = dropTrailingPathSeparator+makeAbsolute = encodeFS >=> D.makeAbsolute >=> decodeFS -- | Construct a path relative to the current directory, similar to -- 'makeRelative'. -- -- The operation may fail with the same exceptions as 'getCurrentDirectory'. makeRelativeToCurrentDirectory :: FilePath -> IO FilePath-makeRelativeToCurrentDirectory x = do- (`makeRelative` x) <$> getCurrentDirectory+makeRelativeToCurrentDirectory =+ encodeFS >=> D.makeRelativeToCurrentDirectory >=> decodeFS -- | Given the name or path of an executable file, 'findExecutable' searches -- for such a file in a list of system-defined locations, which generally@@ -978,9 +711,7 @@ -- testing each file for executable permissions. Details can be found in the -- documentation of 'findFileWith'. findExecutable :: String -> IO (Maybe FilePath)-findExecutable binary =- listTHead- (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)+findExecutable = encodeFS >=> D.findExecutable >=> (`for` decodeFS) -- | Search for executable files in a list of system-defined locations, which -- generally includes @PATH@ and possibly more.@@ -995,9 +726,7 @@ -- -- @since 1.2.2.0 findExecutables :: String -> IO [FilePath]-findExecutables binary =- listTToList- (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)+findExecutables = encodeFS >=> D.findExecutables >=> (`for` decodeFS) -- | Given a name or path, 'findExecutable' appends the 'exeExtension' to the -- query and searches for executable files in the list of given search@@ -1013,16 +742,11 @@ -- -- @since 1.2.4.0 findExecutablesInDirectories :: [FilePath] -> String -> IO [FilePath]-findExecutablesInDirectories path binary =- listTToList (findExecutablesInDirectoriesLazy path binary)--findExecutablesInDirectoriesLazy :: [FilePath] -> String -> ListT IO FilePath-findExecutablesInDirectoriesLazy path binary =- findFilesWithLazy isExecutable path (binary <.> exeExtension)---- | Test whether a file has executable permissions.-isExecutable :: FilePath -> IO Bool-isExecutable file = executable <$> getPermissions file+findExecutablesInDirectories path binary = do+ path' <- for path encodeFS+ binary' <- encodeFS binary+ D.findExecutablesInDirectories path' binary'+ >>= (`for` decodeFS) -- | Search through the given list of directories for the given file. --@@ -1051,7 +775,11 @@ -- -- @since 1.2.6.0 findFileWith :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO (Maybe FilePath)-findFileWith f ds name = listTHead (findFilesWithLazy f ds name)+findFileWith f ds name = do+ ds' <- for ds encodeFS+ name' <- encodeFS name+ D.findFileWith (decodeFS >=> f) ds' name'+ >>= (`for` decodeFS) -- | @findFilesWith predicate dirs name@ searches through the list of -- directories (@dirs@) for files that have the given @name@ and satisfy the@@ -1072,42 +800,25 @@ -- -- @since 1.2.1.0 findFilesWith :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO [FilePath]-findFilesWith f ds name = listTToList (findFilesWithLazy f ds name)--findFilesWithLazy- :: (FilePath -> IO Bool) -> [FilePath] -> String -> ListT IO FilePath-findFilesWithLazy f dirs path- -- make sure absolute paths are handled properly irrespective of 'dirs'- -- https://github.com/haskell/directory/issues/72- | isAbsolute path = ListT (find [""])- | otherwise = ListT (find dirs)-- where-- find [] = pure Nothing- find (d : ds) = do- let p = d </> path- found <- doesFileExist p `andM` f p- if found- then pure (Just (p, ListT (find ds)))- else find ds+findFilesWith f ds name = do+ ds' <- for ds encodeFS+ name' <- encodeFS name+ res <- D.findFilesWith (decodeFS >=> f) ds' name'+ for res decodeFS -- | Filename extension for executable files (including the dot if any) -- (usually @\"\"@ on POSIX systems and @\".exe\"@ on Windows or OS\/2). -- -- @since 1.2.4.0 exeExtension :: String-exeExtension = exeExtensionInternal+exeExtension = so D.exeExtension -- | Similar to 'listDirectory', but always includes the special entries (@.@ -- and @..@). (This applies to Windows as well.) -- -- The operation may fail with the same exceptions as 'listDirectory'. getDirectoryContents :: FilePath -> IO [FilePath]-getDirectoryContents path =- ((`ioeSetFileName` path) .- (`ioeAddLocation` "getDirectoryContents")) `modifyIOError` do- getDirectoryContentsInternal path+getDirectoryContents = encodeFS >=> D.getDirectoryContents >=> (`for` decodeFS) -- | @'listDirectory' dir@ returns a list of /all/ entries in /dir/ without -- the special entries (@.@ and @..@).@@ -1141,8 +852,7 @@ -- @since 1.2.5.0 -- listDirectory :: FilePath -> IO [FilePath]-listDirectory path = filter f <$> getDirectoryContents path- where f filename = filename /= "." && filename /= ".."+listDirectory = encodeFS >=> D.listDirectory >=> (`for` decodeFS) -- | Obtain the current working directory as an absolute path. --@@ -1178,12 +888,7 @@ -- The operating system has no notion of current working directory. -- getCurrentDirectory :: IO FilePath-getCurrentDirectory =- (`ioeAddLocation` "getCurrentDirectory") `modifyIOError` do- specializeErrorString- "Current working directory no longer exists"- isDoesNotExistError- getCurrentDirectoryInternal+getCurrentDirectory = D.getCurrentDirectory >>= decodeFS -- | Change the working directory to the given path. --@@ -1219,7 +924,7 @@ -- @[ENOTDIR]@ -- setCurrentDirectory :: FilePath -> IO ()-setCurrentDirectory = setCurrentDirectoryInternal+setCurrentDirectory = encodeFS >=> D.setCurrentDirectory -- | Run an 'IO' action with the given working directory and restore the -- original working directory afterwards, even if the given action fails due@@ -1234,17 +939,13 @@ -> IO a -- ^ Action to be executed -> IO a withCurrentDirectory dir action =- bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do- setCurrentDirectory dir- action+ encodeFS dir >>= (`D.withCurrentDirectory` action) -- | Obtain the size of a file in bytes. -- -- @since 1.2.7.0 getFileSize :: FilePath -> IO Integer-getFileSize path =- (`ioeAddLocation` "getFileSize") `modifyIOError` do- fileSizeFromMetadata <$> getFileMetadata path+getFileSize = encodeFS >=> D.getFileSize -- | Test whether the given path points to an existing filesystem object. If -- the user lacks necessary permissions to search the parent directories, this@@ -1252,10 +953,7 @@ -- -- @since 1.2.7.0 doesPathExist :: FilePath -> IO Bool-doesPathExist path = do- (True <$ getFileMetadata path)- `catchIOError` \ _ ->- pure False+doesPathExist = encodeFS >=> D.doesPathExist {- |The operation 'doesDirectoryExist' returns 'True' if the argument file exists and is either a directory or a symbolic link to a directory,@@ -1263,25 +961,15 @@ -} doesDirectoryExist :: FilePath -> IO Bool-doesDirectoryExist path = do- pathIsDirectory path- `catchIOError` \ _ ->- pure False+doesDirectoryExist = encodeFS >=> D.doesDirectoryExist {- |The operation 'doesFileExist' returns 'True' if the argument file exists and is not a directory, and 'False' otherwise. -} doesFileExist :: FilePath -> IO Bool-doesFileExist path = do- (not <$> pathIsDirectory path)- `catchIOError` \ _ ->- pure False+doesFileExist = encodeFS >=> D.doesFileExist -pathIsDirectory :: FilePath -> IO Bool-pathIsDirectory path =- (`ioeAddLocation` "pathIsDirectory") `modifyIOError` do- fileTypeIsDirectory . fileTypeFromMetadata <$> getFileMetadata path -- | Create a /file/ symbolic link. The target path can be either absolute or -- relative and need not refer to an existing file. The order of arguments@@ -1313,10 +1001,12 @@ :: FilePath -- ^ path to the target file -> FilePath -- ^ path of the link to be created -> IO ()-createFileLink target link =- (`ioeAddLocation` "createFileLink") `modifyIOError` do- createSymbolicLink False target link+createFileLink target link = do+ target' <- encodeFS target+ link' <- encodeFS link+ D.createFileLink target' link' + -- | Create a /directory/ symbolic link. The target path can be either -- absolute or relative and need not refer to an existing directory. The -- order of arguments follows the POSIX convention.@@ -1348,9 +1038,10 @@ :: FilePath -- ^ path to the target directory -> FilePath -- ^ path of the link to be created -> IO ()-createDirectoryLink target link =- (`ioeAddLocation` "createDirectoryLink") `modifyIOError` do- createSymbolicLink True target link+createDirectoryLink target link = do+ target' <- encodeFS target+ link' <- encodeFS link+ D.createDirectoryLink target' link' -- | Remove an existing /directory/ symbolic link. --@@ -1361,9 +1052,7 @@ -- -- @since 1.3.1.0 removeDirectoryLink :: FilePath -> IO ()-removeDirectoryLink path =- (`ioeAddLocation` "removeDirectoryLink") `modifyIOError` do- removePathInternal linkToDirectoryIsDirectory path+removeDirectoryLink = encodeFS >=> D.removeDirectoryLink -- | Check whether an existing @path@ is a symbolic link. If @path@ is a -- regular file or directory, 'False' is returned. If @path@ does not exist@@ -1382,10 +1071,7 @@ -- -- @since 1.3.0.0 pathIsSymbolicLink :: FilePath -> IO Bool-pathIsSymbolicLink path =- ((`ioeAddLocation` "pathIsSymbolicLink") .- (`ioeSetFileName` path)) `modifyIOError` do- fileTypeIsLink . fileTypeFromMetadata <$> getSymbolicLinkMetadata path+pathIsSymbolicLink = encodeFS >=> D.pathIsSymbolicLink {-# DEPRECATED isSymbolicLink "Use 'pathIsSymbolicLink' instead" #-} isSymbolicLink :: FilePath -> IO Bool@@ -1405,9 +1091,7 @@ -- -- @since 1.3.1.0 getSymbolicLinkTarget :: FilePath -> IO FilePath-getSymbolicLinkTarget path =- (`ioeAddLocation` "getSymbolicLinkTarget") `modifyIOError` do- readSymbolicLink path+getSymbolicLinkTarget = encodeFS >=> D.getSymbolicLinkTarget >=> decodeFS -- | Obtain the time at which the file or directory was last accessed. --@@ -1425,9 +1109,7 @@ -- @since 1.2.3.0 -- getAccessTime :: FilePath -> IO UTCTime-getAccessTime path =- (`ioeAddLocation` "getAccessTime") `modifyIOError` do- accessTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)+getAccessTime = encodeFS >=> D.getAccessTime -- | Obtain the time at which the file or directory was last modified. --@@ -1443,9 +1125,7 @@ -- and the underlying filesystem supports them. -- getModificationTime :: FilePath -> IO UTCTime-getModificationTime path =- (`ioeAddLocation` "getModificationTime") `modifyIOError` do- modificationTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)+getModificationTime = encodeFS >=> D.getModificationTime -- | Change the time at which the file or directory was last accessed. --@@ -1471,9 +1151,7 @@ -- @since 1.2.3.0 -- setAccessTime :: FilePath -> UTCTime -> IO ()-setAccessTime path atime =- (`ioeAddLocation` "setAccessTime") `modifyIOError` do- setFileTimes path (Just atime, Nothing)+setAccessTime path atime = encodeFS path >>= (`D.setAccessTime` atime) -- | Change the time at which the file or directory was last modified. --@@ -1500,16 +1178,7 @@ -- setModificationTime :: FilePath -> UTCTime -> IO () setModificationTime path mtime =- (`ioeAddLocation` "setModificationTime") `modifyIOError` do- setFileTimes path (Nothing, Just mtime)--setFileTimes :: FilePath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()-setFileTimes _ (Nothing, Nothing) = return ()-setFileTimes path (atime, mtime) =- ((`ioeAddLocation` "setFileTimes") .- (`ioeSetFileName` path)) `modifyIOError` do- setTimes (emptyToCurDir path)- (utcTimeToPOSIXSeconds <$> atime, utcTimeToPOSIXSeconds <$> mtime)+ encodeFS path >>= (`D.setModificationTime` mtime) {- | Returns the current user's home directory. @@ -1535,9 +1204,7 @@ cannot be found. -} getHomeDirectory :: IO FilePath-getHomeDirectory =- (`ioeAddLocation` "getHomeDirectory") `modifyIOError` do- getHomeDirectoryInternal+getHomeDirectory = D.getHomeDirectory >>= decodeFS -- | Obtain the paths to special directories for storing user-specific -- application data, configuration, and cache files, conforming to the@@ -1568,17 +1235,7 @@ -- to the path; if empty, the base -- path is returned -> IO FilePath-getXdgDirectory xdgDir suffix =- (`ioeAddLocation` "getXdgDirectory") `modifyIOError` do- simplify . (</> suffix) <$> do- env <- lookupEnv $ case xdgDir of- XdgData -> "XDG_DATA_HOME"- XdgConfig -> "XDG_CONFIG_HOME"- XdgCache -> "XDG_CACHE_HOME"- XdgState -> "XDG_STATE_HOME"- case env of- Just path | isAbsolute path -> pure path- _ -> getXdgDirectoryFallback getHomeDirectory xdgDir+getXdgDirectory xdgDir = encodeFS >=> D.getXdgDirectory xdgDir >=> decodeFS -- | Similar to 'getXdgDirectory' but retrieves the entire list of XDG -- directories.@@ -1589,14 +1246,7 @@ -- Refer to the docs of 'XdgDirectoryList' for more details. getXdgDirectoryList :: XdgDirectoryList -- ^ which special directory list -> IO [FilePath]-getXdgDirectoryList xdgDirs =- (`ioeAddLocation` "getXdgDirectoryList") `modifyIOError` do- env <- lookupEnv $ case xdgDirs of- XdgDataDirs -> "XDG_DATA_DIRS"- XdgConfigDirs -> "XDG_CONFIG_DIRS"- case env of- Nothing -> getXdgDirectoryListFallback xdgDirs- Just paths -> pure (splitSearchPath paths)+getXdgDirectoryList = D.getXdgDirectoryList >=> (`for` decodeFS) -- | Obtain the path to a special directory for storing user-specific -- application data (traditional Unix location). Newer applications may@@ -1627,9 +1277,7 @@ getAppUserDataDirectory :: FilePath -- ^ a relative path that is appended -- to the path -> IO FilePath-getAppUserDataDirectory appName = do- (`ioeAddLocation` "getAppUserDataDirectory") `modifyIOError` do- getAppUserDataDirectoryInternal appName+getAppUserDataDirectory = encodeFS >=> D.getAppUserDataDirectory >=>decodeFS {- | Returns the current user's document directory. @@ -1652,9 +1300,7 @@ cannot be found. -} getUserDocumentsDirectory :: IO FilePath-getUserDocumentsDirectory = do- (`ioeAddLocation` "getUserDocumentsDirectory") `modifyIOError` do- getUserDocumentsDirectoryInternal+getUserDocumentsDirectory = D.getUserDocumentsDirectory >>= decodeFS {- | Returns the current directory for temporary files. @@ -1683,4 +1329,4 @@ The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO FilePath-getTemporaryDirectory = getTemporaryDirectoryInternal+getTemporaryDirectory = D.getTemporaryDirectory >>= decodeFS
System/Directory/Internal/Common.hs view
@@ -1,18 +1,35 @@-module System.Directory.Internal.Common where+module System.Directory.Internal.Common+ ( module System.Directory.Internal.Common+ , OsPath+ , OsString+ ) where import Prelude () import System.Directory.Internal.Prelude-import System.FilePath- ( addTrailingPathSeparator+import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))+import GHC.IO.Encoding.UTF16 (mkUTF16le)+import GHC.IO.Encoding.UTF8 (mkUTF8)+import System.IO (hSetBinaryMode)+import System.OsPath+ ( OsPath+ , OsString+ , addTrailingPathSeparator+ , decodeUtf+ , decodeWith+ , encodeUtf , hasTrailingPathSeparator , isPathSeparator , isRelative , joinDrive , joinPath , normalise+ , pack , pathSeparator , pathSeparators , splitDirectories , splitDrive+ , toChar+ , unpack+ , unsafeFromChar ) -- | A generator with side-effects.@@ -59,13 +76,7 @@ go (Right ()) [] = pure () go s (m : ms) = s `seq` do r <- tryIOError m- go (thenEither s r) ms-- -- equivalent to (*>) for Either, defined here to retain compatibility- -- with base prior to 4.3- thenEither :: Either b a -> Either b a -> Either b a- thenEither x@(Left _) _ = x- thenEither _ y = y+ go (s *> r) ms -- | Similar to 'try' but only catches a specify kind of 'IOError' as -- specified by the predicate.@@ -95,46 +106,69 @@ newLoc = loc <> if null oldLoc then "" else ":" <> oldLoc oldLoc = ioeGetLocation e +rightOrError :: Exception e => Either e a -> a+rightOrError (Left e) = error (displayException e)+rightOrError (Right a) = a++-- | Fallibly converts String to OsString. Only intended to be used on literals.+os :: String -> OsString+os = rightOrError . encodeUtf++-- | Fallibly converts OsString to String. Only intended to be used on literals.+so :: OsString -> String+so = rightOrError . decodeUtf++ioeSetOsPath :: IOError -> OsPath -> IOError+ioeSetOsPath err =+ ioeSetFileName err .+ rightOrError .+ decodeWith+ (mkUTF8 TransliterateCodingFailure)+ (mkUTF16le TransliterateCodingFailure)+ -- | Given a list of path segments, expand @.@ and @..@. The path segments -- must not contain path separators.-expandDots :: [FilePath] -> [FilePath]+expandDots :: [OsPath] -> [OsPath] expandDots = reverse . go [] where go ys' xs' = case xs' of [] -> ys'- x : xs ->- case x of- "." -> go ys' xs- ".." ->+ x : xs+ | x == os "." -> go ys' xs+ | x == os ".." -> case ys' of [] -> go (x : ys') xs- ".." : _ -> go (x : ys') xs- _ : ys -> go ys xs- _ -> go (x : ys') xs+ y : ys+ | y == os ".." -> go (x : ys') xs+ | otherwise -> go ys xs+ | otherwise -> go (x : ys') xs -- | Convert to the right kind of slashes.-normalisePathSeps :: FilePath -> FilePath-normalisePathSeps p = (\ c -> if isPathSeparator c then pathSeparator else c) <$> p+normalisePathSeps :: OsPath -> OsPath+normalisePathSeps p = pack (normaliseChar <$> unpack p)+ where normaliseChar c = if isPathSeparator c then pathSeparator else c -- | Remove redundant trailing slashes and pick the right kind of slash.-normaliseTrailingSep :: FilePath -> FilePath+normaliseTrailingSep :: OsPath -> OsPath normaliseTrailingSep path = do- let path' = reverse path+ let path' = reverse (unpack path) let (sep, path'') = span isPathSeparator path' let addSep = if null sep then id else (pathSeparator :)- reverse (addSep path'')+ pack (reverse (addSep path'')) -- | Convert empty paths to the current directory, otherwise leave it -- unchanged.-emptyToCurDir :: FilePath -> FilePath-emptyToCurDir "" = "."-emptyToCurDir path = path+emptyToCurDir :: OsPath -> OsPath+emptyToCurDir path+ | path == mempty = os "."+ | otherwise = path -- | Similar to 'normalise' but empty paths stay empty.-simplifyPosix :: FilePath -> FilePath-simplifyPosix "" = ""-simplifyPosix path = normalise path+simplifyPosix :: OsPath -> OsPath+simplifyPosix path+ | path == mempty = mempty+ | otherwise = normalise path -- | Similar to 'normalise' but: --@@ -143,12 +177,11 @@ -- * paths starting with @\\\\?\\@ are preserved. -- -- The goal is to preserve the meaning of paths better than 'normalise'.-simplifyWindows :: FilePath -> FilePath-simplifyWindows "" = ""-simplifyWindows path =- case drive' of- "\\\\?\\" -> drive' <> subpath- _ -> simplifiedPath+simplifyWindows :: OsPath -> OsPath+simplifyWindows path+ | path == mempty = mempty+ | drive' == os "\\\\?\\" = drive' <> subpath+ | otherwise = simplifiedPath where simplifiedPath = joinDrive drive' subpath' (drive, subpath) = splitDrive path@@ -157,24 +190,29 @@ stripPardirs . expandDots . skipSeps . splitDirectories $ subpath - upperDrive d = case d of- c : ':' : s | isAlpha c && all isPathSeparator s -> toUpper c : ':' : s+ upperDrive d = case unpack d of+ c : k : s+ | isAlpha (toChar c), toChar k == ':', all isPathSeparator s ->+ -- unsafeFromChar is safe here since all characters are ASCII.+ pack (unsafeFromChar (toUpper (toChar c)) : unsafeFromChar ':' : s) _ -> d- skipSeps = filter (not . (`elem` (pure <$> pathSeparators)))- stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== "..")+ skipSeps =+ (pack <$>) .+ filter (not . (`elem` (pure <$> pathSeparators))) .+ (unpack <$>)+ stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== os "..") | otherwise = id- prependSep | subpathIsAbsolute = (pathSeparator :)+ prependSep | subpathIsAbsolute = (pack [pathSeparator] <>) | otherwise = id avoidEmpty | not pathIsAbsolute- && (null drive || hasTrailingPathSep) -- prefer "C:" over "C:."+ , drive == mempty || hasTrailingPathSep -- prefer "C:" over "C:." = emptyToCurDir | otherwise = id- appendSep p | hasTrailingPathSep- && not (pathIsAbsolute && null p)+ appendSep p | hasTrailingPathSep, not (pathIsAbsolute && p == mempty) = addTrailingPathSeparator p | otherwise = p pathIsAbsolute = not (isRelative path)- subpathIsAbsolute = any isPathSeparator (take 1 subpath)+ subpathIsAbsolute = any isPathSeparator (take 1 (unpack subpath)) hasTrailingPathSep = hasTrailingPathSeparator subpath data FileType = File@@ -205,26 +243,13 @@ , searchable :: Bool } deriving (Eq, Ord, Read, Show) --- | Truncate the destination file and then copy the contents of the source--- file to the destination file. If the destination file already exists, its--- attributes shall remain unchanged. Otherwise, its attributes are reset to--- the defaults.-copyFileContents :: FilePath -- ^ Source filename- -> FilePath -- ^ Destination filename- -> IO ()-copyFileContents fromFPath toFPath =- (`ioeAddLocation` "copyFileContents") `modifyIOError` do- withBinaryFile toFPath WriteMode $ \ hTo ->- copyFileToHandle fromFPath hTo---- | Copy all data from a file to a handle.-copyFileToHandle :: FilePath -- ^ Source file- -> Handle -- ^ Destination handle- -> IO ()-copyFileToHandle fromFPath hTo =- (`ioeAddLocation` "copyFileToHandle") `modifyIOError` do- withBinaryFile fromFPath ReadMode $ \ hFrom ->- copyHandleData hFrom hTo+withBinaryHandle :: IO Handle -> (Handle -> IO r) -> IO r+withBinaryHandle open = bracket openBinary hClose+ where+ openBinary = do+ h <- open+ hSetBinaryMode h True+ pure h -- | Copy data from one handle to another until end of file. copyHandleData :: Handle -- ^ Source handle
System/Directory/Internal/Config.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE CPP #-} module System.Directory.Internal.Config where #include <HsDirectoryConfig.h>+import System.Directory.Internal.Common -exeExtension :: String-exeExtension = EXE_EXTENSION+exeExtension :: OsString+exeExtension = os EXE_EXTENSION -- We avoid using #const_str from hsc because it breaks cross-compilation -- builds, so we use this ugly workaround where we simply paste the C string -- literal directly in here. This will probably break if the EXE_EXTENSION
System/Directory/Internal/Posix.hsc view
@@ -13,24 +13,34 @@ import System.Directory.Internal.Config (exeExtension) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime)-import System.FilePath ((</>), isRelative, splitSearchPath)+import System.OsPath ((</>), encodeFS, isRelative, splitSearchPath)+import System.OsString.Internal.Types (OsString(OsString, getOsString)) import qualified Data.Time.Clock.POSIX as POSIXTime-import qualified GHC.Foreign as GHC-import qualified System.Posix as Posix-import qualified System.Posix.User as PU+import qualified System.Posix.Directory.PosixPath as Posix+import qualified System.Posix.Env.PosixString as Posix+import qualified System.Posix.Files.PosixString as Posix+import qualified System.Posix.IO.PosixString as Posix+import qualified System.Posix.PosixPath.FilePath as Posix+import qualified System.Posix.Types as Posix+import qualified System.Posix.User as Posix -createDirectoryInternal :: FilePath -> IO ()-createDirectoryInternal path = Posix.createDirectory path 0o777+createDirectoryInternal :: OsPath -> IO ()+createDirectoryInternal (OsString path) = Posix.createDirectory path 0o777 -removePathInternal :: Bool -> FilePath -> IO ()-removePathInternal True = Posix.removeDirectory-removePathInternal False = Posix.removeLink+removePathInternal :: Bool -> OsPath -> IO ()+removePathInternal True = Posix.removeDirectory . getOsString+removePathInternal False = Posix.removeLink . getOsString -renamePathInternal :: FilePath -> FilePath -> IO ()-renamePathInternal = Posix.rename+renamePathInternal :: OsPath -> OsPath -> IO ()+renamePathInternal (OsString p1) (OsString p2) = Posix.rename p1 p2 +-- On POSIX, the removability of a file is only affected by the attributes of+-- the containing directory.+filesAlwaysRemovable :: Bool+filesAlwaysRemovable = True+ -- | On POSIX, equivalent to 'simplifyPosix'.-simplify :: FilePath -> FilePath+simplify :: OsPath -> OsPath simplify = simplifyPosix -- we use the 'free' from the standard library here since it's not entirely@@ -71,31 +81,31 @@ allocaBytes (pathMax + 1) (realpath >=> action) where realpath = throwErrnoIfNull "" . c_realpath path -canonicalizePathWith :: ((FilePath -> IO FilePath) -> FilePath -> IO FilePath)- -> FilePath- -> IO FilePath+canonicalizePathWith :: ((OsPath -> IO OsPath) -> OsPath -> IO OsPath)+ -> OsPath+ -> IO OsPath canonicalizePathWith attemptRealpath path = do- encoding <- getFileSystemEncoding- let realpath path' =- GHC.withCString encoding path' (`withRealpath` GHC.peekCString encoding)+ let realpath (OsString path') =+ Posix.withFilePath path'+ (`withRealpath` ((OsString <$>) . Posix.peekFilePath)) attemptRealpath realpath path -canonicalizePathSimplify :: FilePath -> IO FilePath+canonicalizePathSimplify :: OsPath -> IO OsPath canonicalizePathSimplify = pure -findExecutablesLazyInternal :: ([FilePath] -> String -> ListT IO FilePath)- -> String- -> ListT IO FilePath+findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)+ -> OsString+ -> ListT IO OsPath findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary = liftJoinListT $ do path <- getPath pure (findExecutablesInDirectoriesLazy path binary) -exeExtensionInternal :: String+exeExtensionInternal :: OsString exeExtensionInternal = exeExtension -getDirectoryContentsInternal :: FilePath -> IO [FilePath]-getDirectoryContentsInternal path =+getDirectoryContentsInternal :: OsPath -> IO [OsPath]+getDirectoryContentsInternal (OsString path) = bracket (Posix.openDirStream path) Posix.closeDirStream@@ -105,12 +115,12 @@ where loop acc = do e <- Posix.readDirStream dirp- if null e+ if e == mempty then pure (acc [])- else loop (acc . (e:))+ else loop (acc . (OsString e :)) -getCurrentDirectoryInternal :: IO FilePath-getCurrentDirectoryInternal = Posix.getWorkingDirectory+getCurrentDirectoryInternal :: IO OsPath+getCurrentDirectoryInternal = OsString <$> Posix.getWorkingDirectory -- | Convert a path into an absolute path. If the given path is relative, the -- current directory is prepended and the path may or may not be simplified.@@ -121,33 +131,37 @@ -- operation may throw exceptions. -- -- Empty paths are treated as the current directory.-prependCurrentDirectory :: FilePath -> IO FilePath+prependCurrentDirectory :: OsPath -> IO OsPath prependCurrentDirectory path | isRelative path = ((`ioeAddLocation` "prependCurrentDirectory") .- (`ioeSetFileName` path)) `modifyIOError` do+ (`ioeSetOsPath` path)) `modifyIOError` do (</> path) <$> getCurrentDirectoryInternal | otherwise = pure path -setCurrentDirectoryInternal :: FilePath -> IO ()-setCurrentDirectoryInternal = Posix.changeWorkingDirectory+setCurrentDirectoryInternal :: OsPath -> IO ()+setCurrentDirectoryInternal = Posix.changeWorkingDirectory . getOsString linkToDirectoryIsDirectory :: Bool linkToDirectoryIsDirectory = False -createSymbolicLink :: Bool -> FilePath -> FilePath -> IO ()-createSymbolicLink _ = Posix.createSymbolicLink+createHardLink :: OsPath -> OsPath -> IO ()+createHardLink (OsString p1) (OsString p2) = Posix.createLink p1 p2 -readSymbolicLink :: FilePath -> IO FilePath-readSymbolicLink = Posix.readSymbolicLink+createSymbolicLink :: Bool -> OsPath -> OsPath -> IO ()+createSymbolicLink _ (OsString p1) (OsString p2) =+ Posix.createSymbolicLink p1 p2 +readSymbolicLink :: OsPath -> IO OsPath+readSymbolicLink = (OsString <$>) . Posix.readSymbolicLink . getOsString+ type Metadata = Posix.FileStatus -getSymbolicLinkMetadata :: FilePath -> IO Metadata-getSymbolicLinkMetadata = Posix.getSymbolicLinkStatus+getSymbolicLinkMetadata :: OsPath -> IO Metadata+getSymbolicLinkMetadata = Posix.getSymbolicLinkStatus . getOsString -getFileMetadata :: FilePath -> IO Metadata-getFileMetadata = Posix.getFileStatus+getFileMetadata :: OsPath -> IO Metadata+getFileMetadata = Posix.getFileStatus . getOsString fileTypeFromMetadata :: Metadata -> FileType fileTypeFromMetadata stat@@ -163,21 +177,11 @@ accessTimeFromMetadata :: Metadata -> UTCTime accessTimeFromMetadata =- POSIXTime.posixSecondsToUTCTime . posix_accessTimeHiRes+ POSIXTime.posixSecondsToUTCTime . Posix.accessTimeHiRes modificationTimeFromMetadata :: Metadata -> UTCTime modificationTimeFromMetadata =- POSIXTime.posixSecondsToUTCTime . posix_modificationTimeHiRes--posix_accessTimeHiRes, posix_modificationTimeHiRes- :: Posix.FileStatus -> POSIXTime-#if MIN_VERSION_unix(2, 6, 0)-posix_accessTimeHiRes = Posix.accessTimeHiRes-posix_modificationTimeHiRes = Posix.modificationTimeHiRes-#else-posix_accessTimeHiRes = realToFrac . Posix.accessTime-posix_modificationTimeHiRes = realToFrac . Posix.modificationTime-#endif+ POSIXTime.posixSecondsToUTCTime . Posix.modificationTimeHiRes type Mode = Posix.FileMode @@ -197,19 +201,20 @@ setWriteMode False m = m .&. complement allWriteMode setWriteMode True m = m .|. allWriteMode -setFileMode :: FilePath -> Mode -> IO ()-setFileMode = Posix.setFileMode+setFileMode :: OsPath -> Mode -> IO ()+setFileMode = Posix.setFileMode . getOsString -setFilePermissions :: FilePath -> Mode -> IO ()+setFilePermissions :: OsPath -> Mode -> IO () setFilePermissions = setFileMode -getAccessPermissions :: FilePath -> IO Permissions+getAccessPermissions :: OsPath -> IO Permissions getAccessPermissions path = do m <- getFileMetadata path let isDir = fileTypeIsDirectory (fileTypeFromMetadata m)- r <- Posix.fileAccess path True False False- w <- Posix.fileAccess path False True False- x <- Posix.fileAccess path False False True+ let OsString path' = path+ r <- Posix.fileAccess path' True False False+ w <- Posix.fileAccess path' False True False+ x <- Posix.fileAccess path' False False True pure Permissions { readable = r , writable = w@@ -217,7 +222,7 @@ , searchable = x && isDir } -setAccessPermissions :: FilePath -> Permissions -> IO ()+setAccessPermissions :: OsPath -> Permissions -> IO () setAccessPermissions path (Permissions r w e s) = do m <- getFileMetadata path setFileMode path (modifyBit (e || s) Posix.ownerExecuteMode .@@ -229,98 +234,141 @@ modifyBit False b m = m .&. complement b modifyBit True b m = m .|. b -copyOwnerFromStatus :: Posix.FileStatus -> FilePath -> IO ()-copyOwnerFromStatus st dst = do+copyOwnerFromStatus :: Posix.FileStatus -> OsPath -> IO ()+copyOwnerFromStatus st (OsString dst) = do Posix.setOwnerAndGroup dst (Posix.fileOwner st) (-1) -copyGroupFromStatus :: Posix.FileStatus -> FilePath -> IO ()-copyGroupFromStatus st dst = do+copyGroupFromStatus :: Posix.FileStatus -> OsPath -> IO ()+copyGroupFromStatus st (OsString dst) = do Posix.setOwnerAndGroup dst (-1) (Posix.fileGroup st) -tryCopyOwnerAndGroupFromStatus :: Posix.FileStatus -> FilePath -> IO ()+tryCopyOwnerAndGroupFromStatus :: Posix.FileStatus -> OsPath -> IO () tryCopyOwnerAndGroupFromStatus st dst = do ignoreIOExceptions (copyOwnerFromStatus st dst) ignoreIOExceptions (copyGroupFromStatus st dst) -copyFileWithMetadataInternal :: (Metadata -> FilePath -> IO ())- -> (Metadata -> FilePath -> IO ())- -> FilePath- -> FilePath+defaultFlags :: Posix.OpenFileFlags+defaultFlags =+ Posix.defaultFileFlags+ { Posix.noctty = True+ , Posix.nonBlock = True+ , Posix.cloexec = True+ }++openFileForRead :: OsPath -> IO Handle+openFileForRead (OsString p) =+ Posix.fdToHandle =<< Posix.openFd p Posix.ReadOnly defaultFlags++openFileForWrite :: OsPath -> IO Handle+openFileForWrite (OsString p) =+ Posix.fdToHandle =<<+ Posix.openFd p Posix.WriteOnly+ defaultFlags { Posix.creat = Just 0o666, Posix.trunc = True }++-- | Truncate the destination file and then copy the contents of the source+-- file to the destination file. If the destination file already exists, its+-- attributes shall remain unchanged. Otherwise, its attributes are reset to+-- the defaults.+copyFileContents :: OsPath -- ^ Source filename+ -> OsPath -- ^ Destination filename+ -> IO ()+copyFileContents fromFPath toFPath =+ (`ioeAddLocation` "copyFileContents") `modifyIOError` do+ withBinaryHandle (openFileForWrite toFPath) $ \ hTo -> do+ withBinaryHandle (openFileForRead fromFPath) $ \ hFrom -> do+ copyHandleData hFrom hTo++copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ())+ -> (Metadata -> OsPath -> IO ())+ -> OsPath+ -> OsPath -> IO () copyFileWithMetadataInternal copyPermissionsFromMetadata copyTimesFromMetadata src dst = do- st <- Posix.getFileStatus src+ st <- Posix.getFileStatus (getOsString src) copyFileContents src dst tryCopyOwnerAndGroupFromStatus st dst copyPermissionsFromMetadata st dst copyTimesFromMetadata st dst -setTimes :: FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()+setTimes :: OsPath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO () #ifdef HAVE_UTIMENSAT-setTimes path' (atime', mtime') =- withFilePath path' $ \ path'' ->+setTimes (OsString path') (atime', mtime') =+ Posix.withFilePath path' $ \ path'' -> withArray [ maybe utimeOmit toCTimeSpec atime' , maybe utimeOmit toCTimeSpec mtime' ] $ \ times ->- throwErrnoPathIfMinus1_ "" path' $+ Posix.throwErrnoPathIfMinus1_ "" path' $ c_utimensat c_AT_FDCWD path'' times 0 #else-setTimes path' (Just atime', Just mtime') = setFileTimes' path' atime' mtime'-setTimes path' (atime', mtime') = do- m <- getFileMetadata path'+setTimes (OsString path') (Just atime', Just mtime') =+ Posix.setFileTimesHiRes path' atime' mtime'+setTimes (OsString path') (atime', mtime') = do+ m <- getFileMetadata (OsString path') let atimeOld = accessTimeFromMetadata m let mtimeOld = modificationTimeFromMetadata m- setFileTimes' path'+ Posix.setFileTimesHiRes path' (fromMaybe (POSIXTime.utcTimeToPOSIXSeconds atimeOld) atime') (fromMaybe (POSIXTime.utcTimeToPOSIXSeconds mtimeOld) mtime')--setFileTimes' :: FilePath -> POSIXTime -> POSIXTime -> IO ()-# if MIN_VERSION_unix(2, 7, 0)-setFileTimes' = Posix.setFileTimesHiRes-# else-setFileTimes' pth atime' mtime' =- Posix.setFileTimes pth- (fromInteger (truncate atime'))- (fromInteger (truncate mtime'))-# endif #endif +lookupEnvOs :: OsString -> IO (Maybe OsString)+lookupEnvOs (OsString name) = (OsString <$>) <$> Posix.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 [FilePath]-getPath = splitSearchPath <$> getEnv "PATH"+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 FilePath+getHomeDirectoryInternal :: IO OsPath getHomeDirectoryInternal = do- e <- lookupEnv "HOME"+ e <- lookupEnvOs (os "HOME") case e of Just fp -> pure fp- Nothing -> PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID)+ -- TODO: os here is bad, but unix's System.Posix.User.UserEntry does not+ -- have ByteString/OsString variants+ Nothing ->+ encodeFS =<<+ Posix.homeDirectory <$>+ (Posix.getEffectiveUserID >>= Posix.getUserEntryForID) -getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath+getXdgDirectoryFallback :: IO OsPath -> XdgDirectory -> IO OsPath getXdgDirectoryFallback getHomeDirectory xdgDir = do (<$> getHomeDirectory) $ flip (</>) $ case xdgDir of- XdgData -> ".local/share"- XdgConfig -> ".config"- XdgCache -> ".cache"- XdgState -> ".local/state"+ XdgData -> os ".local/share"+ XdgConfig -> os ".config"+ XdgCache -> os ".cache"+ XdgState -> os ".local/state" -getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath]+getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsPath] getXdgDirectoryListFallback xdgDirs = pure $ case xdgDirs of- XdgDataDirs -> ["/usr/local/share/", "/usr/share/"]- XdgConfigDirs -> ["/etc/xdg"]+ XdgDataDirs -> [os "/usr/local/share/", os "/usr/share/"]+ XdgConfigDirs -> [os "/etc/xdg"] -getAppUserDataDirectoryInternal :: FilePath -> IO FilePath+getAppUserDataDirectoryInternal :: OsPath -> IO OsPath getAppUserDataDirectoryInternal appName =- (\ home -> home <> ('/' : '.' : appName)) <$> getHomeDirectoryInternal+ (\ home -> home <> (os "/" <> os "." <> appName)) <$> getHomeDirectoryInternal -getUserDocumentsDirectoryInternal :: IO FilePath+getUserDocumentsDirectoryInternal :: IO OsPath getUserDocumentsDirectoryInternal = getHomeDirectoryInternal -getTemporaryDirectoryInternal :: IO FilePath-getTemporaryDirectoryInternal = fromMaybe "/tmp" <$> lookupEnv "TMPDIR"+getTemporaryDirectoryInternal :: IO OsPath+getTemporaryDirectoryInternal = fromMaybe (os "/tmp") <$> lookupEnvOs (os "TMPDIR") #endif
System/Directory/Internal/Prelude.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Stability: unstable@@ -8,14 +7,6 @@ module System.Directory.Internal.Prelude ( module Prelude-#if !MIN_VERSION_base(4, 6, 0)- , forkFinally- , lookupEnv-#endif-#if !MIN_VERSION_base(4, 8, 0)- , module Control.Applicative- , module Data.Functor-#endif , module Control.Arrow , module Control.Concurrent , module Control.Exception@@ -36,22 +27,11 @@ , module System.Exit , module System.IO , module System.IO.Error- , module System.Posix.Internals , module System.Posix.Types , module System.Timeout , Void ) where-#if MIN_VERSION_base(4, 6, 0)-import System.Environment (lookupEnv)-#else-import Prelude hiding (catch)-#endif-#if MIN_VERSION_base(4, 8, 0) import Data.Void (Void)-#else-import Control.Applicative (Applicative, (<*>), (*>), pure)-import Data.Functor ((<$>), (<$))-#endif import Control.Arrow (second) import Control.Concurrent ( forkIO@@ -60,16 +40,14 @@ , putMVar , readMVar , takeMVar-#if MIN_VERSION_base(4, 6, 0) , forkFinally-#else- , ThreadId-#endif ) import Control.Exception- ( SomeException+ ( Exception(displayException)+ , SomeException , bracket , bracket_+ , bracketOnError , catch , finally , mask@@ -80,7 +58,7 @@ import Control.Monad ((>=>), (<=<), unless, when, replicateM, replicateM_) import Data.Bits ((.&.), (.|.), complement) import Data.Char (isAlpha, isAscii, toLower, toUpper)-import Data.Foldable (for_, traverse_)+import Data.Foldable (for_) import Data.Function (on) import Data.Maybe (catMaybes, fromMaybe, maybeToList) import Data.Monoid ((<>), mconcat, mempty)@@ -118,14 +96,9 @@ , CUShort(..) , CWString , CWchar(..)- , peekCString- , peekCWStringLen , throwErrnoIfMinus1Retry_ , throwErrnoIfMinus1_ , throwErrnoIfNull- , throwErrnoPathIfMinus1_- , withCString- , withCWString ) import GHC.IO.Exception ( IOErrorType@@ -136,7 +109,7 @@ ) ) import GHC.IO.Encoding (getFileSystemEncoding)-import System.Environment (getArgs, getEnv)+import System.Environment (getArgs) import System.Exit (exitFailure) import System.IO ( Handle@@ -150,11 +123,11 @@ , openBinaryTempFile , stderr , stdout- , withBinaryFile ) import System.IO.Error ( IOError , catchIOError+ , doesNotExistErrorType , illegalOperationErrorType , ioeGetErrorString , ioeGetErrorType@@ -172,28 +145,5 @@ , tryIOError , userError )-import System.Posix.Internals (withFilePath) import System.Posix.Types (EpochTime) import System.Timeout (timeout)--#if !MIN_VERSION_base(4, 6, 0)-lookupEnv :: String -> IO (Maybe String)-lookupEnv name = do- env <- tryIOError (getEnv name)- case env of- Left err | isDoesNotExistError err -> pure Nothing- | otherwise -> throwIO err- Right value -> pure (Just value)--forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId-forkFinally action and_then =- mask $ \restore ->- forkIO $ try (restore action) >>= and_then-#endif--#if !MIN_VERSION_base(4, 8, 0)-data Void = Void--_unusedVoid :: Void-_unusedVoid = Void-#endif
System/Directory/Internal/Windows.hsc view
@@ -11,6 +11,7 @@ ##endif #include <shlobj.h> #include <windows.h>+#include <HsBaseConfig.h> #include <System/Directory/Internal/utility.h> #include <System/Directory/Internal/windows_ext.h> import Prelude ()@@ -19,61 +20,70 @@ import System.Directory.Internal.Config (exeExtension) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime)-import System.FilePath+#ifdef __IO_MANAGER_WINIO__+import GHC.IO.SubSystem (IoSubSystem(IoPOSIX, IoNative), ioSubSystem)+#endif+import System.OsPath ( (</>) , isPathSeparator , isRelative+ , pack , pathSeparator , splitDirectories , takeExtension+ , toChar+ , unpack )+import System.OsPath.Types (WindowsPath, WindowsString)+import System.OsString.Internal.Types (OsString(OsString, getOsString)) import qualified Data.List as List-import qualified System.Win32 as Win32+import qualified System.Win32.WindowsString.File as Win32+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 -createDirectoryInternal :: FilePath -> IO ()+createDirectoryInternal :: OsPath -> IO () createDirectoryInternal path =- (`ioeSetFileName` path) `modifyIOError` do+ (`ioeSetOsPath` path) `modifyIOError` do path' <- furnishPath path Win32.createDirectory path' Nothing -removePathInternal :: Bool -> FilePath -> IO ()+removePathInternal :: Bool -> OsPath -> IO () removePathInternal isDir path =- (`ioeSetFileName` path) `modifyIOError` do+ (`ioeSetOsPath` path) `modifyIOError` do furnishPath path >>= if isDir then Win32.removeDirectory else Win32.deleteFile -renamePathInternal :: FilePath -> FilePath -> IO ()+renamePathInternal :: OsPath -> OsPath -> IO () renamePathInternal opath npath =- (`ioeSetFileName` opath) `modifyIOError` do+ (`ioeSetOsPath` opath) `modifyIOError` do opath' <- furnishPath opath npath' <- furnishPath npath-#if MIN_VERSION_Win32(2, 6, 0) Win32.moveFileEx opath' (Just npath') Win32.mOVEFILE_REPLACE_EXISTING-#else- Win32.moveFileEx opath' npath' Win32.mOVEFILE_REPLACE_EXISTING-#endif -copyFileWithMetadataInternal :: (Metadata -> FilePath -> IO ())- -> (Metadata -> FilePath -> IO ())- -> FilePath- -> FilePath+-- On Windows, the removability of a file may be affected by the attributes of+-- the file itself.+filesAlwaysRemovable :: Bool+filesAlwaysRemovable = False++copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ())+ -> (Metadata -> OsPath -> IO ())+ -> OsPath+ -> OsPath -> IO () copyFileWithMetadataInternal _ _ src dst =- (`ioeSetFileName` src) `modifyIOError` do+ (`ioeSetOsPath` src) `modifyIOError` do src' <- furnishPath src dst' <- furnishPath dst Win32.copyFile src' dst' False -win32_cSIDL_LOCAL_APPDATA :: Win32.CSIDL-#if MIN_VERSION_Win32(2, 3, 1)-win32_cSIDL_LOCAL_APPDATA = Win32.cSIDL_LOCAL_APPDATA-#else-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_ENVVAR_NOT_FOUND :: Win32.ErrCode+win32_eRROR_ENVVAR_NOT_FOUND = (#const ERROR_ENVVAR_NOT_FOUND)+ win32_eRROR_INVALID_FUNCTION :: Win32.ErrCode win32_eRROR_INVALID_FUNCTION = (#const ERROR_INVALID_FUNCTION) @@ -89,64 +99,42 @@ win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE :: Win32.DWORD win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE = 0x2 -win32_fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag-#if MIN_VERSION_Win32(2, 4, 0)-win32_fILE_ATTRIBUTE_REPARSE_POINT = Win32.fILE_ATTRIBUTE_REPARSE_POINT-#else-win32_fILE_ATTRIBUTE_REPARSE_POINT = (#const FILE_ATTRIBUTE_REPARSE_POINT)-#endif--win32_fILE_SHARE_DELETE :: Win32.ShareMode-#if MIN_VERSION_Win32(2, 3, 1)-win32_fILE_SHARE_DELETE = Win32.fILE_SHARE_DELETE -- added in 2.3.0.2-#else-win32_fILE_SHARE_DELETE = (#const FILE_SHARE_DELETE)-#endif- maxShareMode :: Win32.ShareMode maxShareMode =- win32_fILE_SHARE_DELETE .|.+ Win32.fILE_SHARE_DELETE .|. Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE -win32_getLongPathName, win32_getShortPathName :: FilePath -> IO FilePath-#if MIN_VERSION_Win32(2, 4, 0)-win32_getLongPathName = Win32.getLongPathName-win32_getShortPathName = Win32.getShortPathName-#else-win32_getLongPathName path =- ((`ioeSetLocation` "GetLongPathName") .- (`ioeSetFileName` path)) `modifyIOError` do- withCWString path $ \ ptrPath -> do- getPathNameWith (c_GetLongPathName ptrPath)--win32_getShortPathName path =- ((`ioeSetLocation` "GetShortPathName") .- (`ioeSetFileName` path)) `modifyIOError` do- withCWString path $ \ ptrPath -> do- getPathNameWith (c_GetShortPathName ptrPath)--foreign import WINAPI unsafe "windows.h GetLongPathNameW"- c_GetLongPathName- :: Ptr CWchar- -> Ptr CWchar- -> Win32.DWORD- -> IO Win32.DWORD+openFileForRead :: OsPath -> IO Handle+openFileForRead (OsString path) =+ bracketOnError+ (Win32.createFile+ path+ Win32.gENERIC_READ+ maxShareMode+ Nothing+ Win32.oPEN_ALWAYS+ (Win32.fILE_ATTRIBUTE_NORMAL .|. possiblyOverlapped)+ Nothing)+ Win32.closeHandle+ Win32.hANDLEToHandle -foreign import WINAPI unsafe "windows.h GetShortPathNameW"- c_GetShortPathName- :: Ptr CWchar- -> Ptr CWchar- -> Win32.DWORD- -> IO Win32.DWORD+possiblyOverlapped :: Win32.FileAttributeOrFlag+#ifdef __IO_MANAGER_WINIO__+possiblyOverlapped | ioSubSystem == IoNative = Win32.fILE_FLAG_OVERLAPPED+ | otherwise = 0+#else+possiblyOverlapped = 0 #endif -win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO FilePath-win32_getFinalPathNameByHandle _h _flags =- (`ioeSetLocation` "GetFinalPathNameByHandle") `modifyIOError` do+win32_getFinalPathNameByHandle :: Win32.HANDLE -> Win32.DWORD -> IO WindowsPath #ifdef HAVE_GETFINALPATHNAMEBYHANDLEW- getPathNameWith $ \ ptr len -> do- c_GetFinalPathNameByHandle _h ptr len _flags+win32_getFinalPathNameByHandle h flags = do+ result <- peekTStringWith (#const MAX_PATH) $ \ ptr len -> do+ c_GetFinalPathNameByHandle h ptr len flags+ case result of+ Left errCode -> Win32.failWith "GetFinalPathNameByHandle" errCode+ Right path -> pure path foreign import WINAPI unsafe "windows.h GetFinalPathNameByHandleW" c_GetFinalPathNameByHandle@@ -157,14 +145,19 @@ -> IO Win32.DWORD #else- throwIO (mkIOError UnsupportedOperation- "platform does not support GetFinalPathNameByHandle"- Nothing Nothing)+win32_getFinalPathNameByHandle _ _ = throwIO $+ mkIOError+ UnsupportedOperation+ "platform does not support GetFinalPathNameByHandle"+ Nothing+ Nothing #endif -getFinalPathName :: FilePath -> IO FilePath+getFinalPathName :: OsPath -> IO OsPath getFinalPathName =- (fromExtendedLengthPath <$>) . rawGetFinalPathName . toExtendedLengthPath+ (fromExtendedLengthPath <$>) .+ rawGetFinalPathName .+ toExtendedLengthPath where #ifdef HAVE_GETFINALPATHNAMEBYHANDLEW rawGetFinalPathName path = do@@ -173,7 +166,7 @@ bracket open Win32.closeHandle $ \ h -> do win32_getFinalPathNameByHandle h 0 #else- rawGetFinalPathName = win32_getLongPathName <=< win32_getShortPathName+ rawGetFinalPathName = Win32.getLongPathName <=< Win32.getShortPathName #endif win32_fILE_FLAG_OPEN_REPARSE_POINT :: Win32.FileAttributeOrFlag@@ -194,9 +187,9 @@ win32_sYMLINK_FLAG_RELATIVE = 0x00000001 data Win32_REPARSE_DATA_BUFFER- = Win32_MOUNT_POINT_REPARSE_DATA_BUFFER String String+ = Win32_MOUNT_POINT_REPARSE_DATA_BUFFER WindowsString WindowsString -- ^ substituteName printName- | Win32_SYMLINK_REPARSE_DATA_BUFFER String String Bool+ | Win32_SYMLINK_REPARSE_DATA_BUFFER WindowsString WindowsString Bool -- ^ substituteName printName isRelative | Win32_GENERIC_REPARSE_DATA_BUFFER @@ -247,10 +240,10 @@ (flags .&. win32_sYMLINK_FLAG_RELATIVE /= 0)) | otherwise -> pure Win32_GENERIC_REPARSE_DATA_BUFFER where- peekName :: Ptr CWchar -> CUShort -> CUShort -> IO String+ peekName :: Ptr CWchar -> CUShort -> CUShort -> IO WindowsString peekName buf offset size =- peekCWStringLen ( buf `plusPtr` fromIntegral offset- , fromIntegral size `div` sizeOf (0 :: CWchar) )+ Win32.peekTStringLen ( buf `plusPtr` fromIntegral offset+ , fromIntegral size `div` sizeOf (0 :: CWchar) ) deviceIoControl :: Win32.HANDLE@@ -279,9 +272,9 @@ -> Ptr Void -> IO Win32.BOOL -readSymbolicLink :: FilePath -> IO FilePath+readSymbolicLink :: OsPath -> IO OsPath readSymbolicLink path =- (`ioeSetFileName` path) `modifyIOError` do+ (`ioeSetOsPath` path) `modifyIOError` do path' <- furnishPath path let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING (Win32.fILE_FLAG_BACKUP_SEMANTICS .|.@@ -300,41 +293,47 @@ | otherwise -> Win32.failWith "DeviceIoControl" e Right _ -> pure () rData <- win32_peek_REPARSE_DATA_BUFFER ptr- strip <$> case rData of+ strip . OsString <$> case rData of Win32_MOUNT_POINT_REPARSE_DATA_BUFFER sn _ -> pure sn Win32_SYMLINK_REPARSE_DATA_BUFFER sn _ _ -> pure sn _ -> throwIO (mkIOError InappropriateType "readSymbolicLink" Nothing Nothing) where- strip sn = fromMaybe sn (List.stripPrefix "\\??\\" sn)+ strip sn =+ fromMaybe sn+ (pack <$> List.stripPrefix (unpack (os "\\??\\")) (unpack sn)) -- | On Windows, equivalent to 'simplifyWindows'.-simplify :: FilePath -> FilePath+simplify :: OsPath -> OsPath simplify = simplifyWindows -- | Normalise the path separators and prepend the @"\\\\?\\"@ prefix if -- necessary or possible. This is used for symbolic links targets because -- they can't handle forward slashes.-normaliseSeparators :: FilePath -> FilePath+normaliseSeparators :: OsPath -> WindowsPath normaliseSeparators path- | isRelative path = normaliseSep <$> path+ | isRelative path = getOsString (pack (normaliseSep <$> unpack path)) | otherwise = toExtendedLengthPath path where normaliseSep c = if isPathSeparator c then pathSeparator else c -- | 'simplify' the path and prepend the @"\\\\?\\"@ if possible. This -- function can sometimes be used to bypass the @MAX_PATH@ length restriction -- in Windows API calls.-toExtendedLengthPath :: FilePath -> FilePath-toExtendedLengthPath path- | isRelative path = simplifiedPath- | otherwise =- case simplifiedPath of- '\\' : '?' : '?' : '\\' : _ -> simplifiedPath- '\\' : '\\' : '?' : '\\' : _ -> simplifiedPath- '\\' : '\\' : '.' : '\\' : _ -> simplifiedPath- '\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath- _ -> "\\\\?\\" <> simplifiedPath+toExtendedLengthPath :: OsPath -> WindowsPath+toExtendedLengthPath path =+ getOsString $+ if isRelative path+ then simplifiedPath+ else+ case toChar <$> simplifiedPath' of+ '\\' : '?' : '?' : '\\' : _ -> simplifiedPath+ '\\' : '\\' : '?' : '\\' : _ -> simplifiedPath+ '\\' : '\\' : '.' : '\\' : _ -> simplifiedPath+ '\\' : '\\' : _ ->+ os "\\\\?\\UNC" <> pack (tail simplifiedPath')+ _ -> os "\\\\?\\" <> simplifiedPath where simplifiedPath = simplify path+ simplifiedPath' = unpack simplifiedPath -- | Make a path absolute and convert to an extended length path, if possible. --@@ -342,79 +341,99 @@ -- -- This function never fails. If it doesn't understand the path, it just -- returns the path unchanged.-furnishPath :: FilePath -> IO FilePath+furnishPath :: OsPath -> IO WindowsPath furnishPath path = (toExtendedLengthPath <$> rawPrependCurrentDirectory path) `catchIOError` \ _ ->- pure path+ pure (getOsString path) -- | Strip the @"\\\\?\\"@ prefix if possible. -- The prefix is kept if the meaning of the path would otherwise change.-fromExtendedLengthPath :: FilePath -> FilePath-fromExtendedLengthPath ePath =- case ePath of- '\\' : '\\' : '?' : '\\' : path ->+fromExtendedLengthPath :: WindowsPath -> OsPath+fromExtendedLengthPath ePath' =+ case unpack ePath of+ c1 : c2 : c3 : c4 : path+ | (toChar <$> [c1, c2, c3, c4]) == "\\\\?\\" -> case path of- 'U' : 'N' : 'C' : subpath@('\\' : _) -> "\\" <> subpath- drive : ':' : subpath+ c5 : c6 : c7 : subpath@(c8 : _)+ | (toChar <$> [c5, c6, c7, c8]) == "UNC\\" -> pack subpath+ drive : col : subpath -- if the path is not "regular", then the prefix is necessary -- to ensure the path is interpreted literally- | isAlpha drive && isAscii drive && isPathRegular subpath -> path+ | toChar col == ':', isDriveChar drive, isPathRegular subpath ->+ pack path _ -> ePath _ -> ePath where+ ePath = OsString ePath'+ isDriveChar drive = isAlpha (toChar drive) && isAscii (toChar drive) isPathRegular path =- not ('/' `elem` path ||- "." `elem` splitDirectories path ||- ".." `elem` splitDirectories path)+ not ('/' `elem` (toChar <$> path) ||+ os "." `elem` splitDirectories (pack path) ||+ os ".." `elem` splitDirectories (pack path)) -getPathNameWith :: (Ptr CWchar -> Win32.DWORD -> IO Win32.DWORD) -> IO FilePath-getPathNameWith cFunc = do- let getPathNameWithLen len = do- allocaArray (fromIntegral len) $ \ ptrPathOut -> do- len' <- Win32.failIfZero "" (cFunc ptrPathOut len)- if len' <= len- then Right <$> peekCWStringLen (ptrPathOut, fromIntegral len')- else pure (Left len')- r <- getPathNameWithLen ((#const MAX_PATH) * (#size wchar_t))- case r of- Right s -> pure s- Left len -> do- r' <- getPathNameWithLen len- case r' of- Right s -> pure s- Left _ -> throwIO (mkIOError OtherError "" Nothing Nothing- `ioeSetErrorString` "path changed unexpectedly")+saturatingDouble :: Win32.DWORD -> Win32.DWORD+saturatingDouble s | s > maxBound `div` 2 = maxBound+ | otherwise = s * 2 -canonicalizePathWith :: ((FilePath -> IO FilePath) -> FilePath -> IO FilePath)- -> FilePath- -> IO FilePath+-- Handles Windows APIs that write strings through a user-provided buffer and+-- can propose a new length when it isn't big enough. This is similar to+-- Win32.try, but also returns the precise error code.+peekTStringWith :: Win32.DWORD+ -> (Win32.LPTSTR -> Win32.DWORD -> IO Win32.DWORD)+ -- ^ Must accept a buffer and its size in TCHARs. If the+ -- buffer is large enough for the function, it must write a+ -- string to it, which need not be null-terminated, and+ -- return the length of the string, not including the null+ -- terminator if present. If the buffer is too small, it+ -- must return a proposed buffer size in TCHARs, although it+ -- need not guarantee success with the proposed size if,+ -- say, the underlying data changes in the interim. If it+ -- fails for any other reason, it must return zero and+ -- communicate the error code through GetLastError.+ -> IO (Either Win32.ErrCode WindowsPath)+peekTStringWith bufferSize cFunc = do+ outcome <- do+ allocaArray (fromIntegral bufferSize) $ \ ptr -> do+ size <- cFunc ptr bufferSize+ case size of+ 0 -> Right . Left <$> Win32.getLastError+ _ | size <= bufferSize ->+ Right . Right <$> Win32.peekTStringLen (ptr, fromIntegral size)+ | otherwise ->+ -- At least double the size to ensure fast termination.+ pure (Left (max size (saturatingDouble bufferSize)))+ case outcome of+ Left proposedSize -> peekTStringWith proposedSize cFunc+ Right result -> pure result++canonicalizePathWith :: ((OsPath -> IO OsPath) -> OsPath -> IO OsPath)+ -> OsPath+ -> IO OsPath canonicalizePathWith attemptRealpath = attemptRealpath getFinalPathName -canonicalizePathSimplify :: FilePath -> IO FilePath+canonicalizePathSimplify :: OsPath -> IO OsPath canonicalizePathSimplify path = getFullPathName path `catchIOError` \ _ -> pure path -searchPathEnvForExes :: String -> IO (Maybe FilePath)-searchPathEnvForExes binary = Win32.searchPath Nothing binary $-#if MIN_VERSION_Win32(2, 6, 0)- Just-#endif- exeExtension+searchPathEnvForExes :: OsString -> IO (Maybe OsPath)+searchPathEnvForExes (OsString binary) =+ (OsString <$>) <$>+ Win32.searchPath Nothing binary (Just (getOsString exeExtension)) -findExecutablesLazyInternal :: ([FilePath] -> String -> ListT IO FilePath)- -> String- -> ListT IO FilePath+findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)+ -> OsString+ -> ListT IO OsPath findExecutablesLazyInternal _ = maybeToListT . searchPathEnvForExes -exeExtensionInternal :: String+exeExtensionInternal :: OsString exeExtensionInternal = exeExtension -getDirectoryContentsInternal :: FilePath -> IO [FilePath]+getDirectoryContentsInternal :: OsPath -> IO [OsPath] getDirectoryContentsInternal path = do- query <- furnishPath (path </> "*")+ query <- furnishPath (path </> os "*") bracket (Win32.findFirstFile query) (\ (h, _) -> Win32.findClose h)@@ -422,28 +441,28 @@ where -- we needn't worry about empty directories: a directory always -- has at least "." and ".." entries- loop :: Win32.HANDLE -> Win32.FindData -> [FilePath] -> IO [FilePath]+ loop :: Win32.HANDLE -> Win32.FindData -> [OsPath] -> IO [OsPath] loop h fdat acc = do filename <- Win32.getFindDataFileName fdat more <- Win32.findNextFile h fdat if more- then loop h fdat (filename : acc)- else pure (filename : acc)+ then loop h fdat (OsString filename : acc)+ else pure (OsString filename : acc) -- no need to reverse, ordering is undefined -getCurrentDirectoryInternal :: IO FilePath-getCurrentDirectoryInternal = Win32.getCurrentDirectory+getCurrentDirectoryInternal :: IO OsPath+getCurrentDirectoryInternal = OsString <$> Win32.getCurrentDirectory -getFullPathName :: FilePath -> IO FilePath+getFullPathName :: OsPath -> IO OsPath getFullPathName path = fromExtendedLengthPath <$> Win32.getFullPathName (toExtendedLengthPath path) -- | Similar to 'prependCurrentDirectory' but fails for empty paths.-rawPrependCurrentDirectory :: FilePath -> IO FilePath+rawPrependCurrentDirectory :: OsPath -> IO OsPath rawPrependCurrentDirectory path | isRelative path = ((`ioeAddLocation` "prependCurrentDirectory") .- (`ioeSetFileName` path)) `modifyIOError` do+ (`ioeSetOsPath` path)) `modifyIOError` do getFullPathName path | otherwise = pure path @@ -456,19 +475,19 @@ -- operation may throw exceptions. -- -- Empty paths are treated as the current directory.-prependCurrentDirectory :: FilePath -> IO FilePath+prependCurrentDirectory :: OsPath -> IO OsPath prependCurrentDirectory = rawPrependCurrentDirectory . emptyToCurDir -- SetCurrentDirectory does not support long paths even with the \\?\ prefix -- https://ghc.haskell.org/trac/ghc/ticket/13373#comment:6-setCurrentDirectoryInternal :: FilePath -> IO ()-setCurrentDirectoryInternal = Win32.setCurrentDirectory+setCurrentDirectoryInternal :: OsPath -> IO ()+setCurrentDirectoryInternal = Win32.setCurrentDirectory . getOsString -createSymbolicLinkUnpriv :: String -> String -> Bool -> IO ()+createSymbolicLinkUnpriv :: WindowsPath -> WindowsPath -> Bool -> IO () createSymbolicLinkUnpriv link _target _isDir = #ifdef HAVE_CREATESYMBOLICLINKW- withCWString link $ \ pLink ->- withCWString _target $ \ pTarget -> do+ Win32.withTString link $ \ pLink ->+ Win32.withTString _target $ \ pTarget -> do let flags = if _isDir then win32_sYMBOLIC_LINK_FLAG_DIRECTORY else 0 call pLink pTarget flags win32_sYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE where@@ -481,14 +500,16 @@ let msg = "Incorrect function. The underlying file system " <> "might not support symbolic links." throwIO (mkIOError illegalOperationErrorType- "CreateSymbolicLink" Nothing (Just link)+ "CreateSymbolicLink" Nothing Nothing+ `ioeSetOsPath` OsString link `ioeSetErrorString` msg) | e == win32_eRROR_PRIVILEGE_NOT_HELD -> do let msg = "A required privilege is not held by the client. " <> "Creating symbolic links usually requires " <> "administrative rights." throwIO (mkIOError permissionErrorType "CreateSymbolicLink"- Nothing (Just link)+ Nothing Nothing+ `ioeSetOsPath` OsString link `ioeSetErrorString` msg) | e == win32_eRROR_INVALID_PARAMETER && unpriv /= 0 ->@@ -502,27 +523,31 @@ :: Ptr CWchar -> Ptr CWchar -> Win32.DWORD -> IO Win32.BYTE #else- throwIO . (`ioeSetErrorString` unsupportedErrorMsg) $+ throwIO . (`ioeSetErrorString` unsupportedErrorMsg)+ . (`ioeSetOsPath` OsString link) $ mkIOError UnsupportedOperation "CreateSymbolicLink"- Nothing (Just link)+ Nothing Nothing where unsupportedErrorMsg = "Not supported on Windows XP or older" #endif linkToDirectoryIsDirectory :: Bool linkToDirectoryIsDirectory = True -createSymbolicLink :: Bool -> FilePath -> FilePath -> IO ()+createSymbolicLink :: Bool -> OsPath -> OsPath -> IO () createSymbolicLink isDir target link =- (`ioeSetFileName` link) `modifyIOError` do+ (`ioeSetOsPath` link) `modifyIOError` do -- normaliseSeparators ensures the target gets normalised properly link' <- furnishPath link- createSymbolicLinkUnpriv link' (normaliseSeparators target) isDir+ createSymbolicLinkUnpriv+ link'+ (normaliseSeparators target)+ isDir type Metadata = Win32.BY_HANDLE_FILE_INFORMATION -getSymbolicLinkMetadata :: FilePath -> IO Metadata+getSymbolicLinkMetadata :: OsPath -> IO Metadata getSymbolicLinkMetadata path =- (`ioeSetFileName` path) `modifyIOError` do+ (`ioeSetOsPath` path) `modifyIOError` do path' <- furnishPath path let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING (Win32.fILE_FLAG_BACKUP_SEMANTICS .|.@@ -530,9 +555,9 @@ bracket open Win32.closeHandle $ \ h -> do Win32.getFileInformationByHandle h -getFileMetadata :: FilePath -> IO Metadata+getFileMetadata :: OsPath -> IO Metadata getFileMetadata path =- (`ioeSetFileName` path) `modifyIOError` do+ (`ioeSetOsPath` path) `modifyIOError` do path' <- furnishPath path let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing@@ -545,7 +570,7 @@ | isDir = Directory | otherwise = File where- isLink = attrs .&. win32_fILE_ATTRIBUTE_REPARSE_POINT /= 0+ isLink = attrs .&. Win32.fILE_ATTRIBUTE_REPARSE_POINT /= 0 isDir = attrs .&. Win32.fILE_ATTRIBUTE_DIRECTORY /= 0 attrs = Win32.bhfiFileAttributes info @@ -575,23 +600,16 @@ posixToWindowsTime t = Win32.FILETIME $ truncate (t * 10000000 + windowsPosixEpochDifference) -setTimes :: FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()+setTimes :: OsPath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO () setTimes path' (atime', mtime') = bracket (openFileHandle path' Win32.gENERIC_WRITE) Win32.closeHandle $ \ handle ->-#if MIN_VERSION_Win32(2,12,0) Win32.setFileTime handle Nothing (posixToWindowsTime <$> atime') (posixToWindowsTime <$> mtime')-#else- maybeWith with (posixToWindowsTime <$> atime') $ \ atime'' ->- maybeWith with (posixToWindowsTime <$> mtime') $ \ mtime'' ->- Win32.failIf_ not "" $- Win32.c_SetFileTime handle nullPtr atime'' mtime''-#endif -- | Open the handle of an existing file or directory.-openFileHandle :: String -> Win32.AccessMode -> IO Win32.HANDLE+openFileHandle :: OsString -> Win32.AccessMode -> IO Win32.HANDLE openFileHandle path mode =- (`ioeSetFileName` path) `modifyIOError` do+ (`ioeSetOsPath` path) `modifyIOError` do path' <- furnishPath path Win32.createFile path' mode maxShareMode Nothing Win32.oPEN_EXISTING flags Nothing@@ -610,26 +628,26 @@ setWriteMode False m = m .|. Win32.fILE_ATTRIBUTE_READONLY setWriteMode True m = m .&. complement Win32.fILE_ATTRIBUTE_READONLY -setFileMode :: FilePath -> Mode -> IO ()+setFileMode :: OsPath -> Mode -> IO () setFileMode path mode =- (`ioeSetFileName` path) `modifyIOError` do+ (`ioeSetOsPath` path) `modifyIOError` do path' <- furnishPath path Win32.setFileAttributes path' mode -- | A restricted form of 'setFileMode' that only sets the permission bits. -- For Windows, this means only the "read-only" attribute is affected.-setFilePermissions :: FilePath -> Mode -> IO ()+setFilePermissions :: OsPath -> Mode -> IO () setFilePermissions path m = do m' <- modeFromMetadata <$> getFileMetadata path setFileMode path ((m' .&. complement Win32.fILE_ATTRIBUTE_READONLY) .|. (m .&. Win32.fILE_ATTRIBUTE_READONLY)) -getAccessPermissions :: FilePath -> IO Permissions+getAccessPermissions :: OsPath -> IO Permissions getAccessPermissions path = do m <- getFileMetadata path let isDir = fileTypeIsDirectory (fileTypeFromMetadata m) let w = hasWriteMode (modeFromMetadata m)- let x = (toLower <$> takeExtension path)+ let x = (toLower . toChar <$> unpack (takeExtension path)) `elem` [".bat", ".cmd", ".com", ".exe"] pure Permissions { readable = True@@ -638,39 +656,57 @@ , searchable = isDir } -setAccessPermissions :: FilePath -> Permissions -> IO ()+setAccessPermissions :: OsPath -> Permissions -> IO () setAccessPermissions path Permissions{writable = w} = do setFilePermissions path (setWriteMode w 0) -getFolderPath :: Win32.CSIDL -> IO FilePath-getFolderPath what = Win32.sHGetFolderPath nullPtr what nullPtr 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)) -getHomeDirectoryInternal :: IO FilePath+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++getHomeDirectoryInternal :: IO OsPath getHomeDirectoryInternal = getFolderPath Win32.cSIDL_PROFILE `catchIOError` \ _ -> getFolderPath Win32.cSIDL_WINDOWS -getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath+getXdgDirectoryFallback :: IO OsPath -> XdgDirectory -> IO OsPath getXdgDirectoryFallback _ xdgDir = do case xdgDir of XdgData -> getFolderPath Win32.cSIDL_APPDATA XdgConfig -> getFolderPath Win32.cSIDL_APPDATA- XdgCache -> getFolderPath win32_cSIDL_LOCAL_APPDATA- XdgState -> getFolderPath win32_cSIDL_LOCAL_APPDATA+ XdgCache -> getFolderPath Win32.cSIDL_LOCAL_APPDATA+ XdgState -> getFolderPath Win32.cSIDL_LOCAL_APPDATA -getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath]+getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsPath] getXdgDirectoryListFallback _ = pure <$> getFolderPath win32_cSIDL_COMMON_APPDATA -getAppUserDataDirectoryInternal :: FilePath -> IO FilePath+getAppUserDataDirectoryInternal :: OsPath -> IO OsPath getAppUserDataDirectoryInternal appName =- (\ appData -> appData <> ('\\' : appName))+ (\ appData -> appData <> (os "\\" <> appName)) <$> getXdgDirectoryFallback getHomeDirectoryInternal XdgData -getUserDocumentsDirectoryInternal :: IO FilePath+getUserDocumentsDirectoryInternal :: IO OsPath getUserDocumentsDirectoryInternal = getFolderPath Win32.cSIDL_PERSONAL -getTemporaryDirectoryInternal :: IO FilePath-getTemporaryDirectoryInternal = Win32.getTemporaryDirectory+getTemporaryDirectoryInternal :: IO OsPath+getTemporaryDirectoryInternal = OsString <$> Win32.getTemporaryDirectory #endif
+ System/Directory/OsPath.hs view
@@ -0,0 +1,1652 @@+-----------------------------------------------------------------------------+-- |+-- Module : System.Directory.OsPath+-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer : libraries@haskell.org+-- Stability : stable+-- Portability : portable+--+-- System-independent interface to directory manipulation.+--+-- @since 1.2.8.0+--+-----------------------------------------------------------------------------++module System.Directory.OsPath+ (+ -- $intro++ -- * Actions on directories+ createDirectory+ , createDirectoryIfMissing+ , removeDirectory+ , removeDirectoryRecursive+ , removePathForcibly+ , renameDirectory+ , listDirectory+ , getDirectoryContents+ -- ** Current working directory+ , getCurrentDirectory+ , setCurrentDirectory+ , withCurrentDirectory++ -- * Pre-defined directories+ , getHomeDirectory+ , XdgDirectory(..)+ , getXdgDirectory+ , XdgDirectoryList(..)+ , getXdgDirectoryList+ , getAppUserDataDirectory+ , getUserDocumentsDirectory+ , getTemporaryDirectory++ -- * Actions on files+ , removeFile+ , renameFile+ , renamePath+ , copyFile+ , copyFileWithMetadata+ , getFileSize++ , canonicalizePath+ , makeAbsolute+ , makeRelativeToCurrentDirectory++ -- * Existence tests+ , doesPathExist+ , doesFileExist+ , doesDirectoryExist++ , findExecutable+ , findExecutables+ , findExecutablesInDirectories+ , findFile+ , findFiles+ , findFileWith+ , findFilesWith+ , exeExtension++ -- * Symbolic links+ , createFileLink+ , createDirectoryLink+ , removeDirectoryLink+ , pathIsSymbolicLink+ , getSymbolicLinkTarget++ -- * Permissions++ -- $permissions++ , Permissions+ , emptyPermissions+ , readable+ , writable+ , executable+ , searchable+ , setOwnerReadable+ , setOwnerWritable+ , setOwnerExecutable+ , setOwnerSearchable++ , getPermissions+ , setPermissions+ , copyPermissions++ -- * Timestamps++ , getAccessTime+ , getModificationTime+ , setAccessTime+ , setModificationTime++ ) where+import Prelude ()+import System.Directory.Internal+import System.Directory.Internal.Prelude+import System.OsPath+ ( (<.>)+ , (</>)+ , addTrailingPathSeparator+ , decodeFS+ , dropTrailingPathSeparator+ , encodeFS+ , hasTrailingPathSeparator+ , isAbsolute+ , joinPath+ , makeRelative+ , splitDirectories+ , splitSearchPath+ , takeDirectory+ )+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)++{- $intro+A directory contains a series of entries, each of which is a named+reference to a file system object (file, directory etc.). Some+entries may be hidden, inaccessible, or have some administrative+function (e.g. @.@ or @..@ under+<http://www.opengroup.org/onlinepubs/009695399 POSIX>), but in+this standard all such entries are considered to form part of the+directory contents. Entries in sub-directories are not, however,+considered to form part of the directory contents.++Each file system object is referenced by a /path/. There is+normally at least one absolute path to each file system object. In+some operating systems, it may also be possible to have paths which+are relative to the current directory.++Unless otherwise documented:++* 'IO' operations in this package may throw any 'IOError'. No other types of+ exceptions shall be thrown.++* The list of possible 'IOErrorType's in the API documentation is not+ exhaustive. The full list may vary by platform and/or evolve over time.++-}++-----------------------------------------------------------------------------+-- Permissions++{- $permissions++directory offers a limited (and quirky) interface for reading and setting file+and directory permissions; see 'getPermissions' and 'setPermissions' for a+discussion of their limitations. Because permissions are very difficult to+implement portably across different platforms, users who wish to do more+sophisticated things with permissions are advised to use other,+platform-specific libraries instead. For example, if you are only interested+in permissions on POSIX-like platforms,+<https://hackage.haskell.org/package/unix/docs/System-Posix-Files.html unix>+offers much more flexibility.++ The 'Permissions' type is used to record whether certain operations are+ permissible on a file\/directory. 'getPermissions' and 'setPermissions'+ get and set these permissions, respectively. Permissions apply both to+ files and directories. For directories, the executable field will be+ 'False', and for files the searchable field will be 'False'. Note that+ directories may be searchable without being readable, if permission has+ been given to use them as part of a path, but not to examine the+ directory contents.++Note that to change some, but not all permissions, a construct on the following lines must be used.++> makeReadable f = do+> p <- getPermissions f+> setPermissions f (p {readable = True})++-}++emptyPermissions :: Permissions+emptyPermissions = Permissions {+ readable = False,+ writable = False,+ executable = False,+ searchable = False+ }++setOwnerReadable :: Bool -> Permissions -> Permissions+setOwnerReadable b p = p { readable = b }++setOwnerWritable :: Bool -> Permissions -> Permissions+setOwnerWritable b p = p { writable = b }++setOwnerExecutable :: Bool -> Permissions -> Permissions+setOwnerExecutable b p = p { executable = b }++setOwnerSearchable :: Bool -> Permissions -> Permissions+setOwnerSearchable b p = p { searchable = b }++-- | Get the permissions of a file or directory.+--+-- On Windows, the 'writable' permission corresponds to the "read-only"+-- attribute. The 'executable' permission is set if the file extension is of+-- an executable file type. The 'readable' permission is always set.+--+-- On POSIX systems, this returns the result of @access@.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to access the+-- permissions, or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+getPermissions :: OsPath -> IO Permissions+getPermissions path =+ (`ioeAddLocation` "getPermissions") `modifyIOError` do+ getAccessPermissions (emptyToCurDir path)++-- | Set the permissions of a file or directory.+--+-- On Windows, this is only capable of changing the 'writable' permission,+-- which corresponds to the "read-only" attribute. Changing the other+-- permissions has no effect.+--+-- On POSIX systems, this sets the /owner/ permissions.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to set the permissions,+-- or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+setPermissions :: OsPath -> Permissions -> IO ()+setPermissions path p =+ (`ioeAddLocation` "setPermissions") `modifyIOError` do+ setAccessPermissions (emptyToCurDir path) p++-- | Copy the permissions of one file to another. This reproduces the+-- permissions more accurately than using 'getPermissions' followed by+-- 'setPermissions'.+--+-- On Windows, this copies only the read-only attribute.+--+-- On POSIX systems, this is equivalent to @stat@ followed by @chmod@.+copyPermissions :: OsPath -> OsPath -> IO ()+copyPermissions src dst =+ (`ioeAddLocation` "copyPermissions") `modifyIOError` do+ m <- getFileMetadata src+ copyPermissionsFromMetadata m dst++copyPermissionsFromMetadata :: Metadata -> OsPath -> IO ()+copyPermissionsFromMetadata m dst = do+ -- instead of setFileMode, setFilePermissions is used here+ -- this is to retain backward compatibility in copyPermissions+ setFilePermissions dst (modeFromMetadata m)++-----------------------------------------------------------------------------+-- Implementation++{- |@'createDirectory' dir@ creates a new directory @dir@ which is+initially empty, or as near to empty as the operating system+allows.++The operation may fail with:++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES]@++* 'isAlreadyExistsError'+The operand refers to a directory that already exists.+@ [EEXIST]@++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+The operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+There is no path to the directory.+@[ENOENT, ENOTDIR]@++* 'System.IO.isFullError'+Insufficient resources (virtual memory, process file descriptors,+physical disk space, etc.) are available to perform the operation.+@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* @InappropriateType@+The path refers to an existing non-directory object.+@[EEXIST]@++-}++createDirectory :: OsPath -> IO ()+createDirectory = createDirectoryInternal++-- | @'createDirectoryIfMissing' parents dir@ creates a new directory+-- @dir@ if it doesn\'t exist. If the first argument is 'True'+-- the function will also create all parent directories if they are missing.+createDirectoryIfMissing :: Bool -- ^ Create its parents too?+ -> OsPath -- ^ The path to the directory you want to make+ -> IO ()+createDirectoryIfMissing create_parents path0+ | create_parents = createDirs (parents path0)+ | otherwise = createDirs (take 1 (parents path0))+ where+ parents = reverse . scanl1 (</>) . splitDirectories . simplify++ createDirs [] = pure ()+ createDirs (dir:[]) = createDir dir ioError+ createDirs (dir:dirs) =+ createDir dir $ \_ -> do+ createDirs dirs+ createDir dir ioError++ createDir dir notExistHandler = do+ r <- tryIOError (createDirectory dir)+ case r of+ Right () -> pure ()+ Left e+ | isDoesNotExistError e -> notExistHandler e+ -- createDirectory (and indeed POSIX mkdir) does not distinguish+ -- between a dir already existing and a file already existing. So we+ -- check for it here. Unfortunately there is a slight race condition+ -- here, but we think it is benign. It could report an exception in+ -- the case that the dir did exist but another process deletes the+ -- directory and creates a file in its place before we can check+ -- that the directory did indeed exist.+ -- We also follow this path when we get a permissions error, as+ -- trying to create "." when in the root directory on Windows+ -- fails with+ -- CreateDirectory ".": permission denied (Access is denied.)+ -- This caused GHCi to crash when loading a module in the root+ -- directory.+ | isAlreadyExistsError e+ || isPermissionError e -> do+ canIgnore <- pathIsDirectory dir+ `catchIOError` \ _ ->+ pure (isAlreadyExistsError e)+ unless canIgnore (ioError e)+ | otherwise -> ioError e+++{- | @'removeDirectory' dir@ removes an existing directory /dir/. The+implementation may specify additional constraints which must be+satisfied before a directory can be removed (e.g. the directory has to+be empty, or may not be in use by other processes). It is not legal+for an implementation to partially remove a directory unless the+entire directory is removed. A conformant implementation need not+support directory removal in all situations (e.g. removal of the root+directory).++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+The operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The directory does not exist.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY, ENOTEMPTY, EEXIST]@++* @UnsupportedOperation@+The implementation does not support removal in this situation.+@[EINVAL]@++* @InappropriateType@+The operand refers to an existing non-directory object.+@[ENOTDIR]@++-}++removeDirectory :: OsPath -> IO ()+removeDirectory = removePathInternal True++-- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/+-- together with its contents and subdirectories. Within this directory,+-- symbolic links are removed without affecting their targets.+--+-- On Windows, the operation fails if /dir/ is a directory symbolic link.+--+-- This operation is reported to be flaky on Windows so retry logic may+-- be advisable. See: https://github.com/haskell/directory/pull/108+removeDirectoryRecursive :: OsPath -> IO ()+removeDirectoryRecursive path =+ (`ioeAddLocation` "removeDirectoryRecursive") `modifyIOError` do+ m <- getSymbolicLinkMetadata path+ case fileTypeFromMetadata m of+ Directory ->+ removeContentsRecursive path+ DirectoryLink ->+ ioError (err `ioeSetErrorString` "is a directory symbolic link")+ _ ->+ ioError (err `ioeSetErrorString` "not a directory")+ where err = mkIOError InappropriateType "" Nothing Nothing `ioeSetOsPath` path++-- | @removePathRecursive path@ removes an existing file or directory at+-- /path/ together with its contents and subdirectories. Symbolic links are+-- removed without affecting their the targets.+--+-- This operation is reported to be flaky on Windows so retry logic may+-- be advisable. See: https://github.com/haskell/directory/pull/108+removePathRecursive :: OsPath -> IO ()+removePathRecursive path =+ (`ioeAddLocation` "removePathRecursive") `modifyIOError` do+ m <- getSymbolicLinkMetadata path+ case fileTypeFromMetadata m of+ Directory -> removeContentsRecursive path+ DirectoryLink -> removeDirectory path+ _ -> removeFile path++-- | @removeContentsRecursive dir@ removes the contents of the directory+-- /dir/ recursively. Symbolic links are removed without affecting their the+-- targets.+--+-- This operation is reported to be flaky on Windows so retry logic may+-- be advisable. See: https://github.com/haskell/directory/pull/108+removeContentsRecursive :: OsPath -> IO ()+removeContentsRecursive path =+ (`ioeAddLocation` "removeContentsRecursive") `modifyIOError` do+ cont <- listDirectory path+ for_ [path </> x | x <- cont] removePathRecursive+ removeDirectory path++-- | Removes a file or directory at /path/ together with its contents and+-- subdirectories. Symbolic links are removed without affecting their+-- targets. If the path does not exist, nothing happens.+--+-- Unlike other removal functions, this function will also attempt to delete+-- files marked as read-only or otherwise made unremovable due to permissions.+-- As a result, if the removal is incomplete, the permissions or attributes on+-- the remaining files may be altered. If there are hard links in the+-- directory, then permissions on all related hard links may be altered.+--+-- If an entry within the directory vanishes while @removePathForcibly@ is+-- running, it is silently ignored.+--+-- If an exception occurs while removing an entry, @removePathForcibly@ will+-- still try to remove as many entries as it can before failing with an+-- exception. The first exception that it encountered is re-thrown.+removePathForcibly :: OsPath -> IO ()+removePathForcibly path =+ (`ioeAddLocation` "removePathForcibly") `modifyIOError` do+ ignoreDoesNotExistError $ do+ m <- getSymbolicLinkMetadata path+ case fileTypeFromMetadata m of+ DirectoryLink -> do+ makeRemovable path+ removeDirectory path+ Directory -> do+ makeRemovable path+ names <- listDirectory path+ sequenceWithIOErrors_ $+ [ removePathForcibly (path </> name) | name <- names ] +++ [ removeDirectory path ]+ _ -> do+ unless filesAlwaysRemovable (makeRemovable path)+ removeFile path+ where++ ignoreDoesNotExistError :: IO () -> IO ()+ ignoreDoesNotExistError action =+ () <$ tryIOErrorType isDoesNotExistError action++ makeRemovable :: OsPath -> IO ()+ makeRemovable p = (`catchIOError` \ _ -> pure ()) $ do+ perms <- getPermissions p+ setPermissions path perms{ readable = True+ , searchable = True+ , writable = True }++{- |'removeFile' /file/ removes the directory entry for an existing file+/file/, where /file/ is not itself a directory. The+implementation may specify additional constraints which must be+satisfied before a file can be removed (e.g. the file may not be in+use by other processes).++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+The operand is not a valid file name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The file does not exist.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY]@++* @InappropriateType@+The operand refers to an existing directory.+@[EPERM, EINVAL]@++-}++removeFile :: OsPath -> IO ()+removeFile = removePathInternal False++{- |@'renameDirectory' old new@ changes the name of an existing+directory from /old/ to /new/. If the /new/ directory+already exists, it is atomically replaced by the /old/ directory.+If the /new/ directory is neither the /old/ directory nor an+alias of the /old/ directory, it is removed as if by+'removeDirectory'. A conformant implementation need not support+renaming directories in all situations (e.g. renaming to an existing+directory, or across different physical devices), but the constraints+must be documented.++On Win32 platforms, @renameDirectory@ fails if the /new/ directory already+exists.++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+Either operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The original directory does not exist, or there is no path to the target.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'System.IO.isFullError'+Insufficient resources are available to perform the operation.+@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY, ENOTEMPTY, EEXIST]@++* @UnsupportedOperation@+The implementation does not support renaming in this situation.+@[EINVAL, EXDEV]@++* @InappropriateType@+Either path refers to an existing non-directory object.+@[ENOTDIR, EISDIR]@++-}++renameDirectory :: OsPath -> OsPath -> IO ()+renameDirectory opath npath =+ (`ioeAddLocation` "renameDirectory") `modifyIOError` do+ -- XXX this test isn't performed atomically with the following rename+ isDir <- pathIsDirectory opath+ when (not isDir) . ioError $+ mkIOError InappropriateType "renameDirectory" Nothing Nothing+ `ioeSetErrorString` "not a directory"+ `ioeSetOsPath` opath+ renamePath opath npath++{- |@'renameFile' old new@ changes the name of an existing file system+object from /old/ to /new/. If the /new/ object already exists, it is+replaced by the /old/ object. Neither path may refer to an existing+directory. A conformant implementation need not support renaming files+in all situations (e.g. renaming across different physical devices), but+the constraints must be documented.++On Windows, this calls @MoveFileEx@ with @MOVEFILE_REPLACE_EXISTING@ set,+which is not guaranteed to be atomic+(<https://github.com/haskell/directory/issues/109>).++On other platforms, this operation is atomic.++The operation may fail with:++* @HardwareFault@+A physical I\/O error has occurred.+@[EIO]@++* @InvalidArgument@+Either operand is not a valid file name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError'+The original file does not exist, or there is no path to the target.+@[ENOENT, ENOTDIR]@++* 'isPermissionError'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'System.IO.isFullError'+Insufficient resources are available to perform the operation.+@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* @UnsatisfiedConstraints@+Implementation-dependent constraints are not satisfied.+@[EBUSY]@++* @UnsupportedOperation@+The implementation does not support renaming in this situation.+@[EXDEV]@++* @InappropriateType@+Either path refers to an existing directory.+@[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@++-}++renameFile :: OsPath -> OsPath -> IO ()+renameFile opath npath =+ (`ioeAddLocation` "renameFile") `modifyIOError` do+ -- XXX the tests are not performed atomically with the rename+ checkNotDir opath+ renamePath opath npath+ -- The underlying rename implementation can throw odd exceptions when the+ -- destination is a directory. For example, Windows typically throws a+ -- permission error, while POSIX systems may throw a resource busy error+ -- if one of the paths refers to the current directory. In these cases,+ -- we check if the destination is a directory and, if so, throw an+ -- InappropriateType error.+ `catchIOError` \ err -> do+ checkNotDir npath+ ioError err+ where checkNotDir path = do+ m <- tryIOError (getSymbolicLinkMetadata path)+ case fileTypeIsDirectory . fileTypeFromMetadata <$> m of+ Right True ->+ ioError $+ mkIOError InappropriateType "" Nothing Nothing+ `ioeSetErrorString` "is a directory"+ `ioeSetOsPath` path+ _ -> pure ()++-- | Rename a file or directory. If the destination path already exists, it+-- is replaced atomically. The destination path must not point to an existing+-- directory. A conformant implementation need not support renaming files in+-- all situations (e.g. renaming across different physical devices), but the+-- constraints must be documented.+--+-- The operation may fail with:+--+-- * @HardwareFault@+-- A physical I\/O error has occurred.+-- @[EIO]@+--+-- * @InvalidArgument@+-- Either operand is not a valid file name.+-- @[ENAMETOOLONG, ELOOP]@+--+-- * 'isDoesNotExistError'+-- The original file does not exist, or there is no path to the target.+-- @[ENOENT, ENOTDIR]@+--+-- * 'isPermissionError'+-- The process has insufficient privileges to perform the operation.+-- @[EROFS, EACCES, EPERM]@+--+-- * 'System.IO.isFullError'+-- Insufficient resources are available to perform the operation.+-- @[EDQUOT, ENOSPC, ENOMEM, EMLINK]@+--+-- * @UnsatisfiedConstraints@+-- Implementation-dependent constraints are not satisfied.+-- @[EBUSY]@+--+-- * @UnsupportedOperation@+-- The implementation does not support renaming in this situation.+-- @[EXDEV]@+--+-- * @InappropriateType@+-- Either the destination path refers to an existing directory, or one of the+-- parent segments in the destination path is not a directory.+-- @[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@+renamePath :: OsPath -- ^ Old path+ -> OsPath -- ^ New path+ -> IO ()+renamePath opath npath =+ (`ioeAddLocation` "renamePath") `modifyIOError` do+ renamePathInternal opath npath++-- | Copy a file with its permissions. If the destination file already exists,+-- it is replaced atomically. Neither path may refer to an existing+-- directory. No exceptions are thrown if the permissions could not be+-- copied.+copyFile :: OsPath -- ^ Source filename+ -> OsPath -- ^ Destination filename+ -> IO ()+copyFile fromFPath toFPath =+ (`ioeAddLocation` "copyFile") `modifyIOError` do+ atomicCopyFileContents fromFPath toFPath+ (ignoreIOExceptions . copyPermissions fromFPath)++-- | Copy all data from a file to a handle.+copyFileToHandle :: OsPath -- ^ Source file+ -> Handle -- ^ Destination handle+ -> IO ()+copyFileToHandle fromFPath hTo =+ (`ioeAddLocation` "copyFileToHandle") `modifyIOError` do+ withBinaryHandle (openFileForRead fromFPath) $ \ hFrom ->+ copyHandleData hFrom hTo++-- | Copy the contents of a source file to a destination file, replacing the+-- destination file atomically via @withReplacementFile@, resetting the+-- attributes of the destination file to the defaults.+atomicCopyFileContents :: OsPath -- ^ Source filename+ -> OsPath -- ^ Destination filename+ -> (OsPath -> IO ()) -- ^ Post-action+ -> IO ()+atomicCopyFileContents fromFPath toFPath postAction =+ (`ioeAddLocation` "atomicCopyFileContents") `modifyIOError` do+ withReplacementFile toFPath postAction $ \ hTo -> do+ copyFileToHandle fromFPath hTo++-- | A helper function useful for replacing files in an atomic manner. The+-- function creates a temporary file in the directory of the destination file,+-- opens it, performs the main action with its handle, closes it, performs the+-- post-action with its path, and finally replaces the destination file with+-- the temporary file. If an error occurs during any step of this process,+-- the temporary file is removed and the destination file remains untouched.+withReplacementFile :: OsPath -- ^ Destination file+ -> (OsPath -> IO ()) -- ^ Post-action+ -> (Handle -> IO a) -- ^ Main action+ -> IO a+withReplacementFile path postAction action =+ (`ioeAddLocation` "withReplacementFile") `modifyIOError` do+ mask $ \ restore -> do+ -- TODO: AFPP doesn't support openBinaryTempFile yet,+ -- so we have to use this (sad) workaround+ -- (on unix, converts using filesystem encoding, on windows+ -- converts with UTF-16LE)+ d <- decodeFS (takeDirectory path)+ (tmpFPath', hTmp) <- openBinaryTempFile d ".copyFile.tmp"+ tmpFPath <- encodeFS tmpFPath'+ (`onException` ignoreIOExceptions (removeFile tmpFPath)) $ do+ r <- (`onException` ignoreIOExceptions (hClose hTmp)) $ do+ restore (action hTmp)+ hClose hTmp+ restore (postAction tmpFPath)+ renameFile tmpFPath path+ pure r++-- | Copy a file with its associated metadata. If the destination file+-- already exists, it is overwritten. There is no guarantee of atomicity in+-- the replacement of the destination file. Neither path may refer to an+-- existing directory. If the source and/or destination are symbolic links,+-- the copy is performed on the targets of the links.+--+-- On Windows, it behaves like the Win32 function+-- <https://msdn.microsoft.com/en-us/library/windows/desktop/aa363851.aspx CopyFile>,+-- which copies various kinds of metadata including file attributes and+-- security resource properties.+--+-- On Unix-like systems, permissions, access time, and modification time are+-- preserved. If possible, the owner and group are also preserved. Note that+-- the very act of copying can change the access time of the source file,+-- hence the access times of the two files may differ after the operation+-- completes.+copyFileWithMetadata :: OsPath -- ^ Source file+ -> OsPath -- ^ Destination file+ -> IO ()+copyFileWithMetadata src dst =+ (`ioeAddLocation` "copyFileWithMetadata") `modifyIOError`+ copyFileWithMetadataInternal copyPermissionsFromMetadata+ copyTimesFromMetadata+ src+ dst++copyTimesFromMetadata :: Metadata -> OsPath -> IO ()+copyTimesFromMetadata st dst = do+ let atime = accessTimeFromMetadata st+ let mtime = modificationTimeFromMetadata st+ setFileTimes dst (Just atime, Just mtime)++-- | Make a path absolute, normalize the path, and remove as many indirections+-- from it as possible. Any trailing path separators are discarded via+-- 'dropTrailingPathSeparator'. Additionally, on Windows the letter case of+-- the path is canonicalized.+--+-- __Note__: This function is a very big hammer. If you only need an absolute+-- path, 'makeAbsolute' is sufficient for removing dependence on the current+-- working directory.+--+-- Indirections include the two special directories @.@ and @..@, as well as+-- any symbolic links (and junction points on Windows). The input path need+-- not point to an existing file or directory. Canonicalization is performed+-- on the longest prefix of the path that points to an existing file or+-- directory. The remaining portion of the path that does not point to an+-- existing file or directory will still be normalized, but case+-- canonicalization and indirection removal are skipped as they are impossible+-- to do on a nonexistent path.+--+-- Most programs should not worry about the canonicity of a path. In+-- particular, despite the name, the function does not truly guarantee+-- canonicity of the returned path due to the presence of hard links, mount+-- points, etc.+--+-- If the path points to an existing file or directory, then the output path+-- shall also point to the same file or directory, subject to the condition+-- that the relevant parts of the file system do not change while the function+-- is still running. In other words, the function is definitively not atomic.+-- The results can be utterly wrong if the portions of the path change while+-- this function is running.+--+-- Since some indirections (symbolic links on all systems, @..@ on non-Windows+-- systems, and junction points on Windows) are dependent on the state of the+-- existing filesystem, the function can only make a conservative attempt by+-- removing such indirections from the longest prefix of the path that still+-- points to an existing file or directory.+--+-- Note that on Windows parent directories @..@ are always fully expanded+-- before the symbolic links, as consistent with the rest of the Windows API+-- (such as @GetFullPathName@). In contrast, on POSIX systems parent+-- directories @..@ are expanded alongside symbolic links from left to right.+-- To put this more concretely: if @L@ is a symbolic link for @R/P@, then on+-- Windows @L\\..@ refers to @.@, whereas on other operating systems @L/..@+-- refers to @R@.+--+-- Similar to 'System.FilePath.normalise', passing an empty path is equivalent+-- to passing the current directory.+--+-- @canonicalizePath@ can resolve at least 64 indirections in a single path,+-- more than what is supported by most operating systems. Therefore, it may+-- return the fully resolved path even though the operating system itself+-- would have long given up.+--+-- On Windows XP or earlier systems, junction expansion is not performed due+-- to their lack of @GetFinalPathNameByHandle@.+--+-- /Changes since 1.2.3.0:/ The function has been altered to be more robust+-- and has the same exception behavior as 'makeAbsolute'.+--+-- /Changes since 1.3.0.0:/ The function no longer preserves the trailing path+-- separator. File symbolic links that appear in the middle of a path are+-- properly dereferenced. Case canonicalization and symbolic link expansion+-- are now performed on Windows.+--+canonicalizePath :: OsPath -> IO OsPath+canonicalizePath = \ path ->+ ((`ioeAddLocation` "canonicalizePath") .+ (`ioeSetOsPath` path)) `modifyIOError` do+ -- simplify does more stuff, like upper-casing the drive letter+ dropTrailingPathSeparator . simplify <$>+ (canonicalizePathWith attemptRealpath =<< prependCurrentDirectory path)+ where++ -- allow up to 64 cycles before giving up+ attemptRealpath realpath =+ attemptRealpathWith (64 :: Int) Nothing realpath+ <=< canonicalizePathSimplify++ -- n is a counter to make sure we don't run into an infinite loop; we+ -- don't try to do any cycle detection here because an adversary could DoS+ -- any arbitrarily clever algorithm+ attemptRealpathWith n mFallback realpath path =+ case mFallback of+ -- too many indirections ... giving up.+ Just fallback | n <= 0 -> pure fallback+ -- either mFallback == Nothing (first attempt)+ -- or n > 0 (still have some attempts left)+ _ -> realpathPrefix (reverse (zip prefixes suffixes))++ where++ segments = splitDirectories path+ prefixes = scanl1 (</>) segments+ suffixes = tail (scanr (</>) mempty segments)++ -- try to call realpath on the largest possible prefix+ realpathPrefix candidates =+ case candidates of+ [] -> pure path+ (prefix, suffix) : rest -> do+ exist <- doesPathExist prefix+ if not exist+ -- never call realpath on an inaccessible path+ -- (to avoid bugs in system realpath implementations)+ -- try a smaller prefix instead+ then realpathPrefix rest+ else do+ mp <- tryIOError (realpath prefix)+ case mp of+ -- realpath failed: try a smaller prefix instead+ Left _ -> realpathPrefix rest+ -- realpath succeeded: fine-tune the result+ Right p -> realpathFurther (p </> suffix) p suffix++ -- by now we have a reasonable fallback value that we can use if we+ -- run into too many indirections; the fallback value is the same+ -- result that we have been returning in versions prior to 1.3.1.0+ -- (this is essentially the fix to #64)+ realpathFurther fallback p suffix =+ case splitDirectories suffix of+ [] -> pure fallback+ next : restSuffix -> do+ -- see if the 'next' segment is a symlink+ mTarget <- tryIOError (getSymbolicLinkTarget (p </> next))+ case mTarget of+ Left _ -> pure fallback+ Right target -> do+ -- if so, dereference it and restart the whole cycle+ let mFallback' = Just (fromMaybe fallback mFallback)+ path' <- canonicalizePathSimplify+ (p </> target </> joinPath restSuffix)+ attemptRealpathWith (n - 1) mFallback' realpath path'++-- | Convert a path into an absolute path. If the given path is relative, the+-- current directory is prepended and then the combined result is normalized.+-- If the path is already absolute, the path is simply normalized. The+-- function preserves the presence or absence of the trailing path separator+-- unless the path refers to the root directory @/@.+--+-- If the path is already absolute, the operation never fails. Otherwise, the+-- operation may fail with the same exceptions as 'getCurrentDirectory'.+--+makeAbsolute :: OsPath -> IO OsPath+makeAbsolute path =+ ((`ioeAddLocation` "makeAbsolute") .+ (`ioeSetOsPath` path)) `modifyIOError` do+ matchTrailingSeparator path . simplify <$> prependCurrentDirectory path++-- | Add or remove the trailing path separator in the second path so as to+-- match its presence in the first path.+--+-- (internal API)+matchTrailingSeparator :: OsPath -> OsPath -> OsPath+matchTrailingSeparator path+ | hasTrailingPathSeparator path = addTrailingPathSeparator+ | otherwise = dropTrailingPathSeparator++-- | Construct a path relative to the current directory, similar to+-- 'makeRelative'.+--+-- The operation may fail with the same exceptions as 'getCurrentDirectory'.+makeRelativeToCurrentDirectory :: OsPath -> IO OsPath+makeRelativeToCurrentDirectory x = do+ (`makeRelative` x) <$> getCurrentDirectory++-- | Given the name or path of an executable file, 'findExecutable' searches+-- for such a file in a list of system-defined locations, which generally+-- includes @PATH@ and possibly more. The full path to the executable is+-- returned if found. For example, @(findExecutable \"ghc\")@ would normally+-- give you the path to GHC.+--+-- The path returned by @'findExecutable' name@ corresponds to the program+-- that would be executed by+-- @<http://hackage.haskell.org/package/process/docs/System-Process.html#v:createProcess createProcess>@+-- when passed the same string (as a @RawCommand@, not a @ShellCommand@),+-- provided that @name@ is not a relative path with more than one segment.+--+-- On Windows, 'findExecutable' calls the Win32 function+-- @<https://msdn.microsoft.com/en-us/library/aa365527.aspx SearchPath>@,+-- which may search other places before checking the directories in the @PATH@+-- environment variable. Where it actually searches depends on registry+-- settings, but notably includes the directory containing the current+-- executable.+--+-- On non-Windows platforms, the behavior is equivalent to 'findFileWith'+-- using the search directories from the @PATH@ environment variable and+-- testing each file for executable permissions. Details can be found in the+-- documentation of 'findFileWith'.+findExecutable :: OsString -> IO (Maybe OsPath)+findExecutable binary =+ listTHead+ (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)++-- | Search for executable files in a list of system-defined locations, which+-- generally includes @PATH@ and possibly more.+--+-- On Windows, this /only returns the first occurrence/, if any. Its behavior+-- is therefore equivalent to 'findExecutable'.+--+-- On non-Windows platforms, the behavior is equivalent to+-- 'findExecutablesInDirectories' using the search directories from the @PATH@+-- environment variable. Details can be found in the documentation of+-- 'findExecutablesInDirectories'.+findExecutables :: OsString -> IO [OsPath]+findExecutables binary =+ listTToList+ (findExecutablesLazyInternal findExecutablesInDirectoriesLazy binary)++-- | Given a name or path, 'findExecutable' appends the 'exeExtension' to the+-- query and searches for executable files in the list of given search+-- directories and returns all occurrences.+--+-- The behavior is equivalent to 'findFileWith' using the given search+-- directories and testing each file for executable permissions. Details can+-- be found in the documentation of 'findFileWith'.+--+-- Unlike other similarly named functions, 'findExecutablesInDirectories' does+-- not use @SearchPath@ from the Win32 API. The behavior of this function on+-- Windows is therefore equivalent to those on non-Windows platforms.+findExecutablesInDirectories :: [OsPath] -> OsString -> IO [OsPath]+findExecutablesInDirectories path binary =+ listTToList (findExecutablesInDirectoriesLazy path binary)++findExecutablesInDirectoriesLazy :: [OsPath] -> OsString -> ListT IO OsPath+findExecutablesInDirectoriesLazy path binary =+ findFilesWithLazy isExecutable path (binary <.> exeExtension)++-- | Test whether a file has executable permissions.+isExecutable :: OsPath -> IO Bool+isExecutable file = executable <$> getPermissions file++-- | Search through the given list of directories for the given file.+--+-- The behavior is equivalent to 'findFileWith', returning only the first+-- occurrence. Details can be found in the documentation of 'findFileWith'.+findFile :: [OsPath] -> OsString -> IO (Maybe OsPath)+findFile = findFileWith (\ _ -> pure True)++-- | Search through the given list of directories for the given file and+-- returns all paths where the given file exists.+--+-- The behavior is equivalent to 'findFilesWith'. Details can be found in the+-- documentation of 'findFilesWith'.+findFiles :: [OsPath] -> OsString -> IO [OsPath]+findFiles = findFilesWith (\ _ -> pure True)++-- | Search through a given list of directories for a file that has the given+-- name and satisfies the given predicate and return the path of the first+-- occurrence. The directories are checked in a left-to-right order.+--+-- This is essentially a more performant version of 'findFilesWith' that+-- always returns the first result, if any. Details can be found in the+-- documentation of 'findFilesWith'.+findFileWith :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> IO (Maybe OsPath)+findFileWith f ds name = listTHead (findFilesWithLazy f ds name)++-- | @findFilesWith predicate dirs name@ searches through the list of+-- directories (@dirs@) for files that have the given @name@ and satisfy the+-- given @predicate@ and returns the paths of those files. The directories+-- are checked in a left-to-right order and the paths are returned in the same+-- order.+--+-- If the @name@ is a relative path, then for every search directory @dir@,+-- the function checks whether @dir '</>' name@ exists and satisfies the+-- predicate. If so, @dir '</>' name@ is returned as one of the results. In+-- other words, the returned paths can be either relative or absolute+-- depending on the search directories were used. If there are no search+-- directories, no results are ever returned.+--+-- If the @name@ is an absolute path, then the function will return a single+-- result if the file exists and satisfies the predicate and no results+-- otherwise. This is irrespective of what search directories were given.+findFilesWith :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> IO [OsPath]+findFilesWith f ds name = listTToList (findFilesWithLazy f ds name)++findFilesWithLazy+ :: (OsPath -> IO Bool) -> [OsPath] -> OsString -> ListT IO OsPath+findFilesWithLazy f dirs path+ -- make sure absolute paths are handled properly irrespective of 'dirs'+ -- https://github.com/haskell/directory/issues/72+ | isAbsolute path = ListT (find [mempty])+ | otherwise = ListT (find dirs)++ where++ find [] = pure Nothing+ find (d : ds) = do+ let p = d </> path+ found <- doesFileExist p `andM` f p+ if found+ then pure (Just (p, ListT (find ds)))+ else find ds++-- | Filename extension for executable files (including the dot if any)+-- (usually @\"\"@ on POSIX systems and @\".exe\"@ on Windows or OS\/2).+exeExtension :: OsString+exeExtension = exeExtensionInternal++-- | Similar to 'listDirectory', but always includes the special entries (@.@+-- and @..@). (This applies to Windows as well.)+--+-- The operation may fail with the same exceptions as 'listDirectory'.+getDirectoryContents :: OsPath -> IO [OsPath]+getDirectoryContents path =+ ((`ioeSetOsPath` path) .+ (`ioeAddLocation` "getDirectoryContents")) `modifyIOError` do+ getDirectoryContentsInternal path++-- | @'listDirectory' dir@ returns a list of /all/ entries in /dir/ without+-- the special entries (@.@ and @..@).+--+-- The operation may fail with:+--+-- * @HardwareFault@+-- A physical I\/O error has occurred.+-- @[EIO]@+--+-- * @InvalidArgument@+-- The operand is not a valid directory name.+-- @[ENAMETOOLONG, ELOOP]@+--+-- * 'isDoesNotExistError'+-- The directory does not exist.+-- @[ENOENT, ENOTDIR]@+--+-- * 'isPermissionError'+-- The process has insufficient privileges to perform the operation.+-- @[EACCES]@+--+-- * 'System.IO.isFullError'+-- Insufficient resources are available to perform the operation.+-- @[EMFILE, ENFILE]@+--+-- * @InappropriateType@+-- The path refers to an existing non-directory object.+-- @[ENOTDIR]@+--+listDirectory :: OsPath -> IO [OsPath]+listDirectory path = filter f <$> getDirectoryContents path+ where f filename = filename /= os "." && filename /= os ".."++-- | Obtain the current working directory as an absolute path.+--+-- In a multithreaded program, the current working directory is a global state+-- shared among all threads of the process. Therefore, when performing+-- filesystem operations from multiple threads, it is highly recommended to+-- use absolute rather than relative paths (see: 'makeAbsolute').+--+-- Note that 'getCurrentDirectory' is not guaranteed to return the same path+-- received by 'setCurrentDirectory'. On POSIX systems, the path returned will+-- always be fully dereferenced (not contain any symbolic links). For more+-- information, refer to the documentation of+-- <https://pubs.opengroup.org/onlinepubs/9699919799/functions/getcwd.html getcwd>.+--+-- The operation may fail with:+--+-- * @HardwareFault@+-- A physical I\/O error has occurred.+-- @[EIO]@+--+-- * 'isDoesNotExistError'+-- There is no path referring to the working directory.+-- @[EPERM, ENOENT, ESTALE...]@+--+-- * 'isPermissionError'+-- The process has insufficient privileges to perform the operation.+-- @[EACCES]@+--+-- * 'System.IO.isFullError'+-- Insufficient resources are available to perform the operation.+--+-- * @UnsupportedOperation@+-- The operating system has no notion of current working directory.+--+getCurrentDirectory :: IO OsPath+getCurrentDirectory =+ (`ioeAddLocation` "getCurrentDirectory") `modifyIOError` do+ specializeErrorString+ "Current working directory no longer exists"+ isDoesNotExistError+ getCurrentDirectoryInternal++-- | Change the working directory to the given path.+--+-- In a multithreaded program, the current working directory is a global state+-- shared among all threads of the process. Therefore, when performing+-- filesystem operations from multiple threads, it is highly recommended to+-- use absolute rather than relative paths (see: 'makeAbsolute').+--+-- The operation may fail with:+--+-- * @HardwareFault@+-- A physical I\/O error has occurred.+-- @[EIO]@+--+-- * @InvalidArgument@+-- The operand is not a valid directory name.+-- @[ENAMETOOLONG, ELOOP]@+--+-- * 'isDoesNotExistError'+-- The directory does not exist.+-- @[ENOENT, ENOTDIR]@+--+-- * 'isPermissionError'+-- The process has insufficient privileges to perform the operation.+-- @[EACCES]@+--+-- * @UnsupportedOperation@+-- The operating system has no notion of current working directory, or the+-- working directory cannot be dynamically changed.+--+-- * @InappropriateType@+-- The path refers to an existing non-directory object.+-- @[ENOTDIR]@+--+setCurrentDirectory :: OsPath -> IO ()+setCurrentDirectory = setCurrentDirectoryInternal++-- | Run an 'IO' action with the given working directory and restore the+-- original working directory afterwards, even if the given action fails due+-- to an exception.+--+-- The operation may fail with the same exceptions as 'getCurrentDirectory'+-- and 'setCurrentDirectory'.+--+withCurrentDirectory :: OsPath -- ^ Directory to execute in+ -> IO a -- ^ Action to be executed+ -> IO a+withCurrentDirectory dir action =+ bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do+ setCurrentDirectory dir+ action++-- | Obtain the size of a file in bytes.+getFileSize :: OsPath -> IO Integer+getFileSize path =+ (`ioeAddLocation` "getFileSize") `modifyIOError` do+ fileSizeFromMetadata <$> getFileMetadata path++-- | Test whether the given path points to an existing filesystem object. If+-- the user lacks necessary permissions to search the parent directories, this+-- function may return false even if the file does actually exist. This+-- operation traverses symbolic links, so it can return either True or False+-- for them.+doesPathExist :: OsPath -> IO Bool+doesPathExist path = do+ (True <$ getFileMetadata path)+ `catchIOError` \ _ ->+ pure False++-- | The operation 'doesDirectoryExist' returns 'True' if the argument file+-- exists and is either a directory or a symbolic link to a directory, and+-- 'False' otherwise. This operation traverses symbolic links, so it can+-- return either True or False for them.+doesDirectoryExist :: OsPath -> IO Bool+doesDirectoryExist path = do+ pathIsDirectory path+ `catchIOError` \ _ ->+ pure False++-- | The operation 'doesFileExist' returns 'True' if the argument file exists+-- and is not a directory, and 'False' otherwise. This operation traverses+-- symbolic links, so it can return either True or False for them.+doesFileExist :: OsPath -> IO Bool+doesFileExist path = do+ (not <$> pathIsDirectory path)+ `catchIOError` \ _ ->+ pure False++pathIsDirectory :: OsPath -> IO Bool+pathIsDirectory path =+ (`ioeAddLocation` "pathIsDirectory") `modifyIOError` do+ fileTypeIsDirectory . fileTypeFromMetadata <$> getFileMetadata path++-- | Create a /file/ symbolic link. The target path can be either absolute or+-- relative and need not refer to an existing file. The order of arguments+-- follows the POSIX convention.+--+-- To remove an existing file symbolic link, use 'removeFile'.+--+-- Although the distinction between /file/ symbolic links and /directory/+-- symbolic links does not exist on POSIX systems, on Windows this is an+-- intrinsic property of every symbolic link and cannot be changed without+-- recreating the link. A file symbolic link that actually points to a+-- directory will fail to dereference and vice versa. Moreover, creating+-- symbolic links on Windows may require privileges unavailable to users+-- outside the Administrators group. Portable programs that use symbolic+-- links should take both into consideration.+--+-- On Windows, the function is implemented using @CreateSymbolicLink@. Since+-- 1.3.3.0, the @SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE@ flag is included+-- if supported by the operating system. On POSIX, the function uses @symlink@+-- and is therefore atomic.+--+-- Windows-specific errors: This operation may fail with 'permissionErrorType'+-- if the user lacks the privileges to create symbolic links. It may also+-- fail with 'illegalOperationErrorType' if the file system does not support+-- symbolic links.+createFileLink+ :: OsPath -- ^ path to the target file+ -> OsPath -- ^ path of the link to be created+ -> IO ()+createFileLink target link =+ (`ioeAddLocation` "createFileLink") `modifyIOError` do+ createSymbolicLink False target link++-- | Create a /directory/ symbolic link. The target path can be either+-- absolute or relative and need not refer to an existing directory. The+-- order of arguments follows the POSIX convention.+--+-- To remove an existing directory symbolic link, use 'removeDirectoryLink'.+--+-- Although the distinction between /file/ symbolic links and /directory/+-- symbolic links does not exist on POSIX systems, on Windows this is an+-- intrinsic property of every symbolic link and cannot be changed without+-- recreating the link. A file symbolic link that actually points to a+-- directory will fail to dereference and vice versa. Moreover, creating+-- symbolic links on Windows may require privileges unavailable to users+-- outside the Administrators group. Portable programs that use symbolic+-- links should take both into consideration.+--+-- On Windows, the function is implemented using @CreateSymbolicLink@ with+-- @SYMBOLIC_LINK_FLAG_DIRECTORY@. Since 1.3.3.0, the+-- @SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE@ flag is also included if+-- supported by the operating system. On POSIX, this is an alias for+-- 'createFileLink' and is therefore atomic.+--+-- Windows-specific errors: This operation may fail with 'permissionErrorType'+-- if the user lacks the privileges to create symbolic links. It may also+-- fail with 'illegalOperationErrorType' if the file system does not support+-- symbolic links.+createDirectoryLink+ :: OsPath -- ^ path to the target directory+ -> OsPath -- ^ path of the link to be created+ -> IO ()+createDirectoryLink target link =+ (`ioeAddLocation` "createDirectoryLink") `modifyIOError` do+ createSymbolicLink True target link++-- | Remove an existing /directory/ symbolic link.+--+-- On Windows, this is an alias for 'removeDirectory'. On POSIX systems, this+-- is an alias for 'removeFile'.+--+-- See also: 'removeFile', which can remove an existing /file/ symbolic link.+removeDirectoryLink :: OsPath -> IO ()+removeDirectoryLink path =+ (`ioeAddLocation` "removeDirectoryLink") `modifyIOError` do+ removePathInternal linkToDirectoryIsDirectory path++-- | Check whether an existing @path@ is a symbolic link. If @path@ is a+-- regular file or directory, 'False' is returned. If @path@ does not exist+-- or is otherwise inaccessible, an exception is thrown (see below).+--+-- On Windows, this checks for @FILE_ATTRIBUTE_REPARSE_POINT@. In addition to+-- symbolic links, the function also returns true on junction points. On+-- POSIX systems, this checks for @S_IFLNK@.+--+-- The operation may fail with:+--+-- * 'isDoesNotExistError' if the symbolic link does not exist; or+--+-- * 'isPermissionError' if the user is not permitted to read the symbolic+-- link.+pathIsSymbolicLink :: OsPath -> IO Bool+pathIsSymbolicLink path =+ ((`ioeAddLocation` "pathIsSymbolicLink") .+ (`ioeSetOsPath` path)) `modifyIOError` do+ fileTypeIsLink . fileTypeFromMetadata <$> getSymbolicLinkMetadata path++-- | Retrieve the target path of either a file or directory symbolic link.+-- The returned path may not be absolute, may not exist, and may not even be a+-- valid path.+--+-- On Windows systems, this calls @DeviceIoControl@ with+-- @FSCTL_GET_REPARSE_POINT@. In addition to symbolic links, the function+-- also works on junction points. On POSIX systems, this calls @readlink@.+--+-- Windows-specific errors: This operation may fail with+-- 'illegalOperationErrorType' if the file system does not support symbolic+-- links.+getSymbolicLinkTarget :: OsPath -> IO OsPath+getSymbolicLinkTarget path =+ (`ioeAddLocation` "getSymbolicLinkTarget") `modifyIOError` do+ readSymbolicLink path++-- | Obtain the time at which the file or directory was last accessed.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to read+-- the access time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- Caveat for POSIX systems: This function returns a timestamp with sub-second+-- resolution only if this package is compiled against @unix-2.6.0.0@ or later+-- and the underlying filesystem supports them.+--+getAccessTime :: OsPath -> IO UTCTime+getAccessTime path =+ (`ioeAddLocation` "getAccessTime") `modifyIOError` do+ accessTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)++-- | Obtain the time at which the file or directory was last modified.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to read+-- the modification time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- Caveat for POSIX systems: This function returns a timestamp with sub-second+-- resolution only if this package is compiled against @unix-2.6.0.0@ or later+-- and the underlying filesystem supports them.+--+getModificationTime :: OsPath -> IO UTCTime+getModificationTime path =+ (`ioeAddLocation` "getModificationTime") `modifyIOError` do+ modificationTimeFromMetadata <$> getFileMetadata (emptyToCurDir path)++-- | Change the time at which the file or directory was last accessed.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to alter the+-- access time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- Some caveats for POSIX systems:+--+-- * Not all systems support @utimensat@, in which case the function can only+-- emulate the behavior by reading the modification time and then setting+-- both the access and modification times together. On systems where+-- @utimensat@ is supported, the access time is set atomically with+-- nanosecond precision.+--+-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the function+-- would not be able to set timestamps with sub-second resolution. In this+-- case, there would also be loss of precision in the modification time.+--+setAccessTime :: OsPath -> UTCTime -> IO ()+setAccessTime path atime =+ (`ioeAddLocation` "setAccessTime") `modifyIOError` do+ setFileTimes path (Just atime, Nothing)++-- | Change the time at which the file or directory was last modified.+--+-- The operation may fail with:+--+-- * 'isPermissionError' if the user is not permitted to alter the+-- modification time; or+--+-- * 'isDoesNotExistError' if the file or directory does not exist.+--+-- Some caveats for POSIX systems:+--+-- * Not all systems support @utimensat@, in which case the function can only+-- emulate the behavior by reading the access time and then setting both the+-- access and modification times together. On systems where @utimensat@ is+-- supported, the modification time is set atomically with nanosecond+-- precision.+--+-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the function+-- would not be able to set timestamps with sub-second resolution. In this+-- case, there would also be loss of precision in the access time.+--+setModificationTime :: OsPath -> UTCTime -> IO ()+setModificationTime path mtime =+ (`ioeAddLocation` "setModificationTime") `modifyIOError` do+ setFileTimes path (Nothing, Just mtime)++setFileTimes :: OsPath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()+setFileTimes _ (Nothing, Nothing) = return ()+setFileTimes path (atime, mtime) =+ ((`ioeAddLocation` "setFileTimes") .+ (`ioeSetOsPath` path)) `modifyIOError` do+ setTimes (emptyToCurDir path)+ (utcTimeToPOSIXSeconds <$> atime, utcTimeToPOSIXSeconds <$> mtime)++{- | Returns the current user's home directory.++The directory returned is expected to be writable by the current user,+but note that it isn't generally considered good practice to store+application-specific data here; use 'getXdgDirectory' or+'getAppUserDataDirectory' instead.++On Unix, 'getHomeDirectory' behaves as follows:++* Returns $HOME env variable if set (including to an empty string).+* Otherwise uses home directory returned by `getpwuid_r` using the UID of the current proccesses user. This basically reads the /etc/passwd file. An empty home directory field is considered valid.++On Windows, the system is queried for a suitable path; a typical path might be @C:\/Users\//\<user\>/@.++The operation may fail with:++* @UnsupportedOperation@+The operating system has no notion of home directory.++* 'isDoesNotExistError'+The home directory for the current user does not exist, or+cannot be found.+-}+getHomeDirectory :: IO OsPath+getHomeDirectory =+ (`ioeAddLocation` "getHomeDirectory") `modifyIOError` do+ getHomeDirectoryInternal++-- | Obtain the paths to special directories for storing user-specific+-- application data, configuration, and cache files, conforming to the+-- <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html XDG Base Directory Specification>.+-- Compared with 'getAppUserDataDirectory', this function provides a more+-- fine-grained hierarchy as well as greater flexibility for the user.+--+-- 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+-- just return the second argument.+--+-- Note: The directory may not actually exist, in which case you would need+-- to create it with file mode @700@ (i.e. only accessible by the owner).+--+-- As of 1.3.5.0, the environment variable is ignored if set to a relative+-- path, per revised XDG Base Directory Specification. See+-- <https://github.com/haskell/directory/issues/100 #100>.+getXdgDirectory :: XdgDirectory -- ^ which special directory+ -> OsPath -- ^ a relative path that is appended+ -- to the path; if empty, the base+ -- path is returned+ -> IO OsPath+getXdgDirectory xdgDir suffix =+ (`ioeAddLocation` "getXdgDirectory") `modifyIOError` do+ simplify . (</> suffix) <$> do+ env <- lookupEnvOs . os $ case xdgDir of+ XdgData -> "XDG_DATA_HOME"+ XdgConfig -> "XDG_CONFIG_HOME"+ XdgCache -> "XDG_CACHE_HOME"+ XdgState -> "XDG_STATE_HOME"+ case env of+ Just path | isAbsolute path -> pure path+ _ -> getXdgDirectoryFallback getHomeDirectory xdgDir++-- | 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 [OsPath]+getXdgDirectoryList xdgDirs =+ (`ioeAddLocation` "getXdgDirectoryList") `modifyIOError` do+ env <- lookupEnvOs . os $ 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+-- prefer the the XDG-conformant location provided by 'getXdgDirectory'+-- (<https://github.com/haskell/directory/issues/6#issuecomment-96521020 migration guide>).+--+-- The argument is usually the name of the application. Since it will be+-- integrated into the path, it must consist of valid path characters.+--+-- * On Unix-like systems, the path is @~\/./\<app\>/@.+-- * On Windows, the path is @%APPDATA%\//\<app\>/@+-- (e.g. @C:\/Users\//\<user\>/\/AppData\/Roaming\//\<app\>/@)+--+-- Note: the directory may not actually exist, in which case you would need+-- to create it. It is expected that the parent directory exists and is+-- writable.+--+-- The operation may fail with:+--+-- * @UnsupportedOperation@+-- The operating system has no notion of application-specific data+-- directory.+--+-- * 'isDoesNotExistError'+-- The home directory for the current user does not exist, or cannot be+-- found.+--+getAppUserDataDirectory :: OsPath -- ^ a relative path that is appended+ -- to the path+ -> IO OsPath+getAppUserDataDirectory appName = do+ (`ioeAddLocation` "getAppUserDataDirectory") `modifyIOError` do+ getAppUserDataDirectoryInternal appName++{- | Returns the current user's document directory.++The directory returned is expected to be writable by the current user,+but note that it isn't generally considered good practice to store+application-specific data here; use 'getXdgDirectory' or+'getAppUserDataDirectory' instead.++On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@+environment variable. On Windows, the system is queried for a+suitable path; a typical path might be @C:\/Users\//\<user\>/\/Documents@.++The operation may fail with:++* @UnsupportedOperation@+The operating system has no notion of document directory.++* 'isDoesNotExistError'+The document directory for the current user does not exist, or+cannot be found.+-}+getUserDocumentsDirectory :: IO OsPath+getUserDocumentsDirectory = do+ (`ioeAddLocation` "getUserDocumentsDirectory") `modifyIOError` do+ getUserDocumentsDirectoryInternal++{- | Returns the current directory for temporary files.++On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@+environment variable or \"\/tmp\" if the variable isn\'t defined.+On Windows, the function checks for the existence of environment variables in+the following order and uses the first path found:++*+TMP environment variable.++*+TEMP environment variable.++*+USERPROFILE environment variable.++*+The Windows directory++The operation may fail with:++* @UnsupportedOperation@+The operating system has no notion of temporary directory.++The function doesn\'t verify whether the path exists.+-}+getTemporaryDirectory :: IO OsPath+getTemporaryDirectory = getTemporaryDirectoryInternal
changelog.md view
@@ -1,6 +1,24 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.8.0 (Sep 2022)++ * Drop support for `base` older than 4.11.0.+ * Drop support for `filepath` older than 1.4.100.+ * Drop support for `time` older than 1.8.0.+ * Drop support for `unix` older than 2.8.0.+ * Drop support for `Win32` older than 2.13.3.+ * Modules in `directory` are no longer considered+ [Safe](https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/safe_haskell.html)+ because the `System.OsPath` dependency is no longer Safe.+ * A new module, `System.Directory.OsPath`, has been introduced to support+ AFPP (`OsPath` and `OsString`) with an analogous API. The old module,+ `System.Directory`, shall be in maintenance mode as new features will no+ longer be accepted there.+ ([#136](https://github.com/haskell/directory/pull/136))+ * `removePathForcibly` no longer changes permissions of files on non-Windows+ systems. ([#135](https://github.com/haskell/directory/issues/135))+ ## 1.3.7.1 (Jul 2022) * Relax `time` version bounds to support 1.12.
directory.cabal view
@@ -1,5 +1,5 @@ name: directory-version: 1.3.7.1+version: 1.3.8.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -36,12 +36,11 @@ Library default-language: Haskell2010- other-extensions:- CPP- Trustworthy+ other-extensions: CPP exposed-modules: System.Directory+ System.Directory.OsPath System.Directory.Internal System.Directory.Internal.Prelude other-modules:@@ -54,19 +53,20 @@ include-dirs: . build-depends:- base >= 4.5 && < 4.18,- time >= 1.4 && < 1.13,- filepath >= 1.3 && < 1.5+ base >= 4.11.0 && < 4.18,+ time >= 1.8.0 && < 1.13,+ filepath >= 1.4.100 && < 1.5 if os(windows)- build-depends: Win32 >= 2.2.2 && < 2.14+ build-depends: Win32 >= 2.13.3 && < 2.14 else- build-depends: unix >= 2.5.1 && < 2.9+ build-depends: unix >= 2.8.0 && < 2.9 ghc-options: -Wall test-suite test default-language: Haskell2010- other-extensions: BangPatterns, CPP, Safe+ other-extensions: BangPatterns, CPP+ default-extensions: OverloadedStrings ghc-options: -Wall hs-source-dirs: tests main-is: Main.hs@@ -107,7 +107,6 @@ RenameDirectory RenameFile001 RenamePath- Safe Simplify T8482 WithCurrentDirectory
tests/CanonicalizePath.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} module CanonicalizePath where #include "util.inl"-import System.FilePath ((</>), dropFileName, dropTrailingPathSeparator,- normalise, takeFileName)+import System.Directory.Internal+import System.OsPath ((</>), dropFileName, dropTrailingPathSeparator,+ normalise, takeFileName) import TestUtils main :: TestEnv -> IO ()@@ -141,9 +142,9 @@ T(expectEq) () fooNon fooNon13 T(expectEq) () fooNon fooNon14 T(expectEq) () fooNon (dropFileName cfooNon15 <>- (toLower <$> takeFileName cfooNon15))+ (os (toLower <$> so (takeFileName cfooNon15)))) T(expectEq) () fooNon (dropFileName cfooNon16 <>- (toLower <$> takeFileName cfooNon16))+ (os (toLower <$> so (takeFileName cfooNon16)))) T(expectNe) () fooNon cfooNon15 T(expectNe) () fooNon cfooNon16
tests/CopyFile001.hs view
@@ -1,17 +1,18 @@ {-# LANGUAGE CPP #-} module CopyFile001 where #include "util.inl"-import System.FilePath ((</>))+import System.Directory.Internal+import System.OsPath ((</>)) import qualified Data.List as List main :: TestEnv -> IO () main _t = do createDirectory dir- writeFile (dir </> from) contents+ writeFile (so (dir </> from)) contents T(expectEq) () [from] . List.sort =<< listDirectory dir copyFile (dir </> from) (dir </> to) T(expectEq) () [from, to] . List.sort =<< listDirectory dir- T(expectEq) () contents =<< readFile (dir </> to)+ T(expectEq) () contents =<< readFile (so (dir </> to)) where contents = "This is the data\n" from = "source"
tests/CopyFile002.hs view
@@ -1,17 +1,18 @@ {-# LANGUAGE CPP #-} module CopyFile002 where #include "util.inl"+import System.Directory.Internal import qualified Data.List as List main :: TestEnv -> IO () main _t = do -- Similar to CopyFile001 but moves a file in the current directory -- (Bug #1652 on GHC Trac)- writeFile from contents+ writeFile (so from) contents T(expectEq) () [from] . List.sort =<< listDirectory "." copyFile from to T(expectEq) () [from, to] . List.sort =<< listDirectory "."- T(expectEq) () contents =<< readFile to+ T(expectEq) () contents =<< readFile (so to) where contents = "This is the data\n" from = "source"
tests/CopyFileWithMetadata.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} module CopyFileWithMetadata where #include "util.inl"+import System.Directory.Internal import qualified Data.List as List main :: TestEnv -> IO ()@@ -25,7 +26,7 @@ for_ ["b", "c"] $ \ f -> do T(expectEq) f perm =<< getPermissions f T(expectEq) f mtime =<< getModificationTime f- T(expectEq) f contents =<< readFile f+ T(expectEq) f contents =<< readFile (so f) where contents = "This is the data\n"
tests/CreateDirectoryIfMissing001.hs view
@@ -2,7 +2,8 @@ module CreateDirectoryIfMissing001 where #include "util.inl" import Data.Either (lefts)-import System.FilePath ((</>), addTrailingPathSeparator)+import System.Directory.Internal+import System.OsPath ((</>), addTrailingPathSeparator) main :: TestEnv -> IO () main _t = do@@ -27,13 +28,13 @@ T(inform) "done." cleanup - writeFile testdir testdir+ writeFile (so testdir) (so testdir) T(expectIOErrorType) () isAlreadyExistsError $ createDirectoryIfMissing False testdir removeFile testdir cleanup - writeFile testdir testdir+ writeFile (so testdir) (so testdir) T(expectIOErrorType) () isNotADirectoryError $ createDirectoryIfMissing True testdir_a removeFile testdir@@ -43,7 +44,7 @@ testname = "CreateDirectoryIfMissing001" - testdir = testname <> ".d"+ testdir = os (testname <> ".d") testdir_a = testdir </> "a" numRepeats = T.readArg _t testname "num-repeats" 10000
tests/DoesPathExist.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} module DoesPathExist where #include "util.inl"+import TestUtils (supportsSymlinks) main :: TestEnv -> IO () main _t = do@@ -22,6 +23,20 @@ T(expect) () =<< doesPathExist "sOmEfIlE" #endif T(expect) () =<< doesPathExist "\x3c0\x42f\x97f3\xe6\x221e"++ supportsSymbolicLinks <- supportsSymlinks+ when supportsSymbolicLinks $ do++ createDirectoryLink "somedir" "somedirlink"+ createFileLink "somefile" "somefilelink"+ createFileLink "nonexistent" "nonexistentlink"++ T(expect) () =<< doesFileExist "somefilelink"+ T(expect) () . not =<< doesDirectoryExist "somefilelink"+ T(expect) () =<< doesDirectoryExist "somedirlink"+ T(expect) () . not =<< doesFileExist "somedirlink"+ T(expect) () . not =<< doesDirectoryExist "nonexistentlink"+ T(expect) () . not =<< doesFileExist "nonexistentlink" where #if defined(mingw32_HOST_OS)
tests/FindFile001.hs view
@@ -2,7 +2,8 @@ module FindFile001 where #include "util.inl" import qualified Data.List as List-import System.FilePath ((</>))+import System.Directory.Internal+import System.OsPath ((</>)) main :: TestEnv -> IO () main _t = do@@ -10,8 +11,8 @@ createDirectory "bar" createDirectory "qux" writeFile "foo" ""- writeFile ("bar" </> "foo") ""- writeFile ("qux" </> "foo") ":3"+ writeFile (so ("bar" </> "foo")) ""+ writeFile (so ("qux" </> "foo")) ":3" -- make sure findFile is lazy enough T(expectEq) () (Just ("." </> "foo")) =<< findFile ("." : undefined) "foo"@@ -23,7 +24,7 @@ T(expectEq) () (Just ("." </> "foo")) =<< findFile [".", "bar"] ("foo") T(expectEq) () (Just ("bar" </> "foo")) =<< findFile ["bar", "."] ("foo") - let f fn = (== ":3") <$> readFile fn+ let f fn = (== ":3") <$> readFile (so fn) for_ (List.permutations ["qux", "bar", "."]) $ \ ds -> do let (match, noMatch) = List.partition (== "qux") ds
tests/GetDirContents001.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE CPP #-} module GetDirContents001 where #include "util.inl"-import System.FilePath ((</>))+import System.Directory.Internal+import System.OsPath ((</>)) import qualified Data.List as List main :: TestEnv -> IO ()@@ -12,8 +13,8 @@ T(expectEq) () [] . List.sort =<< listDirectory dir names <- for [1 .. 100 :: Int] $ \ i -> do- let name = 'f' : show i- writeFile (dir </> name) ""+ let name = "f" <> os (show i)+ writeFile (so (dir </> name)) "" return name T(expectEq) () (List.sort (specials <> names)) . List.sort =<< getDirectoryContents dir
tests/GetFileSize.hs view
@@ -5,10 +5,8 @@ main :: TestEnv -> IO () main _t = do - withBinaryFile "emptyfile" WriteMode $ \ _ -> do- return ()- withBinaryFile "testfile" WriteMode $ \ h -> do- hPutStr h string+ writeFile "emptyfile" ""+ writeFile "testfile" string T(expectEq) () 0 =<< getFileSize "emptyfile" T(expectEq) () (fromIntegral (length string)) =<< getFileSize "testfile"
tests/LongPaths.hs view
@@ -2,7 +2,7 @@ module LongPaths where #include "util.inl" import TestUtils-import System.FilePath ((</>))+import System.OsPath ((</>)) main :: TestEnv -> IO () main _t = do
tests/Main.hs view
@@ -27,7 +27,6 @@ import qualified RenameDirectory import qualified RenameFile001 import qualified RenamePath-import qualified Safe import qualified Simplify import qualified T8482 import qualified WithCurrentDirectory@@ -62,7 +61,6 @@ T.isolatedRun _t "RenameDirectory" RenameDirectory.main T.isolatedRun _t "RenameFile001" RenameFile001.main T.isolatedRun _t "RenamePath" RenamePath.main- T.isolatedRun _t "Safe" Safe.main T.isolatedRun _t "Simplify" Simplify.main T.isolatedRun _t "T8482" T8482.main T.isolatedRun _t "WithCurrentDirectory" WithCurrentDirectory.main
tests/MakeAbsolute.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE CPP #-} module MakeAbsolute where #include "util.inl"-import System.FilePath ((</>), addTrailingPathSeparator,- dropTrailingPathSeparator, normalise)+import System.OsPath ((</>), addTrailingPathSeparator,+ dropTrailingPathSeparator, normalise) #if defined(mingw32_HOST_OS)-import System.FilePath (takeDrive)+import System.Directory.Internal+import System.OsPath (takeDrive, toChar, unpack) #endif main :: TestEnv -> IO ()@@ -37,10 +38,10 @@ #if defined(mingw32_HOST_OS) cwd <- getCurrentDirectory- let driveLetter = toUpper (head (takeDrive cwd))+ let driveLetter = toUpper (toChar (head (unpack (takeDrive cwd)))) let driveLetter' = if driveLetter == 'Z' then 'A' else succ driveLetter- drp1 <- makeAbsolute (driveLetter : ":foobar")- drp2 <- makeAbsolute (driveLetter' : ":foobar")+ drp1 <- makeAbsolute (os (driveLetter : ":foobar"))+ drp2 <- makeAbsolute (os (driveLetter' : ":foobar")) T(expectEq) () drp1 =<< makeAbsolute "foobar"- T(expectEq) () drp2 (driveLetter' : ":\\foobar")+ T(expectEq) () drp2 (os (driveLetter' : ":\\foobar")) #endif
tests/MinimizeNameConflicts.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module MinimizeNameConflicts ( main- , module System.Directory+ , module System.Directory.OsPath #if defined(mingw32_HOST_OS) , module System.Win32 #else@@ -31,4 +31,4 @@ -- https://github.com/haskell/directory/issues/52 main :: TestEnv -> IO () main _t = do- T(expect) "no-op" True+ T(expect) ("no-op" :: String) True
tests/RemoveDirectoryRecursive001.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE CPP #-} module RemoveDirectoryRecursive001 where #include "util.inl"-import System.FilePath ((</>), normalise)+import System.Directory.Internal+import System.OsPath ((</>), normalise) import qualified Data.List as List-import TestUtils+import TestUtils (modifyPermissions, symlinkOrCopy) main :: TestEnv -> IO () main _t = do@@ -24,8 +25,8 @@ createDirectoryIfMissing True (tmp "a/z") createDirectoryIfMissing True (tmp "b") createDirectoryIfMissing True (tmp "c")- writeFile (tmp "a/x/w/u") "foo"- writeFile (tmp "a/t") "bar"+ writeFile (so (tmp "a/x/w/u")) "foo"+ writeFile (so (tmp "a/t")) "bar" symlinkOrCopy (normalise "../a") (tmp "b/g") symlinkOrCopy (normalise "../b") (tmp "c/h") symlinkOrCopy (normalise "a") (tmp "d")@@ -85,5 +86,5 @@ getDirectoryContents tmpD where testName = "removeDirectoryRecursive001"- tmpD = testName ++ ".tmp"+ tmpD = testName <> ".tmp" tmp s = tmpD </> normalise s
tests/RemovePathForcibly.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE CPP #-} module RemovePathForcibly where #include "util.inl"-import System.FilePath ((</>), normalise)+import System.Directory.Internal+import System.OsPath ((</>), normalise) import qualified Data.List as List-import TestUtils+import TestUtils (hardLinkOrCopy, modifyPermissions, symlinkOrCopy) main :: TestEnv -> IO () main _t = do@@ -25,9 +26,9 @@ createDirectoryIfMissing True (tmp "b") createDirectoryIfMissing True (tmp "c") createDirectoryIfMissing True (tmp "f")- writeFile (tmp "a/x/w/u") "foo"- writeFile (tmp "a/t") "bar"- writeFile (tmp "f/s") "qux"+ writeFile (so (tmp "a/x/w/u")) "foo"+ writeFile (so (tmp "a/t")) "bar"+ writeFile (so (tmp "f/s")) "qux" symlinkOrCopy (normalise "../a") (tmp "b/g") symlinkOrCopy (normalise "../b") (tmp "c/h") symlinkOrCopy (normalise "a") (tmp "d")@@ -83,6 +84,16 @@ T(expectEq) () [".", ".."] . List.sort =<< getDirectoryContents tmpD + ----------------------------------------------------------------------+ -- regression test for https://github.com/haskell/directory/issues/135+ + writeFile "hl1" "hardlinked"+ setPermissions "hl1" emptyPermissions+ origPermissions <- getPermissions "hl1"+ hardLinkOrCopy "hl1" "hl2"+ removePathForcibly "hl2"+ T(expectEq) () origPermissions =<< getPermissions "hl1"+ where testName = "removePathForcibly"- tmpD = testName ++ ".tmp"+ tmpD = testName <> ".tmp" tmp s = tmpD </> normalise s
tests/RenameFile001.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE CPP #-} module RenameFile001 where #include "util.inl"+import System.Directory.Internal main :: TestEnv -> IO () main _t = do writeFile tmp1 contents1- renameFile tmp1 tmp2+ renameFile (os tmp1) (os tmp2) T(expectEq) () contents1 =<< readFile tmp2 writeFile tmp1 contents2- renameFile tmp2 tmp1+ renameFile (os tmp2) (os tmp1) T(expectEq) () contents1 =<< readFile tmp1 where tmp1 = "tmp1"
tests/RenamePath.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} module RenamePath where #include "util.inl"+import System.Directory.Internal main :: TestEnv -> IO () main _t = do@@ -11,10 +12,10 @@ T(expectEq) () ["b"] =<< listDirectory "." writeFile tmp1 contents1- renamePath tmp1 tmp2+ renamePath (os tmp1) (os tmp2) T(expectEq) () contents1 =<< readFile tmp2 writeFile tmp1 contents2- renamePath tmp2 tmp1+ renamePath (os tmp2) (os tmp1) T(expectEq) () contents1 =<< readFile tmp1 where
− tests/Safe.hs
@@ -1,7 +0,0 @@--- Verify that System.Directory is indeed Safe (regression test for issue #30)-{-# LANGUAGE Safe #-}-module Safe where-import System.Directory ()--main :: a -> IO ()-main _ = return ()
tests/Simplify.hs view
@@ -2,7 +2,7 @@ module Simplify where #include "util.inl" import System.Directory.Internal (simplifyWindows)-import System.FilePath (normalise)+import System.OsPath (normalise) main :: TestEnv -> IO () main _t = do
tests/T8482.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE CPP #-} module T8482 where #include "util.inl"+import System.Directory.Internal -tmp1 :: FilePath+tmp1 :: OsPath tmp1 = "T8482.tmp1" -testdir :: FilePath+testdir :: OsPath testdir = "T8482.dir" main :: TestEnv -> IO () main _t = do- writeFile tmp1 "hello"+ writeFile (so tmp1) "hello" createDirectory testdir T(expectIOErrorType) () (is InappropriateType) (renameFile testdir tmp1) T(expectIOErrorType) () (is InappropriateType) (renameFile tmp1 testdir)
tests/TestUtils.hs view
@@ -1,17 +1,20 @@ {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-} -- | Utility functions specific to 'directory' tests module TestUtils ( copyPathRecursive+ , hardLinkOrCopy , modifyPermissions , symlinkOrCopy , supportsSymlinks ) where import Prelude () import System.Directory.Internal.Prelude-import System.Directory-import System.FilePath ((</>), normalise, takeDirectory)+import System.Directory.Internal+import System.Directory.OsPath+import Data.String (IsString(fromString))+import System.OsPath ((</>), normalise, takeDirectory) #if defined(mingw32_HOST_OS)-import System.Directory.Internal (win32_getFinalPathNameByHandle) import qualified System.Win32 as Win32 #endif @@ -19,7 +22,7 @@ -- /path/ together with its contents and subdirectories. -- -- Warning: mostly untested and might not handle symlinks correctly.-copyPathRecursive :: FilePath -> FilePath -> IO ()+copyPathRecursive :: OsPath -> OsPath -> IO () copyPathRecursive source dest = (`ioeSetLocation` "copyPathRecursive") `modifyIOError` do dirExists <- doesDirectoryExist source@@ -31,7 +34,7 @@ [(source </> x, dest </> x) | x <- contents] else copyFile source dest -modifyPermissions :: FilePath -> (Permissions -> Permissions) -> IO ()+modifyPermissions :: OsPath -> (Permissions -> Permissions) -> IO () modifyPermissions path modify = do permissions <- getPermissions path setPermissions path (modify permissions)@@ -52,11 +55,19 @@ _ -> ioError e #endif +-- | Create a hard link on Posix. On Windows, it just copies.+hardLinkOrCopy :: OsPath -> OsPath -> IO ()+#if defined(mingw32_HOST_OS)+hardLinkOrCopy = copyPathRecursive+#else+hardLinkOrCopy = createHardLink+#endif+ -- | Create a symbolic link. On Windows, this falls back to copying if -- forbidden by Group Policy or is not supported. On other platforms, there -- is no fallback. Also, automatically detect if the source is a file or a -- directory and create the appropriate type of link.-symlinkOrCopy :: FilePath -> FilePath -> IO ()+symlinkOrCopy :: OsPath -> OsPath -> IO () symlinkOrCopy target link = do let fullTarget = takeDirectory link </> target handleSymlinkUnavail (copyPathRecursive fullTarget link) $ do@@ -76,7 +87,7 @@ -- returns 'True'. supportsLinkCreation :: IO Bool supportsLinkCreation = do- let path = "_symlink_test.tmp"+ let path = os "_symlink_test.tmp" isSupported <- handleSymlinkUnavail (return False) $ do True <$ createFileLink path path when isSupported $ do@@ -94,3 +105,6 @@ #else return True #endif++instance IsString OsString where+ fromString = os
tests/Util.hs view
@@ -4,14 +4,11 @@ module Util where import Prelude () import System.Directory.Internal.Prelude-import System.Directory+import System.Directory.Internal+import System.Directory.OsPath import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime)-#if MIN_VERSION_base(4, 7, 0) import System.Environment (getEnvironment, setEnv, unsetEnv)-#elif !defined(mingw32_HOST_OS)-import qualified System.Posix as Posix-#endif-import System.FilePath ((</>), normalise)+import System.OsPath ((</>), decodeFS, encodeFS, normalise) import qualified Data.List as List modifyIORef' :: IORef a -> (a -> a) -> IO ()@@ -127,7 +124,7 @@ Right _ -> Left ["did not throw an exception"] -- | Traverse the directory tree in preorder.-preprocessPathRecursive :: (FilePath -> IO ()) -> FilePath -> IO ()+preprocessPathRecursive :: (OsPath -> IO ()) -> OsPath -> IO () preprocessPathRecursive f path = do dirExists <- doesDirectoryExist path if dirExists@@ -136,11 +133,11 @@ f path when (not isLink) $ do names <- listDirectory path- traverse_ (preprocessPathRecursive f) ((path </>) <$> names)+ for_ ((path </>) <$> names) (preprocessPathRecursive f) else do f path -withNewDirectory :: Bool -> FilePath -> IO a -> IO a+withNewDirectory :: Bool -> OsPath -> IO a -> IO a withNewDirectory keep dir action = do dir' <- makeAbsolute dir bracket_ (createDirectoryIfMissing True dir') (cleanup dir') action@@ -167,20 +164,11 @@ updateEnvs [] [] = pure () updateEnvs kvs1 [] = for_ kvs1 (unsetEnv . fst) updateEnvs [] kvs2 = for_ kvs2 (uncurry setEnv)-#if MIN_VERSION_base(4, 7, 0)-#elif !defined(mingw32_HOST_OS)- getEnvironment = Posix.getEnvironment- setEnv k v = Posix.setEnv k v True- unsetEnv = Posix.unsetEnv-#else- getEnvironment = pure []- setEnv _ _ = pure ()- unsetEnv _ = pure ()-#endif -isolateWorkingDirectory :: Bool -> FilePath -> IO a -> IO a+isolateWorkingDirectory :: Bool -> OsPath -> IO a -> IO a isolateWorkingDirectory keep dir action = do- when (normalise dir `List.elem` [".", "./"]) $+ normalisedDir <- decodeFS (normalise dir)+ when (normalisedDir `List.elem` [".", "./"]) $ throwIO (userError ("isolateWorkingDirectory cannot be used " <> "with current directory")) dir' <- makeAbsolute dir@@ -197,11 +185,11 @@ Right () -> return () isolatedRun :: TestEnv -> String -> (TestEnv -> IO ()) -> IO ()-isolatedRun t@TestEnv{testKeepDirs = keep} name = run t name . (isolate .)+isolatedRun t@TestEnv{testKeepDirs = keep} name action = do+ workDir <- encodeFS ("dist/test-" <> name <> ".tmp")+ run t name (isolate workDir . action) where- isolate =- isolateEnvironment .- isolateWorkingDirectory keep ("dist/test-" <> name <> ".tmp")+ isolate workDir = isolateEnvironment . isolateWorkingDirectory keep workDir tryRead :: Read a => String -> Maybe a tryRead s =
tests/WithCurrentDirectory.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE CPP #-} module WithCurrentDirectory where #include "util.inl"-import System.FilePath ((</>))+import System.Directory.Internal+import System.OsPath ((</>)) import qualified Data.List as List main :: TestEnv -> IO ()@@ -10,13 +11,13 @@ -- Make sure we're starting empty T(expectEq) () [] . List.sort =<< listDirectory dir cwd <- getCurrentDirectory- withCurrentDirectory dir (writeFile testfile contents)+ withCurrentDirectory dir (writeFile (so testfile) contents) -- Are we still in original directory? T(expectEq) () cwd =<< getCurrentDirectory -- Did the test file get created? T(expectEq) () [testfile] . List.sort =<< listDirectory dir -- Does the file contain what we expected to write?- T(expectEq) () contents =<< readFile (dir </> testfile)+ T(expectEq) () contents =<< readFile (so (dir </> testfile)) where testfile = "testfile" contents = "some data\n"
tests/Xdg.hs view
@@ -1,12 +1,10 @@ {-# LANGUAGE CPP #-} module Xdg where-#if MIN_VERSION_base(4, 7, 0) import qualified Data.List as List import System.Environment (setEnv, unsetEnv) import System.FilePath (searchPathSeparator) #if !defined(mingw32_HOST_OS)-import System.FilePath ((</>))-#endif+import System.OsPath ((</>)) #endif #include "util.inl" @@ -20,7 +18,6 @@ T(expect) () True -- avoid warnings about redundant imports -- 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@@ -61,6 +58,5 @@ setEnv "XDG_CONFIG_DIRS" (List.intercalate [searchPathSeparator] ["/c", "/d"]) T(expectEq) () ["/a", "/b"] =<< getXdgDirectoryList XdgDataDirs T(expectEq) () ["/c", "/d"] =<< getXdgDirectoryList XdgConfigDirs-#endif return ()
tests/util.inl view
@@ -2,7 +2,8 @@ import Prelude () import System.Directory.Internal.Prelude-import System.Directory+import System.Directory.OsPath+import TestUtils () import Util (TestEnv) import qualified Util as T -- This comment prevents "T" above from being treated as the function-like