[project @ 2004-08-17 16:48:09 by krasimir]

[ghc-base.git] / System / Directory.hs

diff --git a/System/Directory.hs b/System/Directory.hs
index 58d443c..69acc08 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -24,10 +24,15 @@ module System.Directory
     , 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
@@ -75,6 +80,10 @@ import Foreign.C
 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
@@ -434,7 +443,7 @@ 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) $
+copyFile fromFPath toFPath =
        (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
         bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
         allocaBytes bufferSize $ \buffer ->
@@ -443,7 +452,6 @@ copyFile fromFPath toFPath = handle (changeFunName) $
                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
@@ -600,6 +608,44 @@ setCurrentDirectory path = do
        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
        -- ToDo: add path to error
 
+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.
 -}