module Z.IO.FileSystem
(
File, initFile, readFile, writeFile, getFileFD
, FilePtr, newFilePtr, 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
, 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.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)
getFileFD :: File -> IO UVFD
getFileFD (File fd closedRef) = do
closed <- readIORef closedRef
if closed then throwECLOSED else return fd
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)