module System.Posix.Directory (
createDirectory, removeDirectory,
DirStream,
openDirStream,
readDirStream,
rewindDirStream,
closeDirStream,
DirStreamOffset,
tellDirStream,
seekDirStream,
getWorkingDirectory,
changeWorkingDirectory,
changeWorkingDirectoryFd,
) where
import System.IO.Error
import System.Posix.Error
import System.Posix.Types
import Foreign
import Foreign.C
createDirectory :: FilePath -> FileMode -> IO ()
createDirectory name mode =
withCString name $ \s ->
throwErrnoPathIfMinus1_ "createDirectory" name (c_mkdir s mode)
foreign import ccall unsafe "mkdir"
c_mkdir :: CString -> CMode -> IO CInt
newtype DirStream = DirStream (Ptr CDir)
openDirStream :: FilePath -> IO DirStream
openDirStream name =
withCString name $ \s -> do
dirp <- throwErrnoPathIfNull "openDirStream" name $ c_opendir s
return (DirStream dirp)
foreign import ccall unsafe "__hsunix_opendir"
c_opendir :: CString -> IO (Ptr CDir)
readDirStream :: DirStream -> IO FilePath
readDirStream (DirStream dirp) =
alloca $ \ptr_dEnt -> loop ptr_dEnt
where
loop ptr_dEnt = do
resetErrno
r <- c_readdir dirp ptr_dEnt
if (r == 0)
then do dEnt <- peek ptr_dEnt
if (dEnt == nullPtr)
then return []
else do
entry <- (d_name dEnt >>= peekCString)
c_freeDirEnt dEnt
return entry
else do errno <- getErrno
if (errno == eINTR) then loop ptr_dEnt else do
let (Errno eo) = errno
if (eo == 0)
then return []
else throwErrno "readDirStream"
type CDir = ()
type CDirent = ()
foreign import ccall unsafe "__hscore_readdir"
c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
foreign import ccall unsafe "__hscore_free_dirent"
c_freeDirEnt :: Ptr CDirent -> IO ()
foreign import ccall unsafe "__hscore_d_name"
d_name :: Ptr CDirent -> IO CString
rewindDirStream :: DirStream -> IO ()
rewindDirStream (DirStream dirp) = c_rewinddir dirp
foreign import ccall unsafe "rewinddir"
c_rewinddir :: Ptr CDir -> IO ()
closeDirStream :: DirStream -> IO ()
closeDirStream (DirStream dirp) = do
throwErrnoIfMinus1_ "closeDirStream" (c_closedir dirp)
foreign import ccall unsafe "closedir"
c_closedir :: Ptr CDir -> IO CInt
newtype DirStreamOffset = DirStreamOffset COff
seekDirStream :: DirStream -> DirStreamOffset -> IO ()
seekDirStream (DirStream dirp) (DirStreamOffset off) =
c_seekdir dirp off
foreign import ccall unsafe "seekdir"
c_seekdir :: Ptr CDir -> COff -> IO ()
tellDirStream :: DirStream -> IO DirStreamOffset
tellDirStream (DirStream dirp) = do
off <- c_telldir dirp
return (DirStreamOffset off)
foreign import ccall unsafe "telldir"
c_telldir :: Ptr CDir -> IO COff
getWorkingDirectory :: IO FilePath
getWorkingDirectory = do
p <- mallocBytes long_path_size
go p long_path_size
where go p bytes = do
p' <- c_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"
foreign import ccall unsafe "getcwd"
c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar)
foreign import ccall unsafe "__hsunix_long_path_size"
long_path_size :: Int
changeWorkingDirectory :: FilePath -> IO ()
changeWorkingDirectory path =
modifyIOError (`ioeSetFileName` path) $
withCString path $ \s ->
throwErrnoIfMinus1Retry_ "changeWorkingDirectory" (c_chdir s)
foreign import ccall unsafe "chdir"
c_chdir :: CString -> IO CInt
removeDirectory :: FilePath -> IO ()
removeDirectory path =
modifyIOError (`ioeSetFileName` path) $
withCString path $ \s ->
throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)
foreign import ccall unsafe "rmdir"
c_rmdir :: CString -> IO CInt
changeWorkingDirectoryFd :: Fd -> IO ()
changeWorkingDirectoryFd (Fd fd) =
throwErrnoIfMinus1_ "changeWorkingDirectoryFd" (c_fchdir fd)
foreign import ccall unsafe "fchdir"
c_fchdir :: CInt -> IO CInt