, getHomeDirectory
, getAppUserDataDirectory
, getUserDocumentsDirectory
+ , getTemporaryDirectory
-- * Actions on files
, removeFile -- :: FilePath -> IO ()
, renameFile -- :: FilePath -> FilePath -> IO ()
-#ifdef __GLASGOW_HASKELL__
, copyFile -- :: FilePath -> FilePath -> IO ()
-#endif
+
+ , canonicalizePath
+ , findExecutable
-- * Existence tests
, doesFileExist -- :: FilePath -> IO Bool
, getModificationTime -- :: FilePath -> IO ClockTime
) where
+import System.Environment ( getEnv )
+import System.FilePath
+import System.IO.Error
+
#ifdef __NHC__
import Directory
-import System (getEnv)
+import NHC.FFI
#endif /* __NHC__ */
#ifdef __HUGS__
import Hugs.Directory
-import System.Environment (getEnv)
#endif /* __HUGS__ */
#ifdef __GLASGOW_HASKELL__
import System.Posix.Internals
import System.Time ( ClockTime(..) )
import System.IO
-import System.IO.Error
import Foreign
import Foreign.C
import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
-#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
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.
-}
copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
+#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
+ do readFile fromFPath >>= writeFile toFPath
+ try (getPermissions fromFPath >>= setPermissions toFPath)
+ return ()
+#else
(bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
- allocaBytes bufferSize $ \buffer ->
- copyContents hFrom hTo buffer) `catch` (ioError . changeFunName)
+ allocaBytes bufferSize $ \buffer -> do
+ copyContents hFrom hTo buffer
+ try (getPermissions fromFPath >>= setPermissions toFPath)
+ return ()) `catch` (ioError . changeFunName)
where
bufferSize = 1024
when (count > 0) $ do
hPutBuf hTo buffer count
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
+-- path. Note that it is impossible to guarantee that the
+-- implication (same file\/dir <=> same canonicalizedPath) holds
+-- in either direction: this function can make only a best-effort
+-- attempt.
+canonicalizePath :: FilePath -> IO FilePath
+canonicalizePath fpath =
+ withCString fpath $ \pInPath ->
+ allocaBytes long_path_size $ \pOutPath ->
+#if defined(mingw32_TARGET_OS)
+ alloca $ \ppFilePart ->
+ do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
+#else
+ do c_realpath pInPath pOutPath
+#endif
+ peekCString pOutPath
+
+#if defined(mingw32_TARGET_OS)
+foreign import stdcall unsafe "GetFullPathName"
+ c_GetFullPathName :: CString
+ -> CInt
+ -> CString
+ -> Ptr CString
+ -> IO CInt
+#else
+foreign import ccall unsafe "realpath"
+ c_realpath :: CString
+ -> 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
+-- is the path to the found executable or Nothing if there isn't
+-- such executable. For example (findExecutable \"ghc\")
+-- gives you the path to GHC.
+findExecutable :: String -> IO (Maybe FilePath)
+findExecutable binary = do
+ path <- getEnv "PATH"
+ search (parseSearchPath path)
+ where
+ fileName = binary `joinFileExt` exeExtension
+ search :: [FilePath] -> IO (Maybe FilePath)
+ search [] = return Nothing
+ search (d:ds) = do
+ let path = d `joinFileName` fileName
+ b <- doesFileExist path
+ if b then return (Just path)
+ else search ds
+#ifdef __GLASGOW_HASKELL__
{- |@'getDirectoryContents' dir@ returns a list of /all/ entries
in /dir/.
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 ()
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
projects / ghc-base.git / blobdiff