[project @ 2004-08-31 09:07:26 by ross]

make the new directory queries available to all implementations,
though the mingw versions only work for GHC.

diff --git a/System/Directory.hs b/System/Directory.hs
index 096712c..c63a88a 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -64,17 +64,14 @@ module System.Directory
 #ifdef __NHC__
 import Directory
 import System (getEnv)
-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__)
+#endif /* __NHC__ */
+
+#ifdef __HUGS__
 import Hugs.Directory
-#else
+import System.Environment (getEnv)
+#endif /* __HUGS__ */
 
+#ifdef __GLASGOW_HASKELL__
 import Prelude
 
 import Control.Exception       ( bracket )
@@ -87,9 +84,7 @@ import System.IO.Error
 import Foreign
 import Foreign.C
 
-#ifdef __GLASGOW_HASKELL__
 import GHC.IOBase      ( IOException(..), IOErrorType(..), ioException )
-#endif
 
 #ifndef mingw32_TARGET_OS
 import System.Environment
@@ -619,6 +614,93 @@ setCurrentDirectory path = do
        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
        -- ToDo: add path to error
 
+{- |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 "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 "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 "getModificationTime" name $ \ st ->
+ modificationTime st
+
+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_ loc (c_stat s p)
+       f p
+
+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_ loc (lstat s p)
+       f p
+
+modificationTime :: Ptr CStat -> IO ClockTime
+modificationTime stat = do
+    mtime <- st_mtime stat
+    let realToInteger = round . realToFrac :: Real a => a -> Integer
+    return (TOD (realToInteger (mtime :: CTime)) 0)
+    
+isDirectory :: Ptr CStat -> IO Bool
+isDirectory stat = do
+  mode <- st_mode stat
+  return (s_isdir mode)
+
+fileNameEndClean :: String -> String
+fileNameEndClean name = 
+  if i > 0 && (ec == '\\' || ec == '/') then 
+     fileNameEndClean (take i name)
+   else
+     name
+  where
+      i  = (length name) - 1
+      ec = name !! i
+
+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
+foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
+
+foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
+foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
+foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
+
+#endif /* __GLASGOW_HASKELL__ */
+
 {- | Returns the current user's home directory.
 
 The directory returned is expected to be writable by the current user,
@@ -642,7 +724,7 @@ cannot be found.
 -}
 getHomeDirectory :: IO FilePath
 getHomeDirectory =
-#ifdef mingw32_TARGET_OS
+#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
   allocaBytes long_path_size $ \pPath -> do
      r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
      if (r < 0)
@@ -682,7 +764,7 @@ cannot be found.
 -}
 getAppUserDataDirectory :: String -> IO FilePath
 getAppUserDataDirectory appName = do
-#ifdef mingw32_TARGET_OS
+#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
   allocaBytes long_path_size $ \pPath -> do
      r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
      s <- peekCString pPath
@@ -715,7 +797,7 @@ cannot be found.
 -}
 getUserDocumentsDirectory :: IO FilePath
 getUserDocumentsDirectory = do
-#ifdef mingw32_TARGET_OS
+#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
   allocaBytes long_path_size $ \pPath -> do
      r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
      peekCString pPath
@@ -723,7 +805,7 @@ getUserDocumentsDirectory = do
   getEnv "HOME"
 #endif
 
-#ifdef mingw32_TARGET_OS
+#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
 foreign import stdcall unsafe "SHGetFolderPath" 
             c_SHGetFolderPath :: Ptr () 
                               -> CInt 
@@ -736,90 +818,3 @@ 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.
--}
-
-doesDirectoryExist :: FilePath -> IO Bool
-doesDirectoryExist name = 
- catch
-   (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 "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 "getModificationTime" name $ \ st ->
- modificationTime st
-
-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_ loc (c_stat s p)
-       f p
-
-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_ loc (lstat s p)
-       f p
-
-modificationTime :: Ptr CStat -> IO ClockTime
-modificationTime stat = do
-    mtime <- st_mtime stat
-    let realToInteger = round . realToFrac :: Real a => a -> Integer
-    return (TOD (realToInteger (mtime :: CTime)) 0)
-    
-isDirectory :: Ptr CStat -> IO Bool
-isDirectory stat = do
-  mode <- st_mode stat
-  return (s_isdir mode)
-
-fileNameEndClean :: String -> String
-fileNameEndClean name = 
-  if i > 0 && (ec == '\\' || ec == '/') then 
-     fileNameEndClean (take i name)
-   else
-     name
-  where
-      i  = (length name) - 1
-      ec = name !! i
-
-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
-foreign import ccall unsafe "__hscore_X_OK" x_OK :: CMode
-
-foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
-foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
-foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
-
-#endif