{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

This module provide IO operations related to filesystem, operations are implemented using libuv's threadpool to achieve non-block behavior (non-block here meaning won't block other haskell threads), which should be prefered when the operations' estimated time is long enough(>1ms) or running with a non-threaded haskell runtime, such as accessing network filesystem or scan a very large directory. Otherwise you may block RTS's capability thus all the other haskell threads live on it.

The threadpool version operations have overheads similar to safe FFI, but provide same adventages:

  * The libuv's threadpool have a limit on concurrent threads number (4 by default), which can reduce disk contention.
  * The threadpool version works with non-threaded runtime, which doesn't have safe FFI available.
  * The threadpool version won't relinquish current HEC (Haskell Execution Context) a.k.a. capability.

-}

module Z.IO.FileSystem.Threaded
  ( -- * regular file devices
    FileT, checkFileTClosed
  , initFileT, readFileT, writeFileT
    -- * opening constant
  , 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
      )
  -- * filesystem operations
  , mkdir
  , unlink
  , mkdtemp
  , rmdir
  , DirEntType(..)
  , scandir
  , UVStat(..), UVTimeSpec(..)
  , stat, lstat, fstat
  , rename
  , fsync, fdatasync
  , ftruncate
  , UVCopyFileFlag(COPYFILE_DEFAULT, COPYFILE_EXCL, COPYFILE_FICLONE)
  , copyfile
  , UVAccessMode(F_OK, R_OK, W_OK, X_OK)
  , AccessResult(..)
  , access
  , chmod, fchmod
  , utime, futime
  , UVSymlinkFlag(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           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

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

-- | 'FileT' and its operations are NOT thread safe, use 'MVar' 'FileT' in multiple threads.
--
-- Note this is a differet data type from "Z.IO.FileSystem" \'s one, the 'Input'
-- and 'Output' instance use thread pool version functions.
--
-- 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 'readFileT' \/ 'writeFileT'.
--
data FileT =  FileT  {-# UNPACK #-} !UVFD      -- ^ the file
                     {-# UNPACK #-} !(IORef Bool)  -- ^ closed flag

-- | If fd is -1 (closed), throw 'ResourceVanished' ECLOSED.
checkFileTClosed :: HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed :: FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed (FileT UVFD
fd IORef Bool
closedRef) UVFD -> 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 UVFD -> IO a
f UVFD
fd

instance Input FileT where
    readInput :: FileT -> Ptr Word8 -> Int -> IO Int
readInput FileT
f Ptr Word8
buf Int
bufSiz = HasCallStack => FileT -> Ptr Word8 -> Int -> Int64 -> IO Int
FileT -> Ptr Word8 -> Int -> Int64 -> IO Int
readFileT FileT
f Ptr Word8
buf Int
bufSiz (-Int64
1)

-- | Read file with given offset
--
-- Read length may be smaller than buffer size.
readFileT :: HasCallStack
          => FileT
          -> Ptr Word8 -- ^ buffer
          -> Int       -- ^ buffer size
          -> Int64     -- ^ file offset, pass -1 to use default(system) offset
          -> IO Int    -- ^ read length
readFileT :: FileT -> Ptr Word8 -> Int -> Int64 -> IO Int
readFileT FileT
uvf Ptr Word8
buf Int
bufSiz Int64
off =
    FileT -> (UVFD -> IO Int) -> IO Int
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf  ((UVFD -> IO Int) -> IO Int) -> (UVFD -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd -> do
        UVManager
uvm <- IO UVManager
getUVManager
        HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
withUVRequest UVManager
uvm (UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_read_threaded UVFD
fd Ptr Word8
buf Int
bufSiz Int64
off)

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

-- | Write buffer to file
--
-- This function will loop until all bytes are written.
writeFileT :: HasCallStack
           => FileT
           -> Ptr Word8 -- ^ buffer
           -> Int       -- ^ buffer size
           -> Int64     -- ^ file offset, pass -1 to use default(system) offset
           -> IO ()
writeFileT :: FileT -> Ptr Word8 -> Int -> Int64 -> IO ()
writeFileT FileT
uvf Ptr Word8
buf0 Int
bufSiz0 Int64
off0 =
    FileT -> (UVFD -> IO ()) -> IO ()
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf ((UVFD -> IO ()) -> IO ()) -> (UVFD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd -> do
             (if Int64
off0 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int64
1 then UVFD -> Ptr Word8 -> Int -> IO ()
go UVFD
fd Ptr Word8
buf0 Int
bufSiz0
                            else UVFD -> Ptr Word8 -> Int -> Int64 -> IO ()
go' UVFD
fd Ptr Word8
buf0 Int
bufSiz0 Int64
off0)
  where
    -- use -1 offset to use fd's default offset
    go :: UVFD -> Ptr Word8 -> Int -> IO ()
go UVFD
fd Ptr Word8
buf Int
bufSiz = do
        UVManager
uvm <- IO UVManager
getUVManager
        Int
written <- HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
withUVRequest UVManager
uvm
            (UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_write_threaded UVFD
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)
            (UVFD -> Ptr Word8 -> Int -> IO ()
go UVFD
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' :: UVFD -> Ptr Word8 -> Int -> Int64 -> IO ()
go' UVFD
fd Ptr Word8
buf Int
bufSiz !Int64
off = do
        UVManager
uvm <- IO UVManager
getUVManager
        Int
written <- HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
withUVRequest UVManager
uvm
            (UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_write_threaded UVFD
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
$
            UVFD -> Ptr Word8 -> Int -> Int64 -> IO ()
go' UVFD
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 will wait for the referencing counter goes
-- down to zero (no reading or writing is in process), which can
-- be a problem if you are using multiple readers or writers in multiple threads.
-- In that case you have to stop all reading or writing thread if you don't want to
-- block the resource thread.
initFileT :: 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_MODE'.
          -> Resource FileT
initFileT :: CBytes -> FileFlag -> FileMode -> Resource FileT
initFileT CBytes
path FileFlag
flags FileMode
mode =
    IO FileT -> (FileT -> IO ()) -> Resource FileT
forall a. IO a -> (a -> IO ()) -> Resource a
initResource
        (do UVManager
uvm <- IO UVManager
getUVManager
            Int
fd <- CBytes -> (CString -> IO Int) -> IO Int
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
                HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
withUVRequest UVManager
uvm (CString -> FileFlag -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_open_threaded CString
p FileFlag
flags FileMode
mode)
            UVFD -> IORef Bool -> FileT
FileT (Int -> UVFD
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fd) (IORef Bool -> FileT) -> IO (IORef Bool) -> IO FileT
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)
        (\ (FileT UVFD
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_ (UVFD -> IO Int
hs_uv_fs_close UVFD
fd)
                IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
closedRef Bool
True)

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

-- | Equivalent to <http://linux.die.net/man/2/mkdir mkdir(2)>.
--
-- Note mode is currently not implemented on Windows.
mkdir :: HasCallStack => CBytes -> FileMode -> IO ()
mkdir :: CBytes -> FileMode -> IO ()
mkdir CBytes
path FileMode
mode = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_mkdir_threaded CString
p FileMode
mode)

-- | Equivalent to <http://linux.die.net/man/2/unlink unlink(2)>.
unlink :: HasCallStack => CBytes -> IO ()
unlink :: CBytes -> IO ()
unlink CBytes
path = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_unlink_threaded CString
p)

-- | 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 -> (CString -> IO CBytes) -> IO CBytes
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO CBytes) -> IO CBytes)
-> (CString -> IO CBytes) -> IO CBytes
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        HasCallStack => Int -> (CString -> IO Int) -> IO CBytes
Int -> (CString -> IO Int) -> IO CBytes
CBytes.create (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
7) ((CString -> IO Int) -> IO CBytes)
-> (CString -> IO Int) -> IO CBytes
forall a b. (a -> b) -> a -> b
$ \ CString
p' -> do  -- we append "XXXXXX\NUL" in C
            UVManager
uvm <- IO UVManager
getUVManager
            HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> Int -> CString -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_mkdtemp_threaded CString
p Int
size CString
p')
            Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
6)

-- | Equivalent to <http://linux.die.net/man/2/rmdir rmdir(2)>.
rmdir :: HasCallStack => CBytes -> IO ()
rmdir :: CBytes -> IO ()
rmdir CBytes
path = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path (IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> (CString -> IO Int) -> CString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int
withUVRequest UVManager
uvm ((Ptr UVLoop -> IO UVSlotUnSafe) -> IO Int)
-> (CString -> Ptr UVLoop -> IO UVSlotUnSafe) -> CString -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_rmdir_threaded)

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

-- | 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
    UVManager
uvm <- IO UVManager
getUVManager
    IO (Ptr (Ptr UVDirEnt), Int)
-> ((Ptr (Ptr UVDirEnt), Int) -> IO ())
-> ((Ptr (Ptr UVDirEnt), Int) -> IO [(CBytes, DirEntType)])
-> IO [(CBytes, DirEntType)]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (CBytes
-> (CString -> IO (Ptr (Ptr UVDirEnt), Int))
-> IO (Ptr (Ptr UVDirEnt), Int)
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO (Ptr (Ptr UVDirEnt), Int))
 -> IO (Ptr (Ptr UVDirEnt), Int))
-> (CString -> IO (Ptr (Ptr UVDirEnt), Int))
-> IO (Ptr (Ptr UVDirEnt), Int)
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
            (Ptr (Ptr (Ptr UVDirEnt)) -> IO Int)
-> IO (Ptr (Ptr UVDirEnt), Int)
forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
allocPrimSafe ((Ptr (Ptr (Ptr UVDirEnt)) -> IO Int)
 -> IO (Ptr (Ptr UVDirEnt), Int))
-> (Ptr (Ptr (Ptr UVDirEnt)) -> IO Int)
-> IO (Ptr (Ptr UVDirEnt), Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr (Ptr UVDirEnt))
dents ->
                HasCallStack =>
UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO ()) -> IO Int
UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO ()) -> IO Int
withUVRequestEx UVManager
uvm
                    (CString
-> Ptr (Ptr (Ptr UVDirEnt)) -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_scandir_threaded CString
p Ptr (Ptr (Ptr UVDirEnt))
dents)
                    (Ptr (Ptr (Ptr UVDirEnt)) -> Int -> IO ()
hs_uv_fs_scandir_extra_cleanup Ptr (Ptr (Ptr UVDirEnt))
dents))
        (\ (Ptr (Ptr UVDirEnt)
dents, Int
n) -> Ptr (Ptr UVDirEnt) -> Int -> IO ()
hs_uv_fs_scandir_cleanup Ptr (Ptr UVDirEnt)
dents Int
n)
        (\ (Ptr (Ptr UVDirEnt)
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 UVDirEnt
dent <- Ptr (Ptr UVDirEnt) -> Int -> IO (Ptr UVDirEnt)
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr (Ptr UVDirEnt)
dents Int
i
            (CString
p, UVDirEntType
typ) <- Ptr UVDirEnt -> IO (CString, UVDirEntType)
peekUVDirEnt Ptr UVDirEnt
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'))

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

-- | Equivalent to <http://linux.die.net/man/2/stat stat(2)>
stat :: HasCallStack => CBytes -> IO UVStat
stat :: CBytes -> IO UVStat
stat CBytes
path = do
    CBytes -> (CString -> IO UVStat) -> IO UVStat
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO UVStat) -> IO UVStat)
-> (CString -> IO UVStat) -> IO UVStat
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
         Int -> (Ptr UVStat -> IO UVStat) -> IO UVStat
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr UVStat -> IO UVStat) -> IO UVStat)
-> (Ptr UVStat -> IO UVStat) -> IO UVStat
forall a b. (a -> b) -> a -> b
$ \ Ptr UVStat
s -> do
            UVManager
uvm <- IO UVManager
getUVManager
            HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_stat_threaded CString
p Ptr UVStat
s)
            Ptr UVStat -> IO UVStat
peekUVStat Ptr UVStat
s

-- | Equivalent to <http://linux.die.net/man/2/lstat lstat(2)>
lstat :: HasCallStack => CBytes -> IO UVStat
lstat :: CBytes -> IO UVStat
lstat CBytes
path =
    CBytes -> (CString -> IO UVStat) -> IO UVStat
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO UVStat) -> IO UVStat)
-> (CString -> IO UVStat) -> IO UVStat
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
         Int -> (Ptr UVStat -> IO UVStat) -> IO UVStat
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr UVStat -> IO UVStat) -> IO UVStat)
-> (Ptr UVStat -> IO UVStat) -> IO UVStat
forall a b. (a -> b) -> a -> b
$ \ Ptr UVStat
s -> do
            UVManager
uvm <- IO UVManager
getUVManager
            HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_lstat_threaded CString
p Ptr UVStat
s)
            Ptr UVStat -> IO UVStat
peekUVStat Ptr UVStat
s

-- | Equivalent to <http://linux.die.net/man/2/fstat fstat(2)>
fstat :: HasCallStack => FileT -> IO UVStat
fstat :: FileT -> IO UVStat
fstat FileT
uvf = FileT -> (UVFD -> IO UVStat) -> IO UVStat
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf ((UVFD -> IO UVStat) -> IO UVStat)
-> (UVFD -> IO UVStat) -> IO UVStat
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd ->
     (Int -> (Ptr UVStat -> IO UVStat) -> IO UVStat
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
uvStatSize ((Ptr UVStat -> IO UVStat) -> IO UVStat)
-> (Ptr UVStat -> IO UVStat) -> IO UVStat
forall a b. (a -> b) -> a -> b
$ \ Ptr UVStat
s -> do
        UVManager
uvm <- IO UVManager
getUVManager
        HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (UVFD -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_fstat_threaded UVFD
fd Ptr UVStat
s)
        Ptr UVStat -> IO UVStat
peekUVStat Ptr UVStat
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' = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path' ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p' ->
            HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> CString -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_rename_threaded CString
p CString
p')

-- | Equivalent to <http://linux.die.net/man/2/fsync fsync(2)>.
fsync :: HasCallStack => FileT -> IO ()
fsync :: FileT -> IO ()
fsync FileT
uvf = FileT -> (UVFD -> IO ()) -> IO ()
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf ((UVFD -> IO ()) -> IO ()) -> (UVFD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd -> do
    UVManager
uvm <- IO UVManager
getUVManager
    HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (UVFD -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_fsync_threaded UVFD
fd)

-- | Equivalent to <http://linux.die.net/man/2/fdatasync fdatasync(2)>.
fdatasync :: HasCallStack => FileT -> IO ()
fdatasync :: FileT -> IO ()
fdatasync FileT
uvf = FileT -> (UVFD -> IO ()) -> IO ()
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf ((UVFD -> IO ()) -> IO ()) -> (UVFD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd -> do
    UVManager
uvm <- IO UVManager
getUVManager
    HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (UVFD -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_fdatasync_threaded UVFD
fd)

-- | Equivalent to <http://linux.die.net/man/2/ftruncate ftruncate(2)>.
ftruncate :: HasCallStack => FileT -> Int64 -> IO ()
ftruncate :: FileT -> Int64 -> IO ()
ftruncate FileT
uvf Int64
off = FileT -> (UVFD -> IO ()) -> IO ()
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf ((UVFD -> IO ()) -> IO ()) -> (UVFD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd -> do
    UVManager
uvm <- IO UVManager
getUVManager
    HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (UVFD -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_ftruncate_threaded UVFD
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 -> UVCopyFileFlag -> IO ()
copyfile :: CBytes -> CBytes -> UVCopyFileFlag -> IO ()
copyfile CBytes
path CBytes
path' UVCopyFileFlag
flag = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path' ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p' ->
            HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString
-> CString -> UVCopyFileFlag -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_copyfile_threaded CString
p CString
p' UVCopyFileFlag
flag)

-- | Equivalent to <http://linux.die.net/man/2/access access(2)> on Unix.
-- Windows uses GetFileAttributesW().
access :: HasCallStack => CBytes -> UVAccessMode -> IO AccessResult
access :: CBytes -> UVAccessMode -> IO AccessResult
access CBytes
path UVAccessMode
mode = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO AccessResult) -> IO AccessResult
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO AccessResult) -> IO AccessResult)
-> (CString -> IO AccessResult) -> IO AccessResult
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe)
-> (Int -> IO AccessResult)
-> IO AccessResult
forall b.
HasCallStack =>
UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO b) -> IO b
withUVRequest' UVManager
uvm (CString -> UVAccessMode -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_access_threaded CString
p UVAccessMode
mode) (CInt -> IO AccessResult
handleResult (CInt -> IO AccessResult)
-> (Int -> CInt) -> Int -> IO AccessResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  where
    handleResult :: CInt -> IO AccessResult
handleResult CInt
r
        | CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0           = AccessResult -> IO AccessResult
forall (m :: * -> *) a. Monad m => a -> m a
return AccessResult
AccessOK
        | CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
UV_ENOENT   = AccessResult -> IO AccessResult
forall (m :: * -> *) a. Monad m => a -> m a
return AccessResult
NoExistence
        | CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
UV_EACCES   = AccessResult -> IO AccessResult
forall (m :: * -> *) a. Monad m => a -> m a
return AccessResult
NoPermission
        | Bool
otherwise        = do
            String
name <- CInt -> IO String
uvErrName CInt
r
            String
desc <- CInt -> IO String
uvStdError CInt
r
            CInt -> IOEInfo -> IO AccessResult
forall a. CInt -> IOEInfo -> IO a
throwUVError CInt
r (String -> String -> CallStack -> IOEInfo
IOEInfo String
name String
desc CallStack
HasCallStack => CallStack
callStack)

-- | Equivalent to <http://linux.die.net/man/2/chmod chmod(2)>.
chmod :: HasCallStack => CBytes -> FileMode -> IO ()
chmod :: CBytes -> FileMode -> IO ()
chmod CBytes
path FileMode
mode = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_chmod_threaded CString
p FileMode
mode)

-- | Equivalent to <http://linux.die.net/man/2/fchmod fchmod(2)>.
fchmod :: HasCallStack => FileT -> FileMode -> IO ()
fchmod :: FileT -> FileMode -> IO ()
fchmod FileT
uvf FileMode
mode = FileT -> (UVFD -> IO ()) -> IO ()
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf ((UVFD -> IO ()) -> IO ()) -> (UVFD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd -> do
    UVManager
uvm <- IO UVManager
getUVManager
    HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (UVFD -> FileMode -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_fchmod_threaded UVFD
fd FileMode
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:
--
--   * second     = v
--   * nanosecond = (v * 1000000) % 1000000 * 1000;
--
-- second and nanosecond are fields in 'UVTimeSpec' respectively.
--
-- Note libuv prior to v1.23.1 have issues which may result in nanosecond not set, 'futime' doesn't have
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 = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_utime_threaded CString
p Double
atime Double
mtime)

-- | Equivalent to <http://linux.die.net/man/2/futime futime(2)>.
--
-- Same precision notes with 'utime'.
futime :: HasCallStack => FileT -> Double -> Double -> IO ()
futime :: FileT -> Double -> Double -> IO ()
futime FileT
uvf Double
atime Double
mtime = FileT -> (UVFD -> IO ()) -> IO ()
forall a. HasCallStack => FileT -> (UVFD -> IO a) -> IO a
checkFileTClosed FileT
uvf ((UVFD -> IO ()) -> IO ()) -> (UVFD -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ UVFD
fd -> do
    UVManager
uvm <- IO UVManager
getUVManager
    HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (UVFD -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_futime_threaded UVFD
fd 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' = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path' ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p' ->
            HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString -> CString -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_link_threaded CString
p CString
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 -> UVSymlinkFlag -> IO ()
symlink :: CBytes -> CBytes -> UVSymlinkFlag -> IO ()
symlink CBytes
path CBytes
path' UVSymlinkFlag
flag = do
    UVManager
uvm <- IO UVManager
getUVManager
    CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
        CBytes -> (CString -> IO ()) -> IO ()
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path' ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
p' ->
            HasCallStack =>
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
UVManager -> (Ptr UVLoop -> IO UVSlotUnSafe) -> IO ()
withUVRequest_ UVManager
uvm (CString
-> CString -> UVSymlinkFlag -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_symlink_threaded CString
p CString
p' UVSymlinkFlag
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
    UVManager
uvm <- IO UVManager
getUVManager
    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 -> (CString -> IO (CString, Int)) -> IO (CString, Int)
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO (CString, Int)) -> IO (CString, Int))
-> (CString -> IO (CString, Int)) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
            (Ptr CString -> IO Int) -> IO (CString, Int)
forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
allocPrimSafe ((Ptr CString -> IO Int) -> IO (CString, Int))
-> (Ptr CString -> IO Int) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CString
p' ->
                HasCallStack =>
UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO ()) -> IO Int
UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO ()) -> IO Int
withUVRequestEx UVManager
uvm
                    (CString -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_readlink_threaded CString
p Ptr CString
p')
                    (\ Int
_ -> Ptr CString -> IO ()
hs_uv_fs_readlink_extra_cleanup Ptr CString
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
    UVManager
uvm <- IO UVManager
getUVManager
    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 -> (CString -> IO (CString, Int)) -> IO (CString, Int)
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
path ((CString -> IO (CString, Int)) -> IO (CString, Int))
-> (CString -> IO (CString, Int)) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ CString
p ->
            (Ptr CString -> IO Int) -> IO (CString, Int)
forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
allocPrimSafe ((Ptr CString -> IO Int) -> IO (CString, Int))
-> (Ptr CString -> IO Int) -> IO (CString, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CString
p' ->
                HasCallStack =>
UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO ()) -> IO Int
UVManager
-> (Ptr UVLoop -> IO UVSlotUnSafe) -> (Int -> IO ()) -> IO Int
withUVRequestEx UVManager
uvm
                    (CString -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnSafe
hs_uv_fs_realpath_threaded CString
p Ptr CString
p')
                    (\ Int
_ -> Ptr CString -> IO ()
hs_uv_fs_readlink_extra_cleanup Ptr CString
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)