diff --git a/Filesystem.hs b/Filesystem.hs new file mode 100644 --- /dev/null +++ b/Filesystem.hs @@ -0,0 +1,494 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE PackageImports #-} + +-- | +-- Module: Filesystem +-- Copyright: 2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Simple 'FilePath'‐aware wrappers around standard "System.IO" +-- computations. See the linked documentation for each computation for +-- details on exceptions and operating system interaction. +module Filesystem + ( IO.Handle + , IO.IOMode(..) + , rename + + -- * Files + , isFile + , getModified + , getSize + , copyFile + , removeFile + + -- ** Binary files + , openFile + , withFile + , readFile + , writeFile + , appendFile + + -- ** Text files + , openTextFile + , withTextFile + , readTextFile + , writeTextFile + , appendTextFile + + -- * Directories + , isDirectory + , canonicalizePath + , listDirectory + + -- ** Creating + , createDirectory + , createTree + + -- ** Removing + , removeDirectory + , removeTree + + -- ** Current working directory + , getWorkingDirectory + , setWorkingDirectory + + -- ** Commonly used paths + , getHomeDirectory + , getDesktopDirectory + , getDocumentsDirectory + , getAppDataDirectory + , getAppCacheDirectory + , getAppConfigDirectory + ) where + +import Prelude hiding (FilePath, readFile, writeFile, appendFile) + +import qualified Control.Exception as Exc +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Foreign.Ptr (nullPtr) +import Foreign.C (CString, withCString, peekCString) +import qualified System.Environment as SE +import System.FilePath (FilePath, append) +import System.FilePath.CurrentOS (currentOS) +import qualified System.FilePath.Rules as R +import qualified System.IO as IO +import System.IO.Error (isDoesNotExistError) + +#ifdef CABAL_OS_WINDOWS + +import Data.Bits ((.|.)) +import Data.Time ( UTCTime(..) + , fromGregorian + , secondsToDiffTime + , picosecondsToDiffTime) +import qualified System.Win32 as Win32 + +#else + +import Data.Time (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import qualified System.Posix as Posix +import qualified System.Posix.Error as Posix + +#endif + +-- hopefully temporary +import qualified "directory" System.Directory as SD + +-- | Check if a file exists at the given path. +-- +-- See: 'SD.doesFileExist' +isFile :: FilePath -> IO Bool +isFile path = SD.doesFileExist (encodeString path) + +-- | Check if a directory exists at the given path. +-- +-- See: 'SD.doesDirectoryExist' +isDirectory :: FilePath -> IO Bool +isDirectory path = SD.doesDirectoryExist (encodeString path) + +-- | Rename a filesystem object. Some operating systems have restrictions +-- on what objects can be renamed; see linked documentation for details. +-- +-- See: 'SD.renameFile' and 'SD.renameDirectory' +rename :: FilePath -> FilePath -> IO () +rename old new = + 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' +#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. +-- +-- See: 'SD.canonicalizePath' +-- +-- Since: 0.1.1 +canonicalizePath :: FilePath -> IO FilePath +canonicalizePath path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + fmap decodeString (Win32.getFullPathName path') +#else + withCString path' $ \cPath -> do + cOut <- Posix.throwErrnoPathIfNull "canonicalizePath" path' (c_realpath cPath nullPtr) + out <- peekCString cOut + return (decodeString out) +#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. +-- +-- See: 'SD.createDirectory'. +createDirectory :: Bool -- ^ Succeed if the directory already exists + -> FilePath -> IO () +createDirectory False path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.createDirectory path' Nothing +#else + Posix.createDirectory path' 0o777 +#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' +createTree :: FilePath -> IO () +createTree path = SD.createDirectoryIfMissing True (encodeString path) + +-- | List contents of a directory, excluding @\".\"@ and @\"..\"@. Each +-- returned 'FilePath' includes the path of the directory. +-- +-- See: 'SD.getDirectoryContents' +listDirectory :: FilePath -> IO [FilePath] +listDirectory path = fmap cleanup contents where + contents = SD.getDirectoryContents (encodeString path) + cleanup = map (append path) . map decodeString . filter (`notElem` [".", ".."]) + +-- | Remove a file. +-- +-- See: 'SD.removeFile' +removeFile :: FilePath -> IO () +removeFile path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.deleteFile path' +#else + Posix.removeLink path' +#endif + +-- | Remove an empty directory. +-- +-- See: 'SD.removeDirectory' +removeDirectory :: FilePath -> IO () +removeDirectory path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.removeDirectory path' +#else + Posix.removeDirectory path' +#endif + +-- | Recursively remove a directory tree rooted at the given path. +-- +-- See: 'SD.removeDirectoryRecursive' +removeTree :: FilePath -> IO () +removeTree path = SD.removeDirectoryRecursive (encodeString path) + +-- | Get the current working directory. +-- +-- See: 'SD.getCurrentDirectory' +getWorkingDirectory :: IO FilePath +getWorkingDirectory = do +#ifdef CABAL_OS_WINDOWS + raw <- Win32.getCurrentDirectory +#else + raw <- Posix.getWorkingDirectory +#endif + return (decodeString raw) + +-- | Set the current working directory. +-- +-- See: 'SD.setCurrentDirectory' +setWorkingDirectory :: FilePath -> IO () +setWorkingDirectory path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.setCurrentDirectory path' +#else + Posix.changeWorkingDirectory path' +#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'. +-- +-- See: 'SD.getHomeDirectory' +getHomeDirectory :: IO FilePath +getHomeDirectory = fmap decodeString SD.getHomeDirectory + +-- | Get the user’s home 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'. +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'. +-- +-- See: 'SD.getUserDocumentsDirectory' +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. +-- +-- See: 'SD.getAppUserDataDirectory' +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. +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. +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 String) +getenv key = Exc.catch + (fmap Just (SE.getEnv key)) + (\e -> if isDoesNotExistError e + then return Nothing + else Exc.throwIO e) + +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) + 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. +-- +-- See: 'SD.copyFile' +-- +-- Since: 0.1.1 +copyFile :: FilePath -- ^ Old location + -> FilePath -- ^ New location + -> IO () +copyFile old new = SD.copyFile (encodeString old) (encodeString new) + +-- | Get when the object at a given path was last modified. +-- +-- 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 <- Posix.getFileStatus (encodeString 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. +-- +-- 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 <- Posix.getFileStatus (encodeString 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. +-- +-- 'withFile' is easier to use, because it will handle the 'Handle'’s +-- lifetime automatically. +-- +-- See: 'IO.openBinaryFile' +openFile :: FilePath -> IO.IOMode -> IO IO.Handle +openFile path = IO.openBinaryFile (encodeString path) + +-- | 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' +withFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a +withFile path = IO.withBinaryFile (encodeString path) + +-- | Read in the entire contents of a binary file. +-- +-- See: 'B.readFile' +readFile :: FilePath -> IO B.ByteString +readFile path = B.readFile (encodeString path) + +-- | Replace the entire contents of a binary file with the provided +-- 'B.ByteString'. +-- +-- See: 'B.writeFile' +writeFile :: FilePath -> B.ByteString -> IO () +writeFile path = B.writeFile (encodeString path) + +-- | Append a 'B.ByteString' to a file. If the file does not exist, it will +-- be created. +-- +-- See: 'B.appendFile' +appendFile :: FilePath -> B.ByteString -> IO () +appendFile path = B.appendFile (encodeString path) + +-- | Open a file in text mode, and return an open 'Handle'. The 'Handle' +-- should be 'IO.hClose'd when it is no longer needed. +-- +-- 'withTextFile' is easier to use, because it will handle the +-- 'Handle'’s lifetime automatically. +-- +-- See: 'IO.openFile' +openTextFile :: FilePath -> IO.IOMode -> IO IO.Handle +openTextFile path = IO.openFile (encodeString path) + +-- | 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' +withTextFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a +withTextFile path = IO.withFile (encodeString path) + +-- | Read in the entire contents of a text file. +-- +-- See: 'T.readFile' +readTextFile :: FilePath -> IO T.Text +readTextFile path = T.readFile (encodeString path) + +-- | Replace the entire contents of a text file with the provided +-- 'T.Text'. +-- +-- See: 'T.writeFile' +writeTextFile :: FilePath -> T.Text -> IO () +writeTextFile path = T.writeFile (encodeString path) + +-- | Append 'T.Text' to a file. If the file does not exist, it will +-- be created. +-- +-- See: 'T.appendFile' +appendTextFile :: FilePath -> T.Text -> IO () +appendTextFile path = T.appendFile (encodeString path) + +#ifdef CABAL_OS_WINDOWS +withHANDLE :: FilePath -> (Win32.HANDLE -> IO a) -> IO a +withHANDLE path = Exc.bracket open close where + open = Win32.createFile + (encodeString path) + Win32.gENERIC_READ + (Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE) + Nothing + Win32.oPEN_EXISTING + 0 + Nothing + close = Win32.closeHandle +#endif + +encodeString :: FilePath -> String +#ifdef CABAL_OS_WINDOWS +encodeString = T.unpack . R.encode R.windows +#else +encodeString = B8.unpack . R.encode R.posix +#endif + +decodeString :: String -> FilePath +#ifdef CABAL_OS_WINDOWS +decodeString = R.decode R.windows . T.pack +#else +decodeString = R.decode R.posix . B8.pack +#endif diff --git a/lib/Filesystem.hs b/lib/Filesystem.hs deleted file mode 100644 --- a/lib/Filesystem.hs +++ /dev/null @@ -1,974 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE PackageImports #-} - --- | --- 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 - -#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 (CInt, CString, withCAString) -import qualified Foreign.C.Error as CError -import qualified System.Environment as SE - -#if MIN_VERSION_system_filepath(0,4,0) -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 -#else -import System.FilePath (FilePath, append) -import qualified System.FilePath as Path -import System.FilePath.CurrentOS (currentOS, encodeString, decodeString) -import qualified System.FilePath.Rules as R -#endif - -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 "directory" 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 - -#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 "isFile" 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 - Win32.moveFileEx old' new' Win32.mOVEFILE_REPLACE_EXISTING -#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 = - 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 - -#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 - 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) - -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 :: 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 -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 -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 - -withHANDLE :: FilePath -> (Win32.HANDLE -> IO a) -> IO a -withHANDLE path = Exc.bracket open close where - open = Win32.createFile - (encodeString path) - Win32.gENERIC_READ - (Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE) - Nothing - Win32.oPEN_EXISTING - 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 diff --git a/lib/System/Directory.hs b/lib/System/Directory.hs deleted file mode 100644 --- a/lib/System/Directory.hs +++ /dev/null @@ -1,42 +0,0 @@ --- | --- Module: System.Directory --- Copyright: 2011 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Deprecated alias for "Filesystem". -module System.Directory - ( - - -- * Generic operations - isFile - , isDirectory - , rename - , canonicalizePath - , listDirectory - - -- * Creating things - , createDirectory - , createTree - - -- * Removing things - , removeFile - , removeDirectory - , removeTree - - -- * Current working directory - , getWorkingDirectory - , setWorkingDirectory - - -- * Commonly used paths - , getHomeDirectory - , getDesktopDirectory - , getDocumentsDirectory - , getAppDataDirectory - , getAppCacheDirectory - , getAppConfigDirectory - ) where - -import Filesystem diff --git a/lib/System/File.hs b/lib/System/File.hs deleted file mode 100644 --- a/lib/System/File.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | --- Module: System.File --- Copyright: 2011 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Deprecated alias for "Filesystem". -module System.File - ( Filesystem.Handle - , Filesystem.IOMode(..) - - -- * File operations - , copyFile - - -- * File information - , getModified - , getSize - - -- * Binary files - , openFile - , withFile - , Filesystem.readFile - , Filesystem.writeFile - , Filesystem.appendFile - - -- * Text files - , openTextFile - , withTextFile - , readTextFile - , writeTextFile - , appendTextFile - ) where - -import Filesystem diff --git a/lib/hssystemfileio-unix.c b/lib/hssystemfileio-unix.c deleted file mode 100644 --- a/lib/hssystemfileio-unix.c +++ /dev/null @@ -1,93 +0,0 @@ -#include "hssystemfileio-unix.h" - -#include -#include -#include -#include -#include - -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); -} diff --git a/lib/hssystemfileio-unix.h b/lib/hssystemfileio-unix.h deleted file mode 100644 --- a/lib/hssystemfileio-unix.h +++ /dev/null @@ -1,27 +0,0 @@ -#ifndef HSSYSTEMFILEIO_UNIX_H -#define HSSYSTEMFILEIO_UNIX_H - -#include - -struct dirent * -hssystemfileio_alloc_dirent(); - -void -hssystemfileio_free_dirent(struct dirent *); - -int -hssystemfileio_readdir(DIR *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); - -#endif diff --git a/lib/hssystemfileio-win32.c b/lib/hssystemfileio-win32.c deleted file mode 100644 --- a/lib/hssystemfileio-win32.c +++ /dev/null @@ -1,16 +0,0 @@ -#include "hssystemfileio-win32.h" - -#include -#include -#include - -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); -} diff --git a/lib/hssystemfileio-win32.h b/lib/hssystemfileio-win32.h deleted file mode 100644 --- a/lib/hssystemfileio-win32.h +++ /dev/null @@ -1,9 +0,0 @@ -#ifndef HSSYSTEMFILEIO_WIN32_H -#define HSSYSTEMFILEIO_WIN32_H - -#include - -int -hssystemfileio_copy_permissions(const wchar_t *old_path, const wchar_t *new_path); - -#endif diff --git a/scripts/common.bash b/scripts/common.bash deleted file mode 100644 --- a/scripts/common.bash +++ /dev/null @@ -1,23 +0,0 @@ -PATH="$PATH:$PWD/cabal-dev/bin/" - -VERSION=$(awk '/^version:/{print $2}' system-fileio.cabal) - -CABAL_DEV=$(which cabal-dev) -XZ=$(which xz) - -require_cabal_dev() -{ - if [ -z "$CABAL_DEV" ]; then - echo "Can't find 'cabal-dev' executable; make sure it exists on your "'$PATH' - echo "Cowardly refusing to fuck with the global package database" - exit 1 - fi -} - -clean_dev_install() -{ - require_cabal_dev - - rm -rf dist - $CABAL_DEV install || exit 1 -} diff --git a/scripts/run-coverage b/scripts/run-coverage deleted file mode 100644 --- a/scripts/run-coverage +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/bash -if [ ! -f 'system-fileio.cabal' ]; then - echo -n "Can't find system-fileio.cabal; please run this script as" - echo -n " ./scripts/run-coverage from within the system-fileio source" - echo " directory" - exit 1 -fi - -. scripts/common.bash - -require_cabal_dev - -pushd tests -$CABAL_DEV -s ../cabal-dev install --flags="coverage" || exit 1 -popd - -rm -f system-fileio_tests.tix -cabal-dev/bin/system-fileio_tests $@ - -EXCLUDES="\ ---exclude=Main \ ---exclude=FilesystemTests.Posix \ ---exclude=FilesystemTests.Util \ ---exclude=FilesystemTests.Windows -" - -hpc markup --srcdir=src --srcdir=tests/ system-fileio_tests.tix --destdir=hpc-markup $EXCLUDES > /dev/null -hpc report --srcdir=src --srcdir=tests/ system-fileio_tests.tix $EXCLUDES diff --git a/scripts/run-tests b/scripts/run-tests deleted file mode 100644 --- a/scripts/run-tests +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/bash -if [ ! -f 'system-fileio.cabal' ]; then - echo -n "Can't find system-fileio.cabal; please run this script as" - echo -n " ./scripts/run-tests from within the system-fileio source" - echo " directory" - exit 1 -fi - -. scripts/common.bash - -require_cabal_dev - -pushd tests -$CABAL_DEV -s ../cabal-dev install || exit 1 -popd - -cabal-dev/bin/system-fileio_tests $@ diff --git a/system-fileio.cabal b/system-fileio.cabal --- a/system-fileio.cabal +++ b/system-fileio.cabal @@ -1,72 +1,43 @@ name: system-fileio -version: 0.2.7 +version: 0.3 +synopsis: High-level filesystem interaction license: MIT license-file: license.txt author: John Millikin -maintainer: John Millikin +maintainer: jmillikin@gmail.com +copyright: Copyright (c) John Millikin 2011 build-type: Simple -cabal-version: >= 1.6 +cabal-version: >=1.6 category: System stability: experimental -homepage: https://john-millikin.com/software/haskell-filesystem/ +homepage: https://john-millikin.com/software/hs-fileio/ bug-reports: mailto:jmillikin@gmail.com +tested-with: GHC==6.12.1 -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\". 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: - lib/hssystemfileio-unix.h - lib/hssystemfileio-win32.h - -- - scripts/common.bash - scripts/run-coverage - scripts/run-tests - -- - tests/system-fileio-tests.cabal - tests/FilesystemTests.hs - tests/FilesystemTests/Posix.hs - tests/FilesystemTests/Util.hs - tests/FilesystemTests/Windows.hs + packages for use with \"system-filepath\". source-repository head - type: bazaar - location: https://john-millikin.com/branches/system-fileio/0.2/ - -source-repository this - type: bazaar - location: https://john-millikin.com/branches/system-fileio/0.2/ - tag: system-fileio_0.2.7 + type: bzr + location: https://john-millikin.com/software/hs-fileio/ library ghc-options: -Wall -O2 - hs-source-dirs: lib build-depends: - base >= 4.0 && < 5.0 + base >= 3 && < 5 , bytestring >= 0.9 && < 0.10 - , system-filepath >= 0.3.1 && < 0.5 - , text >= 0.7.1 && < 0.12 - , time >= 1.0 && < 1.5 + , directory >= 1.0 && < 1.2 + , system-filepath >= 0.3 && < 0.4 + , text >= 0.1 && < 0.12 + , time >= 1.0 && < 1.3 if os(windows) cpp-options: -DCABAL_OS_WINDOWS - build-depends: - Win32 >= 2.2 && < 2.3 - , directory >= 1.0 && < 1.2 - c-sources: lib/hssystemfileio-win32.c + build-depends: Win32 else - build-depends: - unix >= 2.3 && < 2.6 - c-sources: lib/hssystemfileio-unix.c + build-depends: unix exposed-modules: Filesystem - System.Directory - System.File diff --git a/tests/FilesystemTests.hs b/tests/FilesystemTests.hs deleted file mode 100644 --- a/tests/FilesystemTests.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# 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 (test_Windows) -#else -import FilesystemTests.Posix (test_Posix) -#endif - -main :: IO () -main = Test.Chell.defaultMain tests - -tests :: [Suite] -#ifdef CABAL_OS_WINDOWS -tests = [test_Windows] -#else -tests = [test_Posix] -#endif diff --git a/tests/FilesystemTests/Posix.hs b/tests/FilesystemTests/Posix.hs deleted file mode 100644 --- a/tests/FilesystemTests/Posix.hs +++ /dev/null @@ -1,691 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - --- Copyright (C) 2011 John Millikin --- --- See license.txt for details -module FilesystemTests.Posix - ( test_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) - -test_Posix :: Suite -test_Posix = suite "posix" - [ suite "isFile" - [ test_IsFile "ascii" - (decode "test.txt") - , test_IsFile "utf8" - (fromText "\xA1\xA2.txt") - , test_IsFile "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - , 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" - [ 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" - [ 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 - ] - , 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 - , 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") - ] - , 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" - (decode "old_\xA1\xA2\xA3.txt") - (decode "new_\xA1\xA2\xA3.txt") - ] - , todo "openFile" - , suite "withFile" - [ suite "read" - [ test_WithFile_Read "ascii" - (decode "test.txt") - , test_WithFile_Read "utf8" - (fromText "\xA1\xA2.txt") - , test_WithFile_Read "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - , suite "write" - [ test_WithFile_Write "ascii" - (decode "test.txt") - , test_WithFile_Write "utf8" - (fromText "\xA1\xA2.txt") - , test_WithFile_Write "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - ] - , todo "readFile" - , todo "writeFile" - , todo "appendFile" - , todo "openTextFile" - , 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" - , suite "regression-tests" - [ test_ListDirectoryLeaksFds - ] - ] - -test_IsFile :: Text -> FilePath -> Suite -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_IsDirectory :: Text -> FilePath -> Suite -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 :: Text -> FilePath -> FilePath -> Suite -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 :: Text -> FilePath -> FilePath -> Suite -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 :: Text -> FilePath -> FilePath -> Suite -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_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 - [ 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 :: 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_Read :: Text -> FilePath -> Suite -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 :: Text -> FilePath -> Suite -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 :: 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) - -test_ListDirectoryLeaksFds :: Suite -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) - -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 "getcwd" - c_getcwd :: CString -> CSize -> IO CString - -foreign import ccall unsafe "chdir" - c_chdir :: CString -> IO CInt - -foreign import ccall unsafe "free" - c_free :: Ptr a -> IO () - -foreign import ccall unsafe "getenv" - c_getenv :: CString -> IO CString - -foreign import ccall unsafe "setenv" - c_setenv :: CString -> CString -> CInt -> IO CInt - -foreign import ccall unsafe "unsetenv" - c_unsetenv :: CString -> IO CInt diff --git a/tests/FilesystemTests/Util.hs b/tests/FilesystemTests/Util.hs deleted file mode 100644 --- a/tests/FilesystemTests/Util.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# 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 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 = 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 ())) diff --git a/tests/FilesystemTests/Windows.hs b/tests/FilesystemTests/Windows.hs deleted file mode 100644 --- a/tests/FilesystemTests/Windows.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - --- Copyright (C) 2011 John Millikin --- --- See license.txt for details -module FilesystemTests.Windows - ( test_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) - -test_Windows :: Suite -test_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 :: Suite -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 diff --git a/tests/system-fileio-tests.cabal b/tests/system-fileio-tests.cabal deleted file mode 100644 --- a/tests/system-fileio-tests.cabal +++ /dev/null @@ -1,42 +0,0 @@ -name: 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 && < 0.12 - , 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