+% -----------------------------------------------------------------------------
+% $Id: Directory.lhs,v 1.20 2000/08/24 10:27:01 simonmar Exp $
%
-% (c) The AQUA Project, Glasgow University, 1994-1999
+% (c) The University of Glasgow, 1994-2000
%
+
\section[Directory]{Directory interface}
A directory contains a series of entries, each of which is a named
) where
#ifdef __HUGS__
-import PreludeBuiltin
+--import PreludeBuiltin
#else
-import PrelBase
-import PrelIOBase
-import PrelHandle
-import PrelST
-import PrelArr
-import PrelPack ( unpackNBytesST, packString, unpackCStringST )
-import PrelAddr
+
+import Prelude -- Just to get it in the dependencies
+
+import PrelGHC ( RealWorld, or#, and# )
+import PrelByteArr ( ByteArray, MutableByteArray,
+ newWordArray, readWordArray, newCharArray )
+import PrelArrExtra ( unsafeFreezeByteArray )
+import PrelPack ( packString, unpackCStringST )
+import PrelIOBase ( stToIO,
+ constructErrorAndFail, constructErrorAndFailWithInfo,
+ IOException(..), ioException, IOErrorType(SystemError) )
import Time ( ClockTime(..) )
+import PrelAddr ( Addr, nullAddr, Word(..), wordToInt, intToWord )
#endif
\end{code}
constructErrorAndFailWithInfo "renameDirectory" ("old: " ++ opath ++ ",new: " ++ npath)
\end{code}
-@renameFile old@ {\em new} changes the name of an existing file system
+@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
(getFileStatus name >>= \ st -> return (not (isDirectory st)))
(\ _ -> return False)
-foreign import ccall "libHS_cbits.so" "const_F_OK" unsafe const_F_OK :: Int
-
#ifndef __HUGS__
getModificationTime :: FilePath -> IO ClockTime
getModificationTime name =
getPermissions :: FilePath -> IO Permissions
getPermissions name = do
st <- getFileStatus name
- let
- fm = fileMode st
- isect v = intersectFileMode v fm == v
+ read <- primAccess (primPackString name) readOK
+ write <- primAccess (primPackString name) writeOK
+ exec <- primAccess (primPackString name) executeOK
return (
Permissions {
- readable = isect ownerReadMode,
- writable = isect ownerWriteMode,
- executable = not (isDirectory st) && isect ownerExecuteMode,
- searchable = not (isRegularFile st) && isect ownerExecuteMode
+ readable = read == 0,
+ writable = write == 0,
+ executable = not (isDirectory st) && exec == 0,
+ searchable = not (isRegularFile st) && exec == 0
}
)
rc <- primChmod (primPackString name) mode
if rc == 0
then return ()
- else ioError (IOError Nothing SystemError "setPermissions" "insufficient permissions")
+ else ioException (IOError Nothing SystemError "setPermissions" "insufficient permissions")
\end{code}
(Sigh)..copied from Posix.Files to avoid dep. on posix library
#else
then stToIO (unsafeFreezeByteArray bytes)
#endif
- else ioError (IOError Nothing SystemError "getFileStatus" "")
+ else ioException (IOError Nothing SystemError "getFileStatus" "")
#ifndef __HUGS__
modificationTime :: FileStatus -> IO ClockTime
modificationTime stat = do
- -- ToDo: better, this is ugly stuff.
- i1 <- malloc1
+ i1 <- stToIO (newWordArray (0,1))
setFileMode i1 stat
- secs <- cvtUnsigned i1
- return (TOD secs 0)
- where
- malloc1 = IO $ \ s# ->
- case newIntArray# 1# s# of
- (# s2#, barr# #) -> (# s2#, MutableByteArray bnds barr# #)
-
- bnds = (0,1)
- -- The C routine fills in an unsigned word. We don't have `unsigned2Integer#,'
- -- so we freeze the data bits and use them for an MP_INT structure. Note that
- -- zero is still handled specially, although (J# 1# 1# (ptr to 0#)) is probably
- -- acceptable to gmp.
-
- cvtUnsigned (MutableByteArray _ arr#) = IO $ \ s# ->
- case readIntArray# arr# 0# s# of
- (# s2#, r# #) ->
- if r# ==# 0# then
- (# s2#, 0 #)
- else
- case unsafeFreezeByteArray# arr# s2# of
- (# s3#, frozen# #) ->
- (# s3#, J# 1# 1# frozen# #)
-
-foreign import ccall "libHS_cbits.so" "set_stat_st_mtime" unsafe
- setFileMode :: PrimMutableByteArray RealWorld -> FileStatus -> IO ()
+ secs <- stToIO (readWordArray i1 0)
+ return (TOD (toInteger (wordToInt secs)) 0)
+foreign import ccall "libHS_cbits" "set_stat_st_mtime" unsafe
+ setFileMode :: PrimMutableByteArray RealWorld -> FileStatus -> IO ()
#endif
isDirectory :: FileStatus -> Bool
isRegularFile :: FileStatus -> Bool
isRegularFile stat = prim_S_ISREG (fileMode stat) /= 0
-foreign import ccall "libHS_cbits.so" "sizeof_stat" unsafe sizeof_stat :: Int
-foreign import ccall "libHS_cbits.so" "prim_stat" unsafe
+foreign import ccall "libHS_cbits" "sizeof_stat" unsafe sizeof_stat :: Int
+foreign import ccall "libHS_cbits" "prim_stat" unsafe
primStat :: PrimByteArray -> PrimMutableByteArray RealWorld -> IO Int
-foreign import ccall "libHS_cbits.so" "get_stat_st_mode" unsafe fileMode :: FileStatus -> FileMode
-foreign import ccall "libHS_cbits.so" "prim_S_ISDIR" unsafe prim_S_ISDIR :: FileMode -> Int
-foreign import ccall "libHS_cbits.so" "prim_S_ISREG" unsafe prim_S_ISREG :: FileMode -> Int
+foreign import ccall "libHS_cbits" "get_stat_st_mode" unsafe fileMode :: FileStatus -> FileMode
+foreign import ccall "libHS_cbits" "prim_S_ISDIR" unsafe prim_S_ISDIR :: FileMode -> Int
+foreign import ccall "libHS_cbits" "prim_S_ISREG" unsafe prim_S_ISREG :: FileMode -> Int
\end{code}
\begin{code}
unionFileMode :: FileMode -> FileMode -> FileMode
intersectFileMode :: FileMode -> FileMode -> FileMode
-foreign import ccall "libHS_cbits.so" "const_S_IRUSR" unsafe ownerReadMode :: FileMode
-foreign import ccall "libHS_cbits.so" "const_S_IWUSR" unsafe ownerWriteMode :: FileMode
-foreign import ccall "libHS_cbits.so" "const_S_IXUSR" unsafe ownerExecuteMode :: FileMode
+foreign import ccall "libHS_cbits" "const_S_IRUSR" unsafe ownerReadMode :: FileMode
+foreign import ccall "libHS_cbits" "const_S_IWUSR" unsafe ownerWriteMode :: FileMode
+foreign import ccall "libHS_cbits" "const_S_IXUSR" unsafe ownerExecuteMode :: FileMode
#ifdef __HUGS__
emptyFileMode = primIntToWord 0
unionFileMode = primOrWord
intersectFileMode = primAndWord
#else
---ToDo: tidy up.
-emptyFileMode = W# (int2Word# 0#)
+emptyFileMode = intToWord 0
unionFileMode = orWord
intersectFileMode = andWord
#endif
+\end{code}
+
+\begin{code}
+type AccessMode = Word
+foreign import ccall "libHS_cbits" "const_R_OK" unsafe readOK :: AccessMode
+foreign import ccall "libHS_cbits" "const_W_OK" unsafe writeOK :: AccessMode
+foreign import ccall "libHS_cbits" "const_X_OK" unsafe executeOK :: AccessMode
\end{code}
Some defns. to allow us to share code.
primNewByteArray sz_in_bytes = stToIO (newCharArray (0,sz_in_bytes))
#endif
-foreign import ccall "libHS_cbits.so" "createDirectory" unsafe primCreateDirectory :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "removeDirectory" unsafe primRemoveDirectory :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "removeFile" unsafe primRemoveFile :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "renameDirectory" unsafe primRenameDirectory :: CString -> CString -> IO Int
-foreign import ccall "libHS_cbits.so" "renameFile" unsafe primRenameFile :: CString -> CString -> IO Int
-foreign import ccall "libHS_cbits.so" "openDir__" unsafe primOpenDir :: CString -> IO Addr
-foreign import ccall "libHS_cbits.so" "readDir__" unsafe primReadDir :: Addr -> IO Addr
-foreign import ccall "libHS_cbits.so" "get_dirent_d_name" unsafe primGetDirentDName :: Addr -> IO Addr
-foreign import ccall "libHS_cbits.so" "setCurrentDirectory" unsafe primSetCurrentDirectory :: CString -> IO Int
-foreign import ccall "libHS_cbits.so" "getCurrentDirectory" unsafe primGetCurrentDirectory :: IO Addr
-foreign import ccall "libc.so.6" "free" unsafe primFree :: Addr -> IO ()
-foreign import ccall "libc.so.6" "malloc" unsafe primMalloc :: Word -> IO Addr
-foreign import ccall "libc.so.6" "chmod" unsafe primChmod :: CString -> Word -> IO Int
+foreign import ccall "libHS_cbits" "createDirectory" unsafe primCreateDirectory :: CString -> IO Int
+foreign import ccall "libHS_cbits" "removeDirectory" unsafe primRemoveDirectory :: CString -> IO Int
+foreign import ccall "libHS_cbits" "removeFile" unsafe primRemoveFile :: CString -> IO Int
+foreign import ccall "libHS_cbits" "renameDirectory" unsafe primRenameDirectory :: CString -> CString -> IO Int
+foreign import ccall "libHS_cbits" "renameFile" unsafe primRenameFile :: CString -> CString -> IO Int
+foreign import ccall "libHS_cbits" "openDir__" unsafe primOpenDir :: CString -> IO Addr
+foreign import ccall "libHS_cbits" "readDir__" unsafe primReadDir :: Addr -> IO Addr
+foreign import ccall "libHS_cbits" "get_dirent_d_name" unsafe primGetDirentDName :: Addr -> IO Addr
+foreign import ccall "libHS_cbits" "setCurrentDirectory" unsafe primSetCurrentDirectory :: CString -> IO Int
+foreign import ccall "libHS_cbits" "getCurrentDirectory" unsafe primGetCurrentDirectory :: IO Addr
+foreign import ccall "libc" "free" unsafe primFree :: Addr -> IO ()
+foreign import ccall "libc" "malloc" unsafe primMalloc :: Word -> IO Addr
+foreign import ccall "libc" "chmod" unsafe primChmod :: CString -> Word -> IO Int
+
+foreign import ccall "libc" "access" unsafe
+ primAccess :: CString -> Word -> IO Int
\end{code}
projects / ghc-hetmet.git / blobdiff