-- 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.
, getCurrentDirectory -- :: IO FilePath
, setCurrentDirectory -- :: FilePath -> IO ()
+ -- * Pre-defined directories
+ , getHomeDirectory
+ , getAppUserDataDirectory
+ , getUserDocumentsDirectory
+
-- * Actions on files
, removeFile -- :: FilePath -> IO ()
, renameFile -- :: FilePath -> FilePath -> IO ()
+#ifdef __GLASGOW_HASKELL__
+ , copyFile -- :: FilePath -> FilePath -> IO ()
+#endif
-- * Existence tests
, doesFileExist -- :: FilePath -> IO Bool
#ifdef __NHC__
import Directory
+getHomeDirectory :: IO FilePath
+getHomeDirectory = getEnv "HOME"
+getAppUserDataDirectory :: String -> IO FilePath
+getAppUserDataDirectory appName = do path <- getEnv "HOME"
+ return (path++'/':'.':appName)
+getUserDocumentsDirectory :: IO FilePath
+getUserDocumentsDirectory= getEnv "HOME"
#elif defined(__HUGS__)
import Hugs.Directory
#else
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
+#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
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
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
+{- | Returns the current user's home directory.
+
+The directory returned is expected to be writable by the current user,
+but note that it isn't generally considered good practice to store
+application-specific data here; use 'getAppUserDataDirectory'
+instead.
+
+On Unix, 'getHomeDirectory' returns the value of the @HOME@
+environment variable. On Windows, the system is queried for a
+suitable path; a typical path might be
+@C:/Documents And Settings/user@.
+
+The operation may fail with:
+
+* 'UnsupportedOperation'
+The operating system has no notion of home directory.
+
+* 'isDoesNotExistError'
+The home directory for the current user does not exist, or
+cannot be found.
+-}
+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
+
+{- | Returns the pathname of a directory in which application-specific
+data for the current user can be stored. The result of
+'getAppUserDataDirectory' for a given application is specific to
+the current user.
+
+The argument should be the name of the application, which will be used
+to construct the pathname (so avoid using unusual characters that
+might result in an invalid pathname).
+
+Note: the directory may not actually exist, and may need to be created
+first. It is expected that the parent directory exists and is
+writable.
+
+On Unix, this function returns @$HOME\/.appName@. On Windows, a
+typical path might be
+
+> C:/Documents And Settings/user/Application Data/appName
+
+The operation may fail with:
+
+* 'UnsupportedOperation'
+The operating system has no notion of application-specific data directory.
+
+* 'isDoesNotExistError'
+The home directory for the current user does not exist, or
+cannot be found.
+-}
+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
+
+{- | Returns the current user's document directory.
+
+The directory returned is expected to be writable by the current user,
+but note that it isn't generally considered good practice to store
+application-specific data here; use 'getAppUserDataDirectory'
+instead.
+
+On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@
+environment variable. On Windows, the system is queried for a
+suitable path; a typical path might be
+@C:/Documents and Settings/user/My Documents@.
+
+The operation may fail with:
+
+* 'UnsupportedOperation'
+The operating system has no notion of document directory.
+
+* 'isDoesNotExistError'
+The document directory for the current user does not exist, or
+cannot be found.
+-}
+getUserDocumentsDirectory :: IO FilePath
+getUserDocumentsDirectory = do
+#ifdef mingw32_TARGET_OS
+ allocaBytes long_path_size $ \pPath -> do
+ r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
+ peekCString pPath
+#else
+ getEnv "HOME"
+#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 :: CInt
+foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
+foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt
+foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
+#endif
+
{- |The operation 'doesDirectoryExist' returns 'True' if the argument file
exists and is a directory, and 'False' otherwise.
-}
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