directory 1.2.6.3 → 1.2.7.0

raw patch · 13 files changed

+324/−129 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +2/−2
• System/Directory.hs +107/−13
• cbits/directory.c +0/−9
• changelog.md +22/−7
• directory.cabal +6/−8
• include/HsDirectory.h +0/−70
• tests/DoesDirectoryExist001.hs +8/−0
• tests/DoesPathExist.hs +30/−0
• tests/GetFileSize.hs +19/−0
• tests/Main.hs +8/−0
• tests/RemovePathForcibly.hs +90/−0
• tests/RenamePath.hs +25/−0
• tests/Util.hs +7/−20

@@ -24,6 +24,6 @@ [hl]: https://hackage.haskell.org/package/directory [bi]: https://travis-ci.org/haskell/directory.svg?branch=master [bl]: https://travis-ci.org/haskell/directory-[wi]: https://ci.appveyor.com/api/projects/status/github/haskell/directory?svg=true-[wl]: https://ci.appveyor.com/project/Rufflewind/directory+[wi]: https://ci.appveyor.com/api/projects/status/github/haskell/directory?branch=master&svg=true+[wl]: https://ci.appveyor.com/project/hvr/directory [ac]: https://gnu.org/software/autoconf

@@ -29,6 +29,7 @@     , createDirectoryIfMissing     , removeDirectory     , removeDirectoryRecursive+    , removePathForcibly     , renameDirectory     , listDirectory     , getDirectoryContents@@ -48,6 +49,7 @@     -- * Actions on files     , removeFile     , renameFile+    , renamePath     , copyFile     , copyFileWithMetadata @@ -63,7 +65,10 @@     , findFilesWith     , exeExtension +    , getFileSize+     -- * Existence tests+    , doesPathExist     , doesFileExist     , doesDirectoryExist @@ -565,6 +570,33 @@     mapM_ removePathRecursive [path </> x | x <- cont]     removeDirectory path +-- | @'removePathForcibly@ removes a file or directory at /path/ together with+-- its contents and subdirectories. Symbolic links are removed without+-- affecting their the 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.+removePathForcibly :: FilePath -> IO ()+removePathForcibly path =+  (`ioeSetLocation` "removePathForcibly") `modifyIOError` do+    makeRemovable path `catchIOError` \ _ -> return ()+    dirType <- tryIOErrorType isDoesNotExistError (getDirectoryType path)+    case dirType of+      Left _              -> return ()+      Right NotDirectory  -> removeFile path+      Right DirectoryLink -> removeDirectory path+      Right Directory     -> do+        mapM_ (removePathForcibly . (path </>)) =<< listDirectory path+        removeDirectory path+  where+    makeRemovable p = 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@@ -671,11 +703,7 @@    when (not is_dir) $ do      ioError . (`ioeSetErrorString` "not a directory") $        (mkIOError InappropriateType "renameDirectory" Nothing (Just opath))-#ifdef mingw32_HOST_OS-   Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING-#else-   Posix.rename opath npath-#endif+   renamePath opath npath  {- |@'renameFile' old new@ changes the name of an existing file system object from /old/ to /new/.  If the /new/ object already@@ -725,11 +753,7 @@ renameFile opath npath = (`ioeSetLocation` "renameFile") `modifyIOError` do    -- XXX the tests are not performed atomically with the rename    checkNotDir opath-#ifdef mingw32_HOST_OS-   Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING-#else-   Posix.rename opath npath-#endif+   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@@ -749,6 +773,57 @@          errIsDir path = ioError . (`ioeSetErrorString` "is a directory") $                          mkIOError InappropriateType "" Nothing (Just path) +-- | 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' \/ 'NoSuchThing'+-- The original file does not exist, or there is no path to the target.+-- @[ENOENT, ENOTDIR]@+--+-- * 'isPermissionError' \/ 'PermissionDenied'+-- The process has insufficient privileges to perform the operation.+-- @[EROFS, EACCES, EPERM]@+--+-- * 'ResourceExhausted'+-- 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 :: FilePath                  -- ^ Old path+           -> FilePath                  -- ^ New path+           -> IO ()+renamePath opath npath = (`ioeSetLocation` "renamePath") `modifyIOError` do+#ifdef mingw32_HOST_OS+   Win32.moveFileEx opath npath Win32.mOVEFILE_REPLACE_EXISTING+#else+   Posix.rename opath npath+#endif+ -- | 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@@ -965,9 +1040,6 @@     realpath encoding path =       GHC.withCString encoding path       (`withRealpath` GHC.peekCString encoding)--    doesPathExist path = (Posix.getFileStatus path >> return True)-                         `catchIOError` \ _ -> return False #endif  -- | Convert a path into an absolute path.  If the given path is relative, the@@ -1321,6 +1393,28 @@   bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do     setCurrentDirectory dir     action++-- | Obtain the size of a file in bytes.+getFileSize :: FilePath -> IO Integer+getFileSize path =+  (`ioeSetLocation` "getFileSize") `modifyIOError` do+#ifdef mingw32_HOST_OS+    fromIntegral <$> withFileStatus "" path st_size+#else+    fromIntegral . Posix.fileSize <$> Posix.getFileStatus path+#endif++-- | 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.+doesPathExist :: FilePath -> IO Bool+doesPathExist path =+#ifdef mingw32_HOST_OS+  (withFileStatus "" path $ \ _ -> return True)+#else+  (Posix.getFileStatus path >> return True)+#endif+  `catchIOError` \ _ -> return False  {- |The operation 'doesDirectoryExist' returns 'True' if the argument file exists and is either a directory or a symbolic link to a directory,

@@ -1,9 +0,0 @@-/*- * (c) The University of Glasgow 2002- *- */--/* [DEPRECATED] This file may be removed in future versions. */--#define INLINE-#include "HsDirectory.h"

@@ -1,24 +1,39 @@ Changelog for the [`directory`][1] package ========================================== -## 1.2.6.3 (May 2015)+## 1.2.7.0 (August 2016) +  * Remove deprecated C bits.  This means `HsDirectory.h` and its functions+    are no longer available.+    ([#50](https://github.com/haskell/directory/issues/50))++  * Add `doesPathExist` and `getFileSize`+    ([#57](https://github.com/haskell/directory/issues/57))++  * Add `renamePath`+    ([#58](https://github.com/haskell/directory/issues/58))++  * Add `removePathForcibly`+    ([#59](https://github.com/haskell/directory/issues/59))++## 1.2.6.3 (May 2016)+   * Add missing import of `(<*>)` on Windows for `base` earlier than 4.8.0.0     ([#53](https://github.com/haskell/directory/issues/53)) -## 1.2.6.2 (April 2015)+## 1.2.6.2 (April 2016) +  * Bundled with GHC 8.0.1+   * Fix typo in file time functions when `utimensat` is not available and     version of `unix` package is lower than 2.7.0.0 -## 1.2.6.1 (April 2015)--  * Bundled with GHC 8.0.1+## 1.2.6.1 (April 2016)    * Fix mistake in file time functions when `utimensat` is not available     ([#47](https://github.com/haskell/directory/pull/47)) -## 1.2.6.0 (April 2015)+## 1.2.6.0 (April 2016)    * Make `findExecutable`, `findExecutables`, `findExecutablesInDirectories`,     `findFile`, and `findFilesWith` lazier@@ -36,7 +51,7 @@    * Drop support for Hugs. -## 1.2.5.1 (February 2015)+## 1.2.5.1 (February 2016)    * Improve error message of `getCurrentDirectory` when the current working     directory no longer exists

@@ -1,5 +1,5 @@ name:           directory-version:        1.2.6.3+version:        1.2.7.0 -- NOTE: Don't forget to update ./changelog.md license:        BSD3 license-file:   LICENSE@@ -49,13 +49,7 @@         System.Directory.Internal.Posix         System.Directory.Internal.Windows -    c-sources:-        cbits/directory.c-    include-dirs: . include-    includes:-        HsDirectory.h-    install-includes:-        HsDirectory.h+    include-dirs: .      build-depends:         base     >= 4.5 && < 4.10,@@ -93,16 +87,20 @@         CurrentDirectory001         Directory001         DoesDirectoryExist001+        DoesPathExist         FileTime         FindFile001         GetDirContents001         GetDirContents002+        GetFileSize         GetHomeDirectory001         GetPermissions001         IsSymbolicLink         RemoveDirectoryRecursive001+        RemovePathForcibly         RenameDirectory         RenameFile001+        RenamePath         Safe         T8482         WithCurrentDirectory

@@ -1,70 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The University of Glasgow 2001-2004- *- * Definitions for package `directory' which are visible in Haskell land.- *- * ---------------------------------------------------------------------------*/--/* [DEPRECATED] Do not include this header nor HsDirectoryConfig.h.  They are-   for internal use only and may be removed in future versions. */--#ifndef __HSDIRECTORY_H__-#define __HSDIRECTORY_H__--// On Solaris we have to make sure _FILE_OFFSET_BITS is defined -// before including <sys/stat.h> below, because that header-// will try and define it if it isn't already.-#include "HsFFI.h"--#include "HsDirectoryConfig.h"--// Otherwise these clash with similar definitions from other packages:-#undef PACKAGE_BUGREPORT-#undef PACKAGE_NAME-#undef PACKAGE_STRING-#undef PACKAGE_TARNAME-#undef PACKAGE_VERSION--#if HAVE_SYS_STAT_H-#include <sys/stat.h>-#endif--#if HAVE_SYS_TYPES_H-#include <sys/types.h>-#endif--#include "HsFFI.h"--/* ------------------------------------------------------------------------------   INLINE functions.--   These functions are given as inlines here for when compiling via C,-   but we also generate static versions into the cbits library for-   when compiling to native code.-   -------------------------------------------------------------------------- */--#ifndef INLINE-# if defined(_MSC_VER)-#  define INLINE extern __inline-# else-#  define INLINE static inline-# endif-#endif--/* Do not use: it may give the wrong value on systems where PATH_MAX is not-   defined (e.g. Hurd).  Instead, use System.Directory.Internal.c_PATH_MAX. */-INLINE HsInt __hscore_long_path_size(void) {-#ifdef PATH_MAX-    return PATH_MAX;-#else-    return 4096;-#endif-}--INLINE mode_t __hscore_S_IRUSR(void) { return S_IRUSR; }-INLINE mode_t __hscore_S_IWUSR(void) { return S_IWUSR; }-INLINE mode_t __hscore_S_IXUSR(void) { return S_IXUSR; }-INLINE mode_t __hscore_S_IFDIR(void) { return S_IFDIR; }--#endif /* __HSDIRECTORY_H__ */

@@ -9,6 +9,14 @@   -- [regression test] "/" was not recognised as a directory prior to GHC 6.1   T(expect) () =<< doesDirectoryExist rootDir +  createDirectory "somedir"++  T(expect) () . not =<< doesDirectoryExist "nonexistent"+  T(expect) () =<< doesDirectoryExist "somedir"+#ifdef mingw32_HOST_OS+  T(expect) () =<< doesDirectoryExist "SoMeDiR"+#endif+   where #ifdef mingw32_HOST_OS     rootDir = "C:\\"

@@ -0,0 +1,30 @@+{-# LANGUAGE CPP #-}+module DoesPathExist where+#include "util.inl"+import System.Directory++main :: TestEnv -> IO ()+main _t = do++  T(expect) () =<< doesPathExist rootDir++  createDirectory "somedir"+  writeFile "somefile" "somedata"+  writeFile "\x3c0\x42f\x97f3\xe6\x221e" "somedata"++  T(expect) () . not =<< doesPathExist "nonexistent"+  T(expect) () =<< doesPathExist "somedir"+  T(expect) () =<< doesPathExist "somefile"+  T(expect) () =<< doesPathExist "./somefile"+#ifdef mingw32_HOST_OS+  T(expect) () =<< doesPathExist "SoMeDiR"+  T(expect) () =<< doesPathExist "sOmEfIlE"+#endif+  T(expect) () =<< doesPathExist "\x3c0\x42f\x97f3\xe6\x221e"++  where+#ifdef mingw32_HOST_OS+    rootDir = "C:\\"+#else+    rootDir = "/"+#endif

@@ -0,0 +1,19 @@+{-# LANGUAGE CPP #-}+module GetFileSize where+#include "util.inl"+import System.Directory+import qualified System.IO as IO++main :: TestEnv -> IO ()+main _t = do++  IO.withBinaryFile "emptyfile" IO.WriteMode $ \ _ -> do+    return ()+  IO.withBinaryFile "testfile" IO.WriteMode $ \ h -> do+    IO.hPutStr h string++  T(expectEq) () 0 =<< getFileSize "emptyfile"+  T(expectEq) () (fromIntegral (length string)) =<< getFileSize "testfile"++  where+    string = "The quick brown fox jumps over the lazy dog."

@@ -9,16 +9,20 @@ import qualified CurrentDirectory001 import qualified Directory001 import qualified DoesDirectoryExist001+import qualified DoesPathExist import qualified FileTime import qualified FindFile001 import qualified GetDirContents001 import qualified GetDirContents002+import qualified GetFileSize import qualified GetHomeDirectory001 import qualified GetPermissions001 import qualified IsSymbolicLink import qualified RemoveDirectoryRecursive001+import qualified RemovePathForcibly import qualified RenameDirectory import qualified RenameFile001+import qualified RenamePath import qualified Safe import qualified T8482 import qualified WithCurrentDirectory@@ -34,16 +38,20 @@   T.isolatedRun _t "CurrentDirectory001" CurrentDirectory001.main   T.isolatedRun _t "Directory001" Directory001.main   T.isolatedRun _t "DoesDirectoryExist001" DoesDirectoryExist001.main+  T.isolatedRun _t "DoesPathExist" DoesPathExist.main   T.isolatedRun _t "FileTime" FileTime.main   T.isolatedRun _t "FindFile001" FindFile001.main   T.isolatedRun _t "GetDirContents001" GetDirContents001.main   T.isolatedRun _t "GetDirContents002" GetDirContents002.main+  T.isolatedRun _t "GetFileSize" GetFileSize.main   T.isolatedRun _t "GetHomeDirectory001" GetHomeDirectory001.main   T.isolatedRun _t "GetPermissions001" GetPermissions001.main   T.isolatedRun _t "IsSymbolicLink" IsSymbolicLink.main   T.isolatedRun _t "RemoveDirectoryRecursive001" RemoveDirectoryRecursive001.main+  T.isolatedRun _t "RemovePathForcibly" RemovePathForcibly.main   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 "T8482" T8482.main   T.isolatedRun _t "WithCurrentDirectory" WithCurrentDirectory.main

@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+module RemovePathForcibly where+#include "util.inl"+import System.Directory+import Data.List (sort)+import System.FilePath ((</>), normalise)+import System.IO.Error (catchIOError)+import TestUtils++main :: TestEnv -> IO ()+main _t = do++  ------------------------------------------------------------+  -- clean up junk from previous invocations++  modifyPermissions (tmp "c") (\ p -> p { writable = True })+    `catchIOError` \ _ -> return ()+  removePathForcibly tmpD+    `catchIOError` \ _ -> return ()++  ------------------------------------------------------------+  -- set up++  createDirectoryIfMissing True (tmp "a/x/w")+  createDirectoryIfMissing True (tmp "a/y")+  createDirectoryIfMissing True (tmp "a/z")+  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"+  tryCreateSymbolicLink (normalise "../a") (tmp "b/g")+  tryCreateSymbolicLink (normalise "../b") (tmp "c/h")+  tryCreateSymbolicLink (normalise "a")    (tmp "d")+  setPermissions (tmp "f/s") emptyPermissions+  setPermissions (tmp "f") emptyPermissions++  ------------------------------------------------------------+  -- tests++  removePathForcibly (tmp "f")+  removePathForcibly (tmp "e") -- intentionally non-existent++  T(expectEq) () [".", "..", "a", "b", "c", "d"] . sort =<<+    getDirectoryContents  tmpD+  T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<<+    getDirectoryContents (tmp "a")+  T(expectEq) () [".", "..", "g"] . sort =<<+    getDirectoryContents (tmp "b")+  T(expectEq) () [".", "..", "h"] . sort =<<+    getDirectoryContents (tmp "c")+  T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<<+    getDirectoryContents (tmp "d")++  removePathForcibly (tmp "d")++  T(expectEq) () [".", "..", "a", "b", "c"] . sort =<<+    getDirectoryContents  tmpD+  T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<<+    getDirectoryContents (tmp "a")+  T(expectEq) () [".", "..", "g"] . sort =<<+    getDirectoryContents (tmp "b")+  T(expectEq) () [".", "..", "h"] . sort =<<+    getDirectoryContents (tmp "c")++  removePathForcibly (tmp "c")++  T(expectEq) () [".", "..", "a", "b"] . sort =<<+    getDirectoryContents  tmpD+  T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<<+   getDirectoryContents (tmp "a")+  T(expectEq) () [".", "..", "g"] . sort =<<+    getDirectoryContents (tmp "b")++  removePathForcibly (tmp "b")++  T(expectEq) () [".", "..", "a"] . sort =<<+    getDirectoryContents  tmpD+  T(expectEq) () [".", "..", "t", "x", "y", "z"] . sort =<<+    getDirectoryContents (tmp "a")++  removePathForcibly (tmp "a")++  T(expectEq) () [".", ".."] . sort =<<+    getDirectoryContents  tmpD++  where testName = "removePathForcibly"+        tmpD  = testName ++ ".tmp"+        tmp s = tmpD </> normalise s

@@ -0,0 +1,25 @@+{-# LANGUAGE CPP #-}+module RenamePath where+#include "util.inl"+import System.Directory++main :: TestEnv -> IO ()+main _t = do++  createDirectory "a"+  T(expectEq) () ["a"] =<< listDirectory "."+  renamePath "a" "b"+  T(expectEq) () ["b"] =<< listDirectory "."++  writeFile tmp1 contents1+  renamePath tmp1 tmp2+  T(expectEq) () contents1 =<< readFile tmp2+  writeFile tmp1 contents2+  renamePath tmp2 tmp1+  T(expectEq) () contents1 =<< readFile tmp1++  where+    tmp1 = "tmp1"+    tmp2 = "tmp2"+    contents1 = "test"+    contents2 = "test2"

@@ -14,20 +14,16 @@ import Control.Arrow (second) import Control.Concurrent (forkIO, killThread) import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)-import Control.Exception (SomeException, bracket_, catch,-                          mask, onException, try)+import Control.Exception (SomeException, bracket_, mask, onException, try) import Control.Monad (Monad(..), unless, when)-import System.Directory (createDirectoryIfMissing, emptyPermissions,-                         doesDirectoryExist, isSymbolicLink, listDirectory,-                         makeAbsolute, removeDirectoryRecursive, readable,-                         searchable, setPermissions, withCurrentDirectory,-                         writable)+import System.Directory (createDirectoryIfMissing, doesDirectoryExist,+                         isSymbolicLink, listDirectory, makeAbsolute,+                         removePathForcibly, withCurrentDirectory) import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath (FilePath, (</>), normalise) import System.IO (IO, hFlush, hPutStrLn, putStrLn, stderr, stdout)-import System.IO.Error (IOError, isDoesNotExistError,-                        ioError, tryIOError, userError)+import System.IO.Error (IOError, ioError, tryIOError, userError) import System.Timeout (timeout) import Text.Read (Read, reads) @@ -154,7 +150,7 @@   dir' <- makeAbsolute dir   bracket_ (createDirectoryIfMissing True dir') (cleanup dir') action   where cleanup dir' | keep      = return ()-                     | otherwise = removeDirectoryRecursive dir'+                     | otherwise = removePathForcibly dir'  isolateWorkingDirectory :: Bool -> FilePath -> IO a -> IO a isolateWorkingDirectory keep dir action = do@@ -162,16 +158,7 @@     ioError (userError ("isolateWorkingDirectory cannot be used " <>                         "with current directory"))   dir' <- makeAbsolute dir-  (`preprocessPathRecursive` dir') $ \ f -> do-    setPermissions f emptyPermissions{ readable = True-                                     , searchable = True-                                     , writable = True }-      `catch` \ e ->-        unless (isDoesNotExistError e) $-          ioError e-  removeDirectoryRecursive dir' `catch` \ e ->-    unless (isDoesNotExistError e) $-      ioError e+  removePathForcibly dir'   withNewDirectory keep dir' $     withCurrentDirectory dir' $       action