module Z.IO.FileSystem.Threaded
(
FileT, initFileT, readFileT, writeFileT, getFileTFD
, quickReadFile, quickReadTextFile, quickWriteFile, quickWriteTextFile
, FilePtrT, newFilePtrT, getFileOffset, setFileOffset
, mkdir
, unlink
, mkdtemp
, rmdir
, DirEntType(..)
, scandir
, FStat(..), UVTimeSpec(..)
, stat, lstat, fstat
, rename
, fsync, fdatasync
, ftruncate
, copyfile
, AccessResult(..)
, access
, chmod, fchmod
, utime, futime, lutime
, link, symlink
, readlink, realpath
, chown, fchown, lchown
, AccessMode
, pattern F_OK
, pattern R_OK
, pattern W_OK
, pattern X_OK
, FileMode
, pattern DEFAULT_MODE
, pattern S_IRWXU
, pattern S_IRUSR
, pattern S_IWUSR
, pattern S_IXUSR
, pattern S_IRWXG
, pattern S_IRGRP
, pattern S_IWGRP
, pattern S_IXGRP
, pattern S_IRWXO
, pattern S_IROTH
, FileFlag
, pattern O_APPEND
, pattern O_CREAT
, pattern O_DIRECT
, pattern O_DSYNC
, pattern O_EXCL
, pattern O_EXLOCK
, pattern O_NOATIME
, pattern O_NOFOLLOW
, pattern O_RDONLY
, pattern O_RDWR
, pattern O_SYMLINK
, pattern O_SYNC
, pattern O_TRUNC
, pattern O_WRONLY
, pattern O_RANDOM
, pattern O_SHORT_LIVED
, pattern O_SEQUENTIAL
, pattern O_TEMPORARY
, CopyFileFlag
, pattern COPYFILE_DEFAULT
, pattern COPYFILE_EXCL
, pattern COPYFILE_FICLONE
, pattern COPYFILE_FICLONE_FORCE
, SymlinkFlag
, pattern SYMLINK_DEFAULT
, pattern SYMLINK_DIR
, pattern SYMLINK_JUNCTION
) where
import Control.Monad
import Data.Bits
import Data.Int
import Data.IORef
import Data.Word
import Foreign.Ptr
import Foreign.Storable (peekElemOff)
import Foreign.Marshal.Alloc (allocaBytes)
import Z.Data.CBytes as CBytes
import Z.Data.PrimRef.PrimIORef
import qualified Z.Data.Text as T
import qualified Z.Data.Vector as V
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 #-} !FD
{-# UNPACK #-} !(IORef Bool)
getFileTFD :: FileT -> IO FD
getFileTFD (FileT fd closedRef) = do
closed <- readIORef closedRef
if closed then throwECLOSED else return fd
checkFileTClosed :: HasCallStack => FileT -> (FD -> 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)
quickReadFile :: HasCallStack => CBytes -> IO V.Bytes
quickReadFile filename = do
withResource (initFileT filename O_RDONLY DEFAULT_MODE) $ \ file -> do
readAll' =<< newBufferedInput file
quickReadTextFile :: HasCallStack => CBytes -> IO T.Text
quickReadTextFile filename = T.validate <$> quickReadFile filename
quickWriteFile :: HasCallStack => CBytes -> V.Bytes -> IO ()
quickWriteFile filename content = do
withResource (initFileT filename (O_WRONLY .|. O_CREAT) DEFAULT_MODE) $ \ file -> do
withPrimVectorSafe content (writeOutput file)
quickWriteTextFile :: HasCallStack => CBytes -> T.Text -> IO ()
quickWriteTextFile filename content = quickWriteFile filename (T.getUTF8Bytes content)
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)
chown :: HasCallStack => CBytes -> UID -> GID -> IO ()
chown path uid gid = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest_ uvm (hs_uv_fs_chown_threaded p uid gid)
fchown :: HasCallStack => FD -> UID -> GID -> IO ()
fchown fd uid gid = do
uvm <- getUVManager
withUVRequest_ uvm (hs_uv_fs_fchown_threaded fd uid gid)
lchown :: HasCallStack => CBytes -> UID -> GID -> IO ()
lchown path uid gid = do
uvm <- getUVManager
withCBytesUnsafe path $ \ p ->
withUVRequest_ uvm (hs_uv_fs_lchown_threaded p uid gid)