2 -----------------------------------------------------------------------------
4 -- Module : Compat.Directory
5 -- Copyright : (c) The University of Glasgow 2001-2004
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : provisional
10 -- Portability : portable
12 -- Functions from System.Directory that aren't present in older versions
15 -----------------------------------------------------------------------------
17 module Compat.Directory (
18 getAppUserDataDirectory,
23 #if __GLASGOW_HASKELL__ < 603
27 import Control.Exception ( bracket )
28 import Control.Monad ( when )
29 import System.Environment (getEnv)
30 import System.FilePath
34 import System.Directory(doesFileExist, getPermissions, setPermissions)
35 #if defined(__GLASGOW_HASKELL__)
36 import GHC.IOBase ( IOException(..) )
39 getAppUserDataDirectory :: String -> IO FilePath
40 getAppUserDataDirectory appName = do
41 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
42 allocaBytes long_path_size $ \pPath -> do
43 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
44 s <- peekCString pPath
45 return (s++'\\':appName)
48 return (path++'/':'.':appName)
51 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
52 foreign import stdcall unsafe "SHGetFolderPathA"
53 c_SHGetFolderPath :: Ptr ()
60 -- __compat_long_path_size defined in cbits/directory.c
61 foreign import ccall unsafe "__compat_long_path_size"
64 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
68 copyFile :: FilePath -> FilePath -> IO ()
69 copyFile fromFPath toFPath =
70 #if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
71 do readFile fromFPath >>= writeFile toFPath
72 try (getPermissions fromFPath >>= setPermissions toFPath)
75 (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
76 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
77 allocaBytes bufferSize $ \buffer -> do
78 copyContents hFrom hTo buffer
79 try (getPermissions fromFPath >>= setPermissions toFPath)
80 return ()) `catch` (ioError . changeFunName)
84 changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
86 copyContents hFrom hTo buffer = do
87 count <- hGetBuf hFrom buffer bufferSize
89 hPutBuf hTo buffer count
90 copyContents hFrom hTo buffer
94 findExecutable :: String -> IO (Maybe FilePath)
95 findExecutable binary = do
97 search (parseSearchPath path)
99 #ifdef mingw32_TARGET_OS
100 fileName = binary `joinFileExt` "exe"
105 search :: [FilePath] -> IO (Maybe FilePath)
106 search [] = return Nothing
108 let path = d `joinFileName` fileName
109 b <- doesFileExist path
110 if b then return (Just path)