diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,16 +1,21 @@ # Changelog for system-fileio +## 0.3.16.5 + +* Fix building of the testsuite with `unix-2.8`. +* Tested with GHC 8.0 - 9.12.0. + ## 0.3.16.4 -* Fix for Win32 2.6 and above [#21](https://github.com/fpco/haskell-filesystem/pull/21) +* Fix for Win32 2.6 and above [#21](https://github.com/fpco/haskell-filesystem/pull/21). ## 0.3.16.2 -* withHANDLE (Win32) now works on directories [#8](https://github.com/fpco/haskell-filesystem/issues/8) [#10](https://github.com/fpco/haskell-filesystem/pull/10) +* `withHANDLE` (Win32) now works on directories [#8](https://github.com/fpco/haskell-filesystem/issues/8) [#10](https://github.com/fpco/haskell-filesystem/pull/10). ## 0.3.16.1 -* Use different path encoding on Darwin in POSIX tests [#6](https://github.com/fpco/haskell-filesystem/pull/6) +* Use different path encoding on Darwin in POSIX tests [#6](https://github.com/fpco/haskell-filesystem/pull/6). ## 0.3.16 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ ## system-fileio -Please see [deprecation announcement](https://plus.google.com/+MichaelSnoyman/posts/Ft5hnPqpgEx) +Legacy package (deprecated). This is a small wrapper around the `directory`, `unix`, and `Win32` packages, for use with `system-filepath`. It provides a consistent API diff --git a/lib/Filesystem.hs b/lib/Filesystem.hs --- a/lib/Filesystem.hs +++ b/lib/Filesystem.hs @@ -16,63 +16,63 @@ -- In particular, they do not require POSIX file paths to be valid strings, -- and can therefore open paths regardless of the current locale encoding. module Filesystem - ( - -- * Exports from System.IO - IO.Handle - , IO.IOMode(..) - - -- * Files - , isFile - , getModified - , getSize - , copyFile - , copyFileContent - , copyPermissions - , removeFile - - -- ** Binary files - , openFile - , withFile - , readFile - , writeFile - , appendFile - - -- ** Text files - , openTextFile - , withTextFile - , readTextFile - , writeTextFile - , appendTextFile - - -- * Directories - , isDirectory - , canonicalizePath - , listDirectory - - -- ** Creating directories - , createDirectory - , createTree - - -- ** Removing directories - , removeDirectory - , removeTree - - -- ** Current working directory - , getWorkingDirectory - , setWorkingDirectory - - -- ** Commonly used paths - , getHomeDirectory - , getDesktopDirectory - , getDocumentsDirectory - , getAppDataDirectory - , getAppCacheDirectory - , getAppConfigDirectory - - -- * Other - , rename - ) where + ( + -- * Exports from System.IO + IO.Handle + , IO.IOMode(..) + -- * Files + , isFile + , getModified + , getSize + , copyFile + , copyFileContent + , copyPermissions + , removeFile + + -- ** Binary files + , openFile + , withFile + , readFile + , writeFile + , appendFile + + -- ** Text files + , openTextFile + , withTextFile + , readTextFile + , writeTextFile + , appendTextFile + + -- * Directories + , isDirectory + , canonicalizePath + , listDirectory + + -- ** Creating directories + , createDirectory + , createTree + + -- ** Removing directories + , removeDirectory + , removeTree + + -- ** Current working directory + , getWorkingDirectory + , setWorkingDirectory + + -- ** Commonly used paths + , getHomeDirectory + , getDesktopDirectory + , getDocumentsDirectory + , getAppDataDirectory + , getAppCacheDirectory + , getAppConfigDirectory + + -- * Other + , rename + ) where + import Prelude hiding (FilePath, readFile, writeFile, appendFile) import qualified Control.Exception as Exc @@ -138,10 +138,10 @@ isFile path = SD.doesFileExist (encodeString path) #else isFile path = Exc.catch - (do - stat <- posixStat "isFile" path - return (not (Posix.isDirectory stat))) - ((\_ -> return False) :: IOError -> IO Bool) + (do + stat <- posixStat "isFile" path + return (not (Posix.isDirectory stat))) + ((\_ -> return False) :: IOError -> IO Bool) #endif -- | Check if a directory exists at the given path. @@ -154,10 +154,10 @@ isDirectory path = SD.doesDirectoryExist (encodeString path) #else isDirectory path = Exc.catch - (do - stat <- posixStat "isDirectory" path - return (Posix.isDirectory stat)) - ((\_ -> return False) :: IOError -> IO Bool) + (do + stat <- posixStat "isDirectory" path + return (Posix.isDirectory stat)) + ((\_ -> return False) :: IOError -> IO Bool) #endif -- | Rename a filesystem object. @@ -168,20 +168,20 @@ rename :: FilePath -> FilePath -> IO () rename old new = #ifdef CABAL_OS_WINDOWS - let old' = encodeString old in - let new' = encodeString new in + let old' = encodeString old in + let new' = encodeString new in #if MIN_VERSION_Win32(2,6,0) - Win32.moveFileEx old' (Just new') Win32.mOVEFILE_REPLACE_EXISTING + Win32.moveFileEx old' (Just new') Win32.mOVEFILE_REPLACE_EXISTING #else - Win32.moveFileEx old' new' Win32.mOVEFILE_REPLACE_EXISTING + Win32.moveFileEx old' new' Win32.mOVEFILE_REPLACE_EXISTING #endif #else - withFilePath old $ \old' -> - withFilePath new $ \new' -> - throwErrnoPathIfMinus1_ "rename" old (c_rename old' new') + withFilePath old $ \old' -> + withFilePath new $ \new' -> + throwErrnoPathIfMinus1_ "rename" old (c_rename old' new') foreign import ccall unsafe "rename" - c_rename :: CString -> CString -> IO CInt + c_rename :: CString -> CString -> IO CInt #endif @@ -199,41 +199,41 @@ -- Since: 0.1.1 canonicalizePath :: FilePath -> IO FilePath canonicalizePath path = - fmap (preserveFinalSlash path) $ - let path' = encodeString path in + fmap (preserveFinalSlash path) $ + let path' = encodeString path in #ifdef CABAL_OS_WINDOWS - fmap decodeString $ + fmap decodeString $ #if MIN_VERSION_Win32(2,2,1) - Win32.getFullPathName path' + Win32.getFullPathName path' #else - Win32.withTString path' $ \c_name -> do - Win32.try "getFullPathName" (\buf len -> - c_GetFullPathNameW c_name len buf nullPtr) 512 + Win32.withTString path' $ \c_name -> do + Win32.try "getFullPathName" (\buf len -> + c_GetFullPathNameW c_name len buf nullPtr) 512 #endif #else - withFilePath path $ \cPath -> do - cOut <- Posix.throwErrnoPathIfNull "canonicalizePath" path' (c_realpath cPath nullPtr) - bytes <- B.packCString cOut - c_free cOut - return (R.decode R.posix bytes) + withFilePath path $ \cPath -> do + cOut <- Posix.throwErrnoPathIfNull "canonicalizePath" path' (c_realpath cPath nullPtr) + bytes <- B.packCString cOut + c_free cOut + return (R.decode R.posix bytes) #endif preserveFinalSlash :: FilePath -> FilePath -> FilePath preserveFinalSlash orig out = if Path.null (Path.filename orig) - then Path.append out Path.empty - else out + then Path.append out Path.empty + else out #ifdef CABAL_OS_WINDOWS #if MIN_VERSION_Win32(2,2,1) #else foreign import stdcall unsafe "GetFullPathNameW" - c_GetFullPathNameW :: Win32.LPCTSTR -> Win32.DWORD -> Win32.LPTSTR -> Ptr Win32.LPTSTR -> IO Win32.DWORD + c_GetFullPathNameW :: Win32.LPCTSTR -> Win32.DWORD -> Win32.LPTSTR -> Ptr Win32.LPTSTR -> IO Win32.DWORD #endif #endif #ifndef CABAL_OS_WINDOWS foreign import ccall unsafe "realpath" - c_realpath :: CString -> CString -> IO CString + c_realpath :: CString -> CString -> IO CString #endif -- | Create a directory at a given path. The user may choose whether it is @@ -246,33 +246,33 @@ -> FilePath -> IO () createDirectory succeedIfExists path = #ifdef CABAL_OS_WINDOWS - let path' = encodeString path in - if succeedIfExists - then SD.createDirectoryIfMissing False path' - else Win32.createDirectory path' Nothing + let path' = encodeString path in + if succeedIfExists + then SD.createDirectoryIfMissing False path' + else Win32.createDirectory path' Nothing #else - withFilePath path $ \cPath -> - throwErrnoPathIfMinus1Retry_ "createDirectory" path $ if succeedIfExists - then mkdirIfMissing path cPath 0o777 - else c_mkdir cPath 0o777 + withFilePath path $ \cPath -> + throwErrnoPathIfMinus1Retry_ "createDirectory" path $ if succeedIfExists + then mkdirIfMissing path cPath 0o777 + else c_mkdir cPath 0o777 mkdirIfMissing :: FilePath -> CString -> CInt -> IO CInt mkdirIfMissing path cPath mode = do - rc <- c_mkdir cPath mode - if rc == -1 - then do - errno <- CError.getErrno - if errno == CError.eEXIST - then do - dirExists <- isDirectory path - if dirExists - then return 0 - else return rc - else return rc - else return rc + rc <- c_mkdir cPath mode + if rc == -1 + then do + errno <- CError.getErrno + if errno == CError.eEXIST + then do + dirExists <- isDirectory path + if dirExists + then return 0 + else return rc + else return rc + else return rc foreign import ccall unsafe "mkdir" - c_mkdir :: CString -> CInt -> IO CInt + c_mkdir :: CString -> CInt -> IO CInt #endif -- | Create a directory at a given path, including any parents which might @@ -286,11 +286,11 @@ createTree path = SD.createDirectoryIfMissing True (encodeString path) #else createTree path = do - let parent = Path.parent path - parentExists <- isDirectory parent - unless parentExists (createTree parent) - withFilePath path $ \cPath -> - throwErrnoPathIfMinus1Retry_ "createTree" path (mkdirIfMissing path cPath 0o777) + let parent = Path.parent path + parentExists <- isDirectory parent + unless parentExists (createTree parent) + withFilePath path $ \cPath -> + throwErrnoPathIfMinus1Retry_ "createTree" path (mkdirIfMissing path cPath 0o777) #endif -- | List objects in a directory, excluding @\".\"@ and @\"..\"@. Each @@ -303,71 +303,71 @@ listDirectory :: FilePath -> IO [FilePath] #ifdef CABAL_OS_WINDOWS listDirectory root = fmap cleanup contents where - contents = SD.getDirectoryContents (encodeString root) - cleanup = map (append root) . map decodeString . filter (`notElem` [".", ".."]) + contents = SD.getDirectoryContents (encodeString root) + cleanup = map (append root) . map decodeString . filter (`notElem` [".", ".."]) #else listDirectory root = Exc.bracket alloc free list where - alloc = do - dir <- openDir root - let Dir _ dirp = dir - dirent <- c_alloc_dirent dirp - return (dirent, dir) - free (dirent, dir) = do - c_free_dirent dirent - closeDir dir - list (dirent, dir) = loop where - loop = do - next <- readDir dir dirent - case next of - Nothing -> return [] - Just bytes | ignore bytes -> loop - Just bytes -> do - let name = append root (R.decode R.posix bytes) - names <- loop - return (name:names) + alloc = do + dir <- openDir root + let Dir _ dirp = dir + dirent <- c_alloc_dirent dirp + return (dirent, dir) + free (dirent, dir) = do + c_free_dirent dirent + closeDir dir + list (dirent, dir) = loop where + loop = do + next <- readDir dir dirent + case next of + Nothing -> return [] + Just bytes | ignore bytes -> loop + Just bytes -> do + let name = append root (R.decode R.posix bytes) + names <- loop + return (name:names) ignore :: B.ByteString -> Bool ignore = ignore' where - dot = B.pack [46] - dotdot = B.pack [46, 46] - ignore' b = b == dot || b == dotdot + dot = B.pack [46] + dotdot = B.pack [46, 46] + ignore' b = b == dot || b == dotdot data Dir = Dir FilePath (Ptr ()) openDir :: FilePath -> IO Dir openDir root = withFilePath root $ \cRoot -> do - p <- throwErrnoPathIfNullRetry "listDirectory" root (c_opendir cRoot) - return (Dir root p) + p <- throwErrnoPathIfNullRetry "listDirectory" root (c_opendir cRoot) + return (Dir root p) closeDir :: Dir -> IO () closeDir (Dir _ p) = CError.throwErrnoIfMinus1Retry_ "listDirectory" (c_closedir p) readDir :: Dir -> Ptr () -> IO (Maybe B.ByteString) readDir (Dir _ p) dirent = do - rc <- CError.throwErrnoIfMinus1Retry "listDirectory" (c_readdir p dirent) - if rc == 0 - then do - bytes <- c_dirent_name dirent >>= B.packCString - return (Just bytes) - else return Nothing + rc <- CError.throwErrnoIfMinus1Retry "listDirectory" (c_readdir p dirent) + if rc == 0 + then do + bytes <- c_dirent_name dirent >>= B.packCString + return (Just bytes) + else return Nothing foreign import ccall unsafe "opendir" - c_opendir :: CString -> IO (Ptr ()) + c_opendir :: CString -> IO (Ptr ()) foreign import ccall unsafe "closedir" - c_closedir :: Ptr () -> IO CInt + c_closedir :: Ptr () -> IO CInt foreign import ccall unsafe "hssystemfileio_alloc_dirent" - c_alloc_dirent :: Ptr () -> IO (Ptr ()) + c_alloc_dirent :: Ptr () -> IO (Ptr ()) foreign import ccall unsafe "hssystemfileio_free_dirent" - c_free_dirent :: Ptr () -> IO () + c_free_dirent :: Ptr () -> IO () foreign import ccall unsafe "hssystemfileio_readdir" - c_readdir :: Ptr () -> Ptr () -> IO CInt + c_readdir :: Ptr () -> Ptr () -> IO CInt foreign import ccall unsafe "hssystemfileio_dirent_name" - c_dirent_name :: Ptr () -> IO CString + c_dirent_name :: Ptr () -> IO CString #endif @@ -382,13 +382,13 @@ removeFile :: FilePath -> IO () removeFile path = #ifdef CABAL_OS_WINDOWS - Win32.deleteFile (encodeString path) + Win32.deleteFile (encodeString path) #else - withFilePath path $ \cPath -> - throwErrnoPathIfMinus1_ "removeFile" path (c_unlink cPath) + withFilePath path $ \cPath -> + throwErrnoPathIfMinus1_ "removeFile" path (c_unlink cPath) foreign import ccall unsafe "unlink" - c_unlink :: CString -> IO CInt + c_unlink :: CString -> IO CInt #endif -- | Remove an empty directory. @@ -399,13 +399,13 @@ removeDirectory :: FilePath -> IO () removeDirectory path = #ifdef CABAL_OS_WINDOWS - Win32.removeDirectory (encodeString path) + Win32.removeDirectory (encodeString path) #else - withFilePath path $ \cPath -> - throwErrnoPathIfMinus1Retry_ "removeDirectory" path (c_rmdir cPath) + withFilePath path $ \cPath -> + throwErrnoPathIfMinus1Retry_ "removeDirectory" path (c_rmdir cPath) foreign import ccall unsafe "rmdir" - c_rmdir :: CString -> IO CInt + c_rmdir :: CString -> IO CInt #endif -- | Recursively remove a directory tree rooted at the given path. @@ -424,15 +424,15 @@ removeTree root = SD.removeDirectoryRecursive (encodeString root) #else removeTree root = do - items <- listDirectory root - forM_ items $ \item -> Exc.catch - (removeFile item) - (\exc -> do - isDir <- isRealDir item - if isDir - then removeTree item - else Exc.throwIO (exc :: IOError)) - removeDirectory root + items <- listDirectory root + forM_ items $ \item -> Exc.catch + (removeFile item) + (\exc -> do + isDir <- isRealDir item + if isDir + then removeTree item + else Exc.throwIO (exc :: IOError)) + removeDirectory root -- Check whether a path is a directory, and not just a symlink to a directory. -- @@ -440,11 +440,11 @@ -- itself cannot be deleted. isRealDir :: FilePath -> IO Bool isRealDir path = withFilePath path $ \cPath -> do - rc <- throwErrnoPathIfMinus1Retry "removeTree" path (c_isrealdir cPath) - return (rc == 1) + rc <- throwErrnoPathIfMinus1Retry "removeTree" path (c_isrealdir cPath) + return (rc == 1) foreign import ccall unsafe "hssystemfileio_isrealdir" - c_isrealdir :: CString -> IO CInt + c_isrealdir :: CString -> IO CInt #endif @@ -457,18 +457,18 @@ getWorkingDirectory = do #ifdef CABAL_OS_WINDOWS #if MIN_VERSION_Win32(2,2,1) - fmap decodeString Win32.getCurrentDirectory + fmap decodeString Win32.getCurrentDirectory #else - fmap decodeString (Win32.try "getWorkingDirectory" (flip c_GetCurrentDirectoryW) 512) + fmap decodeString (Win32.try "getWorkingDirectory" (flip c_GetCurrentDirectoryW) 512) #endif #else - buf <- CError.throwErrnoIfNull "getWorkingDirectory" c_getcwd - bytes <- B.packCString buf - c_free buf - return (R.decode R.posix bytes) + buf <- CError.throwErrnoIfNull "getWorkingDirectory" c_getcwd + bytes <- B.packCString buf + c_free buf + return (R.decode R.posix bytes) foreign import ccall unsafe "hssystemfileio_getcwd" - c_getcwd :: IO CString + c_getcwd :: IO CString #endif @@ -476,7 +476,7 @@ #if MIN_VERSION_Win32(2,2,1) #else foreign import stdcall unsafe "GetCurrentDirectoryW" - c_GetCurrentDirectoryW :: Win32.DWORD -> Win32.LPTSTR -> IO Win32.UINT + c_GetCurrentDirectoryW :: Win32.DWORD -> Win32.LPTSTR -> IO Win32.UINT #endif #endif @@ -488,13 +488,13 @@ setWorkingDirectory :: FilePath -> IO () setWorkingDirectory path = #ifdef CABAL_OS_WINDOWS - Win32.setCurrentDirectory (encodeString path) + Win32.setCurrentDirectory (encodeString path) #else - withFilePath path $ \cPath -> - throwErrnoPathIfMinus1Retry_ "setWorkingDirectory" path (c_chdir cPath) + withFilePath path $ \cPath -> + throwErrnoPathIfMinus1Retry_ "setWorkingDirectory" path (c_chdir cPath) foreign import ccall unsafe "chdir" - c_chdir :: CString -> IO CInt + c_chdir :: CString -> IO CInt #endif @@ -518,12 +518,12 @@ getHomeDirectory = fmap decodeString SD.getHomeDirectory #else getHomeDirectory = do - path <- getenv "HOME" - case path of - Just p -> return p - Nothing -> do - -- use getEnv to throw the right exception type - fmap decodeString (SE.getEnv "HOME") + path <- getenv "HOME" + case path of + Just p -> return p + Nothing -> do + -- use getEnv to throw the right exception type + fmap decodeString (SE.getEnv "HOME") #endif -- | Get the user’s desktop directory. This is a good starting point for @@ -535,7 +535,7 @@ -- why the failure occured. getDesktopDirectory :: IO FilePath getDesktopDirectory = xdg "XDG_DESKTOP_DIR" Nothing - (homeSlash "Desktop") + (homeSlash "Desktop") -- | Get the user’s documents directory. This is a good place to save -- user‐created files. For data files the user does not explicitly @@ -547,9 +547,9 @@ getDocumentsDirectory :: IO FilePath getDocumentsDirectory = xdg "XDG_DOCUMENTS_DIR" Nothing #ifdef CABAL_OS_WINDOWS - (fmap decodeString SD.getUserDocumentsDirectory) + (fmap decodeString SD.getUserDocumentsDirectory) #else - (homeSlash "Documents") + (homeSlash "Documents") #endif -- | Get the user’s application data directory, given an application @@ -562,9 +562,9 @@ getAppDataDirectory :: T.Text -> IO FilePath getAppDataDirectory label = xdg "XDG_DATA_HOME" (Just label) #ifdef CABAL_OS_WINDOWS - (fmap decodeString (SD.getAppUserDataDirectory "")) + (fmap decodeString (SD.getAppUserDataDirectory "")) #else - (homeSlash ".local/share") + (homeSlash ".local/share") #endif -- | Get the user’s application cache directory, given an application @@ -577,9 +577,9 @@ getAppCacheDirectory :: T.Text -> IO FilePath getAppCacheDirectory label = xdg "XDG_CACHE_HOME" (Just label) #ifdef CABAL_OS_WINDOWS - (homeSlash "Local Settings\\Cache") + (homeSlash "Local Settings\\Cache") #else - (homeSlash ".cache") + (homeSlash ".cache") #endif -- | Get the user’s application configuration directory, given an @@ -592,46 +592,46 @@ getAppConfigDirectory :: T.Text -> IO FilePath getAppConfigDirectory label = xdg "XDG_CONFIG_HOME" (Just label) #ifdef CABAL_OS_WINDOWS - (homeSlash "Local Settings") + (homeSlash "Local Settings") #else - (homeSlash ".config") + (homeSlash ".config") #endif homeSlash :: String -> IO FilePath homeSlash path = do - home <- getHomeDirectory - return (append home (decodeString path)) + home <- getHomeDirectory + return (append home (decodeString path)) getenv :: String -> IO (Maybe FilePath) #ifdef CABAL_OS_WINDOWS getenv key = Exc.catch - (fmap (Just . decodeString) (SE.getEnv key)) - (\e -> if isDoesNotExistError e - then return Nothing - else Exc.throwIO e) + (fmap (Just . decodeString) (SE.getEnv key)) + (\e -> if isDoesNotExistError e + then return Nothing + else Exc.throwIO e) #else getenv key = withCAString key $ \cKey -> do - ret <- c_getenv cKey - if ret == nullPtr - then return Nothing - else do - bytes <- B.packCString ret - return (Just (R.decode R.posix bytes)) + ret <- c_getenv cKey + if ret == nullPtr + then return Nothing + else do + bytes <- B.packCString ret + return (Just (R.decode R.posix bytes)) foreign import ccall unsafe "getenv" - c_getenv :: CString -> IO CString + c_getenv :: CString -> IO CString #endif xdg :: String -> Maybe T.Text -> IO FilePath -> IO FilePath xdg envkey label fallback = do - env <- getenv envkey - dir <- case env of - Just var -> return var - Nothing -> fallback - return $ case label of - Just text -> append dir (R.fromText currentOS text) - Nothing -> dir + env <- getenv envkey + dir <- case env of + Just var -> return var + Nothing -> fallback + return $ case label of + Just text -> append dir (R.fromText currentOS text) + Nothing -> dir -- | Copy the content of a file to a new entry in the filesystem. If a -- file already exists at the new location, it will be replaced. Copying @@ -646,9 +646,9 @@ -> FilePath -- ^ New location -> IO () copyFileContent oldPath newPath = - withFile oldPath IO.ReadMode $ \old -> - withFile newPath IO.WriteMode $ \new -> - BL.hGetContents old >>= BL.hPut new + withFile oldPath IO.ReadMode $ \old -> + withFile newPath IO.WriteMode $ \new -> + BL.hGetContents old >>= BL.hPut new -- | Copy the permissions from one path to another. Both paths must already -- exist. @@ -662,20 +662,20 @@ -> FilePath -- ^ New location -> IO () copyPermissions oldPath newPath = - withFilePath oldPath $ \cOldPath -> - withFilePath newPath $ \cNewPath -> - CError.throwErrnoIfMinus1Retry_ "copyPermissions" $ - c_copy_permissions cOldPath cNewPath + withFilePath oldPath $ \cOldPath -> + withFilePath newPath $ \cNewPath -> + CError.throwErrnoIfMinus1Retry_ "copyPermissions" $ + c_copy_permissions cOldPath cNewPath #ifdef CABAL_OS_WINDOWS foreign import ccall unsafe "hssystemfileio_copy_permissions" - c_copy_permissions :: CWString -> CWString -> IO CInt + c_copy_permissions :: CWString -> CWString -> IO CInt #else foreign import ccall unsafe "hssystemfileio_copy_permissions" - c_copy_permissions :: CString -> CString -> IO CInt + c_copy_permissions :: CString -> CString -> IO CInt #endif @@ -692,10 +692,10 @@ -> FilePath -- ^ New location -> IO () copyFile oldPath newPath = do - copyFileContent oldPath newPath - Exc.catch - (copyPermissions oldPath newPath) - ((\_ -> return ()) :: IOError -> IO ()) + copyFileContent oldPath newPath + Exc.catch + (copyPermissions oldPath newPath) + ((\_ -> return ()) :: IOError -> IO ()) -- | Get when the object at a given path was last modified. -- @@ -707,28 +707,28 @@ getModified :: FilePath -> IO UTCTime getModified path = do #ifdef CABAL_OS_WINDOWS - info <- withHANDLE path Win32.getFileInformationByHandle - let ftime = Win32.bhfiLastWriteTime info - stime <- Win32.fileTimeToSystemTime ftime - - let date = fromGregorian - (fromIntegral (Win32.wYear stime)) - (fromIntegral (Win32.wMonth stime)) - (fromIntegral (Win32.wDay stime)) - - let seconds = secondsToDiffTime $ - (toInteger (Win32.wHour stime) * 3600) + - (toInteger (Win32.wMinute stime) * 60) + - (toInteger (Win32.wSecond stime)) - - let msecs = picosecondsToDiffTime $ - (toInteger (Win32.wMilliseconds stime) * 1000000000) - - return (UTCTime date (seconds + msecs)) + info <- withHANDLE path Win32.getFileInformationByHandle + let ftime = Win32.bhfiLastWriteTime info + stime <- Win32.fileTimeToSystemTime ftime + + let date = fromGregorian + (fromIntegral (Win32.wYear stime)) + (fromIntegral (Win32.wMonth stime)) + (fromIntegral (Win32.wDay stime)) + + let seconds = secondsToDiffTime $ + (toInteger (Win32.wHour stime) * 3600) + + (toInteger (Win32.wMinute stime) * 60) + + (toInteger (Win32.wSecond stime)) + + let msecs = picosecondsToDiffTime $ + (toInteger (Win32.wMilliseconds stime) * 1000000000) + + return (UTCTime date (seconds + msecs)) #else - stat <- posixStat "getModified" path - let mtime = Posix.modificationTime stat - return (posixSecondsToUTCTime (realToFrac mtime)) + stat <- posixStat "getModified" path + let mtime = Posix.modificationTime stat + return (posixSecondsToUTCTime (realToFrac mtime)) #endif -- | Get the size of an object at a given path. For special objects like @@ -743,11 +743,11 @@ getSize :: FilePath -> IO Integer getSize path = do #ifdef CABAL_OS_WINDOWS - info <- withHANDLE path Win32.getFileInformationByHandle - return (toInteger (Win32.bhfiSize info)) + info <- withHANDLE path Win32.getFileInformationByHandle + return (toInteger (Win32.bhfiSize info)) #else - stat <- posixStat "getSize" path - return (toInteger (Posix.fileSize stat)) + stat <- posixStat "getSize" path + return (toInteger (Posix.fileSize stat)) #endif -- | Open a file in binary mode, and return an open 'Handle'. The 'Handle' @@ -783,7 +783,7 @@ -- why the failure occured. readFile :: FilePath -> IO B.ByteString readFile path = withFile path IO.ReadMode - (\h -> IO.hFileSize h >>= B.hGet h . fromIntegral) + (\h -> IO.hFileSize h >>= B.hGet h . fromIntegral) -- | Replace the entire content of a binary file with the provided -- 'B.ByteString'. @@ -793,7 +793,7 @@ -- why the failure occured. writeFile :: FilePath -> B.ByteString -> IO () writeFile path bytes = withFile path IO.WriteMode - (\h -> B.hPut h bytes) + (\h -> B.hPut h bytes) -- | Append a 'B.ByteString' to a file. If the file does not exist, it will -- be created. @@ -803,7 +803,7 @@ -- why the failure occured. appendFile :: FilePath -> B.ByteString -> IO () appendFile path bytes = withFile path IO.AppendMode - (\h -> B.hPut h bytes) + (\h -> B.hPut h bytes) -- | Open a file in text mode, and return an open 'Handle'. The 'Handle' -- should be closed with 'IO.hClose' when it is no longer needed. @@ -847,7 +847,7 @@ -- why the failure occured. writeTextFile :: FilePath -> T.Text -> IO () writeTextFile path text = withTextFile path IO.WriteMode - (\h -> T.hPutStr h text) + (\h -> T.hPutStr h text) -- | Append 'T.Text' to a file. If the file does not exist, it will -- be created. @@ -857,47 +857,47 @@ -- why the failure occured. appendTextFile :: FilePath -> T.Text -> IO () appendTextFile path text = withTextFile path IO.AppendMode - (\h -> T.hPutStr h text) + (\h -> T.hPutStr h text) #ifdef SYSTEMFILEIO_LOCAL_OPEN_FILE -- | Copied from GHC.IO.FD.openFile openFile' :: String -> FilePath -> IO.IOMode -> (Maybe IO.TextEncoding) -> IO IO.Handle openFile' loc path mode codec = open where - sys_c_open = System.Posix.Internals.c_open - sys_c_close = System.Posix.Internals.c_close - flags = iomodeFlags mode - open = withFilePath path $ \cPath -> do - c_fd <- throwErrnoPathIfMinus1Retry loc path (sys_c_open cPath flags 0o666) - (fd, fd_type) <- Exc.onException - (mkFD c_fd mode Nothing False True) - (sys_c_close c_fd) - when (mode == IO.WriteMode && fd_type == GHC.IO.Device.RegularFile) $ do - GHC.IO.Device.setSize fd 0 - Exc.onException - (mkHandleFromFD fd fd_type (encodeString path) mode False codec) - (GHC.IO.Device.close fd) + sys_c_open = System.Posix.Internals.c_open + sys_c_close = System.Posix.Internals.c_close + flags = iomodeFlags mode + open = withFilePath path $ \cPath -> do + c_fd <- throwErrnoPathIfMinus1Retry loc path (sys_c_open cPath flags 0o666) + (fd, fd_type) <- Exc.onException + (mkFD c_fd mode Nothing False True) + (sys_c_close c_fd) + when (mode == IO.WriteMode && fd_type == GHC.IO.Device.RegularFile) $ do + GHC.IO.Device.setSize fd 0 + Exc.onException + (mkHandleFromFD fd fd_type (encodeString path) mode False codec) + (GHC.IO.Device.close fd) iomodeFlags :: IO.IOMode -> CInt iomodeFlags mode = cased .|. commonFlags where - cased = case mode of - IO.ReadMode -> flagsR + cased = case mode of + IO.ReadMode -> flagsR #ifdef mingw32_HOST_OS - IO.WriteMode -> flagsW .|. System.Posix.Internals.o_TRUNC + IO.WriteMode -> flagsW .|. System.Posix.Internals.o_TRUNC #else - IO.WriteMode -> flagsW + IO.WriteMode -> flagsW #endif - IO.ReadWriteMode -> flagsRW - IO.AppendMode -> flagsA - - flagsR = System.Posix.Internals.o_RDONLY - flagsW = outputFlags .|. System.Posix.Internals.o_WRONLY - flagsRW = outputFlags .|. System.Posix.Internals.o_RDWR - flagsA = flagsW .|. System.Posix.Internals.o_APPEND - - commonFlags = System.Posix.Internals.o_NOCTTY .|. - System.Posix.Internals.o_NONBLOCK - outputFlags = System.Posix.Internals.o_CREAT + IO.ReadWriteMode -> flagsRW + IO.AppendMode -> flagsA + flagsR = System.Posix.Internals.o_RDONLY + flagsW = outputFlags .|. System.Posix.Internals.o_WRONLY + flagsRW = outputFlags .|. System.Posix.Internals.o_RDWR + flagsA = flagsW .|. System.Posix.Internals.o_APPEND + + commonFlags = System.Posix.Internals.o_NOCTTY .|. + System.Posix.Internals.o_NONBLOCK + outputFlags = System.Posix.Internals.o_CREAT + #endif #ifdef CABAL_OS_WINDOWS @@ -906,15 +906,15 @@ -- See issue #8. withHANDLE :: FilePath -> (Win32.HANDLE -> IO a) -> IO a withHANDLE path = Exc.bracket open close where - open = Win32.createFile - (encodeString path) - 0 - (Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE) - Nothing - Win32.oPEN_EXISTING - Win32.fILE_FLAG_BACKUP_SEMANTICS - Nothing - close = Win32.closeHandle + open = Win32.createFile + (encodeString path) + 0 + (Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE) + Nothing + Win32.oPEN_EXISTING + Win32.fILE_FLAG_BACKUP_SEMANTICS + Nothing + close = Win32.closeHandle withFilePath :: FilePath -> (CWString -> IO a) -> IO a withFilePath path = withCWString (encodeString path) @@ -941,20 +941,20 @@ throwErrnoPathIfRetry :: (a -> Bool) -> String -> FilePath -> IO a -> IO a throwErrnoPathIfRetry failed loc path io = loop where - loop = do - a <- io - if failed a - then do - errno <- CError.getErrno - if errno == CError.eINTR - then loop - else CError.throwErrnoPath loc (encodeString path) - else return a + loop = do + a <- io + if failed a + then do + errno <- CError.getErrno + if errno == CError.eINTR + then loop + else CError.throwErrnoPath loc (encodeString path) + else return a throwErrnoPathIfRetry_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO () throwErrnoPathIfRetry_ failed loc path io = do - _ <- throwErrnoPathIfRetry failed loc path io - return () + _ <- throwErrnoPathIfRetry failed loc path io + return () posixStat :: String -> FilePath -> IO Posix.FileStatus #if MIN_VERSION_unix(2,5,1) @@ -964,17 +964,17 @@ withFd :: String -> FilePath -> (Posix.Fd -> IO a) -> IO a withFd fnName path = Exc.bracket open close where - open = withFilePath path $ \cpath -> do - fd <- throwErrnoPathIfMinus1 fnName path (c_open_nonblocking cpath 0) - return (Posix.Fd fd) - close = Posix.closeFd + open = withFilePath path $ \cpath -> do + fd <- throwErrnoPathIfMinus1 fnName path (c_open_nonblocking cpath 0) + return (Posix.Fd fd) + close = Posix.closeFd foreign import ccall unsafe "hssystemfileio_open_nonblocking" - c_open_nonblocking :: CString -> CInt -> IO CInt + c_open_nonblocking :: CString -> CInt -> IO CInt #endif foreign import ccall unsafe "free" - c_free :: Ptr a -> IO () + c_free :: Ptr a -> IO () #endif diff --git a/system-fileio.cabal b/system-fileio.cabal --- a/system-fileio.cabal +++ b/system-fileio.cabal @@ -1,22 +1,24 @@ +cabal-version: 1.18 name: system-fileio -version: 0.3.16.4 +version: 0.3.16.5 license: MIT license-file: license.txt author: John Millikin -maintainer: FP Complete +maintainer: https://github.com/fpco/haskell-filesystem build-type: Simple -cabal-version: >= 1.8 category: System stability: experimental homepage: https://github.com/fpco/haskell-filesystem bug-reports: https://github.com/fpco/haskell-filesystem/issues synopsis: Consistent filesystem interaction across GHC versions (deprecated) -description: Please see: https://plus.google.com/+MichaelSnoyman/posts/Ft5hnPqpgEx +description: Consistent filesystem interaction across GHC versions (deprecated package). -extra-source-files: +extra-doc-files: README.md ChangeLog.md + +extra-source-files: lib/hssystemfileio-unix.h lib/hssystemfileio-win32.h -- @@ -26,6 +28,21 @@ tests/FilesystemTests/Util.hs tests/FilesystemTests/Windows.hs +tested-with: + GHC == 9.12.0 + GHC == 9.10.1 + GHC == 9.8.2 + GHC == 9.6.6 + GHC == 9.4.8 + GHC == 9.2.8 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + GHC == 8.0.2 + source-repository head type: git location: https://github.com/fpco/haskell-filesystem.git @@ -35,11 +52,11 @@ hs-source-dirs: lib build-depends: - base >= 4.0 && < 5.0 + base >= 4.0 && < 5 , bytestring >= 0.9 , system-filepath >= 0.3.1 && < 0.5 , text >= 0.7.1 - , time >= 1.0 && < 2.0 + , time >= 1.0 && < 2 if os(windows) cpp-options: -DCABAL_OS_WINDOWS @@ -57,6 +74,8 @@ exposed-modules: Filesystem + default-language: Haskell2010 + test-suite filesystem_tests type: exitcode-stdio-1.0 main-is: FilesystemTests.hs @@ -66,14 +85,14 @@ hs-source-dirs: tests build-depends: - base >= 4.0 && < 5.0 + base >= 4.0 && < 5 , bytestring >= 0.9 - , chell >= 0.4 && < 0.5 + , chell >= 0.4 && < 0.6 , system-fileio , system-filepath - , temporary >= 1.1 && < 2.0 + , temporary >= 1.1 && < 2 , text - , time >= 1.0 && < 2.0 + , time >= 1.0 && < 2 , transformers >= 0.2 if os(windows) @@ -89,3 +108,5 @@ FilesystemTests.Posix FilesystemTests.Util FilesystemTests.Windows + + default-language: Haskell2010 diff --git a/tests/FilesystemTests.hs b/tests/FilesystemTests.hs --- a/tests/FilesystemTests.hs +++ b/tests/FilesystemTests.hs @@ -7,9 +7,9 @@ -- -- See license.txt for details module Main - ( tests - , main - ) where + ( tests + , main + ) where import Test.Chell diff --git a/tests/FilesystemTests/Posix.hs b/tests/FilesystemTests/Posix.hs --- a/tests/FilesystemTests/Posix.hs +++ b/tests/FilesystemTests/Posix.hs @@ -7,795 +7,803 @@ -- -- See license.txt for details module FilesystemTests.Posix - ( suite_Posix - ) where - -import Prelude hiding (FilePath) -import Control.Exception (bracket) -import Control.Monad -import Control.Monad.IO.Class (liftIO) -import qualified Data.ByteString -import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as Char8 -import qualified Data.Text -import Data.Text (Text) -import qualified Data.Text.IO -import Data.Time.Clock (diffUTCTime, getCurrentTime) -import Foreign -import Foreign.C -import Test.Chell - -#if MIN_VERSION_base(4,2,0) -import qualified GHC.IO.Exception as GHC -#else -import qualified GHC.IOBase as GHC -#endif - -import qualified System.Posix.IO as PosixIO - -import Filesystem -import Filesystem.Path -import qualified Filesystem.Path.Rules as Rules -import qualified Filesystem.Path.CurrentOS as CurrentOS - -import FilesystemTests.Util (assertionsWithTemp, todo) - -suite_Posix :: Suite -suite_Posix = suite "posix" $ - (concatMap suiteTests - [ suite_IsFile - , suite_IsDirectory - , suite_Rename - , suite_CanonicalizePath - , suite_CreateDirectory - , suite_CreateTree - , suite_RemoveFile - , suite_RemoveDirectory - , suite_RemoveTree - , suite_GetWorkingDirectory - , suite_SetWorkingDirectory - , suite_GetHomeDirectory - , suite_GetDesktopDirectory - , suite_GetModified - , suite_GetSize - , suite_CopyFile - , suite_WithFile - , suite_WithTextFile - , suite_RegressionTests - ]) ++ - [ test_ListDirectory - , todo "getDocumentsDirectory" - , todo "getAppDataDirectory" - , todo "getAppCacheDirectory" - , todo "getAppConfigDirectory" - , todo "openFile" - , todo "readFile" - , todo "writeFile" - , todo "appendFile" - , todo "openTextFile" - , todo "readTextFile" - , todo "writeTextFile" - , todo "appendTextFile" - ] - -suite_IsFile :: Suite -suite_IsFile = suite "isFile" - [ test_IsFile "ascii" (decode "test.txt") - , test_IsFile "utf8" (fromText "\xA1\xA2.txt") - , test_IsFile "iso8859" (decode "\xA1\xA2\xA3.txt") - , test_PipeIsFile "pipe.ascii" (decode "test.txt") - , test_PipeIsFile "pipe.utf8" (fromText "\xA1\xA2.txt") - , test_PipeIsFile "pipe.iso8859" (decode "\xA1\xA2\xA3.txt") - ] - -suite_IsDirectory :: Suite -suite_IsDirectory = suite "isDirectory" - [ test_IsDirectory "ascii" (decode "test.d") - , test_IsDirectory "utf8" (fromText "\xA1\xA2.d") - , test_IsDirectory "iso8859" (decode "\xA1\xA2\xA3.d") - ] - -suite_Rename :: Suite -suite_Rename = suite "rename" - [ test_Rename "ascii" - (decode "old_test.txt") - (decode "new_test.txt") - , test_Rename "utf8" - (fromText "old_\xA1\xA2.txt") - (fromText "new_\xA1\xA2.txt") - , test_Rename "iso8859" - (decode "old_\xA1\xA2\xA3.txt") - (decode "new_\xA1\xA2\xA3.txt") - ] - -suite_CanonicalizePath :: Suite -suite_CanonicalizePath = suite "canonicalizePath" - [ test_CanonicalizePath "ascii" - (decode "test-a.txt") - (decode "test-b.txt") - , test_CanonicalizePath "utf8" - (fromText "\xA1\xA2-a.txt") - (fromText "\xA1\xA2-b.txt") - , test_CanonicalizePath "iso8859" - (decode "\xA1\xA2\xA3-a.txt") -#ifdef CABAL_OS_DARWIN - (decode "%A1%A2%A3-b.txt") -#else - (decode "\xA1\xA2\xA3-b.txt") -#endif - , test_CanonicalizePath_TrailingSlash - ] - -suite_CreateDirectory :: Suite -suite_CreateDirectory = suite "createDirectory" - [ test_CreateDirectory "ascii" - (decode "test.d") - , test_CreateDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_CreateDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - , test_CreateDirectory_FailExists - , test_CreateDirectory_SucceedExists - , test_CreateDirectory_FailFileExists - ] - -suite_CreateTree :: Suite -suite_CreateTree = suite "createTree" - [ test_CreateTree "ascii" - (decode "test.d") - , test_CreateTree "ascii-slash" - (decode "test.d/") - , test_CreateTree "utf8" - (fromText "\xA1\xA2.d") - , test_CreateTree "utf8-slash" - (fromText "\xA1\xA2.d/") - , test_CreateTree "iso8859" - (decode "\xA1\xA2\xA3.d") - , test_CreateTree "iso8859-slash" - (decode "\xA1\xA2\xA3.d/") - ] - -suite_RemoveFile :: Suite -suite_RemoveFile = suite "removeFile" - [ test_RemoveFile "ascii" - (decode "test.txt") - , test_RemoveFile "utf8" - (fromText "\xA1\xA2.txt") - , test_RemoveFile "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - -suite_RemoveDirectory :: Suite -suite_RemoveDirectory = suite "removeDirectory" - [ test_RemoveDirectory "ascii" - (decode "test.d") - , test_RemoveDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_RemoveDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - -suite_RemoveTree :: Suite -suite_RemoveTree = suite "removeTree" - [ test_RemoveTree "ascii" - (decode "test.d") - , test_RemoveTree "utf8" - (fromText "\xA1\xA2.d") - , test_RemoveTree "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - -suite_GetWorkingDirectory :: Suite -suite_GetWorkingDirectory = suite "getWorkingDirectory" - [ test_GetWorkingDirectory "ascii" - (decode "test.d") - , test_GetWorkingDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_GetWorkingDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - -suite_SetWorkingDirectory :: Suite -suite_SetWorkingDirectory = suite "setWorkingDirectory" - [ test_SetWorkingDirectory "ascii" - (decode "test.d") - , test_SetWorkingDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_SetWorkingDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - -suite_GetHomeDirectory :: Suite -suite_GetHomeDirectory = suite "getHomeDirectory" - [ test_GetHomeDirectory "ascii" - (decode "/home/test.d") - , test_GetHomeDirectory "utf8" - (decode "/home/\xA1\xA2.d") - , test_GetHomeDirectory "iso8859" - (decode "/home/\xA1\xA2\xA3.d") - ] - -suite_GetDesktopDirectory :: Suite -suite_GetDesktopDirectory = suite "getDesktopDirectory" - [ test_GetDesktopDirectory "ascii" - (decode "/desktop/test.d") - , test_GetDesktopDirectory "utf8" - (decode "/desktop/\xA1\xA2.d") - , test_GetDesktopDirectory "iso8859" - (decode "/desktop/\xA1\xA2\xA3.d") - ] - -suite_GetModified :: Suite -suite_GetModified = suite "getModified" - [ test_GetModified "ascii" - (decode "test.txt") - , test_GetModified "utf8" - (fromText "\xA1\xA2.txt") - , test_GetModified "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - -suite_GetSize :: Suite -suite_GetSize = suite "getSize" - [ test_GetSize "ascii" - (decode "test.txt") - , test_GetSize "utf8" - (fromText "\xA1\xA2.txt") - , test_GetSize "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - -suite_CopyFile :: Suite -suite_CopyFile = suite "copyFile" - [ test_CopyFile "ascii" - (decode "old_test.txt") - (decode "new_test.txt") - , test_CopyFile "utf8" - (fromText "old_\xA1\xA2.txt") - (fromText "new_\xA1\xA2.txt") - , test_CopyFile "iso8859" -#ifdef CABAL_OS_DARWIN - (decode "old_%A1%A2%A3.txt") -#else - (decode "old_\xA1\xA2\xA3.txt") -#endif -#ifdef CABAL_OS_DARWIN - (decode "new_%A1%A2%A3.txt") -#else - (decode "new_\xA1\xA2\xA3.txt") -#endif - ] - -suite_WithFile :: Suite -suite_WithFile = suite "withFile" - [ test_WithFile_Read "read.ascii" - (decode "test.txt") - , test_WithFile_Read "read.utf8" - (fromText "\xA1\xA2.txt") - , test_WithFile_Read "read.iso8859" -#ifdef CABAL_OS_DARWIN - (decode "%A1%A2%A3.txt") -#else - (decode "\xA1\xA2\xA3.txt") -#endif - , test_WithFile_Write "write.ascii" - (decode "test.txt") - , test_WithFile_Write "write.utf8" - (fromText "\xA1\xA2.txt") - , test_WithFile_Write "write.iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - -suite_WithTextFile :: Suite -suite_WithTextFile = suite "withTextFile" - [ test_WithTextFile "ascii" - (decode "test.txt") - , test_WithTextFile "utf8" - (fromText "\xA1\xA2.txt") - , test_WithTextFile "iso8859" -#ifdef CABAL_OS_DARWIN - (decode "%A1%A2%A3.txt") -#else - (decode "\xA1\xA2\xA3.txt") -#endif - ] - -suite_RegressionTests :: Suite -suite_RegressionTests = suite "regression-tests" - [ test_ListDirectoryLeaksFds - ] - -test_IsFile :: String -> FilePath -> Test -test_IsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let path = tmp file_name - - before <- liftIO $ Filesystem.isFile path - $expect (not before) - - touch_ffi path "contents\n" - - after <- liftIO $ Filesystem.isFile path - $expect after - -test_PipeIsFile :: String -> FilePath -> Test -test_PipeIsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let path = tmp file_name - - before <- liftIO $ Filesystem.isFile path - $expect (not before) - - mkfifo_ffi path - - after <- liftIO $ Filesystem.isFile path - $expect after - -test_IsDirectory :: String -> FilePath -> Test -test_IsDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do - let path = tmp dir_name - - before <- liftIO $ Filesystem.isDirectory path - $expect (not before) - - mkdir_ffi path - - after <- liftIO $ Filesystem.isDirectory path - $expect after - -test_Rename :: String -> FilePath -> FilePath -> Test -test_Rename test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do - let old_path = tmp old_name - let new_path = tmp new_name - - touch_ffi old_path "" - - old_before <- liftIO $ Filesystem.isFile old_path - new_before <- liftIO $ Filesystem.isFile new_path - $expect old_before - $expect (not new_before) - - liftIO $ Filesystem.rename old_path new_path - - old_after <- liftIO $ Filesystem.isFile old_path - new_after <- liftIO $ Filesystem.isFile new_path - $expect (not old_after) - $expect new_after - -test_CopyFile :: String -> FilePath -> FilePath -> Test -test_CopyFile test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do - let old_path = tmp old_name - let new_path = tmp new_name - - touch_ffi old_path "" - - old_before <- liftIO $ Filesystem.isFile old_path - new_before <- liftIO $ Filesystem.isFile new_path - $expect old_before - $expect (not new_before) - - liftIO $ Filesystem.copyFile old_path new_path - - old_after <- liftIO $ Filesystem.isFile old_path - new_after <- liftIO $ Filesystem.isFile new_path - $expect old_after - $expect new_after - old_contents <- liftIO $ - Filesystem.withTextFile old_path ReadMode $ - Data.Text.IO.hGetContents - new_contents <- liftIO $ - Filesystem.withTextFile new_path ReadMode $ - Data.Text.IO.hGetContents - $expect (equalLines old_contents new_contents) - -test_CanonicalizePath :: String -> FilePath -> FilePath -> Test -test_CanonicalizePath test_name src_name dst_name = assertionsWithTemp test_name $ \tmp -> do - let src_path = tmp src_name - let subdir = tmp "subdir" - - -- canonicalize the directory first, to avoid false negatives if - -- it gets placed in a symlinked location. - mkdir_ffi subdir - canon_subdir <- liftIO (Filesystem.canonicalizePath subdir) - - let dst_path = canon_subdir dst_name - - touch_ffi dst_path "" - symlink_ffi dst_path src_path - - canonicalized <- liftIO $ Filesystem.canonicalizePath src_path - $expect $ equal canonicalized dst_path - -test_CanonicalizePath_TrailingSlash :: Test -test_CanonicalizePath_TrailingSlash = assertionsWithTemp "trailing-slash" $ \tmp -> do - let src_path = tmp "src" - let subdir = tmp "subdir" - - -- canonicalize the directory first, to avoid false negatives if - -- it gets placed in a symlinked location. - mkdir_ffi subdir - canon_subdir <- liftIO (Filesystem.canonicalizePath (tmp "subdir")) - - let dst_path = canon_subdir "dst" - - mkdir_ffi dst_path - symlink_ffi dst_path src_path - - canonicalized <- liftIO (Filesystem.canonicalizePath (src_path empty)) - $expect (equal canonicalized (dst_path empty)) - -test_CreateDirectory :: String -> FilePath -> Test -test_CreateDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do - let dir_path = tmp dir_name - - exists_before <- liftIO $ Filesystem.isDirectory dir_path - $assert (not exists_before) - - liftIO $ Filesystem.createDirectory False dir_path - exists_after <- liftIO $ Filesystem.isDirectory dir_path - - $expect exists_after - -test_CreateDirectory_FailExists :: Test -test_CreateDirectory_FailExists = assertionsWithTemp "fail-if-exists" $ \tmp -> do - let dir_path = tmp "subdir" - mkdir_ffi dir_path - - $expect $ throwsEq - (mkAlreadyExists "createDirectory" dir_path) - (Filesystem.createDirectory False dir_path) - -test_CreateDirectory_SucceedExists :: Test -test_CreateDirectory_SucceedExists = assertionsWithTemp "succeed-if-exists" $ \tmp -> do - let dir_path = tmp "subdir" - mkdir_ffi dir_path - - liftIO $ Filesystem.createDirectory True dir_path - -test_CreateDirectory_FailFileExists :: Test -test_CreateDirectory_FailFileExists = assertionsWithTemp "fail-if-file-exists" $ \tmp -> do - let dir_path = tmp "subdir" - touch_ffi dir_path "" - - $expect $ throwsEq - (mkAlreadyExists "createDirectory" dir_path) - (Filesystem.createDirectory False dir_path) - $expect $ throwsEq - (mkAlreadyExists "createDirectory" dir_path) - (Filesystem.createDirectory True dir_path) - -mkAlreadyExists :: String -> FilePath -> GHC.IOError -mkAlreadyExists loc path = GHC.IOError Nothing GHC.AlreadyExists loc "File exists" -#if MIN_VERSION_base(4,2,0) - (Just (errnoCInt eEXIST)) -#endif - (Just (CurrentOS.encodeString path)) - -test_CreateTree :: String -> FilePath -> Test -test_CreateTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do - let dir_path = tmp dir_name - let subdir = dir_path "subdir" - - dir_exists_before <- liftIO $ Filesystem.isDirectory dir_path - subdir_exists_before <- liftIO $ Filesystem.isDirectory subdir - $assert (not dir_exists_before) - $assert (not subdir_exists_before) - - liftIO $ Filesystem.createTree subdir - dir_exists_after <- liftIO $ Filesystem.isDirectory dir_path - subdir_exists_after <- liftIO $ Filesystem.isDirectory subdir - - $expect dir_exists_after - $expect subdir_exists_after - -test_ListDirectory :: Test -test_ListDirectory = assertionsWithTemp "listDirectory" $ \tmp -> do - -- OSX replaces non-UTF8 filenames with http-style %XX escapes - let paths = -#ifdef CABAL_OS_DARWIN - [ tmp decode "%A1%A2%A3.txt" - , tmp decode "test.txt" - , tmp fromText "\xA1\xA2.txt" - ] -#else - [ tmp decode "test.txt" - , tmp fromText "\xA1\xA2.txt" - , tmp decode "\xA1\xA2\xA3.txt" - ] -#endif - forM_ paths (\path -> touch_ffi path "") - - names <- liftIO $ Filesystem.listDirectory tmp - $expect $ sameItems paths names - -test_RemoveFile :: String -> FilePath -> Test -test_RemoveFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let file_path = tmp file_name - - touch_ffi file_path "contents\n" - - before <- liftIO $ Filesystem.isFile file_path - $assert before - - liftIO $ Filesystem.removeFile file_path - - after <- liftIO $ Filesystem.isFile file_path - $expect (not after) - -test_RemoveDirectory :: String -> FilePath -> Test -test_RemoveDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do - let dir_path = tmp dir_name - - mkdir_ffi dir_path - - before <- liftIO $ Filesystem.isDirectory dir_path - $assert before - - liftIO $ Filesystem.removeDirectory dir_path - - after <- liftIO $ Filesystem.isDirectory dir_path - $expect (not after) - -test_RemoveTree :: String -> FilePath -> Test -test_RemoveTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do - let dir_path = tmp dir_name - let subdir = dir_path "subdir" - - mkdir_ffi dir_path - mkdir_ffi subdir - - dir_before <- liftIO $ Filesystem.isDirectory dir_path - subdir_before <- liftIO $ Filesystem.isDirectory subdir - $assert dir_before - $assert subdir_before - - liftIO $ Filesystem.removeTree dir_path - - dir_after <- liftIO $ Filesystem.isDirectory dir_path - subdir_after <- liftIO $ Filesystem.isDirectory subdir - $expect (not dir_after) - $expect (not subdir_after) - -test_GetWorkingDirectory :: String -> FilePath -> Test -test_GetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do - -- canonicalize to avoid issues with symlinked temp dirs - canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) - let dir_path = canon_tmp dir_name - - mkdir_ffi dir_path - chdir_ffi dir_path - - cwd <- liftIO $ Filesystem.getWorkingDirectory - $expect (equal cwd dir_path) - -test_SetWorkingDirectory :: String -> FilePath -> Test -test_SetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do - -- canonicalize to avoid issues with symlinked temp dirs - canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) - let dir_path = canon_tmp dir_name - - mkdir_ffi dir_path - liftIO $ Filesystem.setWorkingDirectory dir_path - - cwd <- getcwd_ffi - $expect (equal cwd dir_path) - -test_GetHomeDirectory :: String -> FilePath -> Test -test_GetHomeDirectory test_name dir_name = assertions test_name $ do - path <- liftIO $ withEnv "HOME" (Just dir_name) Filesystem.getHomeDirectory - $expect (equal path dir_name) - -test_GetDesktopDirectory :: String -> FilePath -> Test -test_GetDesktopDirectory test_name dir_name = assertions test_name $ do - path <- liftIO $ - withEnv "XDG_DESKTOP_DIR" (Just dir_name) $ - Filesystem.getDesktopDirectory - $expect (equal path dir_name) - - fallback <- liftIO $ - withEnv "XDG_DESKTOP_DIR" Nothing $ - withEnv "HOME" (Just dir_name) $ - Filesystem.getDesktopDirectory - $expect (equal fallback (dir_name "Desktop")) - -test_GetModified :: String -> FilePath -> Test -test_GetModified test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let file_path = tmp file_name - - touch_ffi file_path "" - now <- liftIO getCurrentTime - - mtime <- liftIO $ Filesystem.getModified file_path - $expect (equalWithin (diffUTCTime mtime now) 0 2) - -test_GetSize :: String -> FilePath -> Test -test_GetSize test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let file_path = tmp file_name - let contents = "contents\n" - - touch_ffi file_path contents - - size <- liftIO $ Filesystem.getSize file_path - $expect (equal size (toInteger (Data.ByteString.length contents))) - -test_WithFile_Read :: String -> FilePath -> Test -test_WithFile_Read test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let file_path = tmp file_name - let contents = "contents\n" - - touch_ffi file_path contents - - read_contents <- liftIO $ - Filesystem.withFile file_path ReadMode $ - Data.ByteString.hGetContents - $expect (equalLines contents read_contents) - -test_WithFile_Write :: String -> FilePath -> Test -test_WithFile_Write test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let file_path = tmp file_name - let contents = "contents\n" - - liftIO $ - Filesystem.withFile file_path WriteMode $ - (\h -> Data.ByteString.hPut h contents) - - read_contents <- liftIO $ - Filesystem.withFile file_path ReadMode $ - Data.ByteString.hGetContents - $expect (equalLines contents read_contents) - -test_WithTextFile :: String -> FilePath -> Test -test_WithTextFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do - let file_path = tmp file_name - let contents = "contents\n" - - touch_ffi file_path (Char8.pack contents) - - read_contents <- liftIO $ - Filesystem.withTextFile file_path ReadMode $ - Data.Text.IO.hGetContents - $expect (equalLines (Data.Text.pack contents) read_contents) - -test_ListDirectoryLeaksFds :: Test -test_ListDirectoryLeaksFds = assertionsWithTemp "listDirectory-leaks-fds" $ \tmp -> do - -- Test that listDirectory doesn't leak file descriptors. - let dir_path = tmp "subdir" - mkdir_ffi dir_path - - nullfd1 <- liftIO $ PosixIO.openFd "/dev/null" PosixIO.ReadOnly Nothing PosixIO.defaultFileFlags - liftIO $ PosixIO.closeFd nullfd1 - - subdirContents <- liftIO $ listDirectory dir_path - - nullfd2 <- liftIO $ PosixIO.openFd "/dev/null" PosixIO.ReadOnly Nothing PosixIO.defaultFileFlags - liftIO $ PosixIO.closeFd nullfd2 - - $assert (equal nullfd1 nullfd2) - -withPathCString :: FilePath -> (CString -> IO a) -> IO a -withPathCString p = Data.ByteString.useAsCString (encode p) - -decode :: ByteString -> FilePath -decode = Rules.decode Rules.posix - -encode :: FilePath -> ByteString -encode = Rules.encode Rules.posix - -fromText :: Text -> FilePath -fromText = Rules.fromText Rules.posix - --- | Create a file using the raw POSIX API, via FFI -touch_ffi :: FilePath -> Data.ByteString.ByteString -> Assertions () -touch_ffi path contents = do - fp <- liftIO $ withPathCString path $ \path_cstr -> - Foreign.C.withCString "wb" $ \mode_cstr -> - c_fopen path_cstr mode_cstr - - $assert (fp /= nullPtr) - - _ <- liftIO $ Data.ByteString.useAsCStringLen contents $ \(buf, len) -> - c_fwrite buf 1 (fromIntegral len) fp - - _ <- liftIO $ c_fclose fp - return () - --- | Create a directory using the raw POSIX API, via FFI -mkdir_ffi :: FilePath -> Assertions () -mkdir_ffi path = do - ret <- liftIO $ withPathCString path $ \path_cstr -> - c_mkdir path_cstr 0o700 - - $assert (ret == 0) - --- | Create a symlink using the raw POSIX API, via FFI -symlink_ffi :: FilePath -> FilePath -> Assertions () -symlink_ffi dst src = do - ret <- liftIO $ - withPathCString dst $ \dst_p -> - withPathCString src $ \src_p -> - c_symlink dst_p src_p - - $assert (ret == 0) - --- | Create a FIFO using the raw POSIX API, via FFI -mkfifo_ffi :: FilePath -> Assertions () -mkfifo_ffi path = do - ret <- liftIO $ withPathCString path $ \path_cstr -> - c_mkfifo path_cstr 0o700 - - $assert (ret == 0) - -getcwd_ffi :: Assertions FilePath -getcwd_ffi = do - buf <- liftIO $ c_getcwd nullPtr 0 - $assert (buf /= nullPtr) - bytes <- liftIO $ Data.ByteString.packCString buf - liftIO $ c_free buf - return (decode bytes) - -chdir_ffi :: FilePath -> Assertions () -chdir_ffi path = do - ret <- liftIO $ - withPathCString path $ \path_p -> - c_chdir path_p - $assert (ret == 0) - -errnoCInt :: Errno -> CInt -errnoCInt (Errno x) = x - -withEnv :: ByteString -> Maybe FilePath -> IO a -> IO a -withEnv name val io = bracket set unset (\_ -> io) where - set = do - old <- getEnv name - setEnv name (fmap encode val) - return old - unset = setEnv name - -getEnv :: ByteString -> IO (Maybe ByteString) -getEnv name = Data.ByteString.useAsCString name $ \cName -> do - ret <- liftIO (c_getenv cName) - if ret == nullPtr - then return Nothing - else fmap Just (Data.ByteString.packCString ret) - -setEnv :: ByteString -> Maybe ByteString -> IO () -setEnv name Nothing = throwErrnoIfMinus1_ "setEnv" $ - Data.ByteString.useAsCString name c_unsetenv -setEnv name (Just val) = throwErrnoIfMinus1_ "setEnv" $ - Data.ByteString.useAsCString name $ \cName -> - Data.ByteString.useAsCString val $ \cVal -> - c_setenv cName cVal 1 - -foreign import ccall unsafe "fopen" - c_fopen :: CString -> CString -> IO (Ptr ()) - -foreign import ccall unsafe "fclose" - c_fclose :: Ptr () -> IO CInt - -foreign import ccall unsafe "fwrite" - c_fwrite :: CString -> CSize -> CSize -> Ptr () -> IO CSize - -foreign import ccall unsafe "mkdir" - c_mkdir :: CString -> CInt -> IO CInt - -foreign import ccall unsafe "symlink" - c_symlink :: CString -> CString -> IO CInt - -foreign import ccall unsafe "mkfifo" - c_mkfifo :: CString -> CInt -> IO CInt - -foreign import ccall unsafe "getcwd" - c_getcwd :: CString -> CSize -> IO CString - -foreign import ccall unsafe "chdir" - c_chdir :: CString -> IO CInt - -foreign import ccall unsafe "free" - c_free :: Ptr a -> IO () - -foreign import ccall unsafe "getenv" - c_getenv :: CString -> IO CString - -foreign import ccall unsafe "setenv" - c_setenv :: CString -> CString -> CInt -> IO CInt - -foreign import ccall unsafe "unsetenv" - c_unsetenv :: CString -> IO CInt + ( suite_Posix + ) where + +import Prelude hiding (FilePath) +import Control.Exception (bracket) +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as Char8 +import qualified Data.Text +import Data.Text (Text) +import qualified Data.Text.IO +import Data.Time.Clock (diffUTCTime, getCurrentTime) +import Foreign +import Foreign.C +import Test.Chell + +#if MIN_VERSION_base(4,2,0) +import qualified GHC.IO.Exception as GHC +#else +import qualified GHC.IOBase as GHC +#endif + +import qualified System.Posix.IO as PosixIO + +import Filesystem +import Filesystem.Path +import qualified Filesystem.Path.Rules as Rules +import qualified Filesystem.Path.CurrentOS as CurrentOS + +import FilesystemTests.Util (assertionsWithTemp, todo) + +suite_Posix :: Suite +suite_Posix = suite "posix" $ + (concatMap suiteTests + [ suite_IsFile + , suite_IsDirectory + , suite_Rename + , suite_CanonicalizePath + , suite_CreateDirectory + , suite_CreateTree + , suite_RemoveFile + , suite_RemoveDirectory + , suite_RemoveTree + , suite_GetWorkingDirectory + , suite_SetWorkingDirectory + , suite_GetHomeDirectory + , suite_GetDesktopDirectory + , suite_GetModified + , suite_GetSize + , suite_CopyFile + , suite_WithFile + , suite_WithTextFile + , suite_RegressionTests + ]) ++ + [ test_ListDirectory + , todo "getDocumentsDirectory" + , todo "getAppDataDirectory" + , todo "getAppCacheDirectory" + , todo "getAppConfigDirectory" + , todo "openFile" + , todo "readFile" + , todo "writeFile" + , todo "appendFile" + , todo "openTextFile" + , todo "readTextFile" + , todo "writeTextFile" + , todo "appendTextFile" + ] + +suite_IsFile :: Suite +suite_IsFile = suite "isFile" + [ test_IsFile "ascii" (decode "test.txt") + , test_IsFile "utf8" (fromText "\xA1\xA2.txt") + , test_IsFile "iso8859" (decode "\xA1\xA2\xA3.txt") + , test_PipeIsFile "pipe.ascii" (decode "test.txt") + , test_PipeIsFile "pipe.utf8" (fromText "\xA1\xA2.txt") + , test_PipeIsFile "pipe.iso8859" (decode "\xA1\xA2\xA3.txt") + ] + +suite_IsDirectory :: Suite +suite_IsDirectory = suite "isDirectory" + [ test_IsDirectory "ascii" (decode "test.d") + , test_IsDirectory "utf8" (fromText "\xA1\xA2.d") + , test_IsDirectory "iso8859" (decode "\xA1\xA2\xA3.d") + ] + +suite_Rename :: Suite +suite_Rename = suite "rename" + [ test_Rename "ascii" + (decode "old_test.txt") + (decode "new_test.txt") + , test_Rename "utf8" + (fromText "old_\xA1\xA2.txt") + (fromText "new_\xA1\xA2.txt") + , test_Rename "iso8859" + (decode "old_\xA1\xA2\xA3.txt") + (decode "new_\xA1\xA2\xA3.txt") + ] + +suite_CanonicalizePath :: Suite +suite_CanonicalizePath = suite "canonicalizePath" + [ test_CanonicalizePath "ascii" + (decode "test-a.txt") + (decode "test-b.txt") + , test_CanonicalizePath "utf8" + (fromText "\xA1\xA2-a.txt") + (fromText "\xA1\xA2-b.txt") + , test_CanonicalizePath "iso8859" + (decode "\xA1\xA2\xA3-a.txt") +#ifdef CABAL_OS_DARWIN + (decode "%A1%A2%A3-b.txt") +#else + (decode "\xA1\xA2\xA3-b.txt") +#endif + , test_CanonicalizePath_TrailingSlash + ] + +suite_CreateDirectory :: Suite +suite_CreateDirectory = suite "createDirectory" + [ test_CreateDirectory "ascii" + (decode "test.d") + , test_CreateDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_CreateDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + , test_CreateDirectory_FailExists + , test_CreateDirectory_SucceedExists + , test_CreateDirectory_FailFileExists + ] + +suite_CreateTree :: Suite +suite_CreateTree = suite "createTree" + [ test_CreateTree "ascii" + (decode "test.d") + , test_CreateTree "ascii-slash" + (decode "test.d/") + , test_CreateTree "utf8" + (fromText "\xA1\xA2.d") + , test_CreateTree "utf8-slash" + (fromText "\xA1\xA2.d/") + , test_CreateTree "iso8859" + (decode "\xA1\xA2\xA3.d") + , test_CreateTree "iso8859-slash" + (decode "\xA1\xA2\xA3.d/") + ] + +suite_RemoveFile :: Suite +suite_RemoveFile = suite "removeFile" + [ test_RemoveFile "ascii" + (decode "test.txt") + , test_RemoveFile "utf8" + (fromText "\xA1\xA2.txt") + , test_RemoveFile "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_RemoveDirectory :: Suite +suite_RemoveDirectory = suite "removeDirectory" + [ test_RemoveDirectory "ascii" + (decode "test.d") + , test_RemoveDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_RemoveDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_RemoveTree :: Suite +suite_RemoveTree = suite "removeTree" + [ test_RemoveTree "ascii" + (decode "test.d") + , test_RemoveTree "utf8" + (fromText "\xA1\xA2.d") + , test_RemoveTree "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_GetWorkingDirectory :: Suite +suite_GetWorkingDirectory = suite "getWorkingDirectory" + [ test_GetWorkingDirectory "ascii" + (decode "test.d") + , test_GetWorkingDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_GetWorkingDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_SetWorkingDirectory :: Suite +suite_SetWorkingDirectory = suite "setWorkingDirectory" + [ test_SetWorkingDirectory "ascii" + (decode "test.d") + , test_SetWorkingDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_SetWorkingDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_GetHomeDirectory :: Suite +suite_GetHomeDirectory = suite "getHomeDirectory" + [ test_GetHomeDirectory "ascii" + (decode "/home/test.d") + , test_GetHomeDirectory "utf8" + (decode "/home/\xA1\xA2.d") + , test_GetHomeDirectory "iso8859" + (decode "/home/\xA1\xA2\xA3.d") + ] + +suite_GetDesktopDirectory :: Suite +suite_GetDesktopDirectory = suite "getDesktopDirectory" + [ test_GetDesktopDirectory "ascii" + (decode "/desktop/test.d") + , test_GetDesktopDirectory "utf8" + (decode "/desktop/\xA1\xA2.d") + , test_GetDesktopDirectory "iso8859" + (decode "/desktop/\xA1\xA2\xA3.d") + ] + +suite_GetModified :: Suite +suite_GetModified = suite "getModified" + [ test_GetModified "ascii" + (decode "test.txt") + , test_GetModified "utf8" + (fromText "\xA1\xA2.txt") + , test_GetModified "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_GetSize :: Suite +suite_GetSize = suite "getSize" + [ test_GetSize "ascii" + (decode "test.txt") + , test_GetSize "utf8" + (fromText "\xA1\xA2.txt") + , test_GetSize "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_CopyFile :: Suite +suite_CopyFile = suite "copyFile" + [ test_CopyFile "ascii" + (decode "old_test.txt") + (decode "new_test.txt") + , test_CopyFile "utf8" + (fromText "old_\xA1\xA2.txt") + (fromText "new_\xA1\xA2.txt") + , test_CopyFile "iso8859" +#ifdef CABAL_OS_DARWIN + (decode "old_%A1%A2%A3.txt") +#else + (decode "old_\xA1\xA2\xA3.txt") +#endif +#ifdef CABAL_OS_DARWIN + (decode "new_%A1%A2%A3.txt") +#else + (decode "new_\xA1\xA2\xA3.txt") +#endif + ] + +suite_WithFile :: Suite +suite_WithFile = suite "withFile" + [ test_WithFile_Read "read.ascii" + (decode "test.txt") + , test_WithFile_Read "read.utf8" + (fromText "\xA1\xA2.txt") + , test_WithFile_Read "read.iso8859" +#ifdef CABAL_OS_DARWIN + (decode "%A1%A2%A3.txt") +#else + (decode "\xA1\xA2\xA3.txt") +#endif + , test_WithFile_Write "write.ascii" + (decode "test.txt") + , test_WithFile_Write "write.utf8" + (fromText "\xA1\xA2.txt") + , test_WithFile_Write "write.iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_WithTextFile :: Suite +suite_WithTextFile = suite "withTextFile" + [ test_WithTextFile "ascii" + (decode "test.txt") + , test_WithTextFile "utf8" + (fromText "\xA1\xA2.txt") + , test_WithTextFile "iso8859" +#ifdef CABAL_OS_DARWIN + (decode "%A1%A2%A3.txt") +#else + (decode "\xA1\xA2\xA3.txt") +#endif + ] + +suite_RegressionTests :: Suite +suite_RegressionTests = suite "regression-tests" + [ test_ListDirectoryLeaksFds + ] + +test_IsFile :: String -> FilePath -> Test +test_IsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let path = tmp file_name + + before <- liftIO $ Filesystem.isFile path + $expect (not before) + + touch_ffi path "contents\n" + + after <- liftIO $ Filesystem.isFile path + $expect after + +test_PipeIsFile :: String -> FilePath -> Test +test_PipeIsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let path = tmp file_name + + before <- liftIO $ Filesystem.isFile path + $expect (not before) + + mkfifo_ffi path + + after <- liftIO $ Filesystem.isFile path + $expect after + +test_IsDirectory :: String -> FilePath -> Test +test_IsDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do + let path = tmp dir_name + + before <- liftIO $ Filesystem.isDirectory path + $expect (not before) + + mkdir_ffi path + + after <- liftIO $ Filesystem.isDirectory path + $expect after + +test_Rename :: String -> FilePath -> FilePath -> Test +test_Rename test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do + let old_path = tmp old_name + let new_path = tmp new_name + + touch_ffi old_path "" + + old_before <- liftIO $ Filesystem.isFile old_path + new_before <- liftIO $ Filesystem.isFile new_path + $expect old_before + $expect (not new_before) + + liftIO $ Filesystem.rename old_path new_path + + old_after <- liftIO $ Filesystem.isFile old_path + new_after <- liftIO $ Filesystem.isFile new_path + $expect (not old_after) + $expect new_after + +test_CopyFile :: String -> FilePath -> FilePath -> Test +test_CopyFile test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do + let old_path = tmp old_name + let new_path = tmp new_name + + touch_ffi old_path "" + + old_before <- liftIO $ Filesystem.isFile old_path + new_before <- liftIO $ Filesystem.isFile new_path + $expect old_before + $expect (not new_before) + + liftIO $ Filesystem.copyFile old_path new_path + + old_after <- liftIO $ Filesystem.isFile old_path + new_after <- liftIO $ Filesystem.isFile new_path + $expect old_after + $expect new_after + old_contents <- liftIO $ + Filesystem.withTextFile old_path ReadMode $ + Data.Text.IO.hGetContents + new_contents <- liftIO $ + Filesystem.withTextFile new_path ReadMode $ + Data.Text.IO.hGetContents + $expect (equalLines old_contents new_contents) + +test_CanonicalizePath :: String -> FilePath -> FilePath -> Test +test_CanonicalizePath test_name src_name dst_name = assertionsWithTemp test_name $ \tmp -> do + let src_path = tmp src_name + let subdir = tmp "subdir" + + -- canonicalize the directory first, to avoid false negatives if + -- it gets placed in a symlinked location. + mkdir_ffi subdir + canon_subdir <- liftIO (Filesystem.canonicalizePath subdir) + + let dst_path = canon_subdir dst_name + + touch_ffi dst_path "" + symlink_ffi dst_path src_path + + canonicalized <- liftIO $ Filesystem.canonicalizePath src_path + $expect $ equal canonicalized dst_path + +test_CanonicalizePath_TrailingSlash :: Test +test_CanonicalizePath_TrailingSlash = assertionsWithTemp "trailing-slash" $ \tmp -> do + let src_path = tmp "src" + let subdir = tmp "subdir" + + -- canonicalize the directory first, to avoid false negatives if + -- it gets placed in a symlinked location. + mkdir_ffi subdir + canon_subdir <- liftIO (Filesystem.canonicalizePath (tmp "subdir")) + + let dst_path = canon_subdir "dst" + + mkdir_ffi dst_path + symlink_ffi dst_path src_path + + canonicalized <- liftIO (Filesystem.canonicalizePath (src_path empty)) + $expect (equal canonicalized (dst_path empty)) + +test_CreateDirectory :: String -> FilePath -> Test +test_CreateDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do + let dir_path = tmp dir_name + + exists_before <- liftIO $ Filesystem.isDirectory dir_path + $assert (not exists_before) + + liftIO $ Filesystem.createDirectory False dir_path + exists_after <- liftIO $ Filesystem.isDirectory dir_path + + $expect exists_after + +test_CreateDirectory_FailExists :: Test +test_CreateDirectory_FailExists = assertionsWithTemp "fail-if-exists" $ \tmp -> do + let dir_path = tmp "subdir" + mkdir_ffi dir_path + + $expect $ throwsEq + (mkAlreadyExists "createDirectory" dir_path) + (Filesystem.createDirectory False dir_path) + +test_CreateDirectory_SucceedExists :: Test +test_CreateDirectory_SucceedExists = assertionsWithTemp "succeed-if-exists" $ \tmp -> do + let dir_path = tmp "subdir" + mkdir_ffi dir_path + + liftIO $ Filesystem.createDirectory True dir_path + +test_CreateDirectory_FailFileExists :: Test +test_CreateDirectory_FailFileExists = assertionsWithTemp "fail-if-file-exists" $ \tmp -> do + let dir_path = tmp "subdir" + touch_ffi dir_path "" + + $expect $ throwsEq + (mkAlreadyExists "createDirectory" dir_path) + (Filesystem.createDirectory False dir_path) + $expect $ throwsEq + (mkAlreadyExists "createDirectory" dir_path) + (Filesystem.createDirectory True dir_path) + +mkAlreadyExists :: String -> FilePath -> GHC.IOError +mkAlreadyExists loc path = GHC.IOError Nothing GHC.AlreadyExists loc "File exists" +#if MIN_VERSION_base(4,2,0) + (Just (errnoCInt eEXIST)) +#endif + (Just (CurrentOS.encodeString path)) + +test_CreateTree :: String -> FilePath -> Test +test_CreateTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do + let dir_path = tmp dir_name + let subdir = dir_path "subdir" + + dir_exists_before <- liftIO $ Filesystem.isDirectory dir_path + subdir_exists_before <- liftIO $ Filesystem.isDirectory subdir + $assert (not dir_exists_before) + $assert (not subdir_exists_before) + + liftIO $ Filesystem.createTree subdir + dir_exists_after <- liftIO $ Filesystem.isDirectory dir_path + subdir_exists_after <- liftIO $ Filesystem.isDirectory subdir + + $expect dir_exists_after + $expect subdir_exists_after + +test_ListDirectory :: Test +test_ListDirectory = assertionsWithTemp "listDirectory" $ \tmp -> do + -- OSX replaces non-UTF8 filenames with http-style %XX escapes + let + paths = +#ifdef CABAL_OS_DARWIN + [ tmp decode "%A1%A2%A3.txt" + , tmp decode "test.txt" + , tmp fromText "\xA1\xA2.txt" + ] +#else + [ tmp decode "test.txt" + , tmp fromText "\xA1\xA2.txt" + , tmp decode "\xA1\xA2\xA3.txt" + ] +#endif + forM_ paths (\path -> touch_ffi path "") + + names <- liftIO $ Filesystem.listDirectory tmp + $expect $ sameItems paths names + +test_RemoveFile :: String -> FilePath -> Test +test_RemoveFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let file_path = tmp file_name + + touch_ffi file_path "contents\n" + + before <- liftIO $ Filesystem.isFile file_path + $assert before + + liftIO $ Filesystem.removeFile file_path + + after <- liftIO $ Filesystem.isFile file_path + $expect (not after) + +test_RemoveDirectory :: String -> FilePath -> Test +test_RemoveDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do + let dir_path = tmp dir_name + + mkdir_ffi dir_path + + before <- liftIO $ Filesystem.isDirectory dir_path + $assert before + + liftIO $ Filesystem.removeDirectory dir_path + + after <- liftIO $ Filesystem.isDirectory dir_path + $expect (not after) + +test_RemoveTree :: String -> FilePath -> Test +test_RemoveTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do + let dir_path = tmp dir_name + let subdir = dir_path "subdir" + + mkdir_ffi dir_path + mkdir_ffi subdir + + dir_before <- liftIO $ Filesystem.isDirectory dir_path + subdir_before <- liftIO $ Filesystem.isDirectory subdir + $assert dir_before + $assert subdir_before + + liftIO $ Filesystem.removeTree dir_path + + dir_after <- liftIO $ Filesystem.isDirectory dir_path + subdir_after <- liftIO $ Filesystem.isDirectory subdir + $expect (not dir_after) + $expect (not subdir_after) + +test_GetWorkingDirectory :: String -> FilePath -> Test +test_GetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do + -- canonicalize to avoid issues with symlinked temp dirs + canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) + let dir_path = canon_tmp dir_name + + mkdir_ffi dir_path + chdir_ffi dir_path + + cwd <- liftIO $ Filesystem.getWorkingDirectory + $expect (equal cwd dir_path) + +test_SetWorkingDirectory :: String -> FilePath -> Test +test_SetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do + -- canonicalize to avoid issues with symlinked temp dirs + canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) + let dir_path = canon_tmp dir_name + + mkdir_ffi dir_path + liftIO $ Filesystem.setWorkingDirectory dir_path + + cwd <- getcwd_ffi + $expect (equal cwd dir_path) + +test_GetHomeDirectory :: String -> FilePath -> Test +test_GetHomeDirectory test_name dir_name = assertions test_name $ do + path <- liftIO $ withEnv "HOME" (Just dir_name) Filesystem.getHomeDirectory + $expect (equal path dir_name) + +test_GetDesktopDirectory :: String -> FilePath -> Test +test_GetDesktopDirectory test_name dir_name = assertions test_name $ do + path <- liftIO $ + withEnv "XDG_DESKTOP_DIR" (Just dir_name) $ + Filesystem.getDesktopDirectory + $expect (equal path dir_name) + + fallback <- liftIO $ + withEnv "XDG_DESKTOP_DIR" Nothing $ + withEnv "HOME" (Just dir_name) $ + Filesystem.getDesktopDirectory + $expect (equal fallback (dir_name "Desktop")) + +test_GetModified :: String -> FilePath -> Test +test_GetModified test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let file_path = tmp file_name + + touch_ffi file_path "" + now <- liftIO getCurrentTime + + mtime <- liftIO $ Filesystem.getModified file_path + $expect (equalWithin (diffUTCTime mtime now) 0 2) + +test_GetSize :: String -> FilePath -> Test +test_GetSize test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let file_path = tmp file_name + let contents = "contents\n" + + touch_ffi file_path contents + + size <- liftIO $ Filesystem.getSize file_path + $expect (equal size (toInteger (Data.ByteString.length contents))) + +test_WithFile_Read :: String -> FilePath -> Test +test_WithFile_Read test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let file_path = tmp file_name + let contents = "contents\n" + + touch_ffi file_path contents + + read_contents <- liftIO $ + Filesystem.withFile file_path ReadMode $ + Data.ByteString.hGetContents + $expect (equalLines contents read_contents) + +test_WithFile_Write :: String -> FilePath -> Test +test_WithFile_Write test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let file_path = tmp file_name + let contents = "contents\n" + + liftIO $ + Filesystem.withFile file_path WriteMode $ + (\h -> Data.ByteString.hPut h contents) + + read_contents <- liftIO $ + Filesystem.withFile file_path ReadMode $ + Data.ByteString.hGetContents + $expect (equalLines contents read_contents) + +test_WithTextFile :: String -> FilePath -> Test +test_WithTextFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do + let file_path = tmp file_name + let contents = "contents\n" + + touch_ffi file_path (Char8.pack contents) + + read_contents <- liftIO $ + Filesystem.withTextFile file_path ReadMode $ + Data.Text.IO.hGetContents + $expect (equalLines (Data.Text.pack contents) read_contents) + +test_ListDirectoryLeaksFds :: Test +test_ListDirectoryLeaksFds = assertionsWithTemp "listDirectory-leaks-fds" $ \tmp -> do + -- Test that listDirectory doesn't leak file descriptors. + let dir_path = tmp "subdir" + mkdir_ffi dir_path + + nullfd1 <- liftIO openDevNull + liftIO $ PosixIO.closeFd nullfd1 + + _subdirContents <- liftIO $ listDirectory dir_path + + nullfd2 <- liftIO openDevNull + liftIO $ PosixIO.closeFd nullfd2 + + $assert (equal nullfd1 nullfd2) + where + openDevNull = +#if MIN_VERSION_unix(2,8,0) + PosixIO.openFd "/dev/null" PosixIO.ReadOnly PosixIO.defaultFileFlags +#else + PosixIO.openFd "/dev/null" PosixIO.ReadOnly Nothing PosixIO.defaultFileFlags +#endif + +withPathCString :: FilePath -> (CString -> IO a) -> IO a +withPathCString p = Data.ByteString.useAsCString (encode p) + +decode :: ByteString -> FilePath +decode = Rules.decode Rules.posix + +encode :: FilePath -> ByteString +encode = Rules.encode Rules.posix + +fromText :: Text -> FilePath +fromText = Rules.fromText Rules.posix + +-- | Create a file using the raw POSIX API, via FFI +touch_ffi :: FilePath -> Data.ByteString.ByteString -> Assertions () +touch_ffi path contents = do + fp <- liftIO $ withPathCString path $ \path_cstr -> + Foreign.C.withCString "wb" $ \mode_cstr -> + c_fopen path_cstr mode_cstr + + $assert (fp /= nullPtr) + + _ <- liftIO $ Data.ByteString.useAsCStringLen contents $ \(buf, len) -> + c_fwrite buf 1 (fromIntegral len) fp + + _ <- liftIO $ c_fclose fp + return () + +-- | Create a directory using the raw POSIX API, via FFI +mkdir_ffi :: FilePath -> Assertions () +mkdir_ffi path = do + ret <- liftIO $ withPathCString path $ \path_cstr -> + c_mkdir path_cstr 0o700 + + $assert (ret == 0) + +-- | Create a symlink using the raw POSIX API, via FFI +symlink_ffi :: FilePath -> FilePath -> Assertions () +symlink_ffi dst src = do + ret <- liftIO $ + withPathCString dst $ \dst_p -> + withPathCString src $ \src_p -> + c_symlink dst_p src_p + + $assert (ret == 0) + +-- | Create a FIFO using the raw POSIX API, via FFI +mkfifo_ffi :: FilePath -> Assertions () +mkfifo_ffi path = do + ret <- liftIO $ withPathCString path $ \path_cstr -> + c_mkfifo path_cstr 0o700 + + $assert (ret == 0) + +getcwd_ffi :: Assertions FilePath +getcwd_ffi = do + buf <- liftIO $ c_getcwd nullPtr 0 + $assert (buf /= nullPtr) + bytes <- liftIO $ Data.ByteString.packCString buf + liftIO $ c_free buf + return (decode bytes) + +chdir_ffi :: FilePath -> Assertions () +chdir_ffi path = do + ret <- liftIO $ + withPathCString path $ \path_p -> + c_chdir path_p + $assert (ret == 0) + +errnoCInt :: Errno -> CInt +errnoCInt (Errno x) = x + +withEnv :: ByteString -> Maybe FilePath -> IO a -> IO a +withEnv name val io = bracket set unset (\_ -> io) where + set = do + old <- getEnv name + setEnv name (fmap encode val) + return old + unset = setEnv name + +getEnv :: ByteString -> IO (Maybe ByteString) +getEnv name = Data.ByteString.useAsCString name $ \cName -> do + ret <- liftIO (c_getenv cName) + if ret == nullPtr + then return Nothing + else fmap Just (Data.ByteString.packCString ret) + +setEnv :: ByteString -> Maybe ByteString -> IO () +setEnv name Nothing = throwErrnoIfMinus1_ "setEnv" $ + Data.ByteString.useAsCString name c_unsetenv +setEnv name (Just val) = throwErrnoIfMinus1_ "setEnv" $ + Data.ByteString.useAsCString name $ \cName -> + Data.ByteString.useAsCString val $ \cVal -> + c_setenv cName cVal 1 + +foreign import ccall unsafe "fopen" + c_fopen :: CString -> CString -> IO (Ptr ()) + +foreign import ccall unsafe "fclose" + c_fclose :: Ptr () -> IO CInt + +foreign import ccall unsafe "fwrite" + c_fwrite :: CString -> CSize -> CSize -> Ptr () -> IO CSize + +foreign import ccall unsafe "mkdir" + c_mkdir :: CString -> CInt -> IO CInt + +foreign import ccall unsafe "symlink" + c_symlink :: CString -> CString -> IO CInt + +foreign import ccall unsafe "mkfifo" + c_mkfifo :: CString -> CInt -> IO CInt + +foreign import ccall unsafe "getcwd" + c_getcwd :: CString -> CSize -> IO CString + +foreign import ccall unsafe "chdir" + c_chdir :: CString -> IO CInt + +foreign import ccall unsafe "free" + c_free :: Ptr a -> IO () + +foreign import ccall unsafe "getenv" + c_getenv :: CString -> IO CString + +foreign import ccall unsafe "setenv" + c_setenv :: CString -> CString -> CInt -> IO CInt + +foreign import ccall unsafe "unsetenv" + c_unsetenv :: CString -> IO CInt diff --git a/tests/FilesystemTests/Util.hs b/tests/FilesystemTests/Util.hs --- a/tests/FilesystemTests/Util.hs +++ b/tests/FilesystemTests/Util.hs @@ -5,9 +5,9 @@ -- -- See license.txt for details module FilesystemTests.Util - ( assertionsWithTemp - , todo - ) where + ( assertionsWithTemp + , todo + ) where import Prelude hiding (FilePath) @@ -20,15 +20,15 @@ assertionsWithTemp :: String -> (FilePath -> Assertions a) -> Test assertionsWithTemp name io = test name impl where - impl options = withTempDir name $ \dir -> do - runTest (assertions name (io dir)) options + impl options = withTempDir name $ \dir -> do + runTest (assertions name (io dir)) options withTempDir :: String -> (FilePath -> IO a) -> IO a withTempDir name io = withSystemTempDirectory - ("tests." ++ name ++ ".") - (\dir -> - let dir' = decodeString dir in - finally (io dir') (removeTree dir')) + ("tests." ++ name ++ ".") + (\dir -> + let dir' = decodeString dir in + finally (io dir') (removeTree dir')) todo :: String -> Test todo name = skipIf True (assertions name (return ())) diff --git a/tests/FilesystemTests/Windows.hs b/tests/FilesystemTests/Windows.hs --- a/tests/FilesystemTests/Windows.hs +++ b/tests/FilesystemTests/Windows.hs @@ -5,8 +5,8 @@ -- -- See license.txt for details module FilesystemTests.Windows - ( suite_Windows - ) where + ( suite_Windows + ) where import Control.Monad import Control.Monad.IO.Class (liftIO) @@ -19,48 +19,49 @@ suite_Windows :: Suite suite_Windows = suite "windows" - [ todo "isFile" - , todo "isDirectory" - , todo "rename" - , todo "canonicalizePath" - , todo "createDirectory" - , todo "createTree" - , test_ListDirectory - , todo "removeFile" - , todo "removeDirectory" - , todo "removeTree" - , todo "getWorkingDirectory" - , todo "setWorkingDirectory" - , todo "getHomeDirectory" - , todo "getDesktopDirectory" - , todo "getDocumentsDirectory" - , todo "getAppDataDirectory" - , todo "getAppCacheDirectory" - , todo "getAppConfigDirectory" - , todo "copyFile" - , todo "getModified" - , todo "getSize" - , todo "openFile" - , todo "withFile" - , todo "readFile" - , todo "writeFile" - , todo "appendFile" - , todo "openTextFile" - , todo "withTextFile" - , todo "readTextFile" - , todo "writeTextFile" - , todo "appendTextFile" - ] + [ todo "isFile" + , todo "isDirectory" + , todo "rename" + , todo "canonicalizePath" + , todo "createDirectory" + , todo "createTree" + , test_ListDirectory + , todo "removeFile" + , todo "removeDirectory" + , todo "removeTree" + , todo "getWorkingDirectory" + , todo "setWorkingDirectory" + , todo "getHomeDirectory" + , todo "getDesktopDirectory" + , todo "getDocumentsDirectory" + , todo "getAppDataDirectory" + , todo "getAppCacheDirectory" + , todo "getAppConfigDirectory" + , todo "copyFile" + , todo "getModified" + , todo "getSize" + , todo "openFile" + , todo "withFile" + , todo "readFile" + , todo "writeFile" + , todo "appendFile" + , todo "openTextFile" + , todo "withTextFile" + , todo "readTextFile" + , todo "writeTextFile" + , todo "appendTextFile" + ] test_ListDirectory :: Test test_ListDirectory = assertionsWithTemp "listDirectory" $ \dir -> do - let paths = - [ dir decode "test.txt" - , dir decode "\12354\946\1076\119070.txt" - , dir decode "\xA1\xA2\xA3.txt" - ] - - liftIO $ forM_ paths (\path -> writeTextFile path "") - - names <- liftIO $ Filesystem.listDirectory dir - $expect $ sameItems paths names + let + paths = + [ dir decode "test.txt" + , dir decode "\12354\946\1076\119070.txt" + , dir decode "\xA1\xA2\xA3.txt" + ] + + liftIO $ forM_ paths (\path -> writeTextFile path "") + + names <- liftIO $ Filesystem.listDirectory dir + $expect $ sameItems paths names