module Z.IO.FileSystem
(
File, initFile, readFile, writeFile
, FilePtr, newFilePtr, getFileOffset, setFileOffset
, FileMode(DEFAULT_MODE, S_IRWXU, S_IRUSR, S_IWUSR
, S_IXUSR, S_IRWXG, S_IRGRP, S_IWGRP, S_IXGRP, S_IRWXO, S_IROTH
)
, FileFlag(O_APPEND, O_CREAT, O_DIRECT, O_DSYNC, O_EXCL
, O_EXLOCK, O_NOATIME, O_NOFOLLOW, O_RDONLY, O_RDWR, O_SYMLINK
, O_SYNC, O_TRUNC, O_WRONLY, O_RANDOM, O_SHORT_LIVED, O_SEQUENTIAL, O_TEMPORARY
)
, mkdir
, unlink
, mkdtemp
, rmdir
, DirEntType(..)
, scandir
, FStat(..), UVTimeSpec(..)
, stat, lstat, fstat
, rename
, fsync, fdatasync
, ftruncate
, CopyFileFlag(COPYFILE_DEFAULT, COPYFILE_EXCL, COPYFILE_FICLONE)
, copyfile
, AccessMode(F_OK, R_OK, W_OK, X_OK)
, AccessResult(..)
, access
, chmod, fchmod
, utime, futime, lutime
, SymlinkFlag(SYMLINK_DEFAULT, SYMLINK_DIR, SYMLINK_JUNCTION)
, link, symlink
, readlink, realpath
) where
import Control.Monad
import Data.Word
import Data.Int
import Data.IORef
import Foreign.Ptr
import Foreign.Storable (peekElemOff)
import Foreign.Marshal.Alloc (allocaBytes)
import Z.Data.CBytes as CBytes
import Z.Data.PrimRef.PrimIORef
import Z.Foreign
import Z.IO.Buffered
import Z.IO.Exception
import Z.IO.Resource
import Z.IO.UV.Errno
import Z.IO.UV.FFI
import Prelude hiding (writeFile, readFile)
data File = File {-# UNPACK #-} !UVFD
{-# UNPACK #-} !(IORef Bool)
checkFileClosed :: HasCallStack => File -> (UVFD -> IO a) -> IO a
checkFileClosed (File fd closedRef) f = do
closed <- readIORef closedRef
if closed then throwECLOSED else f fd
instance Input File where
readInput f buf bufSiz = readFile f buf bufSiz (-1)
readFile :: HasCallStack
=> File
-> Ptr Word8
-> Int
-> Int64
-> IO Int
readFile uvf buf bufSiz off =
checkFileClosed uvf $ \ fd -> throwUVIfMinus $ hs_uv_fs_read fd buf bufSiz off
instance Output File where
writeOutput f buf bufSiz = writeFile f buf bufSiz (-1)
writeFile :: HasCallStack
=> File
-> Ptr Word8
-> Int
-> Int64
-> IO ()
writeFile uvf buf0 bufSiz0 off0 =
checkFileClosed uvf $ \fd -> if off0 == -1 then go fd buf0 bufSiz0
else go' fd buf0 bufSiz0 off0
where
go fd !buf !bufSiz = do
written <- throwUVIfMinus (hs_uv_fs_write fd buf bufSiz (-1))
when (written < bufSiz)
(go fd (buf `plusPtr` written) (bufSiz-written))
go' fd !buf !bufSiz !off = do
written <- throwUVIfMinus (hs_uv_fs_write fd buf bufSiz off)
when (written < bufSiz) $
go' fd (buf `plusPtr` written)
(bufSiz-written)
(off+fromIntegral written)
data FilePtr = FilePtr {-# UNPACK #-} !File
{-# UNPACK #-} !(PrimIORef Int64)
newFilePtr :: File
-> Int64
-> IO FilePtr
newFilePtr uvf off = FilePtr uvf <$> newPrimIORef off
getFileOffset :: FilePtr -> IO Int64
getFileOffset (FilePtr _ offsetRef) = readPrimIORef offsetRef
setFileOffset :: FilePtr -> Int64 -> IO ()
setFileOffset (FilePtr _ offsetRef) = writePrimIORef offsetRef
instance Input FilePtr where
readInput (FilePtr file offsetRef) buf bufSiz =
readPrimIORef offsetRef >>= \ off -> do
l <- readFile file buf bufSiz off
writePrimIORef offsetRef (off + fromIntegral l)
return l
instance Output FilePtr where
writeOutput (FilePtr file offsetRef) buf bufSiz =
readPrimIORef offsetRef >>= \ off -> do
writeFile file buf bufSiz off
writePrimIORef offsetRef (off + fromIntegral bufSiz)
initFile :: HasCallStack
=> CBytes
-> FileFlag
-> FileMode
-> Resource File
initFile path flags mode =
initResource
(do !fd <- withCBytesUnsafe path $ \ p ->
throwUVIfMinus $ hs_uv_fs_open p flags mode
File fd <$> newIORef False)
(\ (File fd closedRef) -> do
closed <- readIORef closedRef
unless closed $ do
throwUVIfMinus_ (hs_uv_fs_close fd)
writeIORef closedRef True)
mkdir :: HasCallStack => CBytes -> FileMode -> IO ()
mkdir path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->
hs_uv_fs_mkdir p mode
unlink :: HasCallStack => CBytes -> IO ()
unlink path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_unlink)
mkdtemp :: HasCallStack => CBytes -> IO CBytes
mkdtemp path = do
let size = CBytes.length path
withCBytesUnsafe path $ \ p -> do
(p',_) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do
throwUVIfMinus_ (hs_uv_fs_mkdtemp p size p')
return p'
rmdir :: HasCallStack => CBytes -> IO ()
rmdir path = throwUVIfMinus_ (withCBytesUnsafe path hs_uv_fs_rmdir)
scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)]
scandir path = do
bracket
(withCBytesUnsafe path $ \ p ->
allocPrimUnsafe $ \ dents ->
throwUVIfMinus (hs_uv_fs_scandir p dents))
(\ (dents, n) -> hs_uv_fs_scandir_cleanup dents n)
(\ (dents, n) -> forM [0..n-1] $ \ i -> do
dent <- peekElemOff dents i
(p, typ) <- peekUVDirEnt dent
let !typ' = fromUVDirEntType typ
!p' <- fromCString p
return (p', typ'))
stat :: HasCallStack => CBytes -> IO FStat
stat path = withCBytesUnsafe path $ \ p ->
allocaBytes uvStatSize $ \ s -> do
throwUVIfMinus_ (hs_uv_fs_stat p s)
peekUVStat s
lstat :: HasCallStack => CBytes -> IO FStat
lstat path = withCBytesUnsafe path $ \ p ->
allocaBytes uvStatSize $ \ s -> do
throwUVIfMinus_ (hs_uv_fs_lstat p s)
peekUVStat s
fstat :: HasCallStack => File -> IO FStat
fstat uvf = checkFileClosed uvf $ \ fd ->
allocaBytes uvStatSize $ \ s -> do
throwUVIfMinus_ (hs_uv_fs_fstat fd s)
peekUVStat s
rename :: HasCallStack => CBytes -> CBytes -> IO ()
rename path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' (hs_uv_fs_rename p)
fsync :: HasCallStack => File -> IO ()
fsync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fsync fd
fdatasync :: HasCallStack => File -> IO ()
fdatasync uvf = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fdatasync fd
ftruncate :: HasCallStack => File -> Int64 -> IO ()
ftruncate uvf off = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_ftruncate fd off
copyfile :: HasCallStack => CBytes -> CBytes -> CopyFileFlag -> IO ()
copyfile path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' $ \ p' -> hs_uv_fs_copyfile p p' flag
access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult
access path mode = do
r <- withCBytesUnsafe path $ \ p -> fromIntegral <$> hs_uv_fs_access p mode
if | r == 0 -> return AccessOK
| r == UV_ENOENT -> return NoExistence
| r == UV_EACCES -> return NoPermission
| otherwise -> do
name <- uvErrName r
desc <- uvStdError r
throwUVError r (IOEInfo name desc callStack)
chmod :: HasCallStack => CBytes -> FileMode -> IO ()
chmod path mode = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_chmod p mode
fchmod :: HasCallStack => File -> FileMode -> IO ()
fchmod uvf mode = checkFileClosed uvf $ \ fd -> throwUVIfMinus_ $ hs_uv_fs_fchmod fd mode
utime :: HasCallStack
=> CBytes
-> Double
-> Double
-> IO ()
utime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_utime p atime mtime
futime :: HasCallStack => File -> Double -> Double -> IO ()
futime uvf atime mtime = checkFileClosed uvf $ \ fd ->
throwUVIfMinus_ (hs_uv_fs_futime fd atime mtime)
lutime :: HasCallStack
=> CBytes
-> Double
-> Double
-> IO ()
lutime path atime mtime = throwUVIfMinus_ . withCBytesUnsafe path $ \ p -> hs_uv_fs_lutime p atime mtime
link :: HasCallStack => CBytes -> CBytes -> IO ()
link path path' = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' $ hs_uv_fs_link p
symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO ()
symlink path path' flag = throwUVIfMinus_ . withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' $ \ p' -> hs_uv_fs_symlink p p' flag
readlink :: HasCallStack => CBytes -> IO CBytes
readlink path = do
bracket
(withCBytesUnsafe path $ \ p ->
allocPrimUnsafe $ \ p' ->
throwUVIfMinus (hs_uv_fs_readlink p p'))
(hs_uv_fs_readlink_cleanup . fst)
(fromCString . fst)
realpath :: HasCallStack => CBytes -> IO CBytes
realpath path = do
bracket
(withCBytesUnsafe path $ \ p ->
allocPrimUnsafe $ \ p' ->
throwUVIfMinus (hs_uv_fs_realpath p p'))
(hs_uv_fs_readlink_cleanup . fst)
(fromCString . fst)