system-fileio-0.3.16.4/lib/0000755000000000000000000000000013343707035013475 5ustar0000000000000000system-fileio-0.3.16.4/tests/0000755000000000000000000000000013230136226014062 5ustar0000000000000000system-fileio-0.3.16.4/tests/FilesystemTests/0000755000000000000000000000000013230136226017231 5ustar0000000000000000system-fileio-0.3.16.4/lib/Filesystem.hs0000644000000000000000000007623313343707035016170 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module: Filesystem -- Copyright: 2011-2012 John Millikin -- License: MIT -- -- Maintainer: John Millikin -- Portability: portable -- -- Simple 'FilePath'‐aware wrappers around standard "System.IO" -- computations. These wrappers are designed to work as similarly as -- possible across various versions of GHC. -- -- 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 import Prelude hiding (FilePath, readFile, writeFile, appendFile) import qualified Control.Exception as Exc import Control.Monad (forM_, unless, when) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.IO as T import Foreign.Ptr (Ptr, nullPtr) import Foreign.C (CInt(..), CString, withCAString) import qualified Foreign.C.Error as CError import qualified System.Environment as SE import Filesystem.Path (FilePath, append) import qualified Filesystem.Path as Path import Filesystem.Path.CurrentOS (currentOS, encodeString, decodeString) import qualified Filesystem.Path.Rules as R import qualified System.IO as IO import System.IO.Error (IOError) #ifdef CABAL_OS_WINDOWS import Data.Bits ((.|.)) import Data.Time ( UTCTime(..) , fromGregorian , secondsToDiffTime , picosecondsToDiffTime) import Foreign.C (CWString, withCWString) import qualified System.Win32 as Win32 import System.IO.Error (isDoesNotExistError) import qualified System.Directory as SD #else import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified System.Posix as Posix import qualified System.Posix.Error as Posix #if MIN_VERSION_unix(2,5,1) import qualified System.Posix.Files.ByteString #endif #endif #ifdef SYSTEMFILEIO_LOCAL_OPEN_FILE import Data.Bits ((.|.)) import GHC.IO.Handle.FD (mkHandleFromFD) import GHC.IO.FD (mkFD) import qualified GHC.IO.Device import qualified System.Posix.Internals #endif -- | Check if a file exists at the given path. -- -- Any non‐directory object, including devices and pipes, are -- considered to be files. Symbolic links are resolved to their targets -- before checking their type. -- -- This computation does not throw exceptions. isFile :: FilePath -> IO Bool #ifdef CABAL_OS_WINDOWS 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) #endif -- | Check if a directory exists at the given path. -- -- Symbolic links are resolved to their targets before checking their type. -- -- This computation does not throw exceptions. isDirectory :: FilePath -> IO Bool #ifdef CABAL_OS_WINDOWS 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) #endif -- | Rename a filesystem object. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. rename :: FilePath -> FilePath -> IO () rename old new = #ifdef CABAL_OS_WINDOWS 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 #else Win32.moveFileEx old' new' Win32.mOVEFILE_REPLACE_EXISTING #endif #else withFilePath old $ \old' -> withFilePath new $ \new' -> throwErrnoPathIfMinus1_ "rename" old (c_rename old' new') foreign import ccall unsafe "rename" c_rename :: CString -> CString -> IO CInt #endif -- | Resolve symlinks and \"..\" path elements to return a canonical path. -- It is intended that two paths referring to the same object will always -- resolve to the same canonical path. -- -- Note that on many operating systems, it is impossible to guarantee that -- two paths to the same file will resolve to the same canonical path. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. -- -- Since: 0.1.1 canonicalizePath :: FilePath -> IO FilePath canonicalizePath path = fmap (preserveFinalSlash path) $ let path' = encodeString path in #ifdef CABAL_OS_WINDOWS fmap decodeString $ #if MIN_VERSION_Win32(2,2,1) Win32.getFullPathName path' #else 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) #endif preserveFinalSlash :: FilePath -> FilePath -> FilePath preserveFinalSlash orig out = if Path.null (Path.filename orig) 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 #endif #endif #ifndef CABAL_OS_WINDOWS foreign import ccall unsafe "realpath" c_realpath :: CString -> CString -> IO CString #endif -- | Create a directory at a given path. The user may choose whether it is -- an error for a directory to already exist at that path. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. createDirectory :: Bool -- ^ Succeed if the directory already exists -> 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 #else 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 foreign import ccall unsafe "mkdir" c_mkdir :: CString -> CInt -> IO CInt #endif -- | Create a directory at a given path, including any parents which might -- be missing. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. createTree :: FilePath -> IO () #ifdef CABAL_OS_WINDOWS 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) #endif -- | List objects in a directory, excluding @\".\"@ and @\"..\"@. Each -- returned 'FilePath' includes the path of the directory. Entries are not -- sorted. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. 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` [".", ".."]) #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) ignore :: B.ByteString -> Bool ignore = ignore' where 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) 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 foreign import ccall unsafe "opendir" c_opendir :: CString -> IO (Ptr ()) foreign import ccall unsafe "closedir" c_closedir :: Ptr () -> IO CInt foreign import ccall unsafe "hssystemfileio_alloc_dirent" c_alloc_dirent :: Ptr () -> IO (Ptr ()) foreign import ccall unsafe "hssystemfileio_free_dirent" c_free_dirent :: Ptr () -> IO () foreign import ccall unsafe "hssystemfileio_readdir" c_readdir :: Ptr () -> Ptr () -> IO CInt foreign import ccall unsafe "hssystemfileio_dirent_name" c_dirent_name :: Ptr () -> IO CString #endif -- | Remove a file. This will fail if the file does not exist. -- -- This computation cannot remove directories. For that, use 'removeDirectory' -- or 'removeTree'. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. removeFile :: FilePath -> IO () removeFile path = #ifdef CABAL_OS_WINDOWS Win32.deleteFile (encodeString path) #else withFilePath path $ \cPath -> throwErrnoPathIfMinus1_ "removeFile" path (c_unlink cPath) foreign import ccall unsafe "unlink" c_unlink :: CString -> IO CInt #endif -- | Remove an empty directory. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. removeDirectory :: FilePath -> IO () removeDirectory path = #ifdef CABAL_OS_WINDOWS Win32.removeDirectory (encodeString path) #else withFilePath path $ \cPath -> throwErrnoPathIfMinus1Retry_ "removeDirectory" path (c_rmdir cPath) foreign import ccall unsafe "rmdir" c_rmdir :: CString -> IO CInt #endif -- | Recursively remove a directory tree rooted at the given path. -- -- This computation does not follow symlinks. If the tree contains symlinks, -- the links themselves will be removed, but not the objects they point to. -- -- If the root path is a symlink, then it will be treated as if it were a -- regular directory. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. removeTree :: FilePath -> IO () #ifdef CABAL_OS_WINDOWS 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 -- Check whether a path is a directory, and not just a symlink to a directory. -- -- This is used in 'removeTree' to prevent recursing into symlinks if the link -- itself cannot be deleted. isRealDir :: FilePath -> IO Bool isRealDir path = withFilePath path $ \cPath -> do rc <- throwErrnoPathIfMinus1Retry "removeTree" path (c_isrealdir cPath) return (rc == 1) foreign import ccall unsafe "hssystemfileio_isrealdir" c_isrealdir :: CString -> IO CInt #endif -- | Get the current working directory. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. getWorkingDirectory :: IO FilePath getWorkingDirectory = do #ifdef CABAL_OS_WINDOWS #if MIN_VERSION_Win32(2,2,1) fmap decodeString Win32.getCurrentDirectory #else 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) foreign import ccall unsafe "hssystemfileio_getcwd" c_getcwd :: IO CString #endif #ifdef CABAL_OS_WINDOWS #if MIN_VERSION_Win32(2,2,1) #else foreign import stdcall unsafe "GetCurrentDirectoryW" c_GetCurrentDirectoryW :: Win32.DWORD -> Win32.LPTSTR -> IO Win32.UINT #endif #endif -- | Set the current working directory. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. setWorkingDirectory :: FilePath -> IO () setWorkingDirectory path = #ifdef CABAL_OS_WINDOWS Win32.setCurrentDirectory (encodeString path) #else withFilePath path $ \cPath -> throwErrnoPathIfMinus1Retry_ "setWorkingDirectory" path (c_chdir cPath) foreign import ccall unsafe "chdir" c_chdir :: CString -> IO CInt #endif -- TODO: expose all known exceptions as specific types, for users to catch -- if need be -- | Get the user’s home directory. This is useful for building paths -- to more specific directories. -- -- For directing the user to open or safe a document, use -- 'getDocumentsDirectory'. -- -- For data files the user does not explicitly create, such as automatic -- saves, use 'getAppDataDirectory'. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. getHomeDirectory :: IO FilePath #ifdef CABAL_OS_WINDOWS 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") #endif -- | Get the user’s desktop directory. This is a good starting point for -- file dialogs and other user queries. For data files the user does not -- explicitly create, such as automatic saves, use 'getAppDataDirectory'. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. getDesktopDirectory :: IO FilePath getDesktopDirectory = xdg "XDG_DESKTOP_DIR" Nothing (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 -- create, such as automatic saves, use 'getAppDataDirectory'. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. getDocumentsDirectory :: IO FilePath getDocumentsDirectory = xdg "XDG_DOCUMENTS_DIR" Nothing #ifdef CABAL_OS_WINDOWS (fmap decodeString SD.getUserDocumentsDirectory) #else (homeSlash "Documents") #endif -- | Get the user’s application data directory, given an application -- label. This directory is where applications should store data the user did -- not explicitly create, such as databases and automatic saves. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. getAppDataDirectory :: T.Text -> IO FilePath getAppDataDirectory label = xdg "XDG_DATA_HOME" (Just label) #ifdef CABAL_OS_WINDOWS (fmap decodeString (SD.getAppUserDataDirectory "")) #else (homeSlash ".local/share") #endif -- | Get the user’s application cache directory, given an application -- label. This directory is where applications should store caches, which -- might be large and can be safely deleted. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. getAppCacheDirectory :: T.Text -> IO FilePath getAppCacheDirectory label = xdg "XDG_CACHE_HOME" (Just label) #ifdef CABAL_OS_WINDOWS (homeSlash "Local Settings\\Cache") #else (homeSlash ".cache") #endif -- | Get the user’s application configuration directory, given an -- application label. This directory is where applications should store their -- configurations and settings. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. getAppConfigDirectory :: T.Text -> IO FilePath getAppConfigDirectory label = xdg "XDG_CONFIG_HOME" (Just label) #ifdef CABAL_OS_WINDOWS (homeSlash "Local Settings") #else (homeSlash ".config") #endif homeSlash :: String -> IO FilePath homeSlash path = do 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) #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)) foreign import ccall unsafe "getenv" 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 -- | 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 -- a file is not atomic. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. -- -- Since: 0.2.4 / 0.3.4 copyFileContent :: FilePath -- ^ Old location -> FilePath -- ^ New location -> IO () copyFileContent oldPath newPath = 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. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. -- -- Since: 0.2.4 / 0.3.4 copyPermissions :: FilePath -- ^ Old location -> FilePath -- ^ New location -> IO () copyPermissions oldPath newPath = 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 #else foreign import ccall unsafe "hssystemfileio_copy_permissions" c_copy_permissions :: CString -> CString -> IO CInt #endif -- | Copy the content and permissions of a file to a new entry in the -- filesystem. If a file already exists at the new location, it will be -- replaced. Copying a file is not atomic. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. -- -- Since: 0.1.1 copyFile :: FilePath -- ^ Old location -> FilePath -- ^ New location -> IO () copyFile oldPath newPath = do copyFileContent oldPath newPath Exc.catch (copyPermissions oldPath newPath) ((\_ -> return ()) :: IOError -> IO ()) -- | Get when the object at a given path was last modified. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. -- -- Since: 0.2 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)) #else 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 -- links or directories, the size is filesystem‐ and -- platform‐dependent. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. -- -- Since: 0.2 getSize :: FilePath -> IO Integer getSize path = do #ifdef CABAL_OS_WINDOWS info <- withHANDLE path Win32.getFileInformationByHandle return (toInteger (Win32.bhfiSize info)) #else stat <- posixStat "getSize" path return (toInteger (Posix.fileSize stat)) #endif -- | Open a file in binary mode, and return an open 'Handle'. The 'Handle' -- should be closed with 'IO.hClose' when it is no longer needed. -- -- 'withFile' is easier to use, because it will handle the 'Handle'’s -- lifetime automatically. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. openFile :: FilePath -> IO.IOMode -> IO IO.Handle #ifdef SYSTEMFILEIO_LOCAL_OPEN_FILE openFile path mode = openFile' "openFile" path mode Nothing #else openFile path = IO.openBinaryFile (encodeString path) #endif -- | Open a file in binary mode, and pass its 'Handle' to a provided -- computation. The 'Handle' will be automatically closed when the -- computation returns. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. withFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a withFile path mode = Exc.bracket (openFile path mode) IO.hClose -- | Read in the entire content of a binary file. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. readFile :: FilePath -> IO B.ByteString readFile path = withFile path IO.ReadMode (\h -> IO.hFileSize h >>= B.hGet h . fromIntegral) -- | Replace the entire content of a binary file with the provided -- 'B.ByteString'. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. writeFile :: FilePath -> B.ByteString -> IO () writeFile path bytes = withFile path IO.WriteMode (\h -> B.hPut h bytes) -- | Append a 'B.ByteString' to a file. If the file does not exist, it will -- be created. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. appendFile :: FilePath -> B.ByteString -> IO () appendFile path bytes = withFile path IO.AppendMode (\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. -- -- 'withTextFile' is easier to use, because it will handle the -- 'Handle'’s lifetime automatically. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. openTextFile :: FilePath -> IO.IOMode -> IO IO.Handle #ifdef SYSTEMFILEIO_LOCAL_OPEN_FILE openTextFile path mode = openFile' "openTextFile" path mode (Just IO.localeEncoding) #else openTextFile path = IO.openFile (encodeString path) #endif -- | Open a file in text mode, and pass its 'Handle' to a provided -- computation. The 'Handle' will be automatically closed when the -- computation returns. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. withTextFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a withTextFile path mode = Exc.bracket (openTextFile path mode) IO.hClose -- | Read in the entire content of a text file. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. readTextFile :: FilePath -> IO T.Text readTextFile path = openTextFile path IO.ReadMode >>= T.hGetContents -- | Replace the entire content of a text file with the provided -- 'T.Text'. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. writeTextFile :: FilePath -> T.Text -> IO () writeTextFile path text = withTextFile path IO.WriteMode (\h -> T.hPutStr h text) -- | Append 'T.Text' to a file. If the file does not exist, it will -- be created. -- -- This computation throws 'IOError' on failure. See “Classifying -- I/O errors” in the "System.IO.Error" documentation for information on -- why the failure occured. appendTextFile :: FilePath -> T.Text -> IO () appendTextFile path text = withTextFile path IO.AppendMode (\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) iomodeFlags :: IO.IOMode -> CInt iomodeFlags mode = cased .|. commonFlags where cased = case mode of IO.ReadMode -> flagsR #ifdef mingw32_HOST_OS IO.WriteMode -> flagsW .|. System.Posix.Internals.o_TRUNC #else 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 #endif #ifdef CABAL_OS_WINDOWS -- Only for accessing file or directory metadata. -- 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 withFilePath :: FilePath -> (CWString -> IO a) -> IO a withFilePath path = withCWString (encodeString path) #else withFilePath :: FilePath -> (CString -> IO a) -> IO a withFilePath path = B.useAsCString (R.encode R.posix path) throwErrnoPathIfMinus1 :: String -> FilePath -> IO CInt -> IO CInt throwErrnoPathIfMinus1 loc path = CError.throwErrnoPathIfMinus1 loc (encodeString path) throwErrnoPathIfMinus1_ :: String -> FilePath -> IO CInt -> IO () throwErrnoPathIfMinus1_ loc path = CError.throwErrnoPathIfMinus1_ loc (encodeString path) throwErrnoPathIfNullRetry :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a) throwErrnoPathIfNullRetry = throwErrnoPathIfRetry (== nullPtr) throwErrnoPathIfMinus1Retry :: String -> FilePath -> IO CInt -> IO CInt throwErrnoPathIfMinus1Retry = throwErrnoPathIfRetry (== -1) throwErrnoPathIfMinus1Retry_ :: String -> FilePath -> IO CInt -> IO () throwErrnoPathIfMinus1Retry_ = throwErrnoPathIfRetry_ (== -1) 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 throwErrnoPathIfRetry_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO () throwErrnoPathIfRetry_ failed loc path io = do _ <- throwErrnoPathIfRetry failed loc path io return () posixStat :: String -> FilePath -> IO Posix.FileStatus #if MIN_VERSION_unix(2,5,1) posixStat _ path = System.Posix.Files.ByteString.getFileStatus (R.encode R.posix path) #else posixStat loc path = withFd loc path Posix.getFdStatus 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 foreign import ccall unsafe "hssystemfileio_open_nonblocking" c_open_nonblocking :: CString -> CInt -> IO CInt #endif foreign import ccall unsafe "free" c_free :: Ptr a -> IO () #endif system-fileio-0.3.16.4/lib/hssystemfileio-win32.c0000644000000000000000000000161213230136226017641 0ustar0000000000000000/* Before including anything, we need to fix up MinGW's MSVCRT defines. MinGW's requires __MSVCRT_VERSION__ >= 0x0601 to define _wstat64(). This is fine for the MinGW distributed with GHC, which sets __MSVCRT_VERSION__ = 0x0700, but fails for the Haskell Platform because its MinGW sets __MSVCRT_VERSION__ = 0x0600. Therefore, we include <_mingw.h> first and bump its MSVCRT if necessary. */ #include <_mingw.h> #if defined(__MSVCRT_VERSION__) # if __MSVCRT_VERSION__ < 0x0601 # define __MSVCRT_VERSION__ 0x0601 # endif #else # define __MSVCRT_VERSION__ 0x0601 #endif #include "hssystemfileio-win32.h" #include #include #include int hssystemfileio_copy_permissions(const wchar_t *old_path, const wchar_t *new_path) { struct __stat64 st; int rc = _wstat64(old_path, &st); if (rc == -1) { return rc; } return _wchmod(new_path, st.st_mode); } system-fileio-0.3.16.4/lib/hssystemfileio-unix.c0000644000000000000000000000412113230136226017660 0ustar0000000000000000#include "hssystemfileio-unix.h" /* Enable POSIX-compliant readdir_r on Solaris */ #define _POSIX_PTHREAD_SEMANTICS /* Enable dirfd() */ #define _BSD_SOURCE #include #include #include #include #include #include #include #include struct dirent * hssystemfileio_alloc_dirent(void *void_dir) { DIR *dir = (DIR *)void_dir; long name_max; size_t name_end; name_max = fpathconf(dirfd(dir), _PC_NAME_MAX); if (name_max == -1) { #if defined(NAME_MAX) && NAME_MAX > 255 name_max = NAME_MAX; #else name_max = 4096; #endif } name_end = (size_t)offsetof(struct dirent, d_name) + name_max + 1; if (name_end > sizeof(struct dirent)) { return malloc(name_end); } return malloc(sizeof(struct dirent)); } void hssystemfileio_free_dirent(struct dirent *p) { free(p); } int hssystemfileio_readdir(void *void_dir, struct dirent *dirent) { struct dirent *dirent_result; DIR *dir = (DIR *)void_dir; while (1) { int rc = readdir_r(dir, dirent, &dirent_result); if (rc != 0) { return -1; } if (dirent_result == NULL) { return 1; } return 0; } } char * hssystemfileio_dirent_name(struct dirent *dirent) { return dirent->d_name; } char * hssystemfileio_getcwd(void) { #ifdef PATH_MAX int bufsize = PATH_MAX; #else int bufsize = 4096; #endif char *buf = malloc(bufsize); while (1) { char *ret = getcwd(buf, bufsize); if (ret != NULL) { return ret; } free(buf); if (errno == ERANGE) { bufsize *= 2; buf = malloc(bufsize); continue; } return NULL; } } int hssystemfileio_isrealdir(const char *path) { struct stat st; int rc = lstat(path, &st); if (rc == -1) { return rc; } if (S_ISDIR(st.st_mode)) { return 1; } return 0; } int hssystemfileio_copy_permissions(const char *old_path, const char *new_path) { struct stat st; int rc = stat(old_path, &st); if (rc == -1) { return rc; } return chmod(new_path, st.st_mode); } int hssystemfileio_open_nonblocking(const char *path, int int_mode) { mode_t mode = int_mode | O_NONBLOCK; return open(path, mode); } system-fileio-0.3.16.4/tests/FilesystemTests.hs0000644000000000000000000000111713230136226017565 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module Main ( tests , main ) where import Test.Chell #ifdef CABAL_OS_WINDOWS import FilesystemTests.Windows (suite_Windows) #else import FilesystemTests.Posix (suite_Posix) #endif main :: IO () main = Test.Chell.defaultMain tests tests :: [Suite] #ifdef CABAL_OS_WINDOWS tests = [suite_Windows] #else tests = [suite_Posix] #endif system-fileio-0.3.16.4/tests/FilesystemTests/Posix.hs0000644000000000000000000005507113230136226020677 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- 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 system-fileio-0.3.16.4/tests/FilesystemTests/Util.hs0000644000000000000000000000176113230136226020507 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module FilesystemTests.Util ( assertionsWithTemp , todo ) where import Prelude hiding (FilePath) import Control.Exception (finally) import System.IO.Temp (withSystemTempDirectory) import Test.Chell import Filesystem (removeTree) import Filesystem.Path.CurrentOS (FilePath, decodeString) 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 withTempDir :: String -> (FilePath -> IO a) -> IO a withTempDir name io = withSystemTempDirectory ("tests." ++ name ++ ".") (\dir -> let dir' = decodeString dir in finally (io dir') (removeTree dir')) todo :: String -> Test todo name = skipIf True (assertions name (return ())) system-fileio-0.3.16.4/tests/FilesystemTests/Windows.hs0000644000000000000000000000313713230136226021223 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright (C) 2011 John Millikin -- -- See license.txt for details module FilesystemTests.Windows ( suite_Windows ) where import Control.Monad import Control.Monad.IO.Class (liftIO) import Test.Chell import Filesystem import Filesystem.Path.CurrentOS import FilesystemTests.Util (assertionsWithTemp, todo) 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" ] 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 system-fileio-0.3.16.4/license.txt0000644000000000000000000000204113230136226015100 0ustar0000000000000000Copyright (c) 2011 John Millikin Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. system-fileio-0.3.16.4/Setup.hs0000644000000000000000000000005613230136226014355 0ustar0000000000000000import Distribution.Simple main = defaultMain system-fileio-0.3.16.4/system-fileio.cabal0000644000000000000000000000411713343707131016504 0ustar0000000000000000name: system-fileio version: 0.3.16.4 license: MIT license-file: license.txt author: John Millikin maintainer: FP Complete 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 extra-source-files: README.md ChangeLog.md lib/hssystemfileio-unix.h lib/hssystemfileio-win32.h -- tests/system-fileio-tests.cabal tests/FilesystemTests.hs tests/FilesystemTests/Posix.hs tests/FilesystemTests/Util.hs tests/FilesystemTests/Windows.hs source-repository head type: git location: https://github.com/fpco/haskell-filesystem.git library ghc-options: -Wall -O2 hs-source-dirs: lib build-depends: base >= 4.0 && < 5.0 , bytestring >= 0.9 , system-filepath >= 0.3.1 && < 0.5 , text >= 0.7.1 , time >= 1.0 && < 2.0 if os(windows) cpp-options: -DCABAL_OS_WINDOWS build-depends: Win32 >= 2.2 , directory >= 1.0 c-sources: lib/hssystemfileio-win32.c else build-depends: unix >= 2.3 c-sources: lib/hssystemfileio-unix.c if impl(ghc >= 7.2.0) && impl(ghc < 7.4.0) cpp-options: -DSYSTEMFILEIO_LOCAL_OPEN_FILE exposed-modules: Filesystem test-suite filesystem_tests type: exitcode-stdio-1.0 main-is: FilesystemTests.hs ghc-options: -Wall -O2 cc-options: -Wall hs-source-dirs: tests build-depends: base >= 4.0 && < 5.0 , bytestring >= 0.9 , chell >= 0.4 && < 0.5 , system-fileio , system-filepath , temporary >= 1.1 && < 2.0 , text , time >= 1.0 && < 2.0 , transformers >= 0.2 if os(windows) cpp-options: -DCABAL_OS_WINDOWS else build-depends: unix >= 2.3 if os(darwin) cpp-options: -DCABAL_OS_DARWIN other-modules: FilesystemTests.Posix FilesystemTests.Util FilesystemTests.Windows system-fileio-0.3.16.4/README.md0000644000000000000000000000073313230136226014202 0ustar0000000000000000## system-fileio Please see [deprecation announcement](https://plus.google.com/+MichaelSnoyman/posts/Ft5hnPqpgEx) This is a small wrapper around the `directory`, `unix`, and `Win32` packages, for use with `system-filepath`. It provides a consistent API to the various versions of these packages distributed with different versions of GHC. In particular, this library supports working with POSIX files that have paths which can't be decoded in the current locale encoding. system-fileio-0.3.16.4/ChangeLog.md0000644000000000000000000000074413343707142015104 0ustar0000000000000000# Changelog for system-fileio ## 0.3.16.4 * 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) ## 0.3.16.1 * Use different path encoding on Darwin in POSIX tests [#6](https://github.com/fpco/haskell-filesystem/pull/6) ## 0.3.16 Maintenance taken over by FP Complete. system-fileio-0.3.16.4/lib/hssystemfileio-unix.h0000644000000000000000000000102713230136226017667 0ustar0000000000000000#ifndef HSSYSTEMFILEIO_UNIX_H #define HSSYSTEMFILEIO_UNIX_H struct dirent; struct dirent * hssystemfileio_alloc_dirent(); void hssystemfileio_free_dirent(struct dirent *); int hssystemfileio_readdir(void *dir, struct dirent *dirent); char * hssystemfileio_dirent_name(struct dirent *dirent); char * hssystemfileio_getcwd(void); int hssystemfileio_isrealdir(const char *); int hssystemfileio_copy_permissions(const char *old_path, const char *new_path); int hssystemfileio_open_nonblocking(const char *path, int mode); #endif system-fileio-0.3.16.4/lib/hssystemfileio-win32.h0000644000000000000000000000026213230136226017646 0ustar0000000000000000#ifndef HSSYSTEMFILEIO_WIN32_H #define HSSYSTEMFILEIO_WIN32_H #include int hssystemfileio_copy_permissions(const wchar_t *old_path, const wchar_t *new_path); #endif system-fileio-0.3.16.4/tests/system-fileio-tests.cabal0000644000000000000000000000173013230136226021000 0ustar0000000000000000name: system-fileio-tests version: 0 build-type: Simple cabal-version: >= 1.6 flag coverage default: False manual: True executable system-fileio_tests main-is: FilesystemTests.hs ghc-options: -Wall hs-source-dirs: ../lib,. if flag(coverage) ghc-options: -fhpc build-depends: base >= 4.0 && < 5.0 , bytestring >= 0.9 && < 0.10 , chell >= 0.2 && < 0.3 , system-filepath >= 0.3 && < 0.5 , temporary >= 1.1 && < 2.0 , text >= 0.1 , time >= 1.0 && < 1.5 , transformers >= 0.2 && < 0.3 if os(windows) cpp-options: -DCABAL_OS_WINDOWS if os(darwin) cpp-options: -DCABAL_OS_DARWIN if os(windows) build-depends: Win32 >= 2.2 && < 2.3 , directory >= 1.0 && < 1.2 c-sources: ../lib/hssystemfileio-win32.c else build-depends: unix >= 2.3 && < 2.6 c-sources: ../lib/hssystemfileio-unix.c if impl(ghc >= 7.2.0) && impl(ghc < 7.4.0) cpp-options: -DSYSTEMFILEIO_LOCAL_OPEN_FILE