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,
21 createDirectoryIfMissing
24 #if __GLASGOW_HASKELL__ < 603
28 import System.Environment (getEnv)
29 import System.FilePath
30 #if __GLASGOW_HASKELL__ > 600
31 import Control.Exception ( bracket )
32 import Control.Monad ( when )
33 import Foreign.Marshal.Alloc ( allocaBytes )
34 import System.IO (IOMode(..), openBinaryFile, hGetBuf, hPutBuf, hClose)
35 import System.IO.Error ( try )
36 import GHC.IOBase ( IOException(..) )
38 import System.IO ( try )
40 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
44 import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
46 getAppUserDataDirectory :: String -> IO FilePath
47 getAppUserDataDirectory appName = do
48 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
49 allocaBytes long_path_size $ \pPath -> do
50 r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
51 s <- peekCString pPath
52 return (s++'\\':appName)
55 return (path++'/':'.':appName)
58 #if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS)
59 foreign import stdcall unsafe "SHGetFolderPathA"
60 c_SHGetFolderPath :: Ptr ()
67 -- __compat_long_path_size defined in cbits/directory.c
68 foreign import ccall unsafe "__compat_long_path_size"
71 foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt
75 copyFile :: FilePath -> FilePath -> IO ()
76 copyFile fromFPath toFPath =
77 #if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
78 do readFile fromFPath >>= writeFile toFPath
79 try (getPermissions fromFPath >>= setPermissions toFPath)
82 (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
83 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
84 allocaBytes bufferSize $ \buffer -> do
85 copyContents hFrom hTo buffer
86 try (getPermissions fromFPath >>= setPermissions toFPath)
87 return ()) `catch` (ioError . changeFunName)
91 changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
93 copyContents hFrom hTo buffer = do
94 count <- hGetBuf hFrom buffer bufferSize
96 hPutBuf hTo buffer count
97 copyContents hFrom hTo buffer
101 findExecutable :: String -> IO (Maybe FilePath)
102 findExecutable binary = do
103 path <- getEnv "PATH"
104 search (parseSearchPath path)
106 #ifdef mingw32_TARGET_OS
107 fileName = binary `joinFileExt` "exe"
112 search :: [FilePath] -> IO (Maybe FilePath)
113 search [] = return Nothing
115 let path = d `joinFileName` fileName
116 b <- doesFileExist path
117 if b then return (Just path)
120 createDirectoryIfMissing :: Bool -- ^ Create its parents too?
121 -> FilePath -- ^ The path to the directory you want to make
123 createDirectoryIfMissing parents file = do
124 b <- doesDirectoryExist file
125 case (b,parents, file) of
126 (_, _, "") -> return ()
127 (True, _, _) -> return ()
128 (_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
129 (_, False, _) -> createDirectory file