directory 1.3.3.0 → 1.3.3.1
raw patch · 11 files changed
+268/−144 lines, 11 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- System.Directory.Internal: prependCurrentDirectoryWith :: IO FilePath -> FilePath -> IO FilePath
+ System.Directory.Internal: emptyToCurDir :: FilePath -> FilePath
+ System.Directory.Internal: expandDots :: [FilePath] -> [FilePath]
+ System.Directory.Internal: normalisePathSeps :: FilePath -> FilePath
+ System.Directory.Internal: normaliseTrailingSep :: FilePath -> FilePath
+ System.Directory.Internal: simplify :: FilePath -> FilePath
+ System.Directory.Internal: simplifyPosix :: FilePath -> FilePath
+ System.Directory.Internal: simplifyWindows :: FilePath -> FilePath
Files
- System/Directory.hs +33/−23
- System/Directory/Internal/Common.hs +95/−28
- System/Directory/Internal/Posix.hsc +22/−6
- System/Directory/Internal/Windows.hsc +62/−86
- changelog.md +6/−0
- directory.cabal +2/−1
- tests/DoesDirectoryExist001.hs +2/−0
- tests/DoesPathExist.hs +2/−0
- tests/GetPermissions001.hs +3/−0
- tests/Main.hs +2/−0
- tests/Simplify.hs +39/−0
System/Directory.hs view
@@ -122,7 +122,6 @@ , isAbsolute , joinPath , makeRelative- , normalise , splitDirectories , takeDirectory )@@ -150,6 +149,16 @@ {- $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@@ -204,7 +213,7 @@ getPermissions :: FilePath -> IO Permissions getPermissions path = (`ioeAddLocation` "getPermissions") `modifyIOError` do- getAccessPermissions path+ getAccessPermissions (emptyToCurDir path) -- | Set the permissions of a file or directory. --@@ -223,7 +232,7 @@ setPermissions :: FilePath -> Permissions -> IO () setPermissions path p = (`ioeAddLocation` "setPermissions") `modifyIOError` do- setAccessPermissions path p+ setAccessPermissions (emptyToCurDir path) p -- | Copy the permissions of one file to another. This reproduces the -- permissions more accurately than using 'getPermissions' followed by@@ -297,7 +306,7 @@ | create_parents = createDirs (parents path0) | otherwise = createDirs (take 1 (parents path0)) where- parents = reverse . scanl1 (</>) . splitDirectories . normalise+ parents = reverse . scanl1 (</>) . splitDirectories . simplify createDirs [] = pure () createDirs (dir:[]) = createDir dir ioError@@ -755,10 +764,10 @@ let mtime = modificationTimeFromMetadata st setFileTimes dst (Just atime, Just mtime) --- | Make a path absolute, 'normalise' 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.+-- | 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@@ -769,7 +778,7 @@ -- 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 undergo 'normalise', but case+-- 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. --@@ -799,8 +808,8 @@ -- Windows @L\\..@ refers to @.@, whereas on other operating systems @L/..@ -- refers to @R@. ----- Similar to 'normalise', passing an empty path is equivalent to passing the--- current directory.+-- 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@@ -822,8 +831,8 @@ canonicalizePath = \ path -> ((`ioeAddLocation` "canonicalizePath") . (`ioeSetFileName` path)) `modifyIOError` do- -- normalise does more stuff, like upper-casing the drive letter- dropTrailingPathSeparator . normalise <$>+ -- simplify does more stuff, like upper-casing the drive letter+ dropTrailingPathSeparator . simplify <$> (canonicalizePathWith attemptRealpath =<< prependCurrentDirectory path) where @@ -888,10 +897,10 @@ 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--- 'normalise'd. If the path is already absolute, the path is simply--- 'normalise'd. The function preserves the presence or absence of the--- trailing path separator unless the path refers to the root directory @/@.+-- 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'.@@ -902,7 +911,7 @@ makeAbsolute path = ((`ioeAddLocation` "makeAbsolute") . (`ioeSetFileName` path)) `modifyIOError` do- matchTrailingSeparator path . normalise <$> prependCurrentDirectory path+ 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.@@ -1379,7 +1388,7 @@ getAccessTime :: FilePath -> IO UTCTime getAccessTime path = (`ioeAddLocation` "getAccessTime") `modifyIOError` do- accessTimeFromMetadata <$> getFileMetadata path+ accessTimeFromMetadata <$> getFileMetadata (emptyToCurDir path) -- | Obtain the time at which the file or directory was last modified. --@@ -1397,7 +1406,7 @@ getModificationTime :: FilePath -> IO UTCTime getModificationTime path = (`ioeAddLocation` "getModificationTime") `modifyIOError` do- modificationTimeFromMetadata <$> getFileMetadata path+ modificationTimeFromMetadata <$> getFileMetadata (emptyToCurDir path) -- | Change the time at which the file or directory was last accessed. --@@ -1460,7 +1469,7 @@ setFileTimes path (atime, mtime) = ((`ioeAddLocation` "setFileTimes") . (`ioeSetFileName` path)) `modifyIOError` do- setTimes (normalise path) -- handle empty paths+ setTimes (emptyToCurDir path) (utcTimeToPOSIXSeconds <$> atime, utcTimeToPOSIXSeconds <$> mtime) {- | Returns the current user's home directory.@@ -1499,7 +1508,8 @@ -- -- 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.+-- 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).@@ -1512,7 +1522,7 @@ -> IO FilePath getXdgDirectory xdgDir suffix = (`ioeAddLocation` "getXdgDirectory") `modifyIOError` do- normalise . (</> suffix) <$> getXdgDirectoryInternal getHomeDirectory xdgDir+ simplify . (</> suffix) <$> getXdgDirectoryInternal getHomeDirectory xdgDir getXdgDirectoryList :: XdgDirectoryList -- ^ which special directory list -> IO [FilePath]
System/Directory/Internal/Common.hs view
@@ -1,8 +1,19 @@ module System.Directory.Internal.Common where import Prelude () import System.Directory.Internal.Prelude-import System.FilePath ((</>), isPathSeparator, isRelative,- pathSeparator, splitDrive, takeDrive)+import System.FilePath+ ( addTrailingPathSeparator+ , hasTrailingPathSeparator+ , isPathSeparator+ , isRelative+ , joinDrive+ , joinPath+ , normalise+ , pathSeparator+ , pathSeparators+ , splitDirectories+ , splitDrive+ ) -- | A generator with side-effects. newtype ListT m a = ListT { unListT :: m (Maybe (a, ListT m a)) }@@ -84,6 +95,88 @@ newLoc = loc <> if null oldLoc then "" else ":" <> oldLoc oldLoc = ioeGetLocation e +-- | Given a list of path segments, expand @.@ and @..@. The path segments+-- must not contain path separators.+expandDots :: [FilePath] -> [FilePath]+expandDots = reverse . go []+ where+ go ys' xs' =+ case xs' of+ [] -> ys'+ x : xs ->+ case x of+ "." -> go ys' xs+ ".." ->+ case ys' of+ [] -> go (x : ys') xs+ ".." : _ -> go (x : ys') xs+ _ : ys -> go ys xs+ _ -> 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++-- | Remove redundant trailing slashes and pick the right kind of slash.+normaliseTrailingSep :: FilePath -> FilePath+normaliseTrailingSep path = do+ let path' = reverse path+ let (sep, path'') = span isPathSeparator path'+ let addSep = if null sep then id else (pathSeparator :)+ reverse (addSep path'')++-- | Convert empty paths to the current directory, otherwise leave it+-- unchanged.+emptyToCurDir :: FilePath -> FilePath+emptyToCurDir "" = "."+emptyToCurDir path = path++-- | Similar to 'normalise' but empty paths stay empty.+simplifyPosix :: FilePath -> FilePath+simplifyPosix "" = ""+simplifyPosix path = normalise path++-- | Similar to 'normalise' but:+--+-- * empty paths stay empty,+-- * parent dirs (@..@) are expanded, and+-- * 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+ where+ simplifiedPath = joinDrive drive' subpath'+ (drive, subpath) = splitDrive path+ drive' = upperDrive (normaliseTrailingSep (normalisePathSeps drive))+ subpath' = appendSep . avoidEmpty . prependSep . joinPath .+ stripPardirs . expandDots . skipSeps .+ splitDirectories $ subpath++ upperDrive d = case d of+ c : ':' : s | isAlpha c && all isPathSeparator s -> toUpper c : ':' : s+ _ -> d+ skipSeps = filter (not . (`elem` (pure <$> pathSeparators)))+ stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== "..")+ | otherwise = id+ prependSep | subpathIsAbsolute = (pathSeparator :)+ | otherwise = id+ avoidEmpty | not pathIsAbsolute+ && (null drive || hasTrailingPathSep) -- prefer "C:" over "C:."+ = emptyToCurDir+ | otherwise = id+ appendSep p | hasTrailingPathSep+ && not (pathIsAbsolute && null p)+ = addTrailingPathSeparator p+ | otherwise = p+ pathIsAbsolute = not (isRelative path)+ subpathIsAbsolute = any isPathSeparator (take 1 subpath)+ hasTrailingPathSep = hasTrailingPathSeparator subpath+ data FileType = File | SymbolicLink -- ^ POSIX: either file or directory link; Windows: file link | Directory@@ -111,32 +204,6 @@ , executable :: Bool , searchable :: Bool } deriving (Eq, Ord, Read, Show)---- | Convert a path into an absolute path. If the given path is relative, the--- current directory is prepended. If the path is already absolute, the path--- is returned unchanged. The function preserves the presence or absence of--- the trailing path separator.------ If the path is already absolute, the operation never fails. Otherwise, the--- operation may fail with the same exceptions as 'getCurrentDirectory'.------ (internal API)-prependCurrentDirectoryWith :: IO FilePath -> FilePath -> IO FilePath-prependCurrentDirectoryWith getCurrentDirectory path =- ((`ioeAddLocation` "prependCurrentDirectory") .- (`ioeSetFileName` path)) `modifyIOError` do- if isRelative path -- avoid the call to `getCurrentDirectory` if we can- then do- cwd <- getCurrentDirectory- let curDrive = takeWhile (not . isPathSeparator) (takeDrive cwd)- let (drive, subpath) = splitDrive path- -- handle drive-relative paths (Windows only)- pure . (</> subpath) $- case drive of- _ : _ | (toUpper <$> drive) /= (toUpper <$> curDrive) ->- drive <> [pathSeparator]- _ -> cwd- else pure path -- | Truncate the destination file and then copy the contents of the source -- file to the destination file. If the destination file already exists, its
System/Directory/Internal/Posix.hsc view
@@ -13,7 +13,7 @@ import System.Directory.Internal.Config (exeExtension) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime)-import System.FilePath ((</>), isRelative, normalise, splitSearchPath)+import System.FilePath ((</>), isRelative, splitSearchPath) import qualified Data.Time.Clock.POSIX as POSIXTime import qualified GHC.Foreign as GHC import qualified System.Posix as Posix@@ -28,6 +28,10 @@ renamePathInternal :: FilePath -> FilePath -> IO () renamePathInternal = Posix.rename +-- | On POSIX, equivalent to 'simplifyPosix'.+simplify :: FilePath -> FilePath+simplify = simplifyPosix+ -- we use the 'free' from the standard library here since it's not entirely -- clear whether Haskell's 'free' corresponds to the same one foreign import ccall unsafe "free" c_free :: Ptr a -> IO ()@@ -96,8 +100,22 @@ getCurrentDirectoryInternal :: IO FilePath getCurrentDirectoryInternal = 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.+-- If the path is already absolute, the path is returned unchanged. The+-- function preserves the presence or absence of the trailing path separator.+--+-- If the path is already absolute, the operation never fails. Otherwise, the+-- operation may throw exceptions.+--+-- Empty paths are treated as the current directory. prependCurrentDirectory :: FilePath -> IO FilePath-prependCurrentDirectory = prependCurrentDirectoryWith getCurrentDirectoryInternal+prependCurrentDirectory path+ | isRelative path =+ ((`ioeAddLocation` "prependCurrentDirectory") .+ (`ioeSetFileName` path)) `modifyIOError` do+ (</> path) <$> getCurrentDirectoryInternal+ | otherwise = pure path setCurrentDirectoryInternal :: FilePath -> IO () setCurrentDirectoryInternal = Posix.changeWorkingDirectory@@ -113,13 +131,11 @@ type Metadata = Posix.FileStatus --- note: normalise is needed to handle empty paths- getSymbolicLinkMetadata :: FilePath -> IO Metadata-getSymbolicLinkMetadata = Posix.getSymbolicLinkStatus . normalise+getSymbolicLinkMetadata = Posix.getSymbolicLinkStatus getFileMetadata :: FilePath -> IO Metadata-getFileMetadata = Posix.getFileStatus . normalise+getFileMetadata = Posix.getFileStatus fileTypeFromMetadata :: Metadata -> FileType fileTypeFromMetadata stat
System/Directory/Internal/Windows.hsc view
@@ -21,17 +21,10 @@ import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime) import System.FilePath ( (</>)- , addTrailingPathSeparator- , hasTrailingPathSeparator , isPathSeparator , isRelative- , joinDrive- , joinPath- , normalise , pathSeparator- , pathSeparators , splitDirectories- , splitDrive , takeExtension ) import qualified Data.List as List@@ -40,20 +33,20 @@ createDirectoryInternal :: FilePath -> IO () createDirectoryInternal path = (`ioeSetFileName` path) `modifyIOError` do- path' <- toExtendedLengthPath <$> prependCurrentDirectory path+ path' <- furnishPath path Win32.createDirectory path' Nothing removePathInternal :: Bool -> FilePath -> IO () removePathInternal isDir path = (`ioeSetFileName` path) `modifyIOError` do- toExtendedLengthPath <$> prependCurrentDirectory path+ furnishPath path >>= if isDir then Win32.removeDirectory else Win32.deleteFile renamePathInternal :: FilePath -> FilePath -> IO () renamePathInternal opath npath = (`ioeSetFileName` opath) `modifyIOError` do- opath' <- toExtendedLengthPath <$> prependCurrentDirectory opath- npath' <- toExtendedLengthPath <$> prependCurrentDirectory npath+ opath' <- furnishPath opath+ npath' <- furnishPath npath #if MIN_VERSION_Win32(2, 6, 0) Win32.moveFileEx opath' (Just npath') Win32.mOVEFILE_REPLACE_EXISTING #else@@ -67,8 +60,8 @@ -> IO () copyFileWithMetadataInternal _ _ src dst = (`ioeSetFileName` src) `modifyIOError` do- src' <- toExtendedLengthPath <$> prependCurrentDirectory src- dst' <- toExtendedLengthPath <$> prependCurrentDirectory dst+ src' <- furnishPath src+ dst' <- furnishPath dst Win32.copyFile src' dst' False win32_cSIDL_LOCAL_APPDATA :: Win32.CSIDL@@ -289,7 +282,7 @@ readSymbolicLink :: FilePath -> IO FilePath readSymbolicLink path = (`ioeSetFileName` path) `modifyIOError` do- path' <- toExtendedLengthPath <$> prependCurrentDirectory path+ path' <- furnishPath path let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING (Win32.fILE_FLAG_BACKUP_SEMANTICS .|. win32_fILE_FLAG_OPEN_REPARSE_POINT) Nothing@@ -315,60 +308,9 @@ where strip sn = fromMaybe sn (List.stripPrefix "\\??\\" sn) --- | Given a list of path segments, expand @.@ and @..@. The path segments--- must not contain path separators.-expandDots :: [FilePath] -> [FilePath]-expandDots = reverse . go []- where- go ys' xs' =- case xs' of- [] -> ys'- x : xs ->- case x of- "." -> go ys' xs- ".." ->- case ys' of- _ : ys -> go ys xs- [] -> go (x : ys') xs- _ -> go (x : ys') xs---- | Remove redundant trailing slashes and pick the right kind of slash.-normaliseTrailingSep :: FilePath -> FilePath-normaliseTrailingSep path = do- let path' = reverse path- let (sep, path'') = span isPathSeparator path'- let addSep = if null sep then id else (pathSeparator :)- reverse (addSep path'')---- | A variant of 'normalise' to handle Windows paths a little better. It------ * deduplicates trailing slashes after the drive,--- * expands parent dirs (@..@), and--- * preserves paths with @\\\\?\\@.-normaliseW :: FilePath -> FilePath-normaliseW path@('\\' : '\\' : '?' : '\\' : _) = path-normaliseW path = normalise (joinDrive drive' subpath')- where- (drive, subpath) = splitDrive path- drive' = normaliseTrailingSep drive- subpath' = appendSep . prependSep . joinPath .- stripPardirs . expandDots . skipSeps .- splitDirectories $ subpath-- skipSeps = filter (not . (`elem` (pure <$> pathSeparators)))- stripPardirs | not (isRelative path) = dropWhile (== "..")- | otherwise = id- prependSep | any isPathSeparator (take 1 subpath) = (pathSeparator :)- | otherwise = id- appendSep | hasTrailingPathSeparator subpath = addTrailingPathSeparator- | otherwise = id---- | Like 'toExtendedLengthPath' but normalises relative paths too.--- This is needed to make sure e.g. getModificationTime works on empty paths.-toNormalisedExtendedLengthPath :: FilePath -> FilePath-toNormalisedExtendedLengthPath path- | isRelative path = normalise path- | otherwise = toExtendedLengthPath path+-- | On Windows, equivalent to 'simplifyWindows'.+simplify :: FilePath -> FilePath+simplify = simplifyWindows -- | Normalise the path separators and prepend the @"\\\\?\\"@ prefix if -- necessary or possible. This is used for symbolic links targets because@@ -379,20 +321,33 @@ | otherwise = toExtendedLengthPath path where normaliseSep c = if isPathSeparator c then pathSeparator else c --- | Add the @"\\\\?\\"@ prefix if necessary or possible. The path remains--- unchanged if the prefix is not added. This function can sometimes be used--- to bypass the @MAX_PATH@ length restriction in Windows API calls.+-- | '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 = path+ | isRelative path = simplifiedPath | otherwise =- case normaliseW path of- '\\' : '?' : '?' : '\\' : _ -> path- '\\' : '\\' : '?' : '\\' : _ -> path- '\\' : '\\' : '.' : '\\' : _ -> path+ case simplifiedPath of+ '\\' : '?' : '?' : '\\' : _ -> simplifiedPath+ '\\' : '\\' : '?' : '\\' : _ -> simplifiedPath+ '\\' : '\\' : '.' : '\\' : _ -> simplifiedPath '\\' : subpath@('\\' : _) -> "\\\\?\\UNC" <> subpath- normalisedPath -> "\\\\?\\" <> normalisedPath+ _ -> "\\\\?\\" <> simplifiedPath+ where simplifiedPath = simplify path +-- | Make a path absolute and convert to an extended length path, if possible.+--+-- Empty paths are left unchanged.+--+-- This function never fails. If it doesn't understand the path, it just+-- returns the path unchanged.+furnishPath :: FilePath -> IO FilePath+furnishPath path =+ (toExtendedLengthPath <$> rawPrependCurrentDirectory path)+ `catchIOError` \ _ ->+ pure path+ -- | Strip the @"\\\\?\\"@ prefix if possible. -- The prefix is kept if the meaning of the path would otherwise change. fromExtendedLengthPath :: FilePath -> FilePath@@ -438,8 +393,7 @@ canonicalizePathSimplify :: FilePath -> IO FilePath canonicalizePathSimplify path =- (fromExtendedLengthPath <$>- Win32.getFullPathName (toExtendedLengthPath path))+ getFullPathName path `catchIOError` \ _ -> pure path @@ -460,7 +414,7 @@ getDirectoryContentsInternal :: FilePath -> IO [FilePath] getDirectoryContentsInternal path = do- query <- toExtendedLengthPath <$> prependCurrentDirectory (path </> "*")+ query <- furnishPath (path </> "*") bracket (Win32.findFirstFile query) (\ (h, _) -> Win32.findClose h)@@ -480,8 +434,30 @@ getCurrentDirectoryInternal :: IO FilePath getCurrentDirectoryInternal = Win32.getCurrentDirectory +getFullPathName :: FilePath -> IO FilePath+getFullPathName path =+ fromExtendedLengthPath <$> Win32.getFullPathName (toExtendedLengthPath path)++-- | Similar to 'prependCurrentDirectory' but fails for empty paths.+rawPrependCurrentDirectory :: FilePath -> IO FilePath+rawPrependCurrentDirectory path+ | isRelative path =+ ((`ioeAddLocation` "prependCurrentDirectory") .+ (`ioeSetFileName` path)) `modifyIOError` do+ getFullPathName path+ | otherwise = pure path++-- | 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.+-- If the path is already absolute, the path is returned unchanged. The+-- function preserves the presence or absence of the trailing path separator.+--+-- If the path is already absolute, the operation never fails. Otherwise, the+-- operation may throw exceptions.+--+-- Empty paths are treated as the current directory. prependCurrentDirectory :: FilePath -> IO FilePath-prependCurrentDirectory = prependCurrentDirectoryWith getCurrentDirectoryInternal+prependCurrentDirectory = rawPrependCurrentDirectory . emptyToCurDir -- SetCurrentDirectory does not support long paths even with the \\?\ prefix -- https://ghc.haskell.org/trac/ghc/ticket/13373#comment:6@@ -539,7 +515,7 @@ createSymbolicLink isDir target link = (`ioeSetFileName` link) `modifyIOError` do -- normaliseSeparators ensures the target gets normalised properly- link' <- toExtendedLengthPath <$> prependCurrentDirectory link+ link' <- furnishPath link createSymbolicLinkUnpriv link' (normaliseSeparators target) isDir type Metadata = Win32.BY_HANDLE_FILE_INFORMATION@@ -547,7 +523,7 @@ getSymbolicLinkMetadata :: FilePath -> IO Metadata getSymbolicLinkMetadata path = (`ioeSetFileName` path) `modifyIOError` do- path' <- toNormalisedExtendedLengthPath <$> prependCurrentDirectory path+ path' <- furnishPath path let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING (Win32.fILE_FLAG_BACKUP_SEMANTICS .|. win32_fILE_FLAG_OPEN_REPARSE_POINT) Nothing@@ -557,7 +533,7 @@ getFileMetadata :: FilePath -> IO Metadata getFileMetadata path = (`ioeSetFileName` path) `modifyIOError` do- path' <- toNormalisedExtendedLengthPath <$> prependCurrentDirectory path+ path' <- furnishPath path let open = Win32.createFile path' 0 maxShareMode Nothing Win32.oPEN_EXISTING Win32.fILE_FLAG_BACKUP_SEMANTICS Nothing bracket open Win32.closeHandle $ \ h -> do@@ -612,7 +588,7 @@ openFileHandle :: String -> Win32.AccessMode -> IO Win32.HANDLE openFileHandle path mode = (`ioeSetFileName` path) `modifyIOError` do- path' <- toExtendedLengthPath <$> prependCurrentDirectory path+ path' <- furnishPath path Win32.createFile path' mode maxShareMode Nothing Win32.oPEN_EXISTING flags Nothing where flags = Win32.fILE_ATTRIBUTE_NORMAL@@ -633,7 +609,7 @@ setFileMode :: FilePath -> Mode -> IO () setFileMode path mode = (`ioeSetFileName` path) `modifyIOError` do- path' <- toNormalisedExtendedLengthPath <$> prependCurrentDirectory path+ path' <- furnishPath path Win32.setFileAttributes path' mode -- | A restricted form of 'setFileMode' that only sets the permission bits.
changelog.md view
@@ -1,6 +1,12 @@ Changelog for the [`directory`][1] package ========================================== +## 1.3.3.1 (August 2018)++ * `doesDirectoryExist` and `doesPathExist` reject empty paths once again,+ reversing an undocumented change introduced in 1.3.1.1.+ ([#84](https://github.com/haskell/directory/issues/84))+ ## 1.3.3.0 (June 2018) * Relax `unix` version bounds to support 2.8.
directory.cabal view
@@ -1,5 +1,5 @@ name: directory-version: 1.3.3.0+version: 1.3.3.1 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE@@ -107,6 +107,7 @@ RenameFile001 RenamePath Safe+ Simplify T8482 WithCurrentDirectory Xdg
tests/DoesDirectoryExist001.hs view
@@ -10,7 +10,9 @@ createDirectory "somedir" + T(expect) () . not =<< doesDirectoryExist "" T(expect) () . not =<< doesDirectoryExist "nonexistent"+ T(expect) () =<< doesDirectoryExist "." T(expect) () =<< doesDirectoryExist "somedir" #if defined(mingw32_HOST_OS) T(expect) () =<< doesDirectoryExist "SoMeDiR"
tests/DoesPathExist.hs view
@@ -11,7 +11,9 @@ writeFile "somefile" "somedata" writeFile "\x3c0\x42f\x97f3\xe6\x221e" "somedata" + T(expect) () . not =<< doesPathExist "" T(expect) () . not =<< doesPathExist "nonexistent"+ T(expect) () =<< doesPathExist "." T(expect) () =<< doesPathExist "somedir" T(expect) () =<< doesPathExist "somefile" T(expect) () =<< doesPathExist "./somefile"
tests/GetPermissions001.hs view
@@ -25,6 +25,9 @@ modifyPermissions foo (\ p -> p { writable = False }) T(expect) () =<< not . writable <$> getPermissions foo + -- test empty path+ modifyPermissions "" id+ where checkCurrentDir = do
tests/Main.hs view
@@ -26,6 +26,7 @@ import qualified RenameFile001 import qualified RenamePath import qualified Safe+import qualified Simplify import qualified T8482 import qualified WithCurrentDirectory import qualified Xdg@@ -58,6 +59,7 @@ 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 T.isolatedRun _t "Xdg" Xdg.main
+ tests/Simplify.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE CPP #-}+module Simplify where+#include "util.inl"+import System.Directory.Internal (simplifyWindows)+import System.FilePath (normalise)++main :: TestEnv -> IO ()+main _t = do+ T(expectIOErrorType) () (const True) (setCurrentDirectory "")+ T(expectEq) () (simplifyWindows "") ""+ T(expectEq) () (simplifyWindows ".") "."+ T(expectEq) () (simplifyWindows "a///b") (normalise "a/b")+ T(expectEq) () (simplifyWindows "./a//b") (normalise "a/b")+ T(expectEq) () (simplifyWindows "a/../../../b/.") (normalise "../../b")+ T(expectEq) () (simplifyWindows "a/.././b/./") (normalise "b/")+ T(expectEq) () (simplifyWindows "C:/a/../b") (normalise "C:/b")+ T(expectEq) () (simplifyWindows "\\\\?\\./a\\../b") "\\\\?\\./a\\../b"+ T(expectEq) () (simplifyWindows "C:/a") (normalise "C:/a")+ T(expectEq) () (simplifyWindows "/a") (normalise "/a")+#ifdef mingw32_HOST_OS+ T(expectEq) () (simplifyWindows "C:") "C:"+ T(expectEq) () (simplifyWindows "c:\\\\") "C:\\"+ T(expectEq) () (simplifyWindows "C:.") "C:"+ T(expectEq) () (simplifyWindows "C:.\\\\") "C:.\\"+ T(expectEq) () (simplifyWindows "C:..") "C:.."+ T(expectEq) () (simplifyWindows "C:..\\") "C:..\\"+ T(expectEq) () (simplifyWindows "C:\\.\\") "C:\\"+ T(expectEq) () (simplifyWindows "C:\\a") "C:\\a"+ T(expectEq) () (simplifyWindows "C:\\a\\\\b\\") "C:\\a\\b\\"+ T(expectEq) () (simplifyWindows "\\\\a\\b") "\\\\a\\b"+ T(expectEq) () (simplifyWindows "//a\\b/c/./d") "\\\\a\\b\\c\\d"+ T(expectEq) () (simplifyWindows "/.") "\\"+ T(expectEq) () (simplifyWindows "/./") "\\"+ T(expectEq) () (simplifyWindows "/../") "\\"+ T(expectEq) () (simplifyWindows "\\a\\.") "\\a"+ T(expectEq) () (simplifyWindows "//?") "\\\\?"+ T(expectEq) () (simplifyWindows "//?\\") "\\\\?\\"+ T(expectEq) () (simplifyWindows "//?/a/b") "\\\\?\\a/b"+#endif