From f7b90904aa25e67d1193ffceec86b83993eab02b Mon Sep 17 00:00:00 2001 From: sof Date: Wed, 7 Nov 2001 07:57:16 +0000 Subject: [PATCH] [project @ 2001-11-07 07:57:16 by sof] no longer used --- ghc/lib/std/Directory.hsc | 570 --------------------------------------------- 1 file changed, 570 deletions(-) delete mode 100644 ghc/lib/std/Directory.hsc diff --git a/ghc/lib/std/Directory.hsc b/ghc/lib/std/Directory.hsc deleted file mode 100644 index a5ef6dc..0000000 --- a/ghc/lib/std/Directory.hsc +++ /dev/null @@ -1,570 +0,0 @@ --- ----------------------------------------------------------------------------- --- $Id: Directory.hsc,v 1.16 2001/08/29 10:19:31 simonmar Exp $ --- --- (c) The University of Glasgow, 1994-2000 --- - --- The Directory Interface - -{- -A directory contains a series of entries, each of which is a named -reference to a file system object (file, directory etc.). Some -entries may be hidden, inaccessible, or have some administrative -function (e.g. "." or ".." under POSIX), but in this standard all such -entries are considered to form part of the directory contents. -Entries in sub-directories are not, however, considered to form part -of the directory contents. - -Each file system object is referenced by a {\em path}. There is -normally at least one absolute path to each file system object. In -some operating systems, it may also be possible to have paths which -are relative to the current directory. --} - -module Directory - ( - Permissions -- instance of (Eq, Ord, Read, Show) - ( Permissions - , readable -- :: Permissions -> Bool - , writable -- :: Permissions -> Bool - , executable -- :: Permissions -> Bool - , searchable -- :: Permissions -> Bool - ) - - , createDirectory -- :: FilePath -> IO () - , removeDirectory -- :: FilePath -> IO () - , renameDirectory -- :: FilePath -> FilePath -> IO () - - , getDirectoryContents -- :: FilePath -> IO [FilePath] - , getCurrentDirectory -- :: IO FilePath - , setCurrentDirectory -- :: FilePath -> IO () - - , removeFile -- :: FilePath -> IO () - , renameFile -- :: FilePath -> FilePath -> IO () - - , doesFileExist -- :: FilePath -> IO Bool - , doesDirectoryExist -- :: FilePath -> IO Bool - - , getPermissions -- :: FilePath -> IO Permissions - , setPermissions -- :: FilePath -> Permissions -> IO () - - , getModificationTime -- :: FilePath -> IO ClockTime - ) where - -import Prelude -- Just to get it in the dependencies - -import Time ( ClockTime(..) ) - -import PrelPosix -import PrelStorable -import PrelCString -import PrelMarshalAlloc -import PrelCTypesISO -import PrelCTypes -import PrelCError -import PrelPtr -import PrelIOBase -import PrelBase - -#include "config.h" -#include -#include -#include -#include -#include - ------------------------------------------------------------------------------ --- Permissions - --- The @Permissions@ type is used to record whether certain --- operations are permissible on a file/directory: --- [to whom? - presumably the "current user"] - -data Permissions - = Permissions { - readable, writable, - executable, searchable :: Bool - } deriving (Eq, Ord, Read, Show) - ------------------------------------------------------------------------------ --- Implementation - --- @createDirectory dir@ creates a new directory {\em dir} which is --- initially empty, or as near to empty as the operating system --- allows. - --- The operation may fail with: - -{- -\begin{itemize} -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EROFS, EACCES]@ -\item @isAlreadyExistsError@ / @AlreadyExists@ -The operand refers to a directory that already exists. -@ [EEXIST]@ -\item @HardwareFault@ -A physical I/O error has occurred. -@ [EIO]@ -\item @InvalidArgument@ -The operand is not a valid directory name. -@[ENAMETOOLONG, ELOOP]@ -\item @NoSuchThing@ -There is no path to the directory. -@[ENOENT, ENOTDIR]@ -\item @ResourceExhausted@ -Insufficient resources (virtual memory, process file descriptors, -physical disk space, etc.) are available to perform the operation. -@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ -\item @InappropriateType@ -The path refers to an existing non-directory object. -@[EEXIST]@ -\end{itemize} --} - -createDirectory :: FilePath -> IO () -createDirectory path = do - withCString path $ \s -> do - throwErrnoIfMinus1Retry_ "createDirectory" $ -#if defined(mingw32_TARGET_OS) - mkdir s -#else - mkdir s 0o777 -#endif - -{- -@removeDirectory dir@ removes an existing directory {\em dir}. The -implementation may specify additional constraints which must be -satisfied before a directory can be removed (e.g. the directory has to -be empty, or may not be in use by other processes). It is not legal -for an implementation to partially remove a directory unless the -entire directory is removed. A conformant implementation need not -support directory removal in all situations (e.g. removal of the root -directory). - -The operation may fail with: -\begin{itemize} -\item @HardwareFault@ -A physical I/O error has occurred. -[@EIO@] -\item @InvalidArgument@ -The operand is not a valid directory name. -@[ENAMETOOLONG, ELOOP]@ -\item @isDoesNotExist@ / @NoSuchThing@ -The directory does not exist. -@[ENOENT, ENOTDIR]@ -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EROFS, EACCES, EPERM]@ -\item @UnsatisfiedConstraints@ -Implementation-dependent constraints are not satisfied. -@[EBUSY, ENOTEMPTY, EEXIST]@ -\item @UnsupportedOperation@ -The implementation does not support removal in this situation. -@[EINVAL]@ -\item @InappropriateType@ -The operand refers to an existing non-directory object. -@[ENOTDIR]@ -\end{itemize} --} - -removeDirectory :: FilePath -> IO () -removeDirectory path = do - withCString path $ \s -> - throwErrnoIfMinus1Retry_ "removeDirectory" (rmdir s) - -{- -@Removefile file@ removes the directory entry for an existing file -{\em file}, where {\em file} is not itself a directory. The -implementation may specify additional constraints which must be -satisfied before a file can be removed (e.g. the file may not be in -use by other processes). - -The operation may fail with: -\begin{itemize} -\item @HardwareFault@ -A physical I/O error has occurred. -@[EIO]@ -\item @InvalidArgument@ -The operand is not a valid file name. -@[ENAMETOOLONG, ELOOP]@ -\item @isDoesNotExist@ / @NoSuchThing@ -The file does not exist. -@[ENOENT, ENOTDIR]@ -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EROFS, EACCES, EPERM]@ -\item @UnsatisfiedConstraints@ -Implementation-dependent constraints are not satisfied. -@[EBUSY]@ -\item @InappropriateType@ -The operand refers to an existing directory. -@[EPERM, EINVAL]@ -\end{itemize} --} - -removeFile :: FilePath -> IO () -removeFile path = do - withCString path $ \s -> - throwErrnoIfMinus1Retry_ "removeFile" (unlink s) - -{- -@renameDirectory@ {\em old} {\em new} changes the name of an existing -directory from {\em old} to {\em new}. If the {\em new} directory -already exists, it is atomically replaced by the {\em old} directory. -If the {\em new} directory is neither the {\em old} directory nor an -alias of the {\em old} directory, it is removed as if by -$removeDirectory$. A conformant implementation need not support -renaming directories in all situations (e.g. renaming to an existing -directory, or across different physical devices), but the constraints -must be documented. - -The operation may fail with: -\begin{itemize} -\item @HardwareFault@ -A physical I/O error has occurred. -@[EIO]@ -\item @InvalidArgument@ -Either operand is not a valid directory name. -@[ENAMETOOLONG, ELOOP]@ -\item @isDoesNotExistError@ / @NoSuchThing@ -The original directory does not exist, or there is no path to the target. -@[ENOENT, ENOTDIR]@ -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EROFS, EACCES, EPERM]@ -\item @ResourceExhausted@ -Insufficient resources are available to perform the operation. -@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ -\item @UnsatisfiedConstraints@ -Implementation-dependent constraints are not satisfied. -@[EBUSY, ENOTEMPTY, EEXIST]@ -\item @UnsupportedOperation@ -The implementation does not support renaming in this situation. -@[EINVAL, EXDEV]@ -\item @InappropriateType@ -Either path refers to an existing non-directory object. -@[ENOTDIR, EISDIR]@ -\end{itemize} --} - -renameDirectory :: FilePath -> FilePath -> IO () -renameDirectory opath npath = - withFileStatus opath $ \st -> do - is_dir <- isDirectory st - if (not is_dir) - then ioException (IOError Nothing InappropriateType "renameDirectory" - ("not a directory") (Just opath)) - else do - - withCString opath $ \s1 -> - withCString npath $ \s2 -> - throwErrnoIfMinus1Retry_ "renameDirectory" (rename s1 s2) - -{- -@renameFile@ {\em old} {\em new} changes the name of an existing file system -object from {\em old} to {\em new}. If the {\em new} object already -exists, it is atomically replaced by the {\em old} object. Neither -path may refer to an existing directory. A conformant implementation -need not support renaming files in all situations (e.g. renaming -across different physical devices), but the constraints must be -documented. - -The operation may fail with: -\begin{itemize} -\item @HardwareFault@ -A physical I/O error has occurred. -@[EIO]@ -\item @InvalidArgument@ -Either operand is not a valid file name. -@[ENAMETOOLONG, ELOOP]@ -\item @isDoesNotExistError@ / @NoSuchThing@ -The original file does not exist, or there is no path to the target. -@[ENOENT, ENOTDIR]@ -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EROFS, EACCES, EPERM]@ -\item @ResourceExhausted@ -Insufficient resources are available to perform the operation. -@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@ -\item @UnsatisfiedConstraints@ -Implementation-dependent constraints are not satisfied. -@[EBUSY]@ -\item @UnsupportedOperation@ -The implementation does not support renaming in this situation. -@[EXDEV]@ -\item @InappropriateType@ -Either path refers to an existing directory. -@[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@ -\end{itemize} --} - -renameFile :: FilePath -> FilePath -> IO () -renameFile opath npath = - withFileOrSymlinkStatus opath $ \st -> do - is_dir <- isDirectory st - if is_dir - then ioException (IOError Nothing InappropriateType "renameFile" - "is a directory" (Just opath)) - else do - - withCString opath $ \s1 -> - withCString npath $ \s2 -> - throwErrnoIfMinus1Retry_ "renameFile" (rename s1 s2) - -{- -@getDirectoryContents dir@ returns a list of {\em all} entries -in {\em dir}. - -The operation may fail with: -\begin{itemize} -\item @HardwareFault@ -A physical I/O error has occurred. -@[EIO]@ -\item @InvalidArgument@ -The operand is not a valid directory name. -@[ENAMETOOLONG, ELOOP]@ -\item @isDoesNotExistError@ / @NoSuchThing@ -The directory does not exist. -@[ENOENT, ENOTDIR]@ -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EACCES]@ -\item @ResourceExhausted@ -Insufficient resources are available to perform the operation. -@[EMFILE, ENFILE]@ -\item @InappropriateType@ -The path refers to an existing non-directory object. -@[ENOTDIR]@ -\end{itemize} --} - -getDirectoryContents :: FilePath -> IO [FilePath] -getDirectoryContents path = do - p <- withCString path $ \s -> - throwErrnoIfNullRetry "getDirectoryContents" (opendir s) - loop p - where - loop :: Ptr CDir -> IO [String] - loop dir = do - resetErrno - p <- readdir dir - if (p /= nullPtr) - then do -#ifndef mingw32_TARGET_OS - entry <- peekCString ((#ptr struct dirent,d_name) p) -#else - entryp <- (#peek struct dirent,d_name) p - entry <- peekCString entryp -- on mingwin it's a char *, not a char [] -#endif - entries <- loop dir - return (entry:entries) - else do errno <- getErrno - if (errno == eINTR) then loop dir else do - throwErrnoIfMinus1_ "getDirectoryContents" $ closedir dir -#ifndef mingw32_TARGET_OS - if (errno == eOK) -#else - if (errno == eNOENT) -- mingwin (20001111) cunningly sets errno to ENOENT when it runs out of files -#endif - then return [] - else throwErrno "getDirectoryContents" - -{- -If the operating system has a notion of current directories, -@getCurrentDirectory@ returns an absolute path to the -current directory of the calling process. - -The operation may fail with: -\begin{itemize} -\item @HardwareFault@ -A physical I/O error has occurred. -@[EIO]@ -\item @isDoesNotExistError@ / @NoSuchThing@ -There is no path referring to the current directory. -@[EPERM, ENOENT, ESTALE...]@ -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EACCES]@ -\item @ResourceExhausted@ -Insufficient resources are available to perform the operation. -\item @UnsupportedOperation@ -The operating system has no notion of current directory. -\end{itemize} --} - -getCurrentDirectory :: IO FilePath -getCurrentDirectory = do - p <- mallocBytes (#const PATH_MAX) - go p (#const PATH_MAX) - where go p bytes = do - p' <- getcwd p (fromIntegral bytes) - if p' /= nullPtr - then do s <- peekCString p' - free p' - return s - else do errno <- getErrno - if errno == eRANGE - then do let bytes' = bytes * 2 - p' <- reallocBytes p bytes' - go p' bytes' - else throwErrno "getCurrentDirectory" - -{- -If the operating system has a notion of current directories, -@setCurrentDirectory dir@ changes the current -directory of the calling process to {\em dir}. - -The operation may fail with: -\begin{itemize} -\item @HardwareFault@ -A physical I/O error has occurred. -@[EIO]@ -\item @InvalidArgument@ -The operand is not a valid directory name. -@[ENAMETOOLONG, ELOOP]@ -\item @isDoesNotExistError@ / @NoSuchThing@ -The directory does not exist. -@[ENOENT, ENOTDIR]@ -\item @isPermissionError@ / @PermissionDenied@ -The process has insufficient privileges to perform the operation. -@[EACCES]@ -\item @UnsupportedOperation@ -The operating system has no notion of current directory, or the -current directory cannot be dynamically changed. -\item @InappropriateType@ -The path refers to an existing non-directory object. -@[ENOTDIR]@ -\end{itemize} --} - -setCurrentDirectory :: FilePath -> IO () -setCurrentDirectory path = do - withCString path $ \s -> - throwErrnoIfMinus1Retry_ "setCurrentDirectory" (chdir s) - -- ToDo: add path to error - -{- -To clarify, @doesDirectoryExist@ returns True if a file system object -exist, and it's a directory. @doesFileExist@ returns True if the file -system object exist, but it's not a directory (i.e., for every other -file system object that is not a directory.) --} - -doesDirectoryExist :: FilePath -> IO Bool -doesDirectoryExist name = - catch - (withFileStatus name $ \st -> isDirectory st) - (\ _ -> return False) - -doesFileExist :: FilePath -> IO Bool -doesFileExist name = do - catch - (withFileStatus name $ \st -> do b <- isDirectory st; return (not b)) - (\ _ -> return False) - -getModificationTime :: FilePath -> IO ClockTime -getModificationTime name = - withFileStatus name $ \ st -> - modificationTime st - -getPermissions :: FilePath -> IO Permissions -getPermissions name = do - withCString name $ \s -> do - read <- access s (#const R_OK) - write <- access s (#const W_OK) - exec <- access s (#const X_OK) - withFileStatus name $ \st -> do - is_dir <- isDirectory st - is_reg <- isRegularFile st - return ( - Permissions { - readable = read == 0, - writable = write == 0, - executable = not is_dir && exec == 0, - searchable = not is_reg && exec == 0 - } - ) - -setPermissions :: FilePath -> Permissions -> IO () -setPermissions name (Permissions r w e s) = do - let - read = if r then (#const S_IRUSR) else emptyCMode - write = if w then (#const S_IWUSR) else emptyCMode - exec = if e || s then (#const S_IXUSR) else emptyCMode - - mode = read `unionCMode` (write `unionCMode` exec) - - withCString name $ \s -> - throwErrnoIfMinus1_ "setPermissions" $ chmod s mode - -withFileStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a -withFileStatus name f = do - allocaBytes (#const sizeof(struct stat)) $ \p -> - withCString name $ \s -> do - throwErrnoIfMinus1Retry_ "withFileStatus" (stat s p) - f p - -withFileOrSymlinkStatus :: FilePath -> (Ptr CStat -> IO a) -> IO a -#ifdef HAVE_LSTAT -withFileOrSymlinkStatus name f = do - allocaBytes (#const sizeof(struct stat)) $ \p -> - withCString name $ \s -> do - throwErrnoIfMinus1Retry_ "withFileOrSymlinkStatus" (lstat s p) - f p -#else -withFileOrSymlinkStatus = withFileStatus -#endif - -modificationTime :: Ptr CStat -> IO ClockTime -modificationTime stat = do - mtime <- (#peek struct stat, st_mtime) stat - return (TOD (toInteger (mtime :: CTime)) 0) - -isDirectory :: Ptr CStat -> IO Bool -isDirectory stat = do - mode <- (#peek struct stat, st_mode) stat - return (s_ISDIR mode /= 0) - -isRegularFile :: Ptr CStat -> IO Bool -isRegularFile stat = do - mode <- (#peek struct stat, st_mode) stat - return (s_ISREG mode /= 0) - -foreign import ccall unsafe s_ISDIR :: CMode -> Int -#def inline HsInt s_ISDIR(m) {return S_ISDIR(m);} - -foreign import ccall unsafe s_ISREG :: CMode -> Int -#def inline HsInt s_ISREG(m) {return S_ISREG(m);} - -emptyCMode :: CMode -emptyCMode = 0 - -unionCMode :: CMode -> CMode -> CMode -unionCMode = (+) - -#if defined(mingw32_TARGET_OS) -foreign import ccall unsafe mkdir :: CString -> IO CInt -#else -foreign import ccall unsafe mkdir :: CString -> CInt -> IO CInt -#endif - -foreign import ccall unsafe chmod :: CString -> CMode -> IO CInt -foreign import ccall unsafe access :: CString -> CMode -> IO CInt -foreign import ccall unsafe rmdir :: CString -> IO CInt -foreign import ccall unsafe chdir :: CString -> IO CInt -foreign import ccall unsafe getcwd :: Ptr CChar -> CInt -> IO (Ptr CChar) -foreign import ccall unsafe unlink :: CString -> IO CInt -foreign import ccall unsafe rename :: CString -> CString -> IO CInt - -foreign import ccall unsafe opendir :: CString -> IO (Ptr CDir) -foreign import ccall unsafe readdir :: Ptr CDir -> IO (Ptr CDirent) -foreign import ccall unsafe closedir :: Ptr CDir -> IO CInt - -foreign import ccall unsafe stat :: CString -> Ptr CStat -> IO CInt - -#ifdef HAVE_LSTAT -foreign import ccall unsafe lstat :: CString -> Ptr CStat -> IO CInt -#endif - -type CDirent = () -- 1.7.10.4