module Z.IO.FileSystem.Threaded
(
FileT, initFileT, readFileT, writeFileT
, FilePtrT, newFilePtrT, 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 Z.Data.CBytes as CBytes
import Z.Data.PrimRef.PrimIORef
import Foreign.Ptr
import Foreign.Storable (peekElemOff)
import Foreign.Marshal.Alloc (allocaBytes)
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 Z.IO.UV.Manager
data FileT = FileT {-# UNPACK #-} !UVFD
{-# UNPACK #-} !(IORef Bool)
checkFileTClosed :: HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed (FileT fd closedRef) f = do
closed <- readIORef closedRef
if closed then throwECLOSED else f fd
instance Input FileT where
readInput f buf bufSiz = readFileT f buf bufSiz (-1)
readFileT :: HasCallStack
=> FileT
-> Ptr Word8
-> Int
-> Int64
-> IO Int
readFileT uvf buf bufSiz off =
checkFileTClosed uvf $ \ fd -> do
uvm <- getUVManager
withUVRequest uvm (hs_uv_fs_read_threaded fd buf bufSiz off)
instance Output FileT where
writeOutput f buf bufSiz = writeFileT f buf bufSiz (-1)
writeFileT :: HasCallStack
=> FileT
-> Ptr Word8
-> Int
-> Int64
-> IO ()
writeFileT uvf buf0 bufSiz0 off0 =
checkFileTClosed uvf $ \ fd -> do
(if off0 == -1 then go fd buf0 bufSiz0
else go' fd buf0 bufSiz0 off0)
where
go fd buf bufSiz = do
uvm <- getUVManager
written <- withUVRequest uvm
(hs_uv_fs_write_threaded fd buf bufSiz (-1))
when (written < bufSiz)
(go fd (buf `plusPtr` written) (bufSiz-written))
go' fd buf bufSiz !off = do
uvm <- getUVManager
written <- withUVRequest uvm
(hs_uv_fs_write_threaded fd buf bufSiz off)
when (written < bufSiz) $
go' fd (buf `plusPtr` written)
(bufSiz-written)
(off+fromIntegral written)
data FilePtrT = FilePtrT {-# UNPACK #-} !FileT
{-# UNPACK #-} !(PrimIORef Int64)
newFilePtrT :: FileT
-> Int64
-> IO FilePtrT
newFilePtrT uvf off = FilePtrT uvf <$> newPrimIORef off
getFileOffset :: FilePtrT -> IO Int64
getFileOffset (FilePtrT _ offsetRef) = readPrimIORef offsetRef
setFileOffset :: FilePtrT -> Int64 -> IO ()
setFileOffset (FilePtrT _ offsetRef) = writePrimIORef offsetRef
instance Input FilePtrT where
readInput (FilePtrT file offsetRef) buf bufSiz =
readPrimIORef offsetRef >>= \ off -> do
l <- readFileT file buf bufSiz off
writePrimIORef offsetRef (off + fromIntegral l)
return l
instance Output FilePtrT where
writeOutput (FilePtrT file offsetRef) buf bufSiz =
readPrimIORef offsetRef >>= \ off -> do
writeFileT file buf bufSiz off
writePrimIORef offsetRef (off + fromIntegral bufSiz)
initFileT :: HasCallStack
=> CBytes
-> FileFlag
-> FileMode
-> Resource FileT
initFileT path flags mode =
initResource
(do uvm <- getUVManager
fd <- withCBytesUnsafe path $ \ p ->
withUVRequest uvm (hs_uv_fs_open_threaded p flags mode)
FileT (fromIntegral fd) <$> newIORef False)
(\ (FileT 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 = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest_ uvm (hs_uv_fs_mkdir_threaded p mode)
unlink :: HasCallStack => CBytes -> IO ()
unlink path = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest_ uvm (hs_uv_fs_unlink_threaded p)
mkdtemp :: HasCallStack => CBytes -> IO CBytes
mkdtemp path = do
let size = CBytes.length path
withCBytesUnsafe path $ \ p -> do
(p'', _) <- CBytes.allocCBytesUnsafe (size+7) $ \ p' -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_mkdtemp_threaded p size p')
return p''
rmdir :: HasCallStack => CBytes -> IO ()
rmdir path = do
uvm <- getUVManager
withCBytesUnsafe path (\ p -> void . withUVRequest uvm $ hs_uv_fs_rmdir_threaded p)
scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)]
scandir path = do
uvm <- getUVManager
bracket
(withCBytesUnsafe path $ \ p ->
allocPrimSafe $ \ dents ->
withUVRequestEx uvm
(hs_uv_fs_scandir_threaded p dents)
(hs_uv_fs_scandir_extra_cleanup 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 = do
withCBytesUnsafe path $ \ p ->
allocaBytes uvStatSize $ \ s -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_stat_threaded p s)
peekUVStat s
lstat :: HasCallStack => CBytes -> IO FStat
lstat path =
withCBytesUnsafe path $ \ p ->
allocaBytes uvStatSize $ \ s -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_lstat_threaded p s)
peekUVStat s
fstat :: HasCallStack => FileT -> IO FStat
fstat uvf = checkFileTClosed uvf $ \ fd ->
(allocaBytes uvStatSize $ \ s -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_fstat_threaded fd s)
peekUVStat s)
rename :: HasCallStack => CBytes -> CBytes -> IO ()
rename path path' = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' $ \ p' ->
withUVRequest_ uvm (hs_uv_fs_rename_threaded p p')
fsync :: HasCallStack => FileT -> IO ()
fsync uvf = checkFileTClosed uvf $ \ fd -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_fsync_threaded fd)
fdatasync :: HasCallStack => FileT -> IO ()
fdatasync uvf = checkFileTClosed uvf $ \ fd -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_fdatasync_threaded fd)
ftruncate :: HasCallStack => FileT -> Int64 -> IO ()
ftruncate uvf off = checkFileTClosed uvf $ \ fd -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_ftruncate_threaded fd off)
copyfile :: HasCallStack => CBytes -> CBytes -> CopyFileFlag -> IO ()
copyfile path path' flag = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' $ \ p' ->
withUVRequest_ uvm (hs_uv_fs_copyfile_threaded p p' flag)
access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult
access path mode = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest' uvm (hs_uv_fs_access_threaded p mode) (handleResult . fromIntegral)
where
handleResult r
| 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 = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest_ uvm (hs_uv_fs_chmod_threaded p mode)
fchmod :: HasCallStack => FileT -> FileMode -> IO ()
fchmod uvf mode = checkFileTClosed uvf $ \ fd -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_fchmod_threaded fd mode)
utime :: HasCallStack
=> CBytes
-> Double
-> Double
-> IO ()
utime path atime mtime = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest_ uvm (hs_uv_fs_utime_threaded p atime mtime)
futime :: HasCallStack => FileT -> Double -> Double -> IO ()
futime uvf atime mtime = checkFileTClosed uvf $ \ fd -> do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_futime_threaded fd atime mtime)
lutime :: HasCallStack
=> CBytes
-> Double
-> Double
-> IO ()
lutime path atime mtime = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest_ uvm (hs_uv_fs_lutime_threaded p atime mtime)
link :: HasCallStack => CBytes -> CBytes -> IO ()
link path path' = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' $ \ p' ->
withUVRequest_ uvm (hs_uv_fs_link_threaded p p')
symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO ()
symlink path path' flag = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withCBytesUnsafe path' $ \ p' ->
withUVRequest_ uvm (hs_uv_fs_symlink_threaded p p' flag)
readlink :: HasCallStack => CBytes -> IO CBytes
readlink path = do
uvm <- getUVManager
bracket
(withCBytesUnsafe path $ \ p ->
allocPrimSafe $ \ p' ->
withUVRequestEx uvm
(hs_uv_fs_readlink_threaded p p')
(\ _ -> hs_uv_fs_readlink_extra_cleanup p'))
(hs_uv_fs_readlink_cleanup . fst)
(fromCString . fst)
realpath :: HasCallStack => CBytes -> IO CBytes
realpath path = do
uvm <- getUVManager
bracket
(withCBytesUnsafe path $ \ p ->
allocPrimSafe $ \ p' ->
withUVRequestEx uvm
(hs_uv_fs_realpath_threaded p p')
(\ _ -> hs_uv_fs_readlink_extra_cleanup p'))
(hs_uv_fs_readlink_cleanup . fst)
(fromCString . fst)