{-|
Module      : Z.IO.FileSystem.Base
Description : Filesystem IO
Copyright   : (c) Dong Han, 2017-2020
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provide IO operations related to filesystem, operations are
implemented using unsafe FFIs, which should be prefered when the operations'
estimated time is short(<1ms), which is much common on modern SSDs.
-}
module Z.IO.FileSystem.Base
  ( -- * Regular file devices
    File, initFile, readFileP, writeFileP, getFileFD, seek
  , readFile, readTextFile, writeFile, writeTextFile
  , readJSONFile, writeJSONFile
    -- * file offset bundle
  , FilePtr, newFilePtr, getFilePtrOffset, setFilePtrOffset
  -- * Filesystem operations
  , mkdir, mkdirp
  , unlink
  , mkdtemp, mkstemp , initTempFile, initTempDir
  , rmdir, rmrf
  , DirEntType(..)
  , scandir
  , scandirRecursively
    -- ** File stats
  , FStat(..), UVTimeSpec(..)
  , doesPathExist, doesFileExist, doesDirExist
  , isLink, isDir, isFile
  , isLinkSt, isDirSt, isFileSt
  , stat, lstat, fstat
  , stat', lstat'
  , rename
  , fsync, fdatasync
  , ftruncate
  , copyfile
  , AccessResult(..)
  , access
  , chmod, fchmod
  , utime, futime, lutime
  , link, symlink
  , readlink, realpath
  , chown, fchown, lchown
  -- * opening constant
  -- ** AccessMode
  , AccessMode
  , pattern F_OK
  , pattern R_OK
  , pattern W_OK
  , pattern X_OK
  -- ** FileMode
  , FileMode
  , pattern DEFAULT_FILE_MODE
  , pattern DEFAULT_DIR_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
  -- ** file type constant
  , pattern S_IFMT
  , pattern S_IFLNK
  , pattern S_IFDIR
  , pattern S_IFREG
  -- ** FileFlag
  , 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
  , CopyFileFlag
  , pattern COPYFILE_DEFAULT
  , pattern COPYFILE_EXCL
  , pattern COPYFILE_FICLONE
  , pattern COPYFILE_FICLONE_FORCE
  -- ** SymlinkFlag
  , SymlinkFlag
  , pattern SYMLINK_DEFAULT
  , pattern SYMLINK_DIR
  , pattern SYMLINK_JUNCTION
  -- ** Whence
  , Whence
  , pattern SEEK_SET
  , pattern SEEK_CUR
  , pattern SEEK_END
  ) where

import           Control.Monad
import           Data.Bits
import           Data.IORef
import           Data.Int
import           Data.Word
import           Foreign.Marshal.Alloc    (allocaBytes)
import           Foreign.Ptr
import           Foreign.Storable         (peekElemOff)
import           Prelude                  hiding (readFile, writeFile)
import qualified Z.Data.Builder           as B
import           Z.Data.CBytes            as CBytes
import qualified Z.Data.JSON              as JSON
import           Z.Data.PrimRef.PrimIORef
import qualified Z.Data.Text              as T
import qualified Z.Data.Text.Print        as T
import qualified Z.Data.Vector            as V
import           Z.Foreign
import           Z.IO.Buffered
import qualified Z.IO.Environment         as Env
import           Z.IO.Exception
import qualified Z.IO.FileSystem.FilePath as P
import           Z.IO.Resource
import           Z.IO.UV.FFI

#include "_Shared.hs"

--------------------------------------------------------------------------------
-- File

-- | 'File' and its operations are NOT thread safe, use 'MVar' 'File' in multiple threads
--
-- libuv implements read and write method with both implict and explict offset capable.
-- Implict offset interface is provided by 'Input' \/ 'Output' instances.
-- Explict offset interface is provided by 'readFileP' \/ 'writeFileP'.
--
data File =  File  {-# UNPACK #-} !FD      -- ^ the file
                   {-# UNPACK #-} !(IORef Bool)  -- ^ closed flag

instance Show File where show :: File -> String
show = File -> String
forall a. Print a => a -> String
T.toString

instance T.Print File where
    toUTF8BuilderP :: Int -> File -> Builder ()
toUTF8BuilderP Int
_ (File FD
fd IORef Bool
_) = Builder ()
"File " Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FD -> Builder ()
forall a. (Integral a, Bounded a) => a -> Builder ()
T.int FD
fd

-- | Return File fd.
getFileFD :: File -> IO FD
getFileFD :: File -> IO FD
getFileFD (File FD
fd IORef Bool
closedRef) = do
    Bool
closed <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
closedRef
    if Bool
closed then IO FD
forall a. HasCallStack => IO a
throwECLOSED else FD -> IO FD
forall (m :: * -> *) a. Monad m => a -> m a
return FD
fd

-- | If fd is -1 (closed), throw 'ResourceVanished' ECLOSED.
checkFileClosed :: HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed :: File -> (FD -> IO a) -> IO a
checkFileClosed (File FD
fd IORef Bool
closedRef) FD -> IO a
f = do
    Bool
closed <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
closedRef
    if Bool
closed then IO a
forall a. HasCallStack => IO a
throwECLOSED else FD -> IO a
f FD
fd

-- | Set file's system offset.
--
-- Equivalent to <https://linux.die.net/man/3/lseek64 lseek64(3)>.
seek :: HasCallStack => File -> Int64 -> Whence -> IO Int64
seek :: File -> Int64 -> FD -> IO Int64
seek File
uvf Int64
off FD
w = File -> (FD -> IO Int64) -> IO Int64
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO Int64) -> IO Int64) -> (FD -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \ FD
fd -> IO Int64 -> IO Int64
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (IO Int64 -> IO Int64) -> IO Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ FD -> Int64 -> FD -> IO Int64
hs_seek FD
fd Int64
off FD
w

instance Input File where
    -- readInput :: HasCallStack => File -> Ptr Word8 -> Int -> IO Int
    -- use -1 offset to use fd's default offset
    readInput :: File -> Ptr Word8 -> Int -> IO Int
readInput File
f Ptr Word8
buf Int
bufSiz = HasCallStack => File -> Ptr Word8 -> Int -> Int64 -> IO Int
File -> Ptr Word8 -> Int -> Int64 -> IO Int
readFileP File
f Ptr Word8
buf Int
bufSiz (-Int64
1)

-- | Read file with given offset
--
-- Read length may be smaller than buffer size.
readFileP :: HasCallStack
           => File
           -> Ptr Word8 -- ^ buffer
           -> Int       -- ^ buffer size
           -> Int64     -- ^ file offset, pass -1 to use default(system) offset
           -> IO Int    -- ^ read length
readFileP :: File -> Ptr Word8 -> Int -> Int64 -> IO Int
readFileP File
uvf Ptr Word8
buf Int
bufSiz Int64
off =
    File -> (FD -> IO Int) -> IO Int
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO Int) -> IO Int) -> (FD -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ FD
fd -> IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ FD -> Ptr Word8 -> Int -> Int64 -> IO Int
hs_uv_fs_read FD
fd Ptr Word8
buf Int
bufSiz Int64
off

instance Output File where
    writeOutput :: File -> Ptr Word8 -> Int -> IO ()
writeOutput File
f Ptr Word8
buf Int
bufSiz = HasCallStack => File -> Ptr Word8 -> Int -> Int64 -> IO ()
File -> Ptr Word8 -> Int -> Int64 -> IO ()
writeFileP File
f Ptr Word8
buf Int
bufSiz (-Int64
1)

-- | Write buffer to file
--
-- This function will loop until all bytes are written.
--
-- Note on linux files opened with 'O_APPEND' behave differently since this function use @pwrite@:
--
-- @
-- POSIX requires that opening a file with the O_APPEND flag should have no effect
-- on the location at which pwrite() writes data. However, on Linux,
-- if a file is opened with O_APPEND, pwrite() appends data to the end of the file,
-- regardless of the value of offset.
-- @
writeFileP :: HasCallStack
            => File
            -> Ptr Word8 -- ^ buffer
            -> Int       -- ^ buffer size
            -> Int64     -- ^ file offset, pass -1 to use default(system) offset
            -> IO ()
writeFileP :: File -> Ptr Word8 -> Int -> Int64 -> IO ()
writeFileP File
uvf Ptr Word8
buf0 Int
bufSiz0 Int64
off0 =
    File -> (FD -> IO ()) -> IO ()
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO ()) -> IO ()) -> (FD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FD
fd ->  if Int64
off0 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int64
1 then FD -> Ptr Word8 -> Int -> IO ()
go FD
fd Ptr Word8
buf0 Int
bufSiz0
                                                else FD -> Ptr Word8 -> Int -> Int64 -> IO ()
go' FD
fd Ptr Word8
buf0 Int
bufSiz0 Int64
off0
  where
    go :: FD -> Ptr Word8 -> Int -> IO ()
go FD
fd !Ptr Word8
buf !Int
bufSiz = do
        Int
written <- IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (FD -> Ptr Word8 -> Int -> Int64 -> IO Int
hs_uv_fs_write FD
fd Ptr Word8
buf Int
bufSiz (-Int64
1))
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
written Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufSiz)
            (FD -> Ptr Word8 -> Int -> IO ()
go FD
fd (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
written) (Int
bufSizInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
written))

    go' :: FD -> Ptr Word8 -> Int -> Int64 -> IO ()
go' FD
fd !Ptr Word8
buf !Int
bufSiz !Int64
off = do
        Int
written <- IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (FD -> Ptr Word8 -> Int -> Int64 -> IO Int
hs_uv_fs_write FD
fd Ptr Word8
buf Int
bufSiz Int64
off)
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
written Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufSiz) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            FD -> Ptr Word8 -> Int -> Int64 -> IO ()
go' FD
fd (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
written)
                   (Int
bufSizInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
written)
                   (Int64
offInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
written)


--------------------------------------------------------------------------------

-- | init a file 'Resource', which open a file when used.
--
-- Resource closing is thread safe, on some versions of OSX, repeatly open and close same file 'Resource' may
-- result in shared memory object error, use 'O_CREAT' to avoid that.
initFile :: HasCallStack
         => CBytes
         -> FileFlag        -- ^ Opening flags, e.g. 'O_CREAT' @.|.@ 'O_RDWR'
         -> FileMode        -- ^ Sets the file mode (permission and sticky bits),
                            -- but only if the file was created, see 'DEFAULT_FILE_MODE'.
         -> Resource File
initFile :: CBytes -> FD -> FD -> Resource File
initFile CBytes
path FD
flags FD
mode =
    IO File -> (File -> IO ()) -> Resource File
forall a. IO a -> (a -> IO ()) -> Resource a
initResource
        (do !FD
fd <- CBytes -> (BA# Word8 -> IO FD) -> IO FD
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO FD) -> IO FD) -> (BA# Word8 -> IO FD) -> IO FD
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
                IO FD -> IO FD
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (IO FD -> IO FD) -> IO FD -> IO FD
forall a b. (a -> b) -> a -> b
$ BA# Word8 -> FD -> FD -> IO FD
hs_uv_fs_open BA# Word8
p FD
flags FD
mode
            FD -> IORef Bool -> File
File FD
fd (IORef Bool -> File) -> IO (IORef Bool) -> IO File
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False)
        (\ (File FD
fd IORef Bool
closedRef) -> do
            Bool
closed <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
closedRef
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
closed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (FD -> IO Int
hs_uv_fs_close FD
fd)
                IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
closedRef Bool
True)

--------------------------------------------------------------------------------

-- | Create a directory named path with numeric mode 'FileMode'.
--
-- Equivalent to <http://linux.die.net/man/2/mkdir mkdir(2)>.
--
-- Note mode is currently not implemented on Windows. On unix you should set execute bit
-- if you want the directory is accessable, e.g. 0o777.
mkdir :: HasCallStack => CBytes -> FileMode -> IO ()
mkdir :: CBytes -> FD -> IO ()
mkdir CBytes
path FD
mode = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
     BA# Word8 -> FD -> IO Int
hs_uv_fs_mkdir BA# Word8
p FD
mode

-- | Recursive directory creation function. Like 'mkdir', but makes all
-- intermediate-level directories needed to contain the leaf directory.
--
-- Equivalent to @mkdir -p@,
--
-- Note mode is currently not implemented on Windows. On unix you should set
-- execute bit if you want the directory is accessable(so that child folder
-- can be created), e.g. 'DEFAULT_DIR_MODE'.
--
mkdirp :: HasCallStack => CBytes -> FileMode -> IO ()
mkdirp :: CBytes -> FD -> IO ()
mkdirp CBytes
path FD
mode = do
    Int
r <- CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> BA# Word8 -> FD -> IO Int
hs_uv_fs_mkdir BA# Word8
p FD
mode
    case Int -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r of
        FD
UV_ENOENT -> do
            (CBytes
root, [CBytes]
segs) <- CBytes -> IO (CBytes, [CBytes])
P.splitSegments CBytes
path
            case [CBytes]
segs of
                CBytes
seg:[CBytes]
segs' -> [CBytes] -> CBytes -> IO ()
loop [CBytes]
segs' (CBytes -> IO ()) -> IO CBytes -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CBytes -> CBytes -> IO CBytes
P.join CBytes
root CBytes
seg
                [CBytes]
_         -> Int -> IO ()
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV Int
r
        FD
UV_EEXIST -> do
            Bool
canIgnore <- HasCallStack => CBytes -> IO Bool
CBytes -> IO Bool
isDir CBytes
path
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
canIgnore (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV Int
r
        FD
_ -> Int -> IO ()
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV Int
r
  where
    loop :: [CBytes] -> CBytes -> IO ()
loop [CBytes]
segs CBytes
p = do
        AccessResult
a <- HasCallStack => CBytes -> FD -> IO AccessResult
CBytes -> FD -> IO AccessResult
access CBytes
p FD
F_OK
        case AccessResult
a of
            AccessResult
AccessOK     -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            AccessResult
NoExistence  -> HasCallStack => CBytes -> FD -> IO ()
CBytes -> FD -> IO ()
mkdir CBytes
p FD
mode
            AccessResult
NoPermission -> FD -> IO ()
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV FD
UV_EACCES
        case [CBytes]
segs of
            (CBytes
nextp:[CBytes]
ps) -> CBytes -> CBytes -> IO CBytes
P.join CBytes
p CBytes
nextp IO CBytes -> (CBytes -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CBytes] -> CBytes -> IO ()
loop [CBytes]
ps
            [CBytes]
_          -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Equivalent to <http://linux.die.net/man/2/unlink unlink(2)>.
unlink :: HasCallStack => CBytes -> IO ()
unlink :: CBytes -> IO ()
unlink CBytes
path = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path BA# Word8 -> IO Int
hs_uv_fs_unlink)


-- | Equivalent to <mkdtemp http://linux.die.net/man/3/mkdtemp>
--
-- Creates a temporary directory in the most secure manner possible.
-- There are no race conditions in the directory’s creation.
-- The directory is readable, writable, and searchable only by the creating user ID.
-- The user of mkdtemp() is responsible for deleting the temporary directory and
-- its contents when done with it.
--
-- Note: the argument is the prefix of the temporary directory,
-- so no need to add XXXXXX ending.
--
mkdtemp :: HasCallStack => CBytes -> IO CBytes
mkdtemp :: CBytes -> IO CBytes
mkdtemp CBytes
path = do
    let size :: Int
size = CBytes -> Int
CBytes.length CBytes
path
    CBytes -> (BA# Word8 -> IO CBytes) -> IO CBytes
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO CBytes) -> IO CBytes)
-> (BA# Word8 -> IO CBytes) -> IO CBytes
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> do
        (CBytes
p',()
_) <- Int -> (MBA# Word8 -> IO ()) -> IO (CBytes, ())
forall a.
HasCallStack =>
Int -> (MBA# Word8 -> IO a) -> IO (CBytes, a)
CBytes.allocCBytesUnsafe (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
7) ((MBA# Word8 -> IO ()) -> IO (CBytes, ()))
-> (MBA# Word8 -> IO ()) -> IO (CBytes, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# Word8
p' -> do  -- we append "XXXXXX\NUL" in C
            IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (BA# Word8 -> Int -> MBA# Word8 -> IO Int
hs_uv_fs_mkdtemp BA# Word8
p Int
size MBA# Word8
p')
        CBytes -> IO CBytes
forall (m :: * -> *) a. Monad m => a -> m a
return CBytes
p'

-- | Equivalent to <mkstemp https://man7.org/linux/man-pages/man3/mkstemp.3.html>
mkstemp :: HasCallStack => CBytes -> IO CBytes
mkstemp :: CBytes -> IO CBytes
mkstemp CBytes
template = do
    let size :: Int
size = CBytes -> Int
CBytes.length CBytes
template
    CBytes -> (BA# Word8 -> IO CBytes) -> IO CBytes
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CBytes.withCBytesUnsafe CBytes
template ((BA# Word8 -> IO CBytes) -> IO CBytes)
-> (BA# Word8 -> IO CBytes) -> IO CBytes
forall a b. (a -> b) -> a -> b
$ \BA# Word8
p -> do
        (CBytes
p', ()
_) <- Int -> (MBA# Word8 -> IO ()) -> IO (CBytes, ())
forall a.
HasCallStack =>
Int -> (MBA# Word8 -> IO a) -> IO (CBytes, a)
CBytes.allocCBytesUnsafe (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) ((MBA# Word8 -> IO ()) -> IO (CBytes, ()))
-> (MBA# Word8 -> IO ()) -> IO (CBytes, ())
forall a b. (a -> b) -> a -> b
$ \ MBA# Word8
p' -> do  -- we append "XXXXXX\NUL" in C
            IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (BA# Word8 -> Int -> MBA# Word8 -> IO Int
hs_uv_fs_mkstemp BA# Word8
p Int
size MBA# Word8
p')
        CBytes -> IO CBytes
forall (m :: * -> *) a. Monad m => a -> m a
return CBytes
p'

-------------------------------------------------------------------------------

-- | Equivalent to <http://linux.die.net/man/2/rmdir rmdir(2)>.
--
-- Note this function may inherent OS limitations such as argument must be an empty folder.
rmdir :: HasCallStack => CBytes -> IO ()
rmdir :: CBytes -> IO ()
rmdir CBytes
path = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path BA# Word8 -> IO Int
hs_uv_fs_rmdir)

-- | Removes a file or directory at path together with its contents and
-- subdirectories. Symbolic links are removed without affecting their targets.
-- If the path does not exist, nothing happens.
rmrf :: HasCallStack => CBytes -> IO ()
rmrf :: CBytes -> IO ()
rmrf CBytes
path =
    CBytes -> (BA# Word8 -> IO ()) -> IO ()
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO ()) -> IO ()) -> (BA# Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BA# Word8
path' ->
    Int -> (Ptr FStat -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr FStat -> IO ()) -> IO ()) -> (Ptr FStat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FStat
s -> do
        FD
r <- Int -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> FD) -> IO Int -> IO FD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BA# Word8 -> Ptr FStat -> IO Int
hs_uv_fs_stat BA# Word8
path' Ptr FStat
s
        if  | FD
r FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
UV_ENOENT -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()   -- nothing if path does not exist.
            | FD
r FD -> FD -> Bool
forall a. Ord a => a -> a -> Bool
< FD
0     -> FD -> IO ()
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV FD
r
            | Bool
otherwise -> do
                FStat
st <- Ptr FStat -> IO FStat
peekUVStat Ptr FStat
s
                case FStat -> FD
stMode FStat
st FD -> FD -> FD
forall a. Bits a => a -> a -> a
.&. FD
S_IFMT of
                    FD
S_IFREG -> HasCallStack => CBytes -> IO ()
CBytes -> IO ()
unlink CBytes
path
                    FD
S_IFLNK -> HasCallStack => CBytes -> IO ()
CBytes -> IO ()
unlink CBytes
path
                    FD
S_IFDIR -> do
                        [(CBytes, DirEntType)]
ds <- HasCallStack => CBytes -> IO [(CBytes, DirEntType)]
CBytes -> IO [(CBytes, DirEntType)]
scandir CBytes
path
                        [(CBytes, DirEntType)] -> ((CBytes, DirEntType) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(CBytes, DirEntType)]
ds (((CBytes, DirEntType) -> IO ()) -> IO ())
-> ((CBytes, DirEntType) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (CBytes
d, DirEntType
t) ->
                            if DirEntType
t DirEntType -> DirEntType -> Bool
forall a. Eq a => a -> a -> Bool
/= DirEntType
DirEntDir
                            then HasCallStack => CBytes -> IO ()
CBytes -> IO ()
unlink CBytes
d
                            else HasCallStack => CBytes -> IO ()
CBytes -> IO ()
rmrf (CBytes -> IO ()) -> IO CBytes -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CBytes
path CBytes -> CBytes -> IO CBytes
`P.join` CBytes
d
                        HasCallStack => CBytes -> IO ()
CBytes -> IO ()
rmdir CBytes
path
                    FD
mode    -> do
                        let desc :: Text
desc = Builder () -> Text
forall a. HasCallStack => Builder a -> Text
B.buildText (Builder () -> Text) -> Builder () -> Text
forall a b. (a -> b) -> a -> b
$ Builder ()
"Unsupported file mode: " Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FD -> Builder ()
forall a. (FiniteBits a, Integral a) => a -> Builder ()
B.hex FD
mode
                        UnsupportedOperation -> IO ()
forall e a. Exception e => e -> IO a
throwIO (UnsupportedOperation -> IO ()) -> UnsupportedOperation -> IO ()
forall a b. (a -> b) -> a -> b
$ IOEInfo -> UnsupportedOperation
UnsupportedOperation (Text -> Text -> CallStack -> IOEInfo
IOEInfo Text
"" Text
desc CallStack
HasCallStack => CallStack
callStack)

-- | Equivalent to <http://linux.die.net/man/3/scandir scandir(3)>.
--
-- Note Unlike scandir(3), this function does not return the “.” and “..” entries.
--
-- Note On Linux, getting the type of an entry is only supported by some file
-- systems (btrfs, ext2, ext3 and ext4 at the time of this writing), check the
-- <http://linux.die.net/man/2/getdents getdents(2)> man page.
scandir :: HasCallStack => CBytes -> IO [(CBytes, DirEntType)]
scandir :: CBytes -> IO [(CBytes, DirEntType)]
scandir CBytes
path = do
    IO (Ptr (Ptr DirEntType), Int)
-> ((Ptr (Ptr DirEntType), Int) -> IO ())
-> ((Ptr (Ptr DirEntType), Int) -> IO [(CBytes, DirEntType)])
-> IO [(CBytes, DirEntType)]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (CBytes
-> (BA# Word8 -> IO (Ptr (Ptr DirEntType), Int))
-> IO (Ptr (Ptr DirEntType), Int)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO (Ptr (Ptr DirEntType), Int))
 -> IO (Ptr (Ptr DirEntType), Int))
-> (BA# Word8 -> IO (Ptr (Ptr DirEntType), Int))
-> IO (Ptr (Ptr DirEntType), Int)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
            (MBA# Word8 -> IO Int) -> IO (Ptr (Ptr DirEntType), Int)
forall a b. Prim a => (MBA# Word8 -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# Word8 -> IO Int) -> IO (Ptr (Ptr DirEntType), Int))
-> (MBA# Word8 -> IO Int) -> IO (Ptr (Ptr DirEntType), Int)
forall a b. (a -> b) -> a -> b
$ \ MBA# Word8
dents ->
                IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (BA# Word8 -> MBA# Word8 -> IO Int
hs_uv_fs_scandir BA# Word8
p MBA# Word8
dents))
        (\ (Ptr (Ptr DirEntType)
dents, Int
n) -> Ptr (Ptr DirEntType) -> Int -> IO ()
hs_uv_fs_scandir_cleanup Ptr (Ptr DirEntType)
dents Int
n)
        (\ (Ptr (Ptr DirEntType)
dents, Int
n) -> [Int]
-> (Int -> IO (CBytes, DirEntType)) -> IO [(CBytes, DirEntType)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO (CBytes, DirEntType)) -> IO [(CBytes, DirEntType)])
-> (Int -> IO (CBytes, DirEntType)) -> IO [(CBytes, DirEntType)]
forall a b. (a -> b) -> a -> b
$ \ Int
i -> do
            Ptr DirEntType
dent <- Ptr (Ptr DirEntType) -> Int -> IO (Ptr DirEntType)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr DirEntType)
dents Int
i
            (CString
p, UVDirEntType
typ) <- Ptr DirEntType -> IO (CString, UVDirEntType)
peekUVDirEnt Ptr DirEntType
dent
            let !typ' :: DirEntType
typ' = UVDirEntType -> DirEntType
fromUVDirEntType UVDirEntType
typ
            !CBytes
p' <- CString -> IO CBytes
fromCString CString
p
            (CBytes, DirEntType) -> IO (CBytes, DirEntType)
forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes
p', DirEntType
typ'))

--------------------------------------------------------------------------------
-- File Status

-- | Equivalent to <http://linux.die.net/man/2/stat stat(2)>
stat :: HasCallStack => CBytes -> IO FStat
stat :: CBytes -> IO FStat
stat CBytes
path = CBytes -> (BA# Word8 -> IO FStat) -> IO FStat
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO FStat) -> IO FStat)
-> (BA# Word8 -> IO FStat) -> IO FStat
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
     Int -> (Ptr FStat -> IO FStat) -> IO FStat
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr FStat -> IO FStat) -> IO FStat)
-> (Ptr FStat -> IO FStat) -> IO FStat
forall a b. (a -> b) -> a -> b
$ \ Ptr FStat
s -> do
        IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (BA# Word8 -> Ptr FStat -> IO Int
hs_uv_fs_stat BA# Word8
p Ptr FStat
s)
        Ptr FStat -> IO FStat
peekUVStat Ptr FStat
s

-- | Equivalent to <http://linux.die.net/man/2/lstat lstat(2)>
lstat :: HasCallStack => CBytes -> IO FStat
lstat :: CBytes -> IO FStat
lstat CBytes
path = CBytes -> (BA# Word8 -> IO FStat) -> IO FStat
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO FStat) -> IO FStat)
-> (BA# Word8 -> IO FStat) -> IO FStat
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
     Int -> (Ptr FStat -> IO FStat) -> IO FStat
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr FStat -> IO FStat) -> IO FStat)
-> (Ptr FStat -> IO FStat) -> IO FStat
forall a b. (a -> b) -> a -> b
$ \ Ptr FStat
s -> do
        IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (BA# Word8 -> Ptr FStat -> IO Int
hs_uv_fs_lstat BA# Word8
p Ptr FStat
s)
        Ptr FStat -> IO FStat
peekUVStat Ptr FStat
s

-- | Equivalent to <http://linux.die.net/man/2/stat stat(2)>
--
-- Return 'Nothing' instead of throwing 'NoSuchThing' if the file doesn't exist.
stat' :: HasCallStack => CBytes -> IO (Maybe FStat)
stat' :: CBytes -> IO (Maybe FStat)
stat' CBytes
path = CBytes -> (BA# Word8 -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO (Maybe FStat)) -> IO (Maybe FStat))
-> (BA# Word8 -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
     Int -> (Ptr FStat -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr FStat -> IO (Maybe FStat)) -> IO (Maybe FStat))
-> (Ptr FStat -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a b. (a -> b) -> a -> b
$ \ Ptr FStat
s -> do
        FD
r <- Int -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> FD) -> IO Int -> IO FD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BA# Word8 -> Ptr FStat -> IO Int
hs_uv_fs_stat BA# Word8
p Ptr FStat
s
        if  | FD
r FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
UV_ENOENT -> Maybe FStat -> IO (Maybe FStat)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FStat
forall a. Maybe a
Nothing
            | FD
r FD -> FD -> Bool
forall a. Ord a => a -> a -> Bool
< FD
0 -> FD -> IO (Maybe FStat)
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV FD
r
            | Bool
otherwise -> FStat -> Maybe FStat
forall a. a -> Maybe a
Just (FStat -> Maybe FStat) -> IO FStat -> IO (Maybe FStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr FStat -> IO FStat
peekUVStat Ptr FStat
s

-- | Equivalent to <http://linux.die.net/man/2/lstat lstat(2)>
--
-- Return 'Nothing' instead of throwing 'NoSuchThing' if the link doesn't exist.
lstat' :: HasCallStack => CBytes -> IO (Maybe FStat)
lstat' :: CBytes -> IO (Maybe FStat)
lstat' CBytes
path = CBytes -> (BA# Word8 -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO (Maybe FStat)) -> IO (Maybe FStat))
-> (BA# Word8 -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
     Int -> (Ptr FStat -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr FStat -> IO (Maybe FStat)) -> IO (Maybe FStat))
-> (Ptr FStat -> IO (Maybe FStat)) -> IO (Maybe FStat)
forall a b. (a -> b) -> a -> b
$ \ Ptr FStat
s -> do
        FD
r <- Int -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> FD) -> IO Int -> IO FD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BA# Word8 -> Ptr FStat -> IO Int
hs_uv_fs_lstat BA# Word8
p Ptr FStat
s
        if  | FD
r FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
UV_ENOENT -> Maybe FStat -> IO (Maybe FStat)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FStat
forall a. Maybe a
Nothing
            | FD
r FD -> FD -> Bool
forall a. Ord a => a -> a -> Bool
< FD
0 -> FD -> IO (Maybe FStat)
forall a b. (Integral a, HasCallStack) => a -> IO b
throwUV FD
r
            | Bool
otherwise -> FStat -> Maybe FStat
forall a. a -> Maybe a
Just (FStat -> Maybe FStat) -> IO FStat -> IO (Maybe FStat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr FStat -> IO FStat
peekUVStat Ptr FStat
s

-- | Equivalent to <http://linux.die.net/man/2/fstat fstat(2)>
fstat :: HasCallStack => File -> IO FStat
fstat :: File -> IO FStat
fstat File
uvf = File -> (FD -> IO FStat) -> IO FStat
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO FStat) -> IO FStat) -> (FD -> IO FStat) -> IO FStat
forall a b. (a -> b) -> a -> b
$ \ FD
fd ->
    Int -> (Ptr FStat -> IO FStat) -> IO FStat
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr FStat -> IO FStat) -> IO FStat)
-> (Ptr FStat -> IO FStat) -> IO FStat
forall a b. (a -> b) -> a -> b
$ \ Ptr FStat
s -> do
        IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (FD -> Ptr FStat -> IO Int
hs_uv_fs_fstat FD
fd Ptr FStat
s)
        Ptr FStat -> IO FStat
peekUVStat Ptr FStat
s

--------------------------------------------------------------------------------

-- | Equivalent to <http://linux.die.net/man/2/rename rename(2)>.
--
-- Note On Windows if this function fails with UV_EBUSY, UV_EPERM or UV_EACCES, it will retry to rename the file up to four times with 250ms wait between attempts before giving up. If both path and new_path are existing directories this function will work only if target directory is empty.
rename :: HasCallStack => CBytes -> CBytes -> IO ()
rename :: CBytes -> CBytes -> IO ()
rename CBytes
path CBytes
path' = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
    CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path' (BA# Word8 -> BA# Word8 -> IO Int
hs_uv_fs_rename BA# Word8
p)

-- | Equivalent to <http://linux.die.net/man/2/fsync fsync(2)>.
fsync :: HasCallStack => File -> IO ()
fsync :: File -> IO ()
fsync File
uvf = File -> (FD -> IO ()) -> IO ()
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO ()) -> IO ()) -> (FD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FD
fd -> IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ FD -> IO Int
hs_uv_fs_fsync FD
fd

-- | Equivalent to <http://linux.die.net/man/2/fdatasync fdatasync(2)>.
fdatasync :: HasCallStack => File -> IO ()
fdatasync :: File -> IO ()
fdatasync File
uvf = File -> (FD -> IO ()) -> IO ()
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO ()) -> IO ()) -> (FD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FD
fd -> IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ FD -> IO Int
hs_uv_fs_fdatasync FD
fd

-- | Equivalent to <http://linux.die.net/man/2/ftruncate ftruncate(2)>.
ftruncate :: HasCallStack => File -> Int64 -> IO ()
ftruncate :: File -> Int64 -> IO ()
ftruncate File
uvf Int64
off = File -> (FD -> IO ()) -> IO ()
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO ()) -> IO ()) -> (FD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FD
fd -> IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ FD -> Int64 -> IO Int
hs_uv_fs_ftruncate FD
fd Int64
off

-- | Copies a file from path to new_path.
--
-- Warning: If the destination path is created, but an error occurs while copying the data, then the destination path is removed. There is a brief window of time between closing and removing the file where another process could access the file.
copyfile :: HasCallStack => CBytes -> CBytes -> CopyFileFlag -> IO ()
copyfile :: CBytes -> CBytes -> FD -> IO ()
copyfile CBytes
path CBytes
path' FD
flag = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
    CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path' ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p' -> BA# Word8 -> BA# Word8 -> FD -> IO Int
hs_uv_fs_copyfile BA# Word8
p BA# Word8
p' FD
flag

-- | Equivalent to <http://linux.die.net/man/2/access access(2)> on Unix.
--
-- Windows uses GetFileAttributesW().
access :: HasCallStack => CBytes -> AccessMode -> IO AccessResult
access :: CBytes -> FD -> IO AccessResult
access CBytes
path FD
mode = do
     FD
r <- CBytes -> (BA# Word8 -> IO FD) -> IO FD
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO FD) -> IO FD) -> (BA# Word8 -> IO FD) -> IO FD
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> Int -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> FD) -> IO Int -> IO FD
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BA# Word8 -> FD -> IO Int
hs_uv_fs_access BA# Word8
p FD
mode
     if | FD
r FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
0           -> AccessResult -> IO AccessResult
forall (m :: * -> *) a. Monad m => a -> m a
return AccessResult
AccessOK
        | FD
r FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
UV_ENOENT   -> AccessResult -> IO AccessResult
forall (m :: * -> *) a. Monad m => a -> m a
return AccessResult
NoExistence
        | FD
r FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
UV_EACCES   -> AccessResult -> IO AccessResult
forall (m :: * -> *) a. Monad m => a -> m a
return AccessResult
NoPermission
        | Bool
otherwise        -> do
            Text
name <- FD -> IO Text
uvErrName FD
r
            Text
desc <- FD -> IO Text
uvStdError FD
r
            FD -> IOEInfo -> IO AccessResult
forall a. FD -> IOEInfo -> IO a
throwUVError FD
r (Text -> Text -> CallStack -> IOEInfo
IOEInfo Text
name Text
desc CallStack
HasCallStack => CallStack
callStack)

-- | Equivalent to <http://linux.die.net/man/2/chmod chmod(2)>.
chmod :: HasCallStack => CBytes -> FileMode -> IO ()
chmod :: CBytes -> FD -> IO ()
chmod CBytes
path FD
mode = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> BA# Word8 -> FD -> IO Int
hs_uv_fs_chmod BA# Word8
p FD
mode

-- | Equivalent to <http://linux.die.net/man/2/fchmod fchmod(2)>.
fchmod :: HasCallStack => File -> FileMode -> IO ()
fchmod :: File -> FD -> IO ()
fchmod File
uvf FD
mode = File -> (FD -> IO ()) -> IO ()
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO ()) -> IO ()) -> (FD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FD
fd -> IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ FD -> FD -> IO Int
hs_uv_fs_fchmod FD
fd FD
mode

-- | Equivalent to <http://linux.die.net/man/2/utime utime(2)>.
--
-- libuv choose 'Double' type due to cross platform concerns, we only provide micro-second precision.
utime :: HasCallStack
      => CBytes
      -> Double     -- ^ atime, i.e. access time
      -> Double     -- ^ mtime, i.e. modify time
      -> IO ()
utime :: CBytes -> Double -> Double -> IO ()
utime CBytes
path Double
atime Double
mtime = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> BA# Word8 -> Double -> Double -> IO Int
hs_uv_fs_utime BA# Word8
p Double
atime Double
mtime

-- | Equivalent to <https://man7.org/linux/man-pages/man3/futimes.3.html futime(3)>.
--
-- Same precision notes with 'utime'.
futime :: HasCallStack => File -> Double -> Double -> IO ()
futime :: File -> Double -> Double -> IO ()
futime File
uvf Double
atime Double
mtime = File -> (FD -> IO ()) -> IO ()
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO ()) -> IO ()) -> (FD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FD
fd ->
    IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (FD -> Double -> Double -> IO Int
hs_uv_fs_futime FD
fd Double
atime Double
mtime)

-- | Equivalent to <https://man7.org/linux/man-pages/man3/lutimes.3.html lutime(3)>.
--
-- Same precision notes with 'utime'.
lutime :: HasCallStack
       => CBytes
       -> Double     -- ^ atime, i.e. access time
       -> Double     -- ^ mtime, i.e. modify time
       -> IO ()
lutime :: CBytes -> Double -> Double -> IO ()
lutime CBytes
path Double
atime Double
mtime = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> BA# Word8 -> Double -> Double -> IO Int
hs_uv_fs_lutime BA# Word8
p Double
atime Double
mtime

-- | Equivalent to <http://linux.die.net/man/2/link link(2)>.
link :: HasCallStack => CBytes -> CBytes -> IO ()
link :: CBytes -> CBytes -> IO ()
link CBytes
path CBytes
path' = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
    CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path' ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ BA# Word8 -> BA# Word8 -> IO Int
hs_uv_fs_link BA# Word8
p

-- | Equivalent to <http://linux.die.net/man/2/symlink symlink(2)>.
--
-- | Note On Windows the flags parameter can be specified to control how the symlink will be created.
--
--   * 'SYMLINK_DIR': indicates that path points to a directory.
--   * 'SYMLINK_JUNCTION': request that the symlink is created using junction points.
--
-- On other platforms these flags are ignored.
symlink :: HasCallStack => CBytes -> CBytes -> SymlinkFlag -> IO ()
symlink :: CBytes -> CBytes -> FD -> IO ()
symlink CBytes
path CBytes
path' FD
flag = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
    CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path' ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p' -> BA# Word8 -> BA# Word8 -> FD -> IO Int
hs_uv_fs_symlink BA# Word8
p BA# Word8
p' FD
flag

-- | Equivalent to <http://linux.die.net/man/2/readlink readlink(2)>.
readlink :: HasCallStack => CBytes -> IO CBytes
readlink :: CBytes -> IO CBytes
readlink CBytes
path = do
    IO (CString, Int)
-> ((CString, Int) -> IO ())
-> ((CString, Int) -> IO CBytes)
-> IO CBytes
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (CBytes -> (BA# Word8 -> IO (CString, Int)) -> IO (CString, Int)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO (CString, Int)) -> IO (CString, Int))
-> (BA# Word8 -> IO (CString, Int)) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
            (MBA# Word8 -> IO Int) -> IO (CString, Int)
forall a b. Prim a => (MBA# Word8 -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# Word8 -> IO Int) -> IO (CString, Int))
-> (MBA# Word8 -> IO Int) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ MBA# Word8
p' ->
                IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (BA# Word8 -> MBA# Word8 -> IO Int
hs_uv_fs_readlink BA# Word8
p MBA# Word8
p'))
        (CString -> IO ()
hs_uv_fs_readlink_cleanup (CString -> IO ())
-> ((CString, Int) -> CString) -> (CString, Int) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString, Int) -> CString
forall a b. (a, b) -> a
fst)
        (CString -> IO CBytes
fromCString (CString -> IO CBytes)
-> ((CString, Int) -> CString) -> (CString, Int) -> IO CBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString, Int) -> CString
forall a b. (a, b) -> a
fst)


-- | Equivalent to <http://linux.die.net/man/3/realpath realpath(3)> on Unix. Windows uses <https://msdn.microsoft.com/en-us/library/windows/desktop/aa364962(v=vs.85).aspx GetFinalPathNameByHandle>.
--
-- Warning This function has certain platform-specific caveats that were discovered when used in Node.
--
--  * macOS and other BSDs: this function will fail with UV_ELOOP if more than 32 symlinks are found while
--    resolving the given path. This limit is hardcoded and cannot be sidestepped.
--
--  * Windows: while this function works in the common case, there are a number of corner cases where it doesn’t:
--
--      * Paths in ramdisk volumes created by tools which sidestep the Volume Manager (such as ImDisk) cannot be resolved.
--      * Inconsistent casing when using drive letters.
--      * Resolved path bypasses subst’d drives.
--
-- While this function can still be used, it’s not recommended if scenarios such as the above need to be supported.
-- The background story and some more details on these issues can be checked <https://github.com/nodejs/node/issues/7726 here>.
--
-- Note This function is not implemented on Windows XP and Windows Server 2003. On these systems, UV_ENOSYS is returned.
realpath :: HasCallStack => CBytes -> IO CBytes
realpath :: CBytes -> IO CBytes
realpath CBytes
path = do
    IO (CString, Int)
-> ((CString, Int) -> IO ())
-> ((CString, Int) -> IO CBytes)
-> IO CBytes
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (CBytes -> (BA# Word8 -> IO (CString, Int)) -> IO (CString, Int)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO (CString, Int)) -> IO (CString, Int))
-> (BA# Word8 -> IO (CString, Int)) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p ->
            (MBA# Word8 -> IO Int) -> IO (CString, Int)
forall a b. Prim a => (MBA# Word8 -> IO b) -> IO (a, b)
allocPrimUnsafe ((MBA# Word8 -> IO Int) -> IO (CString, Int))
-> (MBA# Word8 -> IO Int) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ MBA# Word8
p' ->
                IO Int -> IO Int
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwUVIfMinus (BA# Word8 -> MBA# Word8 -> IO Int
hs_uv_fs_realpath BA# Word8
p MBA# Word8
p'))
        (CString -> IO ()
hs_uv_fs_readlink_cleanup (CString -> IO ())
-> ((CString, Int) -> CString) -> (CString, Int) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString, Int) -> CString
forall a b. (a, b) -> a
fst)
        (CString -> IO CBytes
fromCString (CString -> IO CBytes)
-> ((CString, Int) -> CString) -> (CString, Int) -> IO CBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString, Int) -> CString
forall a b. (a, b) -> a
fst)

-- | Equivalent to <http://linux.die.net/man/2/chown chown(2)>.
chown :: HasCallStack => CBytes -> UID -> GID -> IO ()
chown :: CBytes -> UID -> GID -> IO ()
chown CBytes
path UID
uid GID
gid = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> BA# Word8 -> UID -> GID -> IO Int
hs_uv_fs_chown BA# Word8
p UID
uid GID
gid

-- | Equivalent to <http://linux.die.net/man/2/fchown fchown(2)>.
fchown :: HasCallStack => File -> UID -> GID -> IO ()
fchown :: File -> UID -> GID -> IO ()
fchown File
uvf UID
uid GID
gid = File -> (FD -> IO ()) -> IO ()
forall a. HasCallStack => File -> (FD -> IO a) -> IO a
checkFileClosed File
uvf ((FD -> IO ()) -> IO ()) -> (FD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ FD
fd -> IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ FD -> UID -> GID -> IO Int
hs_uv_fs_fchown FD
fd UID
uid GID
gid

-- | Equivalent to <http://linux.die.net/man/2/lchown lchown(2)>.
lchown :: HasCallStack => CBytes -> UID -> GID -> IO ()
lchown :: CBytes -> UID -> GID -> IO ()
lchown CBytes
path UID
uid GID
gid = IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ())
-> ((BA# Word8 -> IO Int) -> IO Int)
-> (BA# Word8 -> IO Int)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBytes -> (BA# Word8 -> IO Int) -> IO Int
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
path ((BA# Word8 -> IO Int) -> IO ()) -> (BA# Word8 -> IO Int) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
p -> BA# Word8 -> UID -> GID -> IO Int
hs_uv_fs_lchown BA# Word8
p UID
uid GID
gid