#ifdef __HUGS__
import Hugs.Directory
-import Control.Exception ( bracket )
-import System.IO
#endif /* __HUGS__ */
#ifdef __GLASGOW_HASKELL__
modifyBit False m b = m .&. (complement b)
modifyBit True m b = m .|. b
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions source dest = do
+ allocaBytes sizeof_stat $ \ p_stat -> do
+ withCString source $ \p_source -> do
+ withCString dest $ \p_dest -> do
+ throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
+ mode <- st_mode p_stat
+ throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode
+
-----------------------------------------------------------------------------
-- Implementation
withCString path $ \s -> do
throwErrnoIfMinus1Retry_ "createDirectory" $
mkdir s 0o777
+
+#else /* !__GLASGOW_HASKELL__ */
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions fromFPath toFPath
+ = getPermissions fromFPath >>= setPermissions toFPath
+
#endif
-- | @'createDirectoryIfMissing' parents dir@ creates a new directory
-}
copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
-#if defined(__HUGS__)
- (bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
- bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo -> do
- hGetContents hFrom >>= hPutStr hTo
- try (getPermissions fromFPath >>= setPermissions toFPath)
- return ()) `catch` \err ->
- ioError (annotateIOError err "copyFile" Nothing Nothing)
-#elif (!defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ <= 600)
+#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
do readFile fromFPath >>= writeFile toFPath
- try (getPermissions fromFPath >>= setPermissions toFPath)
+ try (copyPermissions fromFPath toFPath)
return ()
#else
(bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
allocaBytes bufferSize $ \buffer -> do
copyContents hFrom hTo buffer
- try (getPermissions fromFPath >>= setPermissions toFPath)
+ try (copyPermissions fromFPath toFPath)
return ()) `catch` (ioError . changeFunName)
where
bufferSize = 1024
allocaBytes long_path_size $ \pPath -> do
r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
if (r < 0)
- then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
- else return 0
+ then do
+ r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
+ when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
+ else return ()
peekCString pPath
#else
getEnv "HOME"
#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
allocaBytes long_path_size $ \pPath -> do
r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
+ when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
s <- peekCString pPath
return (s++'\\':appName)
#else
#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
allocaBytes long_path_size $ \pPath -> do
r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
+ when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
peekCString pPath
#else
getEnv "HOME"
#endif
#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
-foreign import stdcall unsafe "SHGetFolderPath"
+foreign import ccall unsafe "__hscore_getFolderPath"
c_SHGetFolderPath :: Ptr ()
-> CInt
-> Ptr ()
foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
foreign import stdcall unsafe "GetTempPath" c_GetTempPath :: CInt -> CString -> IO CInt
+
+raiseUnsupported loc =
+ ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
+
#endif