packages feed

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 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