{-# LINE 1 "Std/IO/UV/FFI.hsc" #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE UnliftedFFITypes           #-}

{-|
Module      : Std.IO.UV
Description : libuv operations
Copyright   : (c) Winterland, 2017-2018
License     : BSD
Maintainer  : drkoster@qq.com
Stability   : experimental
Portability : non-portable

INTERNAL MODULE, provides all libuv side operations.

-}

module Std.IO.UV.FFI where

import           Data.Bits
import           Data.Int
import           Data.Word
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Ptr
import           Foreign.Storable
import           GHC.Prim
import           Std.Foreign.PrimArray
import           Std.IO.Exception
import           Std.IO.SockAddr    (SockAddr, SocketFamily (..))
import           System.Posix.Types (CSsize (..))
import           GHC.Generics



{-# LINE 40 "Std/IO/UV/FFI.hsc" #-}


{-# LINE 42 "Std/IO/UV/FFI.hsc" #-}

--------------------------------------------------------------------------------
-- libuv version
foreign import ccall unsafe uv_version :: IO CUInt
foreign import ccall unsafe uv_version_string :: IO CString

--------------------------------------------------------------------------------
-- Type alias
type UVSlot = Int
-- | UVSlotUnSafe wrap a slot which may not have a 'MVar' in blocking table, 
--   i.e. the blocking table need to be resized.
newtype UVSlotUnSafe = UVSlotUnSafe { unsafeGetSlot :: UVSlot }
type UVFD = Int32

--------------------------------------------------------------------------------
-- CONSTANT

pattern ACCEPT_BUFFER_SIZE :: Int
pattern ACCEPT_BUFFER_SIZE = 1024
{-# LINE 61 "Std/IO/UV/FFI.hsc" #-}
pattern SO_REUSEPORT_LOAD_BALANCE :: Int
pattern SO_REUSEPORT_LOAD_BALANCE = 1
{-# LINE 63 "Std/IO/UV/FFI.hsc" #-}
pattern INIT_LOOP_SIZE :: Int
pattern INIT_LOOP_SIZE = 128
{-# LINE 65 "Std/IO/UV/FFI.hsc" #-}

--------------------------------------------------------------------------------
-- loop
data UVLoop
data UVLoopData

peekUVEventQueue :: Ptr UVLoopData -> IO (Int, Ptr Int)
peekUVEventQueue p = (,)
    <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
{-# LINE 74 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
{-# LINE 75 "Std/IO/UV/FFI.hsc" #-}

clearUVEventCounter :: Ptr UVLoopData -> IO ()
clearUVEventCounter p = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) p $ (0 :: Int)
{-# LINE 79 "Std/IO/UV/FFI.hsc" #-}

peekUVBufferTable :: Ptr UVLoopData -> IO (Ptr (Ptr Word8), Ptr CSsize)
peekUVBufferTable p = (,)
    <$> ((\hsc_ptr -> peekByteOff hsc_ptr 16) p)
{-# LINE 83 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 24) p)
{-# LINE 84 "Std/IO/UV/FFI.hsc" #-}

newtype UVRunMode = UVRunMode CInt
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

pattern UV_RUN_DEFAULT :: UVRunMode
pattern UV_RUN_DEFAULT = UVRunMode 0
{-# LINE 90 "Std/IO/UV/FFI.hsc" #-}
pattern UV_RUN_ONCE :: UVRunMode
pattern UV_RUN_ONCE    = UVRunMode 1
{-# LINE 92 "Std/IO/UV/FFI.hsc" #-}
pattern UV_RUN_NOWAIT :: UVRunMode
pattern UV_RUN_NOWAIT  = UVRunMode 2
{-# LINE 94 "Std/IO/UV/FFI.hsc" #-}

-- | Peek loop data pointer from uv loop  pointer.
peekUVLoopData :: Ptr UVLoop -> IO (Ptr UVLoopData)
peekUVLoopData p = (\hsc_ptr -> peekByteOff hsc_ptr 0) p
{-# LINE 98 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_loop_init      :: Int -> IO (Ptr UVLoop)
foreign import ccall unsafe hs_uv_loop_close     :: Ptr UVLoop -> IO ()

-- | uv_run with usafe FFI.
foreign import ccall unsafe "hs_uv_run" uv_run    :: Ptr UVLoop -> UVRunMode -> IO CInt

-- | uv_run with safe FFI.
foreign import ccall safe "hs_uv_run" uv_run_safe :: Ptr UVLoop -> UVRunMode -> IO CInt

foreign import ccall unsafe uv_loop_alive :: Ptr UVLoop -> IO CInt

--------------------------------------------------------------------------------
-- thread safe wake up

foreign import ccall unsafe hs_uv_wake_up_timer :: Ptr UVLoopData -> IO CInt
foreign import ccall unsafe hs_uv_wake_up_async :: Ptr UVLoopData -> IO CInt

--------------------------------------------------------------------------------
-- handle
data UVHandle

peekUVHandleData :: Ptr UVHandle -> IO UVSlotUnSafe
peekUVHandleData p =  UVSlotUnSafe <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0) p :: IO Int)
{-# LINE 122 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fileno :: Ptr UVHandle -> IO UVFD
foreign import ccall unsafe hs_uv_handle_alloc :: Ptr UVLoop -> IO (Ptr UVHandle)
foreign import ccall unsafe hs_uv_handle_free  :: Ptr UVHandle -> IO ()
foreign import ccall unsafe hs_uv_handle_close :: Ptr UVHandle -> IO ()

--------------------------------------------------------------------------------
-- request

foreign import ccall unsafe hs_uv_cancel :: Ptr UVLoop -> UVSlot -> IO ()

--------------------------------------------------------------------------------
-- stream

foreign import ccall unsafe hs_uv_listen  :: Ptr UVHandle -> CInt -> IO CInt
foreign import ccall unsafe hs_uv_listen_resume :: Ptr UVHandle -> IO ()

foreign import ccall unsafe hs_uv_read_start :: Ptr UVHandle -> IO CInt
foreign import ccall unsafe hs_uv_write :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnSafe

foreign import ccall unsafe hs_uv_accept_check_alloc :: Ptr UVHandle -> IO (Ptr UVHandle)
foreign import ccall unsafe hs_uv_accept_check_init :: Ptr UVHandle -> IO CInt
foreign import ccall unsafe hs_uv_accept_check_close :: Ptr UVHandle -> IO ()

--------------------------------------------------------------------------------
-- tcp
foreign import ccall unsafe hs_uv_tcp_open :: Ptr UVHandle -> UVFD -> IO CInt
foreign import ccall unsafe uv_tcp_init :: Ptr UVLoop -> Ptr UVHandle -> IO CInt
foreign import ccall unsafe uv_tcp_init_ex :: Ptr UVLoop -> Ptr UVHandle -> CUInt -> IO CInt
foreign import ccall unsafe uv_tcp_nodelay :: Ptr UVHandle -> CInt -> IO CInt
foreign import ccall unsafe uv_tcp_keepalive :: Ptr UVHandle -> CInt -> CUInt -> IO CInt

uV_TCP_IPV6ONLY :: CUInt
uV_TCP_IPV6ONLY = 1
{-# LINE 156 "Std/IO/UV/FFI.hsc" #-}
foreign import ccall unsafe uv_tcp_bind :: Ptr UVHandle -> Ptr SockAddr -> CUInt -> IO CInt
foreign import ccall unsafe hs_uv_tcp_connect :: Ptr UVHandle -> Ptr SockAddr -> IO UVSlotUnSafe
foreign import ccall unsafe hs_set_socket_reuse :: Ptr UVHandle -> IO CInt

--------------------------------------------------------------------------------
-- pipe
foreign import ccall unsafe uv_pipe_init :: Ptr UVLoop -> Ptr UVHandle -> CInt -> IO CInt

--------------------------------------------------------------------------------
-- tty
newtype UVTTYMode = UVTTYMode CInt
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

pattern UV_TTY_MODE_NORMAL :: UVTTYMode
pattern UV_TTY_MODE_NORMAL = UVTTYMode 0
{-# LINE 171 "Std/IO/UV/FFI.hsc" #-}
pattern UV_TTY_MODE_RAW :: UVTTYMode
pattern UV_TTY_MODE_RAW = UVTTYMode 1
{-# LINE 173 "Std/IO/UV/FFI.hsc" #-}
pattern UV_TTY_MODE_IO :: UVTTYMode
pattern UV_TTY_MODE_IO = UVTTYMode 2
{-# LINE 175 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe uv_tty_init :: Ptr UVLoop -> Ptr UVHandle -> CInt -> IO CInt

--------------------------------------------------------------------------------
-- fs

newtype UVFileMode = UVFileMode CInt
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

-- | 00700 user (file owner) has read, write and execute permission
pattern S_IRWXU :: UVFileMode
pattern S_IRWXU = UVFileMode 448
{-# LINE 187 "Std/IO/UV/FFI.hsc" #-}

-- | 00400 user has read permission
pattern S_IRUSR :: UVFileMode
pattern S_IRUSR = UVFileMode 256
{-# LINE 191 "Std/IO/UV/FFI.hsc" #-}

-- | 00200 user has write permission
pattern S_IWUSR :: UVFileMode
pattern S_IWUSR = UVFileMode 128
{-# LINE 195 "Std/IO/UV/FFI.hsc" #-}

-- | 00100 user has execute permission
pattern S_IXUSR :: UVFileMode
pattern S_IXUSR = UVFileMode 64
{-# LINE 199 "Std/IO/UV/FFI.hsc" #-}

-- | 00070 group has read, write and execute permission
pattern S_IRWXG :: UVFileMode
pattern S_IRWXG = UVFileMode 56
{-# LINE 203 "Std/IO/UV/FFI.hsc" #-}

-- | 00040 group has read permission
pattern S_IRGRP :: UVFileMode
pattern S_IRGRP = UVFileMode 32
{-# LINE 207 "Std/IO/UV/FFI.hsc" #-}

-- | 00020 group has write permission
pattern S_IWGRP :: UVFileMode
pattern S_IWGRP = UVFileMode 16
{-# LINE 211 "Std/IO/UV/FFI.hsc" #-}

-- | 00010 group has execute permission
pattern S_IXGRP :: UVFileMode
pattern S_IXGRP = UVFileMode 8
{-# LINE 215 "Std/IO/UV/FFI.hsc" #-}

-- | 00007 others have read, write and execute permission
pattern S_IRWXO :: UVFileMode
pattern S_IRWXO = UVFileMode 7
{-# LINE 219 "Std/IO/UV/FFI.hsc" #-}

-- | 00004 others have read permission
pattern S_IROTH :: UVFileMode
pattern S_IROTH = UVFileMode 4
{-# LINE 223 "Std/IO/UV/FFI.hsc" #-}

-- | 00002 others have write permission
pattern S_IWOTH :: UVFileMode
pattern S_IWOTH = UVFileMode 2
{-# LINE 227 "Std/IO/UV/FFI.hsc" #-}

-- | 00001 others have execute permission
pattern S_IXOTH :: UVFileMode
pattern S_IXOTH = UVFileMode 1
{-# LINE 231 "Std/IO/UV/FFI.hsc" #-}

-- | Default mode for open, 0o666(readable and writable).
pattern DEFAULT_MODE :: UVFileMode
pattern DEFAULT_MODE = UVFileMode 0o666

-- non-threaded functions
foreign import ccall unsafe hs_uv_fs_open    :: CString -> UVFileFlag -> UVFileMode -> IO UVFD
foreign import ccall unsafe hs_uv_fs_close   :: UVFD -> IO Int
foreign import ccall unsafe hs_uv_fs_read    :: UVFD -> Ptr Word8 -> Int -> Int64 -> IO Int
foreign import ccall unsafe hs_uv_fs_write   :: UVFD -> Ptr Word8 -> Int -> Int64 -> IO Int
foreign import ccall unsafe hs_uv_fs_unlink  :: CString -> IO Int
foreign import ccall unsafe hs_uv_fs_mkdir   :: CString -> UVFileMode -> IO Int
foreign import ccall unsafe hs_uv_fs_rmdir   :: CString -> IO Int
foreign import ccall unsafe hs_uv_fs_mkdtemp :: CString -> Int -> CString -> IO Int

-- threaded functions
foreign import ccall unsafe hs_uv_fs_open_threaded
    :: CString -> UVFileFlag -> UVFileMode -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_close_threaded
    :: UVFD -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_read_threaded
    :: UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_write_threaded
    :: UVFD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_unlink_threaded
    :: CString -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_mkdir_threaded
    :: CString -> UVFileMode -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_rmdir_threaded
    :: CString -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_mkdtemp_threaded
    :: CString -> Int -> CString -> Ptr UVLoop -> IO UVSlotUnSafe

newtype UVFileFlag = UVFileFlag CInt
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

-- | The file is opened in append mode. Before each write, the file offset is positioned at the end of the file.
pattern O_APPEND :: UVFileFlag
pattern O_APPEND = UVFileFlag 1024
{-# LINE 270 "Std/IO/UV/FFI.hsc" #-}

-- | The file is created if it does not already exist.
pattern O_CREAT :: UVFileFlag
pattern O_CREAT = UVFileFlag 64
{-# LINE 274 "Std/IO/UV/FFI.hsc" #-}

-- | File IO is done directly to and from user-space buffers, which must be aligned. Buffer size and address should be a multiple of the physical sector size of the block device, (DO NOT USE WITH stdio's @BufferedIO@)
pattern O_DIRECT :: UVFileFlag
pattern O_DIRECT = UVFileFlag 0
{-# LINE 278 "Std/IO/UV/FFI.hsc" #-}

-- | If the path is not a directory, fail the open. (Not useful on regular file)
--
-- Note 'o_DIRECTORY' is not supported on Windows.
pattern O_DIRECTORY :: UVFileFlag
pattern O_DIRECTORY = UVFileFlag 65536
{-# LINE 284 "Std/IO/UV/FFI.hsc" #-}

-- |The file is opened for synchronous IO. Write operations will complete once all data and a minimum of metadata are flushed to disk.
--
-- Note 'o_DSYNC' is supported on Windows via @FILE_FLAG_WRITE_THROUGH@.
pattern O_DSYNC :: UVFileFlag
pattern O_DSYNC = UVFileFlag 4096
{-# LINE 290 "Std/IO/UV/FFI.hsc" #-}

-- | If the 'o_CREAT' flag is set and the file already exists, fail the open.
--
-- Note In general, the behavior of 'o_EXCL' is undefined if it is used without 'o_CREAT'. There is one exception: on 
-- Linux 2.6 and later, 'o_EXCL' can be used without 'o_CREAT' if pathname refers to a block device. If the block 
-- device is in use by the system (e.g., mounted), the open will fail with the error @EBUSY@.
pattern O_EXCL :: UVFileFlag
pattern O_EXCL = UVFileFlag 128
{-# LINE 298 "Std/IO/UV/FFI.hsc" #-}

-- | Atomically obtain an exclusive lock.
--
-- Note UV_FS_O_EXLOCK is only supported on macOS and Windows.
-- (libuv: Changed in version 1.17.0: support is added for Windows.)
pattern O_EXLOCK :: UVFileFlag
pattern O_EXLOCK = UVFileFlag 0
{-# LINE 305 "Std/IO/UV/FFI.hsc" #-}

-- | Do not update the file access time when the file is read.
-- 
-- Note 'o_NOATIME' is not supported on Windows.
pattern O_NOATIME :: UVFileFlag
pattern O_NOATIME = UVFileFlag 0
{-# LINE 311 "Std/IO/UV/FFI.hsc" #-}

-- | If the path identifies a terminal device, opening the path will not cause that terminal to become the controlling terminal for the process (if the process does not already have one). (Not sure if this flag is useful)
--
-- Note 'o_NOCTTY' is not supported on Windows.
pattern O_NOCTTY :: UVFileFlag
pattern O_NOCTTY = UVFileFlag 256
{-# LINE 317 "Std/IO/UV/FFI.hsc" #-}

-- | If the path is a symbolic link, fail the open.
--
-- Note 'o_NOFOLLOW' is not supported on Windows.
pattern O_NOFOLLOW :: UVFileFlag
pattern O_NOFOLLOW = UVFileFlag 131072
{-# LINE 323 "Std/IO/UV/FFI.hsc" #-}

-- | Open the file in nonblocking mode if possible. (Definitely not useful with stdio)
--
-- Note 'o_NONBLOCK' is not supported on Windows. (Not useful on regular file anyway)
pattern O_NONBLOCK :: UVFileFlag
pattern O_NONBLOCK = UVFileFlag 2048
{-# LINE 329 "Std/IO/UV/FFI.hsc" #-}

-- | Access is intended to be random. The system can use this as a hint to optimize file caching.
-- 
-- Note 'o_RANDOM' is only supported on Windows via @FILE_FLAG_RANDOM_ACCESS@.
pattern O_RANDOM :: UVFileFlag
pattern O_RANDOM = UVFileFlag 0
{-# LINE 335 "Std/IO/UV/FFI.hsc" #-}

-- | Open the file for read-only access.
pattern O_RDONLY :: UVFileFlag
pattern O_RDONLY = UVFileFlag 0
{-# LINE 339 "Std/IO/UV/FFI.hsc" #-}

-- | Open the file for read-write access.
pattern O_RDWR :: UVFileFlag
pattern O_RDWR = UVFileFlag 2
{-# LINE 343 "Std/IO/UV/FFI.hsc" #-}


-- | Access is intended to be sequential from beginning to end. The system can use this as a hint to optimize file caching.
-- 
-- Note 'o_SEQUENTIAL' is only supported on Windows via @FILE_FLAG_SEQUENTIAL_SCAN@.
pattern O_SEQUENTIAL :: UVFileFlag
pattern O_SEQUENTIAL = UVFileFlag 0
{-# LINE 350 "Std/IO/UV/FFI.hsc" #-}

-- | The file is temporary and should not be flushed to disk if possible.
--
-- Note 'o_SHORT_LIVED' is only supported on Windows via @FILE_ATTRIBUTE_TEMPORARY@.
pattern O_SHORT_LIVED :: UVFileFlag
pattern O_SHORT_LIVED = UVFileFlag 0
{-# LINE 356 "Std/IO/UV/FFI.hsc" #-}

-- | Open the symbolic link itself rather than the resource it points to.
pattern O_SYMLINK :: UVFileFlag
pattern O_SYMLINK = UVFileFlag 0
{-# LINE 360 "Std/IO/UV/FFI.hsc" #-}

-- | The file is opened for synchronous IO. Write operations will complete once all data and all metadata are flushed to disk.
--
-- Note 'o_SYNC' is supported on Windows via @FILE_FLAG_WRITE_THROUGH@.
pattern O_SYNC :: UVFileFlag
pattern O_SYNC = UVFileFlag 1052672
{-# LINE 366 "Std/IO/UV/FFI.hsc" #-}

-- | The file is temporary and should not be flushed to disk if possible.
--
-- Note 'o_TEMPORARY' is only supported on Windows via @FILE_ATTRIBUTE_TEMPORARY@.
pattern O_TEMPORARY :: UVFileFlag
pattern O_TEMPORARY = UVFileFlag 0
{-# LINE 372 "Std/IO/UV/FFI.hsc" #-}

-- | If the file exists and is a regular file, and the file is opened successfully for write access, its length shall be truncated to zero.
pattern O_TRUNC :: UVFileFlag
pattern O_TRUNC = UVFileFlag 512
{-# LINE 376 "Std/IO/UV/FFI.hsc" #-}

-- | Open the file for write-only access.
pattern O_WRONLY :: UVFileFlag
pattern O_WRONLY = UVFileFlag 1
{-# LINE 380 "Std/IO/UV/FFI.hsc" #-}


{-# LINE 384 "Std/IO/UV/FFI.hsc" #-}
newtype UVDirEntType = UVDirEntType CChar

{-# LINE 386 "Std/IO/UV/FFI.hsc" #-}
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

data DirEntType
    = DirEntUnknown
    | DirEntFile
    | DirEntDir
    | DirEntLink
    | DirEntFIFO
    | DirEntSocket
    | DirEntChar
    | DirEntBlock
  deriving (Read, Show, Eq, Ord, Generic)

fromUVDirEntType :: UVDirEntType -> DirEntType
fromUVDirEntType t
    | t == uV__DT_FILE   = DirEntFile
    | t == uV__DT_DIR    = DirEntDir
    | t == uV__DT_LINK   = DirEntLink
    | t == uV__DT_FIFO   = DirEntFIFO
    | t == uV__DT_SOCKET = DirEntSocket
    | t == uV__DT_CHAR   = DirEntChar
    | t == uV__DT_BLOCK  = DirEntBlock
    | otherwise          = DirEntUnknown

uV__DT_FILE     :: UVDirEntType
uV__DT_FILE     = UVDirEntType 8
uV__DT_DIR      :: UVDirEntType
uV__DT_DIR      = UVDirEntType 4
uV__DT_LINK     :: UVDirEntType
uV__DT_LINK     = UVDirEntType 10
uV__DT_FIFO     :: UVDirEntType
uV__DT_FIFO     = UVDirEntType 1
uV__DT_SOCKET   :: UVDirEntType
uV__DT_SOCKET   = UVDirEntType 12
uV__DT_CHAR     :: UVDirEntType
uV__DT_CHAR     = UVDirEntType 2
uV__DT_BLOCK    :: UVDirEntType
uV__DT_BLOCK    = UVDirEntType 6

{-# LINE 418 "Std/IO/UV/FFI.hsc" #-}

data UVDirEnt

peekUVDirEnt :: Ptr UVDirEnt -> IO (CString, UVDirEntType)

{-# LINE 423 "Std/IO/UV/FFI.hsc" #-}
peekUVDirEnt p = (,) ((\hsc_ptr -> hsc_ptr `plusPtr` 19) p) <$> ((\hsc_ptr -> peekByteOff hsc_ptr 18) p)
{-# LINE 424 "Std/IO/UV/FFI.hsc" #-}

{-# LINE 427 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_scandir_cleanup
    :: Ptr (Ptr UVDirEnt) -> Int -> IO ()
foreign import ccall unsafe hs_uv_fs_scandir
    :: CString -> MBA# (Ptr UVDirEnt) -> IO Int
foreign import ccall unsafe hs_uv_fs_scandir_extra_cleanup
    :: Ptr (Ptr (Ptr UVDirEnt)) -> Int -> IO ()
foreign import ccall unsafe hs_uv_fs_scandir_threaded
    :: CString -> Ptr (Ptr (Ptr UVDirEnt)) -> Ptr UVLoop -> IO UVSlotUnSafe

data UVTimeSpec = UVTimeSpec
    { uvtSecond     :: {-# UNPACK #-} !CLong
    , uvtNanoSecond :: {-# UNPACK #-} !CLong
    } deriving (Show, Read, Eq, Ord, Generic)

instance Storable UVTimeSpec where
    sizeOf _  = (16)
{-# LINE 444 "Std/IO/UV/FFI.hsc" #-}
    alignment _ = 8
{-# LINE 445 "Std/IO/UV/FFI.hsc" #-}
    peek p = UVTimeSpec <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
{-# LINE 446 "Std/IO/UV/FFI.hsc" #-}
                        <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
{-# LINE 447 "Std/IO/UV/FFI.hsc" #-}
    poke p (UVTimeSpec sec nsec) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0) p sec)
{-# LINE 449 "Std/IO/UV/FFI.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8) p nsec)
{-# LINE 450 "Std/IO/UV/FFI.hsc" #-}

data UVStat = UVStat
    { stDev      :: {-# UNPACK #-} !Word64
    , stMode     :: {-# UNPACK #-} !Word64
    , stNlink    :: {-# UNPACK #-} !Word64
    , stUid      :: {-# UNPACK #-} !Word64
    , stGid      :: {-# UNPACK #-} !Word64
    , stRdev     :: {-# UNPACK #-} !Word64
    , stIno      :: {-# UNPACK #-} !Word64
    , stSize     :: {-# UNPACK #-} !Word64
    , stBlksize  :: {-# UNPACK #-} !Word64
    , stBlocks   :: {-# UNPACK #-} !Word64
    , stFlags    :: {-# UNPACK #-} !Word64
    , stGen      :: {-# UNPACK #-} !Word64
    , stAtim     :: {-# UNPACK #-} !UVTimeSpec
    , stMtim     :: {-# UNPACK #-} !UVTimeSpec
    , stCtim     :: {-# UNPACK #-} !UVTimeSpec
    , stBirthtim :: {-# UNPACK #-} !UVTimeSpec
    } deriving (Show, Read, Eq, Ord, Generic)

uvStatSize :: Int
uvStatSize = (160)
{-# LINE 472 "Std/IO/UV/FFI.hsc" #-}

peekUVStat :: Ptr UVStat -> IO UVStat
peekUVStat p = UVStat
    <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
{-# LINE 476 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
{-# LINE 477 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16) p)
{-# LINE 478 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 24) p)
{-# LINE 479 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 32) p)
{-# LINE 480 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 40) p)
{-# LINE 481 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48) p)
{-# LINE 482 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 56) p)
{-# LINE 483 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 64) p)
{-# LINE 484 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 72) p)
{-# LINE 485 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 80) p)
{-# LINE 486 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 88) p)
{-# LINE 487 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 96) p)
{-# LINE 488 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 112) p)
{-# LINE 489 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 128) p)
{-# LINE 490 "Std/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 144) p)
{-# LINE 491 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_stat :: CString -> Ptr UVStat -> IO Int
foreign import ccall unsafe hs_uv_fs_fstat :: UVFD -> Ptr UVStat -> IO Int
foreign import ccall unsafe hs_uv_fs_lstat :: CString -> Ptr UVStat -> IO Int
foreign import ccall unsafe hs_uv_fs_rename :: CString -> CString -> IO Int
foreign import ccall unsafe hs_uv_fs_fsync :: UVFD -> IO Int
foreign import ccall unsafe hs_uv_fs_fdatasync :: UVFD -> IO Int
foreign import ccall unsafe hs_uv_fs_ftruncate :: UVFD -> Int64 -> IO Int

foreign import ccall unsafe hs_uv_fs_stat_threaded
    :: CString -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_fstat_threaded
    :: UVFD -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_lstat_threaded
    :: CString -> Ptr UVStat -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_rename_threaded
    :: CString -> CString -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_fsync_threaded
    :: UVFD -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_fdatasync_threaded
    :: UVFD -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_ftruncate_threaded
    :: UVFD -> Int64 -> Ptr UVLoop -> IO UVSlotUnSafe

-- | Flags control copying.
-- 
--   * 'COPYFILE_EXCL': If present, uv_fs_copyfile() will fail with UV_EEXIST if the destination path already exists. The default behavior is to overwrite the destination if it exists.
--   * 'COPYFILE_FICLONE': If present, uv_fs_copyfile() will attempt to create a copy-on-write reflink. If the underlying platform does not support copy-on-write, then a fallback copy mechanism is used.
-- 
newtype UVCopyFileFlag = UVCopyFileFlag CInt
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

pattern COPYFILE_DEFAULT :: UVCopyFileFlag
pattern COPYFILE_DEFAULT = UVCopyFileFlag 0

pattern COPYFILE_EXCL :: UVCopyFileFlag
pattern COPYFILE_EXCL = UVCopyFileFlag 1
{-# LINE 528 "Std/IO/UV/FFI.hsc" #-}

pattern COPYFILE_FICLONE :: UVCopyFileFlag

{-# LINE 533 "Std/IO/UV/FFI.hsc" #-}
pattern COPYFILE_FICLONE = UVCopyFileFlag 0   -- fallback to normal copy.

{-# LINE 535 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_copyfile :: CString -> CString -> UVCopyFileFlag -> IO Int
foreign import ccall unsafe hs_uv_fs_copyfile_threaded
    :: CString -> CString -> UVCopyFileFlag -> Ptr UVLoop -> IO UVSlotUnSafe

newtype UVAccessMode = UVAccessMode CInt
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

pattern F_OK :: UVAccessMode
pattern F_OK = UVAccessMode 0
{-# LINE 545 "Std/IO/UV/FFI.hsc" #-}
pattern R_OK :: UVAccessMode
pattern R_OK = UVAccessMode 4
{-# LINE 547 "Std/IO/UV/FFI.hsc" #-}
pattern W_OK :: UVAccessMode
pattern W_OK = UVAccessMode 2
{-# LINE 549 "Std/IO/UV/FFI.hsc" #-}
pattern X_OK :: UVAccessMode
pattern X_OK = UVAccessMode 1
{-# LINE 551 "Std/IO/UV/FFI.hsc" #-}

data AccessResult = NoExistence | NoPermission | AccessOK deriving (Show, Eq, Ord)

foreign import ccall unsafe hs_uv_fs_access :: CString -> UVAccessMode -> IO Int
foreign import ccall unsafe hs_uv_fs_access_threaded
    :: CString -> UVAccessMode -> Ptr UVLoop -> IO UVSlotUnSafe

foreign import ccall unsafe hs_uv_fs_chmod :: CString -> UVFileMode -> IO Int
foreign import ccall unsafe hs_uv_fs_chmod_threaded
    :: CString -> UVFileMode -> Ptr UVLoop -> IO UVSlotUnSafe

foreign import ccall unsafe hs_uv_fs_fchmod :: UVFD -> UVFileMode -> IO Int
foreign import ccall unsafe hs_uv_fs_fchmod_threaded
    :: UVFD -> UVFileMode -> Ptr UVLoop -> IO UVSlotUnSafe

foreign import ccall unsafe hs_uv_fs_utime :: CString -> Double -> Double -> IO Int
foreign import ccall unsafe hs_uv_fs_utime_threaded
    :: CString -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnSafe

foreign import ccall unsafe hs_uv_fs_futime :: UVFD -> Double -> Double -> IO Int
foreign import ccall unsafe hs_uv_fs_futime_threaded
    :: UVFD -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnSafe

newtype UVSymlinkFlag = UVSymlinkFlag CInt
    deriving (Eq, Ord, Read, Show, FiniteBits, Bits, Storable)

pattern SYMLINK_DEFAULT :: UVSymlinkFlag
pattern SYMLINK_DEFAULT = UVSymlinkFlag 0

pattern SYMLINK_DIR :: UVSymlinkFlag
pattern SYMLINK_DIR = UVSymlinkFlag 1
{-# LINE 582 "Std/IO/UV/FFI.hsc" #-}

pattern SYMLINK_JUNCTION :: UVSymlinkFlag
pattern SYMLINK_JUNCTION = UVSymlinkFlag 2
{-# LINE 585 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_link :: CString -> CString -> IO Int
foreign import ccall unsafe hs_uv_fs_link_threaded
    :: CString -> CString -> Ptr UVLoop -> IO UVSlotUnSafe

foreign import ccall unsafe hs_uv_fs_symlink :: CString -> CString -> UVSymlinkFlag -> IO Int
foreign import ccall unsafe hs_uv_fs_symlink_threaded
    :: CString -> CString -> UVSymlinkFlag -> Ptr UVLoop -> IO UVSlotUnSafe

-- readlink and realpath share the same cleanup and callback
foreign import ccall unsafe hs_uv_fs_readlink_cleanup
    :: CString -> IO ()
foreign import ccall unsafe hs_uv_fs_readlink
    :: CString -> MBA# CString -> IO Int
foreign import ccall unsafe hs_uv_fs_realpath
    :: CString -> MBA# CString -> IO Int
foreign import ccall unsafe hs_uv_fs_readlink_extra_cleanup
    :: Ptr CString -> IO ()
foreign import ccall unsafe hs_uv_fs_readlink_threaded
    :: CString -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnSafe
foreign import ccall unsafe hs_uv_fs_realpath_threaded
    :: CString -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnSafe

--------------------------------------------------------------------------------
-- misc

newtype UVHandleType = UVHandleType CInt deriving (Eq, Ord, Read, Show, Storable)

pattern UV_UNKNOWN_HANDLE :: UVHandleType
pattern UV_UNKNOWN_HANDLE = UVHandleType 0
{-# LINE 615 "Std/IO/UV/FFI.hsc" #-}
pattern UV_ASYNC :: UVHandleType
pattern UV_ASYNC = UVHandleType 1
{-# LINE 617 "Std/IO/UV/FFI.hsc" #-}
pattern UV_CHECK :: UVHandleType
pattern UV_CHECK = UVHandleType 2
{-# LINE 619 "Std/IO/UV/FFI.hsc" #-}
pattern UV_FS_EVENT :: UVHandleType
pattern UV_FS_EVENT = UVHandleType 3
{-# LINE 621 "Std/IO/UV/FFI.hsc" #-}
pattern UV_FS_POLL :: UVHandleType
pattern UV_FS_POLL = UVHandleType 4
{-# LINE 623 "Std/IO/UV/FFI.hsc" #-}
pattern UV_HANDLE :: UVHandleType
pattern UV_HANDLE = UVHandleType 5
{-# LINE 625 "Std/IO/UV/FFI.hsc" #-}
pattern UV_IDLE :: UVHandleType
pattern UV_IDLE = UVHandleType 6
{-# LINE 627 "Std/IO/UV/FFI.hsc" #-}
pattern UV_NAMED_PIPE :: UVHandleType
pattern UV_NAMED_PIPE = UVHandleType 7
{-# LINE 629 "Std/IO/UV/FFI.hsc" #-}
pattern UV_POLL :: UVHandleType
pattern UV_POLL = UVHandleType 8
{-# LINE 631 "Std/IO/UV/FFI.hsc" #-}
pattern UV_PREPARE :: UVHandleType
pattern UV_PREPARE = UVHandleType 9
{-# LINE 633 "Std/IO/UV/FFI.hsc" #-}
pattern UV_PROCESS :: UVHandleType
pattern UV_PROCESS = UVHandleType 10
{-# LINE 635 "Std/IO/UV/FFI.hsc" #-}
pattern UV_STREAM :: UVHandleType
pattern UV_STREAM = UVHandleType 11
{-# LINE 637 "Std/IO/UV/FFI.hsc" #-}
pattern UV_TCP :: UVHandleType
pattern UV_TCP = UVHandleType 12
{-# LINE 639 "Std/IO/UV/FFI.hsc" #-}
pattern UV_TIMER :: UVHandleType
pattern UV_TIMER = UVHandleType 13
{-# LINE 641 "Std/IO/UV/FFI.hsc" #-}
pattern UV_TTY :: UVHandleType
pattern UV_TTY = UVHandleType 14
{-# LINE 643 "Std/IO/UV/FFI.hsc" #-}
pattern UV_UDP :: UVHandleType
pattern UV_UDP = UVHandleType 15
{-# LINE 645 "Std/IO/UV/FFI.hsc" #-}
pattern UV_SIGNAL :: UVHandleType
pattern UV_SIGNAL = UVHandleType 16
{-# LINE 647 "Std/IO/UV/FFI.hsc" #-}
pattern UV_FILE :: UVHandleType
pattern UV_FILE = UVHandleType 17
{-# LINE 649 "Std/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe uv_guess_handle :: UVFD -> IO UVHandleType