X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=b9dcbfad9a8b3ac05a0d76d4863541e575b9c602;hb=6bf0c4665a11101321b3e1bc2cb4de807cce60ba;hp=62072a2222fb535e80579572247b30f0b3dcba4d;hpb=8fc8458be52b5b7b235b4cc992816a2bd104a95b;p=haskell-directory.git

diff --git a/System/Directory.hs b/System/Directory.hs
index 62072a2..b9dcbfa 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -29,6 +29,7 @@ module System.Directory
     , getHomeDirectory
     , getAppUserDataDirectory
     , getUserDocumentsDirectory
+    , getTemporaryDirectory
 
     -- * Actions on files
     , removeFile		-- :: FilePath -> IO ()
@@ -62,8 +63,13 @@ module System.Directory
     , getModificationTime       -- :: FilePath -> IO ClockTime
    ) where
 
+import System.Environment      ( getEnv )
+import System.FilePath
+import System.IO.Error
+
 #ifdef __NHC__
 import Directory
+import NHC.FFI
 #endif /* __NHC__ */
 
 #ifdef __HUGS__
@@ -79,9 +85,6 @@ import System.Posix.Types
 import System.Posix.Internals
 import System.Time             ( ClockTime(..) )
 import System.IO
-import System.IO.Error
-import System.FilePath
-import System.Environment (getEnv)
 import Foreign
 import Foreign.C
 
@@ -441,6 +444,8 @@ renameFile opath npath =
       withCString npath $ \s2 ->
          throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)
 
+#endif /* __GLASGOW_HASKELL__ */
+
 {- |@'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.
@@ -470,6 +475,7 @@ copyFile fromFPath toFPath =
 				copyContents hFrom hTo buffer
 #endif
 
+#ifdef __GLASGOW_HASKELL__
 -- | Given path referring to a file or directory, returns a
 -- canonicalized path, with the intent that two paths referring
 -- to the same file\/directory will map to the same canonicalized
@@ -502,6 +508,11 @@ foreign import ccall unsafe "realpath"
                               -> CString
                               -> IO CString
 #endif
+#else /* !__GLASGOW_HASKELL__ */
+-- dummy implementation
+canonicalizePath :: FilePath -> IO FilePath
+canonicalizePath fpath = return fpath
+#endif /* !__GLASGOW_HASKELL__ */
 
 -- | Given an executable file name, searches for such file
 -- in the directories listed in system PATH. The returned value 
@@ -513,11 +524,7 @@ findExecutable binary = do
   path <- getEnv "PATH"
   search (parseSearchPath path)
   where
-#ifdef mingw32_TARGET_OS
-    fileName = binary `joinFileExt` "exe"
-#else
-    fileName = binary
-#endif
+    fileName = binary `joinFileExt` drop 1 exeExtension
 
     search :: [FilePath] -> IO (Maybe FilePath)
     search [] = return Nothing
@@ -527,7 +534,7 @@ findExecutable binary = do
 	if b then return (Just path)
              else search ds
 
-
+#ifdef __GLASGOW_HASKELL__
 {- |@'getDirectoryContents' dir@ returns a list of /all/ entries
 in /dir/. 
 
@@ -867,6 +874,35 @@ getUserDocumentsDirectory = do
   getEnv "HOME"
 #endif
 
+{- | Returns the current directory for temporary files.
+
+On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@
+environment variable or \"\/tmp\" if the variable isn\'t defined.
+On Windows, the function checks for the existence of environment variables in 
+the following order and uses the first path found:
+
+* TMP environment variable. 
+* TEMP environment variable. 
+* USERPROFILE environment variable. 
+* The Windows directory
+
+The operation may fail with:
+
+* 'UnsupportedOperation'
+The operating system has no notion of temporary directory.
+
+The function doesn\'t verify whether the path exists.
+-}
+getTemporaryDirectory :: IO FilePath
+getTemporaryDirectory = do
+#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_GetTempPath (fromIntegral long_path_size) pPath
+     peekCString pPath
+#else
+  catch (getEnv "TMPDIR") (\ex -> return "/tmp")
+#endif
+
 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
 foreign import stdcall unsafe "SHGetFolderPath" 
             c_SHGetFolderPath :: Ptr () 
@@ -879,4 +915,6 @@ 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
+
+foreign import stdcall unsafe "GetTempPath" c_GetTempPath :: CInt -> CString -> IO CInt
 #endif