-- * Actions on directories
createDirectory -- :: FilePath -> IO ()
+#ifndef __NHC__
, createDirectoryIfMissing -- :: Bool -> FilePath -> IO ()
+#endif
, removeDirectory -- :: FilePath -> IO ()
, removeDirectoryRecursive -- :: FilePath -> IO ()
, renameDirectory -- :: FilePath -> FilePath -> IO ()
-- $permissions
- , Permissions(
- Permissions,
- readable, -- :: Permissions -> Bool
- writable, -- :: Permissions -> Bool
- executable, -- :: Permissions -> Bool
- searchable -- :: Permissions -> Bool
- )
+ , Permissions
+ , readable -- :: Permissions -> Bool
+ , writable -- :: Permissions -> Bool
+ , executable -- :: Permissions -> Bool
+ , searchable -- :: Permissions -> Bool
+ , setOwnerReadable
+ , setOwnerWritable
+ , setOwnerExecutable
+ , setOwnerSearchable
, getPermissions -- :: FilePath -> IO Permissions
, setPermissions -- :: FilePath -> Permissions -> IO ()
+ , copyPermissions
-- * Timestamps
import Control.Exception.Base
#ifdef __NHC__
-import Directory hiding ( getDirectoryContents
- , doesDirectoryExist, doesFileExist
- , getModificationTime )
+import Directory -- hiding ( getDirectoryContents
+ -- , doesDirectoryExist, doesFileExist
+ -- , getModificationTime )
import System (system)
#endif /* __NHC__ */
executable, searchable :: Bool
} deriving (Eq, Ord, Read, Show)
+setOwnerReadable :: Bool -> Permissions -> Permissions
+setOwnerReadable b p = p { readable = b }
+
+setOwnerWritable :: Bool -> Permissions -> Permissions
+setOwnerWritable b p = p { writable = b }
+
+setOwnerExecutable :: Bool -> Permissions -> Permissions
+setOwnerExecutable b p = p { executable = b }
+
+setOwnerSearchable :: Bool -> Permissions -> Permissions
+setOwnerSearchable b p = p { searchable = b }
+
{- |The 'getPermissions' operation returns the
permissions for the file or directory.
write_ok <- Posix.fileAccess name False True False
exec_ok <- Posix.fileAccess name False False True
stat <- Posix.getFileStatus name
- let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
+ let is_dir = Posix.isDirectory stat
return (
Permissions {
readable = read_ok,
#endif
+#ifndef __NHC__
-- | @'createDirectoryIfMissing' parents dir@ creates a new directory
-- @dir@ if it doesn\'t exist. If the first argument is 'True'
-- the function will also create all parent directories if they are missing.
else throw e
#else
stat <- Posix.getFileStatus dir
- if Posix.fileMode stat .&. Posix.directoryMode /= 0
+ if Posix.isDirectory stat
then return ()
else throw e
#endif
) `catch` ((\_ -> return ()) :: IOException -> IO ())
| otherwise -> throw e
+#endif /* !__NHC__ */
#if __GLASGOW_HASKELL__
{- | @'removeDirectory' dir@ removes an existing directory /dir/. The
is_dir <- isDirectory st
#else
stat <- Posix.getSymbolicLinkStatus opath
- let is_dir = Posix.fileMode stat .&. Posix.directoryMode /= 0
+ let is_dir = Posix.isDirectory stat
#endif
if is_dir
then ioException (ioeSetErrorString
#else
withCString fpath $ \pInPath ->
allocaBytes long_path_size $ \pOutPath ->
- do c_realpath pInPath pOutPath
+ do throwErrnoPathIfNull "canonicalizePath" fpath $ c_realpath pInPath pOutPath
path <- peekCString pOutPath
#endif
return (normalise path)
-- normalise does more stuff, like upper-casing the drive letter
-#if defined(mingw32_HOST_OS)
-foreign import stdcall unsafe "GetFullPathNameA"
- c_GetFullPathName :: CString
- -> CInt
- -> CString
- -> Ptr CString
- -> IO CInt
-#else
+#if !defined(mingw32_HOST_OS)
foreign import ccall unsafe "realpath"
c_realpath :: CString
-> CString
findExecutable :: String -> IO (Maybe FilePath)
findExecutable binary =
#if defined(mingw32_HOST_OS)
- withCString binary $ \c_binary ->
- withCString ('.':exeExtension) $ \c_ext ->
- allocaBytes long_path_size $ \pOutPath ->
- alloca $ \ppFilePart -> do
- res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
- if res > 0 && res < fromIntegral long_path_size
- then do fpath <- peekCString pOutPath
- return (Just fpath)
- else return Nothing
-
-foreign import stdcall unsafe "SearchPathA"
- c_SearchPath :: CString
- -> CString
- -> CString
- -> CInt
- -> CString
- -> Ptr CString
- -> IO CInt
+ Win32.searchPath Nothing binary ('.':exeExtension)
#else
do
path <- getEnv "PATH"
#endif
-#ifndef __HUGS__
+#ifdef __GLASGOW_HASKELL__
{- |@'getDirectoryContents' dir@ returns a list of /all/ entries
in /dir/.
modifyIOError ((`ioeSetFileName` path) .
(`ioeSetLocation` "getDirectoryContents")) $ do
#ifndef mingw32_HOST_OS
- bracket
- (Posix.openDirStream path)
- Posix.closeDirStream
- loop
+ bracket
+ (Posix.openDirStream path)
+ Posix.closeDirStream
+ loop
where
loop dirp = do
e <- Posix.readDirStream dirp
if null e then return [] else do
- es <- loop dirp
- return (e:es)
+ es <- loop dirp
+ return (e:es)
#else
bracket
(Win32.findFirstFile (path </> "*"))
-- no need to reverse, ordering is undefined
#endif /* mingw32 */
-#endif /* !__HUGS__ */
+#endif /* __GLASGOW_HASKELL__ */
{- |If the operating system has a notion of current directories,
#endif /* __GLASGOW_HASKELL__ */
-#ifndef __HUGS__
+#ifdef __GLASGOW_HASKELL__
{- |The operation 'doesDirectoryExist' returns 'True' if the argument file
exists and is a directory, and 'False' otherwise.
-}
(withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)
#else
(do stat <- Posix.getFileStatus name
- return (Posix.fileMode stat .&. Posix.directoryMode /= 0))
+ return (Posix.isDirectory stat))
#endif
`catch` ((\ _ -> return False) :: IOException -> IO Bool)
(withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))
#else
(do stat <- Posix.getFileStatus name
- return (Posix.fileMode stat .&. Posix.directoryMode == 0))
+ return (not (Posix.isDirectory stat)))
#endif
`catch` ((\ _ -> return False) :: IOException -> IO Bool)
modificationTime st
#else
stat <- Posix.getFileStatus name
- let realToInteger = round . realToFrac :: Real a => a -> Integer
- return (TOD (realToInteger (Posix.modificationTime stat)) 0)
+ let mod_time :: Posix.EpochTime
+ mod_time = Posix.modificationTime stat
+ dbl_time :: Double
+ dbl_time = realToFrac mod_time
+ return (TOD (round dbl_time) 0)
#endif
+ -- For info
+ -- round :: (RealFrac a, Integral b => a -> b
+ -- realToFrac :: (Real a, Fractional b) => a -> b
-
-#endif /* !__HUGS__ */
+#endif /* __GLASGOW_HASKELL__ */
#ifdef mingw32_HOST_OS
withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a
modificationTime :: Ptr CStat -> IO ClockTime
modificationTime stat = do
mtime <- st_mtime stat
- let realToInteger = round . realToFrac :: Real a => a -> Integer
- return (TOD (realToInteger (mtime :: CTime)) 0)
+ let dbl_time :: Double
+ dbl_time = realToFrac (mtime :: CTime)
+ return (TOD (round dbl_time) 0)
isDirectory :: Ptr CStat -> IO Bool
isDirectory stat = do
fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
else dropTrailingPathSeparator name
-foreign import ccall unsafe "HsDirectory.h __hscore_R_OK" r_OK :: CInt
-foreign import ccall unsafe "HsDirectory.h __hscore_W_OK" w_OK :: CInt
-foreign import ccall unsafe "HsDirectory.h __hscore_X_OK" x_OK :: CInt
-
foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
-}
getHomeDirectory :: IO FilePath
getHomeDirectory =
+ modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do
#if defined(mingw32_HOST_OS)
- allocaBytes long_path_size $ \pPath -> do
- r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
- if (r0 < 0)
- then do
- r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
- when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
- else return ()
- peekCString pPath
+ r <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0
+ case (r :: Either IOException String) of
+ Right s -> return s
+ Left _ -> do
+ r1 <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0
+ case r1 of
+ Right s -> return s
+ Left e -> ioError (e :: IOException)
#else
- getEnv "HOME"
+ getEnv "HOME"
#endif
{- | Returns the pathname of a directory in which application-specific
-}
getAppUserDataDirectory :: String -> IO FilePath
getAppUserDataDirectory appName = do
+ modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do
#if 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)
+ s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0
+ return (s++'\\':appName)
#else
- path <- getEnv "HOME"
- return (path++'/':'.':appName)
+ path <- getEnv "HOME"
+ return (path++'/':'.':appName)
#endif
{- | Returns the current user's document directory.
-}
getUserDocumentsDirectory :: IO FilePath
getUserDocumentsDirectory = do
+ modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do
#if 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
+ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0
#else
- getEnv "HOME"
+ getEnv "HOME"
#endif
{- | Returns the current directory for temporary files.
#endif
#endif
-#if defined(mingw32_HOST_OS)
-foreign import ccall unsafe "__hscore_getFolderPath"
- c_SHGetFolderPath :: Ptr ()
- -> CInt
- -> Ptr ()
- -> CInt
- -> CString
- -> IO CInt
-foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt
-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
-
-raiseUnsupported :: String -> IO ()
-raiseUnsupported loc =
- ioException (ioeSetErrorString (mkIOError UnsupportedOperation loc Nothing Nothing) "unsupported operation")
-
-#endif
-
-- ToDo: This should be determined via autoconf (AC_EXEEXT)
-- | Extension for executable files
-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
projects / haskell-directory.git / blobdiff