-- 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.
-- * Actions on files
, removeFile -- :: FilePath -> IO ()
, renameFile -- :: FilePath -> FilePath -> IO ()
+ , copyFile -- :: FilePath -> FilePath -> IO ()
-- * Existence tests
, doesFileExist -- :: FilePath -> IO Bool
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 System.Posix.Internals
import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
#endif
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
-
- mode = read `unionCMode` (write `unionCMode` exec)
-
- withCString name $ \s ->
- throwErrnoIfMinus1_ "setPermissions" $ c_chmod s mode
+ 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]@
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 = handle (changeFunName) $
+ (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
+ changeFunName e = e
+
+ 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
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_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