-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
--- Stability : provisional
+-- Stability : stable
-- Portability : portable
--
-- System-independent interface to directory manipulation.
module System.Directory
(
- -- $intro
-
- -- * Permissions
-
- -- $permissions
-
- Permissions(
- Permissions,
- readable, -- :: Permissions -> Bool
- writable, -- :: Permissions -> Bool
- executable, -- :: Permissions -> Bool
- searchable -- :: Permissions -> Bool
- )
+ -- $intro
-- * Actions on directories
- , createDirectory -- :: FilePath -> IO ()
+ createDirectory -- :: FilePath -> IO ()
, removeDirectory -- :: FilePath -> IO ()
, renameDirectory -- :: FilePath -> FilePath -> IO ()
, getDirectoryContents -- :: FilePath -> IO [FilePath]
, getCurrentDirectory -- :: IO FilePath
, setCurrentDirectory -- :: FilePath -> IO ()
+ , getHomeDirectory
+ , getAppUserDataDirectory
-- * Actions on files
, removeFile -- :: FilePath -> IO ()
, renameFile -- :: FilePath -> FilePath -> IO ()
+#ifdef __GLASGOW_HASKELL__
+ , copyFile -- :: FilePath -> FilePath -> IO ()
+#endif
-- * Existence tests
, doesFileExist -- :: FilePath -> IO Bool
, doesDirectoryExist -- :: FilePath -> IO Bool
- -- * Setting and retrieving permissions
+ -- * Permissions
+
+ -- $permissions
+
+ , Permissions(
+ Permissions,
+ readable, -- :: Permissions -> Bool
+ writable, -- :: Permissions -> Bool
+ executable, -- :: Permissions -> Bool
+ searchable -- :: Permissions -> Bool
+ )
, getPermissions -- :: FilePath -> IO Permissions
, setPermissions -- :: FilePath -> Permissions -> IO ()
import Prelude
import Control.Exception ( bracket )
+import Control.Monad ( when )
import System.Posix.Types
+import System.Posix.Internals
import System.Time ( ClockTime(..) )
import System.IO
import System.IO.Error
import Foreign.C
#ifdef __GLASGOW_HASKELL__
-import GHC.Posix
import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
#endif
+#ifndef mingw32_TARGET_OS
+import System.Environment
+#endif
+
{- $intro
A directory contains a series of entries, each of which is a named
reference to a file system object (file, directory etc.). Some
executable, searchable :: Bool
} deriving (Eq, Ord, Read, Show)
+{- |The 'getPermissions' operation returns the
+permissions for the file or directory.
+
+The operation may fail with:
+
+* 'isPermissionError' if the user is not permitted to access
+ the permissions; or
+
+* 'isDoesNotExistError' if the file or directory does not exist.
+
+-}
+
getPermissions :: FilePath -> IO Permissions
getPermissions name = do
withCString name $ \s -> do
read <- c_access s r_OK
write <- c_access s w_OK
exec <- c_access s x_OK
- withFileStatus name $ \st -> do
+ withFileStatus "getPermissions" name $ \st -> do
is_dir <- isDirectory st
return (
Permissions {
}
)
-setPermissions :: FilePath -> Permissions -> IO ()
-setPermissions name (Permissions r w e s) = do
- let
- read = if r then s_IRUSR else emptyCMode
- write = if w then s_IWUSR else emptyCMode
- exec = if e || s then s_IXUSR else emptyCMode
+{- |The 'setPermissions' operation sets the
+permissions for the file or directory.
+
+The operation may fail with:
- mode = read `unionCMode` (write `unionCMode` exec)
+* 'isPermissionError' if the user is not permitted to set
+ the permissions; or
- withCString name $ \s ->
- throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
+* 'isDoesNotExistError' if the file or directory does not exist.
+
+-}
+
+setPermissions :: FilePath -> Permissions -> IO ()
+setPermissions name (Permissions r w e s) = do
+ allocaBytes sizeof_stat $ \ p_stat -> do
+ withCString name $ \p_name -> do
+ throwErrnoIfMinus1_ "setPermissions" $ do
+ c_stat p_name p_stat
+ mode <- st_mode p_stat
+ let mode1 = modifyBit r mode s_IRUSR
+ let mode2 = modifyBit w mode1 s_IWUSR
+ let mode3 = modifyBit (e || s) mode2 s_IXUSR
+ c_chmod p_name mode3
+
+ where
+ modifyBit :: Bool -> CMode -> CMode -> CMode
+ modifyBit False m b = m .&. (complement b)
+ modifyBit True m b = m .|. b
-----------------------------------------------------------------------------
-- Implementation
The operand is not a valid directory name.
[ENAMETOOLONG, ELOOP]
-* 'isDoesNotExist' 'NoSuchThing'
+* 'isDoesNotExistError' \/ 'NoSuchThing'
The directory does not exist.
@[ENOENT, ENOTDIR]@
withCString path $ \s ->
throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
-{- |@'removefile' file@ removes the directory entry for an existing file
+{- |'removeFile' /file/ removes the directory entry for an existing file
/file/, where /file/ is not itself a directory. The
implementation may specify additional constraints which must be
satisfied before a file can be removed (e.g. the file may not be in
* 'HardwareFault'
A physical I\/O error has occurred.
-'EIO'
+@[EIO]@
* 'InvalidArgument'
The operand is not a valid file name.
@[ENAMETOOLONG, ELOOP]@
-* 'isDoesNotExist' \/ 'NoSuchThing'
+* 'isDoesNotExistError' \/ 'NoSuchThing'
The file does not exist.
@[ENOENT, ENOTDIR]@
directory, or across different physical devices), but the constraints
must be documented.
+On Win32 platforms, @renameDirectory@ fails if the /new/ directory already
+exists.
+
The operation may fail with:
* 'HardwareFault'
renameDirectory :: FilePath -> FilePath -> IO ()
renameDirectory opath npath =
- withFileStatus opath $ \st -> do
+ withFileStatus "renameDirectory" opath $ \st -> do
is_dir <- isDirectory st
if (not is_dir)
then ioException (IOError Nothing InappropriateType "renameDirectory"
renameFile :: FilePath -> FilePath -> IO ()
renameFile opath npath =
- withFileOrSymlinkStatus opath $ \st -> do
+ withFileOrSymlinkStatus "renameFile" opath $ \st -> do
is_dir <- isDirectory st
if is_dir
then ioException (IOError Nothing InappropriateType "renameFile"
withCString npath $ \s2 ->
throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
+{- |@'copyFile' old new@ copies the existing file from /old/ to /new/.
+If the /new/ file already exists, it is atomically replaced by the /old/ file.
+Neither path may refer to an existing directory.
+-}
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile fromFPath toFPath =
+ (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
+ bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
+ allocaBytes bufferSize $ \buffer ->
+ copyContents hFrom hTo buffer) `catch` (ioError . changeFunName)
+ where
+ bufferSize = 1024
+
+ changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
+
+ copyContents hFrom hTo buffer = do
+ count <- hGetBuf hFrom buffer bufferSize
+ when (count > 0) $ do
+ hPutBuf hTo buffer count
+ copyContents hFrom hTo buffer
+
+
{- |@'getDirectoryContents' dir@ returns a list of /all/ entries
in /dir/.
getCurrentDirectory :: IO FilePath
getCurrentDirectory = do
- p <- mallocBytes path_max
- go p path_max
+ p <- mallocBytes long_path_size
+ go p long_path_size
where go p bytes = do
p' <- c_getcwd p (fromIntegral bytes)
if p' /= nullPtr
throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
-- ToDo: add path to error
-{- |To clarify, 'doesDirectoryExist' returns 'True' if a file system object
-exist, and it's a directory. 'doesFileExist' returns 'True' if the file
-system object exist, but it's not a directory (i.e., for every other
-file system object that is not a directory.)
+getHomeDirectory :: IO FilePath
+getHomeDirectory =
+#ifdef mingw32_TARGET_OS
+ allocaBytes long_path_size $ \pPath -> do
+ r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
+ if (r < 0)
+ then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
+ else return 0
+ peekCString pPath
+#else
+ getEnv "HOME"
+#endif
+
+getAppUserDataDirectory :: String -> IO FilePath
+getAppUserDataDirectory appName = do
+#ifdef mingw32_TARGET_OS
+ allocaBytes long_path_size $ \pPath -> do
+ r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
+ s <- peekCString pPath
+ return (s++'\\':appName)
+#else
+ path <- getEnv "HOME"
+ return (path++'/':'.':appName)
+#endif
+
+#ifdef mingw32_TARGET_OS
+foreign import stdcall unsafe "SHGetFolderPath"
+ c_SHGetFolderPath :: Ptr ()
+ -> CInt
+ -> Ptr ()
+ -> CInt
+ -> CString
+ -> IO CInt
+foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: Int
+foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: Int
+foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: Int
+#endif
+
+{- |The operation 'doesDirectoryExist' returns 'True' if the argument file
+exists and is a directory, and 'False' otherwise.
-}
doesDirectoryExist :: FilePath -> IO Bool
doesDirectoryExist name =
catch
- (withFileStatus name $ \st -> isDirectory st)
+ (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
(\ _ -> return False)
+{- |The operation 'doesFileExist' returns 'True'
+if the argument file exists and is not a directory, and 'False' otherwise.
+-}
+
doesFileExist :: FilePath -> IO Bool
doesFileExist name = do
catch
- (withFileStatus name $ \st -> do b <- isDirectory st; return (not b))
+ (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
(\ _ -> return False)
+{- |The 'getModificationTime' operation returns the
+clock time at which the file or directory was last modified.
+
+The operation may fail with:
+
+* 'isPermissionError' if the user is not permitted to access
+ the modification time; or
+
+* 'isDoesNotExistError' if the file or directory does not exist.
+
+-}
+
getModificationTime :: FilePath -> IO ClockTime
getModificationTime name =
- withFileStatus name $ \ st ->
+ withFileStatus "getModificationTime" name $ \ st ->
modificationTime st
-withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
-withFileStatus name f = do
+withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
+withFileStatus loc name f = do
modifyIOError (`ioeSetFileName` name) $
allocaBytes sizeof_stat $ \p ->
withCString (fileNameEndClean name) $ \s -> do
- throwErrnoIfMinus1Retry_ "withFileStatus" (c_stat s p)
+ throwErrnoIfMinus1Retry_ loc (c_stat s p)
f p
-withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a
-withFileOrSymlinkStatus name f = do
+withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
+withFileOrSymlinkStatus loc name f = do
modifyIOError (`ioeSetFileName` name) $
allocaBytes sizeof_stat $ \p ->
withCString name $ \s -> do
- throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p)
+ throwErrnoIfMinus1Retry_ loc (lstat s p)
f p
modificationTime :: Ptr CStat -> IO ClockTime
modificationTime stat = do
mtime <- st_mtime stat
- return (TOD (toInteger (mtime :: CTime)) 0)
+ let realToInteger = round . realToFrac :: Real a => a -> Integer
+ return (TOD (realToInteger (mtime :: CTime)) 0)
isDirectory :: Ptr CStat -> IO Bool
isDirectory stat = do
fileNameEndClean :: String -> String
fileNameEndClean name =
- if i >= 0 && (ec == '\\' || ec == '/') then
+ if i > 0 && (ec == '\\' || ec == '/') then
fileNameEndClean (take i name)
else
name
i = (length name) - 1
ec = name !! i
-emptyCMode :: CMode
-emptyCMode = 0
-
-unionCMode :: CMode -> CMode -> CMode
-unionCMode = (+)
-
-
-foreign import ccall unsafe "__hscore_path_max"
- path_max :: Int
-
-foreign import ccall unsafe "__hscore_readdir"
- readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
-
-foreign import ccall unsafe "__hscore_free_dirent"
- freeDirEnt :: Ptr CDirent -> IO ()
-
-foreign import ccall unsafe "__hscore_end_of_dir"
- end_of_dir :: CInt
-
-foreign import ccall unsafe "__hscore_d_name"
- d_name :: Ptr CDirent -> IO CString
+foreign import ccall unsafe "__hscore_long_path_size"
+ long_path_size :: Int
foreign import ccall unsafe "__hscore_R_OK" r_OK :: CMode
foreign import ccall unsafe "__hscore_W_OK" w_OK :: CMode
projects / ghc-base.git / blobdiff