packages feed

system-fileio 0.3.3 → 0.3.4

raw patch · 7 files changed

+1111/−152 lines, 7 files

Files

lib/Filesystem.hs view
@@ -3,25 +3,31 @@  -- | -- Module: Filesystem--- Copyright: 2011 John Millikin+-- Copyright: 2011-2012 John Millikin <jmillikin@gmail.com> -- License: MIT ----- Maintainer: jmillikin@gmail.com+-- Maintainer: John Millikin <jmillikin@gmail.com> -- Portability: portable ----- Simple 'FilePath'&#x2010;aware wrappers around standard "System.IO"--- computations. See the linked documentation for each computation for--- details on exceptions and operating system interaction.+-- Simple 'FilePath'&#8208;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-	( IO.Handle+	(+	-- * Exports from System.IO+	  IO.Handle 	, IO.IOMode(..)-	, rename 	 	-- * Files 	, isFile 	, getModified 	, getSize 	, copyFile+	, copyFileContent+	, copyPermissions 	, removeFile 	 	-- ** Binary files@@ -43,11 +49,11 @@ 	, canonicalizePath 	, listDirectory 	-	-- ** Creating+	-- ** Creating directories 	, createDirectory 	, createTree 	-	-- ** Removing+	-- ** Removing directories 	, removeDirectory 	, removeTree 	@@ -62,24 +68,37 @@ 	, getAppDataDirectory 	, getAppCacheDirectory 	, getAppConfigDirectory+	+	-- * Other+	, rename 	) where +#ifndef CABAL_OS_WINDOWS+#if MIN_VERSION_base(4,2,0)+#define SYSTEMFILEIO_LOCAL_OPEN_FILE+#endif+#endif+ 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 (CString, withCString, peekCString)+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           Filesystem.Path.CurrentOS (currentOS, decodeString, encodeString)+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 (isDoesNotExistError)+import           System.IO.Error (IOError)  #ifdef CABAL_OS_WINDOWS @@ -88,7 +107,10 @@                            , 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 @@ -99,48 +121,86 @@  #endif -import qualified System.Directory as SD+#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. ----- See: 'SD.doesFileExist'+-- Any non&#8208;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. ----- See: 'SD.doesDirectoryExist'+-- 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 "isFile" path+		return (Posix.isDirectory stat))+	((\_ -> return False) :: IOError -> IO Bool)+#endif --- | Rename a filesystem object. Some operating systems have restrictions--- on what objects can be renamed; see linked documentation for details.+-- | Rename a filesystem object. ----- See: 'SD.renameFile' and 'SD.renameDirectory'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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-#ifdef CABAL_OS_WINDOWS 	Win32.moveFileEx old' new' Win32.mOVEFILE_REPLACE_EXISTING #else-	Posix.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+ #endif --- Resolve symlinks and \"..\" path elements to return a canonical path.+-- | 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. ----- See: 'SD.canonicalizePath'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. -- -- Since: 0.1.1 canonicalizePath :: FilePath -> IO FilePath-canonicalizePath path = fmap decodeString $ do-	let path' = encodeString path+canonicalizePath path =+	let path' = encodeString path in #ifdef CABAL_OS_WINDOWS+	fmap decodeString $ #if MIN_VERSION_Win32(2,2,1) 	Win32.getFullPathName path' #else@@ -149,9 +209,11 @@ 			c_GetFullPathNameW c_name len buf nullPtr) 512 #endif #else-	withCString path' $ \cPath -> do+	withFilePath path $ \cPath -> do 		cOut <- Posix.throwErrnoPathIfNull "canonicalizePath" path' (c_realpath cPath nullPtr)-		peekCString cOut+		bytes <- B.packCString cOut+		c_free cOut+		return (R.decode R.posix bytes) #endif  #ifdef CABAL_OS_WINDOWS@@ -170,77 +232,236 @@ -- | 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. ----- See: 'SD.createDirectory'.+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. createDirectory :: Bool -- ^ Succeed if the directory already exists                 -> FilePath -> IO ()-createDirectory False path =-	let path' = encodeString path in+createDirectory succeedIfExists path = #ifdef CABAL_OS_WINDOWS-	Win32.createDirectory path' Nothing+	let path' = encodeString path in+	if succeedIfExists+		then SD.createDirectoryIfMissing False path'+		else Win32.createDirectory path' Nothing #else-	Posix.createDirectory path' 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++foreign import ccall unsafe "mkdir"+	c_mkdir :: CString -> CInt -> IO CInt #endif-createDirectory True path = SD.createDirectoryIfMissing False (encodeString path)  -- | Create a directory at a given path, including any parents which might -- be missing. ----- See: 'SD.createDirectoryIfMissing'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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 contents of a directory, excluding @\".\"@ and @\"..\"@. Each--- returned 'FilePath' includes the path of the directory.+-- | List objects in a directory, excluding @\".\"@ and @\"..\"@. Each+-- returned 'FilePath' includes the path of the directory. Entries are not+-- sorted. ----- See: 'SD.getDirectoryContents'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. listDirectory :: FilePath -> IO [FilePath]-listDirectory path = fmap cleanup contents where-	contents = SD.getDirectoryContents (encodeString path)-	cleanup = map (append path) . map decodeString . filter (`notElem` [".", ".."])+#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+		dirent <- c_alloc_dirent+		dir <- openDir root+		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) --- | Remove a file.+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 "opendir"+	c_closedir :: Ptr () -> IO CInt++foreign import ccall unsafe "hssystemfileio_alloc_dirent"+	c_alloc_dirent :: 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. ----- See: 'SD.removeFile'+-- This computation cannot remove directories. For that, use 'removeDirectory'+-- or 'removeTree'.+--+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. removeFile :: FilePath -> IO () removeFile path =-	let path' = encodeString path in #ifdef CABAL_OS_WINDOWS-	Win32.deleteFile path'+	Win32.deleteFile (encodeString path) #else-	Posix.removeLink path'+	withFilePath path $ \cPath ->+	throwErrnoPathIfMinus1_ "removeFile" path (c_unlink cPath)++foreign import ccall unsafe "unlink"+	c_unlink :: CString -> IO CInt #endif  -- | Remove an empty directory. ----- See: 'SD.removeDirectory'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. removeDirectory :: FilePath -> IO () removeDirectory path =-	let path' = encodeString path in #ifdef CABAL_OS_WINDOWS-	Win32.removeDirectory path'+	Win32.removeDirectory (encodeString path) #else-	Posix.removeDirectory path'+	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. ----- See: 'SD.removeDirectoryRecursive'+-- 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 &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. removeTree :: FilePath -> IO ()-removeTree path = SD.removeDirectoryRecursive (encodeString path)+#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. ----- See: 'SD.getCurrentDirectory'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. getWorkingDirectory :: IO FilePath-getWorkingDirectory = fmap decodeString $ do+getWorkingDirectory = do #ifdef CABAL_OS_WINDOWS #if MIN_VERSION_Win32(2,2,1)-	Win32.getCurrentDirectory+	fmap decodeString Win32.getCurrentDirectory #else-	Win32.try "getCurrentDirectory" (flip c_GetCurrentDirectoryW) 512+	fmap decodeString (Win32.try "getWorkingDirectory" (flip c_GetCurrentDirectoryW) 512) #endif #else-	Posix.getWorkingDirectory+	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@@ -253,14 +474,20 @@  -- | Set the current working directory. ----- See: 'SD.setCurrentDirectory'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured. setWorkingDirectory :: FilePath -> IO () setWorkingDirectory path =-	let path' = encodeString path in #ifdef CABAL_OS_WINDOWS-	Win32.setCurrentDirectory path'+	Win32.setCurrentDirectory (encodeString path) #else-	Posix.changeWorkingDirectory path'+	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@@ -275,22 +502,40 @@ -- For data files the user does not explicitly create, such as automatic -- saves, use 'getAppDataDirectory'. ----- See: 'SD.getHomeDirectory'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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&#x2019;s home directory. This is a good starting point for+-- | Get the user&#x2019;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 &#8220;Classifying+-- I/O errors&#8221; 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&#x2019;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'.+-- user&#8208;created files. For data files the user does not explicitly+-- create, such as automatic saves, use 'getAppDataDirectory'. ----- See: 'SD.getUserDocumentsDirectory'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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@@ -303,7 +548,9 @@ -- label. This directory is where applications should store data the user did -- not explicitly create, such as databases and automatic saves. ----- See: 'SD.getAppUserDataDirectory'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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@@ -315,6 +562,10 @@ -- | Get the user&#x2019;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 &#8220;Classifying+-- I/O errors&#8221; 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@@ -326,6 +577,10 @@ -- | Get the user&#x2019;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 &#8220;Classifying+-- I/O errors&#8221; 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@@ -339,36 +594,107 @@ 	home <- getHomeDirectory 	return (append home (decodeString path)) -getenv :: String -> IO (Maybe String)+getenv :: String -> IO (Maybe FilePath)+#ifdef CABAL_OS_WINDOWS getenv key = Exc.catch-	(fmap Just (SE.getEnv key))+	(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 (decodeString var)+		Just var -> return var 		Nothing -> fallback 	return $ case label of 		Just text -> append dir (R.fromText currentOS text) 		Nothing -> dir --- | Copy a file to a new entry in the filesystem. If a file already exists--- at the new location, it will be replaced.+-- | 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. ----- See: 'SD.copyFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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 &#8220;Classifying+-- I/O errors&#8221; 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 &#8220;Classifying+-- I/O errors&#8221; 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 old new = SD.copyFile (encodeString old) (encodeString new)+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 &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured.+-- -- Since: 0.2 getModified :: FilePath -> IO UTCTime getModified path = do@@ -392,15 +718,19 @@ 	 	return (UTCTime date (seconds + msecs)) #else-	stat <- Posix.getFileStatus (encodeString path)+	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&#x2010; and--- platform&#x2010;dependent.+-- links or directories, the size is filesystem&#8208; and+-- platform&#8208;dependent. --+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; in the "System.IO.Error" documentation for information on+-- why the failure occured.+-- -- Since: 0.2 getSize :: FilePath -> IO Integer getSize path = do@@ -408,39 +738,51 @@ 	info <- withHANDLE path Win32.getFileInformationByHandle 	return (toInteger (Win32.bhfiSize info)) #else-	stat <- Posix.getFileStatus (encodeString path)+	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 'IO.hClose'd when it is no longer needed.+-- should be closed with 'IO.hClose' when it is no longer needed. -- -- 'withFile' is easier to use, because it will handle the 'Handle'&#x2019;s -- lifetime automatically. ----- See: 'IO.openBinaryFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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. ----- See: 'IO.withBinaryFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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 contents of a binary file.+-- | Read in the entire content of a binary file. ----- See: 'B.readFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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 contents of a binary file with the provided+-- | Replace the entire content of a binary file with the provided -- 'B.ByteString'. ----- See: 'B.writeFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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)@@ -448,39 +790,53 @@ -- | Append a 'B.ByteString' to a file. If the file does not exist, it will -- be created. ----- See: 'B.appendFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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 'IO.hClose'd when it is no longer needed.+-- should be closed with 'IO.hClose' when it is no longer needed. -- -- 'withTextFile' is easier to use, because it will handle the -- 'Handle'&#x2019;s lifetime automatically. ----- See: 'IO.openFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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. ----- See: 'IO.withFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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 contents of a text file.+-- | Read in the entire content of a text file. ----- See: 'T.readFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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 contents of a text file with the provided+-- | Replace the entire content of a text file with the provided -- 'T.Text'. ----- See: 'T.writeFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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)@@ -488,12 +844,42 @@ -- | Append 'T.Text' to a file. If the file does not exist, it will -- be created. ----- See: 'T.appendFile'+-- This computation throws 'IOError' on failure. See &#8220;Classifying+-- I/O errors&#8221; 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+openFile' :: String -> FilePath -> IO.IOMode -> (Maybe IO.TextEncoding) -> IO IO.Handle+openFile' loc path mode codec = open where+	mode_flags = case mode of+		IO.ReadMode -> System.Posix.Internals.o_RDONLY+		IO.WriteMode -> System.Posix.Internals.o_WRONLY+		IO.ReadWriteMode -> System.Posix.Internals.o_RDWR+		IO.AppendMode -> System.Posix.Internals.o_APPEND+	flags = mode_flags .|.+	        System.Posix.Internals.o_NOCTTY .|.+	        System.Posix.Internals.o_NONBLOCK+	+	sys_c_open = System.Posix.Internals.c_open+	sys_c_close = System.Posix.Internals.c_close+	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)++#endif+ #ifdef CABAL_OS_WINDOWS+ withHANDLE :: FilePath -> (Win32.HANDLE -> IO a) -> IO a withHANDLE path = Exc.bracket open close where 	open = Win32.createFile@@ -505,4 +891,61 @@ 		0 		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 ()++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 cpath 0)+		return (Posix.Fd fd)+	close = Posix.closeFd++posixStat :: String -> FilePath -> IO Posix.FileStatus+posixStat loc path = withFd loc path Posix.getFdStatus++foreign import ccall unsafe "open"+	c_open :: CString -> CInt -> IO CInt++foreign import ccall unsafe "free"+	c_free :: Ptr a -> IO ()+ #endif
+ lib/hssystemfileio-unix.c view
@@ -0,0 +1,93 @@+#include "hssystemfileio-unix.h"++#include <errno.h>+#include <stdlib.h>+#include <sys/stat.h>+#include <sys/types.h>+#include <unistd.h>++struct dirent *+hssystemfileio_alloc_dirent()+{+	return malloc(sizeof (struct dirent));+}++void+hssystemfileio_free_dirent(struct dirent *p)+{+	free(p);+}++int+hssystemfileio_readdir(DIR *dir, struct dirent *dirent)+{+	struct dirent *dirent_result;+	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);+}
+ lib/hssystemfileio-win32.c view
@@ -0,0 +1,16 @@+#include "hssystemfileio-win32.h"++#include <io.h>+#include <sys/types.h>+#include <sys/stat.h>++int+hssystemfileio_copy_permissions(const wchar_t *old_path, const wchar_t *new_path)+{+	struct _stat st;+	int rc = _wstat(old_path, &st);+	if (rc == -1)+	{ return rc; }+	+	return _wchmod(new_path, st.st_mode);+}
system-fileio.cabal view
@@ -1,21 +1,25 @@ name: system-fileio-version: 0.3.3-synopsis: High-level filesystem interaction+version: 0.3.4 license: MIT license-file: license.txt author: John Millikin <jmillikin@gmail.com> maintainer: John Millikin <jmillikin@gmail.com>-copyright: John Millikin 2011 build-type: Simple cabal-version: >= 1.6 category: System stability: experimental-homepage: https://john-millikin.com/software/hs-fileio/+homepage: https://john-millikin.com/software/haskell-filesystem/ bug-reports: mailto:jmillikin@gmail.com +synopsis: Consistent filesystem interaction across GHC versions description:   This is a small wrapper around the \"directory\", \"unix\", and \"Win32\"-  packages for use with \"system-filepath\".+  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.  extra-source-files:   scripts/common.bash@@ -29,13 +33,13 @@   tests/FilesystemTests/Windows.hs  source-repository head-  type: bzr-  location: https://john-millikin.com/software/hs-fileio/+  type: bazaar+  location: https://john-millikin.com/branches/system-fileio/0.3/  source-repository this-  type: bzr-  location: https://john-millikin.com/branches/hs-fileio/0.3/-  tag: system-fileio_0.3.3+  type: bazaar+  location: https://john-millikin.com/branches/system-fileio/0.3/+  tag: system-fileio_0.3.4  library   ghc-options: -Wall -O2@@ -44,16 +48,20 @@   build-depends:       base >= 4.0 && < 5.0     , bytestring >= 0.9 && < 0.10-    , directory >= 1.0 && < 1.2     , system-filepath >= 0.3.1 && < 0.5     , text >= 0.7.1 && < 0.12     , time >= 1.0 && < 1.5    if os(windows)     cpp-options: -DCABAL_OS_WINDOWS-    build-depends: Win32 >= 2.2 && < 2.3+    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+    build-depends:+        unix >= 2.3 && < 2.6+    c-sources: lib/hssystemfileio-unix.c    exposed-modules:     Filesystem
tests/FilesystemTests/Posix.hs view
@@ -11,17 +11,30 @@ 	) 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           Data.Text.Encoding (encodeUtf8)+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           Filesystem-import           Filesystem.Path.CurrentOS+import           Filesystem.Path+import qualified Filesystem.Path.Rules as Rules+import qualified Filesystem.Path.CurrentOS as CurrentOS  import           FilesystemTests.Util (assertionsWithTemp, todo) @@ -63,40 +76,144 @@ 			(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 		]-	, todo "createDirectory"-	, todo "createTree"+	, 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"+		[ 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/")+		] 	, test_ListDirectory-	, todo "removeFile"-	, todo "removeDirectory"-	, todo "removeTree"-	, todo "getWorkingDirectory"-	, todo "setWorkingDirectory"-	, todo "getHomeDirectory"-	, todo "getDesktopDirectory"+	, 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"+		[ test_RemoveDirectory "ascii"+			(decode "test.d")+		, test_RemoveDirectory "utf8"+			(fromText "\xA1\xA2.d")+		, test_RemoveDirectory "iso8859"+			(decode "\xA1\xA2\xA3.d")+		]+	, 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"+		[ test_GetWorkingDirectory "ascii"+			(decode "test.d")+		, test_GetWorkingDirectory "utf8"+			(fromText "\xA1\xA2.d")+		, test_GetWorkingDirectory "iso8859"+			(decode "\xA1\xA2\xA3.d")+		]+	, 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"+		[ 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"+		[ test_GetDesktopDirectory "ascii"+			(decode "/desktop/test.d")+		, test_GetDesktopDirectory "utf8"+			(decode "/desktop/\xA1\xA2.d")+		, test_GetDesktopDirectory "iso8859"+			(decode "/desktop/\xA1\xA2\xA3.d")+		] 	, todo "getDocumentsDirectory" 	, todo "getAppDataDirectory" 	, todo "getAppCacheDirectory" 	, todo "getAppConfigDirectory"+	, 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"+		[ test_GetSize "ascii"+			(decode "test.txt")+		, test_GetSize "utf8"+			(fromText "\xA1\xA2.txt")+		, test_GetSize "iso8859"+			(decode "\xA1\xA2\xA3.txt")+		] 	, todo "copyFile"-	, todo "getModified"-	, todo "getSize" 	, todo "openFile"-	, todo "withFile"+	, suite "withFile"+		[ test_WithFile "ascii"+			(decode "test.txt")+		, test_WithFile "utf8"+			(fromText "\xA1\xA2.txt")+		, test_WithFile "iso8859"+			(decode "\xA1\xA2\xA3.txt")+		] 	, todo "readFile" 	, todo "writeFile" 	, todo "appendFile" 	, todo "openTextFile"-	, todo "withTextFile"+	, suite "withTextFile"+		[ test_WithTextFile "ascii"+			(decode "test.txt")+		, test_WithTextFile "utf8"+			(fromText "\xA1\xA2.txt")+		, test_WithTextFile "iso8859"+			(decode "\xA1\xA2\xA3.txt")+		] 	, todo "readTextFile" 	, todo "writeTextFile" 	, todo "appendTextFile" 	]  test_IsFile :: Text -> FilePath -> Suite-test_IsFile test_name file_name = assertionsWithTemp test_name $ \dir -> do-	let path = dir </> file_name+test_IsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do+	let path = tmp </> file_name 	 	before <- liftIO $ Filesystem.isFile path 	$expect (not before)@@ -107,8 +224,8 @@ 	$expect after  test_IsDirectory :: Text -> FilePath -> Suite-test_IsDirectory test_name dir_name = assertionsWithTemp test_name $ \dir -> do-	let path = dir </> dir_name+test_IsDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do+	let path = tmp </> dir_name 	 	before <- liftIO $ Filesystem.isDirectory path 	$expect (not before)@@ -119,9 +236,9 @@ 	$expect after  test_Rename :: Text -> FilePath -> FilePath -> Suite-test_Rename test_name old_name new_name = assertionsWithTemp test_name $ \dir -> do-	let old_path = dir </> old_name-	let new_path = dir </> new_name+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 "" 	@@ -137,22 +254,10 @@ 	$expect (not old_after) 	$expect new_after -test_ListDirectory :: Suite-test_ListDirectory = assertionsWithTemp "listDirectory" $ \dir -> do-	let paths =-		[ dir </> decode "test.txt"-		, dir </> fromText "\xA1\xA2.txt"-		, dir </> decode "\xA1\xA2\xA3.txt"-		]-	forM_ paths (\path -> touch_ffi path "")-	-	names <- liftIO $ Filesystem.listDirectory dir-	$expect $ sameItems paths names- test_CanonicalizePath :: Text -> FilePath -> FilePath -> Suite-test_CanonicalizePath test_name src_name dst_name = assertionsWithTemp test_name $ \dir -> do-	let src_path = dir </> src_name-	let subdir = dir </> "subdir"+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.@@ -167,14 +272,236 @@ 	canonicalized <- liftIO $ Filesystem.canonicalizePath src_path 	$expect $ equal canonicalized dst_path -withPathCString :: FilePath -> (CString -> IO a) -> IO a-withPathCString p = Data.ByteString.useAsCString bytes where+test_CreateDirectory :: Text -> FilePath -> Suite+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 :: Suite+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 :: Suite+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 :: Suite+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 :: Text -> FilePath -> Suite+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 :: Suite+test_ListDirectory = assertionsWithTemp "listDirectory" $ \tmp -> do+	-- OSX replaces non-UTF8 filenames with http-style %XX escapes+	let paths = #ifdef CABAL_OS_DARWIN-	bytes = encodeUtf8 (encode p)+		[ tmp </> decode "%A1%A2%A3.txt"+		, tmp </> decode "test.txt"+		, tmp </> fromText "\xA1\xA2.txt"+		] #else-	bytes = encode p+		[ 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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+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 :: Text -> FilePath -> Suite+test_WithFile 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_WithTextFile :: Text -> FilePath -> Suite+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)++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@@ -208,6 +535,47 @@ 	 	$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 ()) @@ -222,3 +590,21 @@  foreign import ccall unsafe "symlink" 	c_symlink :: CString -> CString -> 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
tests/FilesystemTests/Util.hs view
@@ -10,19 +10,28 @@ 	) where  import           Prelude hiding (FilePath)++import           Control.Exception (finally) import           Data.Text (Text, unpack) import           System.IO.Temp (withSystemTempDirectory) import           Test.Chell +import           Filesystem (removeTree) import           Filesystem.Path.CurrentOS (FilePath, decodeString)  assertionsWithTemp :: Text -> (FilePath -> Assertions a) -> Suite assertionsWithTemp name io = test (Test name impl) where-	impl options = withSystemTempDirectory ("tests." ++ unpack name ++ ".") $ \dir -> do-		let dirPath = decodeString dir-		case suiteTests (assertions name (io dirPath)) of+	impl options = withTempDir name $ \dir -> do+		case suiteTests (assertions name (io dir)) of 			[(Test _ io')] -> io' options 			_ -> error "assertionsWithTemp: use in place of 'assertions' only."++withTempDir :: Text -> (FilePath -> IO a) -> IO a+withTempDir name io = withSystemTempDirectory+	("tests." ++ unpack name ++ ".")+	(\dir ->+		let dir' = decodeString dir in+		finally (io dir') (removeTree dir'))  todo :: Text -> Suite todo name = skipIf True (assertions name (return ()))
tests/system-fileio-tests.cabal view
@@ -19,7 +19,6 @@       base >= 4.0 && < 5.0     , bytestring >= 0.9 && < 0.10     , chell >= 0.2 && < 0.3-    , directory >= 1.0 && < 1.2     , system-filepath >= 0.3 && < 0.5     , temporary >= 1.1 && < 2.0     , text >= 0.1 && < 0.12@@ -33,6 +32,11 @@     cpp-options: -DCABAL_OS_DARWIN    if os(windows)-    build-depends: Win32 >= 2.2 && < 2.3+    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+    build-depends:+        unix >= 2.3 && < 2.6+    c-sources: ../lib/hssystemfileio-unix.c