X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FDirectory.hs;h=295d3a50aa01a7b2daff1b25954cb4e7b89cbf45;hb=819adca5f17b40ee129e4a30edf685f817febbf9;hp=53417d657799328d6a681db3f6088aa819ffe202;hpb=402f15d3c991951972e6d21ded2d97418326e48f;p=ghc-base.git diff --git a/System/Directory.hs b/System/Directory.hs index 53417d6..295d3a5 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -65,9 +65,10 @@ module System.Directory , getModificationTime -- :: FilePath -> IO ClockTime ) where +import System.Directory.Internals import System.Environment ( getEnv ) -import System.FilePath import System.IO.Error +import Control.Monad ( when, unless ) #ifdef __NHC__ import Directory @@ -82,7 +83,6 @@ import Hugs.Directory import Prelude import Control.Exception ( bracket ) -import Control.Monad ( when, unless ) import System.Posix.Types import System.Posix.Internals import System.Time ( ClockTime(..) ) @@ -240,6 +240,7 @@ createDirectory path = do withCString path $ \s -> do throwErrnoIfMinus1Retry_ "createDirectory" $ mkdir s 0o777 +#endif -- | @'createDirectoryIfMissing' parents dir@ creates a new directory -- @dir@ if it doesn\'t exist. If the first argument is 'True' @@ -255,6 +256,7 @@ createDirectoryIfMissing parents file = do (_, True, _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file)) (_, False, _) -> createDirectory file +#if __GLASGOW_HASKELL__ {- | @'removeDirectory' dir@ removes an existing directory /dir/. The implementation may specify additional constraints which must be satisfied before a directory can be removed (e.g. the directory has to @@ -301,6 +303,7 @@ removeDirectory path = do modifyIOError (`ioeSetFileName` path) $ withCString path $ \s -> throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s) +#endif -- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/ -- together with its content and all subdirectories. Be careful, @@ -320,6 +323,7 @@ removeDirectoryRecursive startLoc = do removeDirectoryRecursive f Right _ -> return () +#if __GLASGOW_HASKELL__ {- |'removeFile' /file/ removes the directory entry for an existing file /file/, where /file/ is not itself a directory. The implementation may specify additional constraints which must be @@ -515,14 +519,14 @@ copyFile fromFPath toFPath = -- 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 +-- 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) +#if defined(mingw32_HOST_OS) alloca $ \ppFilePart -> do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart #else @@ -530,7 +534,7 @@ canonicalizePath fpath = #endif peekCString pOutPath -#if defined(mingw32_TARGET_OS) +#if defined(mingw32_HOST_OS) foreign import stdcall unsafe "GetFullPathName" c_GetFullPathName :: CString -> CInt @@ -828,7 +832,7 @@ cannot be found. -} getHomeDirectory :: IO FilePath getHomeDirectory = -#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS) +#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath if (r < 0) @@ -868,7 +872,7 @@ cannot be found. -} getAppUserDataDirectory :: String -> IO FilePath getAppUserDataDirectory appName = do -#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS) +#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath s <- peekCString pPath @@ -901,7 +905,7 @@ cannot be found. -} getUserDocumentsDirectory :: IO FilePath getUserDocumentsDirectory = do -#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS) +#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath peekCString pPath @@ -937,7 +941,7 @@ The function doesn\'t verify whether the path exists. -} getTemporaryDirectory :: IO FilePath getTemporaryDirectory = do -#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS) +#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) allocaBytes long_path_size $ \pPath -> do r <- c_GetTempPath (fromIntegral long_path_size) pPath peekCString pPath @@ -945,7 +949,7 @@ getTemporaryDirectory = do catch (getEnv "TMPDIR") (\ex -> return "/tmp") #endif -#if __GLASGOW_HASKELL__ && defined(mingw32_TARGET_OS) +#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS) foreign import stdcall unsafe "SHGetFolderPath" c_SHGetFolderPath :: Ptr () -> CInt