{-# LINE 1 "Z/IO/UV/FFI.hsc" #-}
{-|
Module      : Z.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 Z.IO.UV.FFI where

import           Control.Monad
import           Data.Bits
import           Data.Int
import           Data.Word
import           Data.Primitive.Types   (Prim)
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Ptr
import           Foreign.Storable
import           Z.Data.Array.Unaligned
import           Z.Data.Text.Print   (Print(..))
import           Z.Data.JSON         (JSON)
import           Z.Data.CBytes as CBytes
import           Z.Foreign
import           Z.IO.Exception (throwUVIfMinus_, bracket, HasCallStack)
import           Z.IO.Network.SocketAddr    (SocketAddr)
import           System.Posix.Types (CSsize (..))
import           GHC.Generics



{-# LINE 37 "Z/IO/UV/FFI.hsc" #-}


{-# LINE 39 "Z/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 FD = CInt

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

pattern SO_REUSEPORT_LOAD_BALANCE :: Int
pattern SO_REUSEPORT_LOAD_BALANCE = 1
{-# LINE 58 "Z/IO/UV/FFI.hsc" #-}
pattern INIT_LOOP_SIZE :: Int
pattern INIT_LOOP_SIZE = 128
{-# LINE 60 "Z/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 69 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
{-# LINE 70 "Z/IO/UV/FFI.hsc" #-}

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

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

type UVRunMode = CInt

pattern UV_RUN_DEFAULT :: UVRunMode
pattern UV_RUN_DEFAULT = 0
{-# LINE 84 "Z/IO/UV/FFI.hsc" #-}
pattern UV_RUN_ONCE :: UVRunMode
pattern UV_RUN_ONCE    = 1
{-# LINE 86 "Z/IO/UV/FFI.hsc" #-}
pattern UV_RUN_NOWAIT :: UVRunMode
pattern UV_RUN_NOWAIT  = 2
{-# LINE 88 "Z/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 92 "Z/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 116 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fileno :: Ptr UVHandle -> IO FD
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 ()
foreign import ccall unsafe uv_unref :: Ptr UVHandle -> IO ()

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

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

--------------------------------------------------------------------------------
-- check
foreign import ccall unsafe hs_uv_check_alloc :: IO (Ptr UVHandle)
foreign import ccall unsafe hs_uv_check_init :: Ptr UVHandle    -- ^ uv_check_t
                                             -> Ptr UVHandle    -- ^ uv_handle_t
                                             -> IO CInt
foreign import ccall unsafe hs_uv_check_close :: Ptr UVHandle -> 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 uv_read_stop :: Ptr UVHandle -> IO CInt
foreign import ccall unsafe hs_uv_write :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_try_write :: Ptr UVHandle -> Ptr Word8 -> Int -> IO Int

foreign import ccall unsafe hs_uv_shutdown :: Ptr UVHandle -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_accept_check_start :: Ptr UVHandle -> IO CInt

--------------------------------------------------------------------------------
-- tcp & pipe
foreign import ccall unsafe uv_tcp_open :: Ptr UVHandle -> FD -> 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
foreign import ccall unsafe uv_tcp_getsockname :: Ptr UVHandle -> MBA# SocketAddr -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_tcp_getpeername :: Ptr UVHandle -> MBA# SocketAddr -> MBA# CInt -> IO CInt

uV_TCP_IPV6ONLY :: CUInt
uV_TCP_IPV6ONLY = 1
{-# LINE 161 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe uv_tcp_bind :: Ptr UVHandle -> MBA# SocketAddr -> CUInt -> IO CInt
foreign import ccall unsafe hs_uv_tcp_connect :: Ptr UVHandle -> MBA# SocketAddr -> IO UVSlotUnsafe
foreign import ccall unsafe hs_set_socket_reuse :: Ptr UVHandle -> IO CInt

foreign import ccall unsafe uv_pipe_open :: Ptr UVHandle -> FD -> IO CInt
foreign import ccall unsafe uv_pipe_init :: Ptr UVLoop -> Ptr UVHandle -> CInt -> IO CInt
foreign import ccall unsafe uv_pipe_bind :: Ptr UVHandle -> BA# Word8 -> IO CInt
foreign import ccall unsafe hs_uv_pipe_connect :: Ptr UVHandle -> BA# Word8 -> IO UVSlotUnsafe

--------------------------------------------------------------------------------
-- udp
foreign import ccall unsafe uv_udp_init :: Ptr UVLoop -> Ptr UVHandle -> IO CInt
foreign import ccall unsafe uv_udp_init_ex :: Ptr UVLoop -> Ptr UVHandle -> CUInt -> IO CInt
foreign import ccall unsafe uv_udp_open :: Ptr UVHandle -> FD -> IO CInt
foreign import ccall unsafe uv_udp_bind :: Ptr UVHandle -> MBA# SocketAddr -> UDPFlag -> IO CInt

type Membership = CInt

pattern LEAVE_GROUP :: Membership
pattern LEAVE_GROUP = 0
{-# LINE 182 "Z/IO/UV/FFI.hsc" #-}
pattern JOIN_GROUP :: Membership
pattern JOIN_GROUP = 1
{-# LINE 184 "Z/IO/UV/FFI.hsc" #-}

type UDPFlag = CInt

pattern UDP_DEFAULT        :: UDPFlag
pattern UDP_DEFAULT         = 0
pattern UDP_IPV6ONLY       :: UDPFlag
pattern UDP_IPV6ONLY        = 1
{-# LINE 191 "Z/IO/UV/FFI.hsc" #-}
pattern UDP_REUSEADDR      :: UDPFlag
pattern UDP_REUSEADDR       = 4
{-# LINE 193 "Z/IO/UV/FFI.hsc" #-}

pattern UV_UDP_PARTIAL     :: Int32
pattern UV_UDP_PARTIAL      = 2
{-# LINE 196 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe uv_udp_connect
    :: Ptr UVHandle -> MBA# SocketAddr -> IO CInt
-- | Just pass null pointer as SocketAddr to disconnect
foreign import ccall unsafe "uv_udp_connect" uv_udp_disconnect
    :: Ptr UVHandle -> Ptr SocketAddr -> IO CInt

foreign import ccall unsafe uv_udp_set_membership ::
    Ptr UVHandle -> BA# Word8 -> BA# Word8 -> Membership -> IO CInt
foreign import ccall unsafe uv_udp_set_source_membership ::
    Ptr UVHandle -> BA# Word8 -> BA# Word8 -> BA# Word8 -> Membership -> IO CInt

foreign import ccall unsafe uv_udp_set_multicast_loop :: Ptr UVHandle -> CInt -> IO CInt
foreign import ccall unsafe uv_udp_set_multicast_ttl :: Ptr UVHandle -> CInt -> IO CInt
foreign import ccall unsafe uv_udp_set_multicast_interface :: Ptr UVHandle -> BA# Word8 -> IO CInt
foreign import ccall unsafe uv_udp_set_broadcast :: Ptr UVHandle -> CInt -> IO CInt
foreign import ccall unsafe uv_udp_set_ttl :: Ptr UVHandle -> CInt -> IO CInt

foreign import ccall unsafe hs_uv_udp_recv_start :: Ptr UVHandle -> IO CInt
foreign import ccall unsafe uv_udp_recv_stop :: Ptr UVHandle -> IO CInt

foreign import ccall unsafe hs_uv_udp_check_start :: Ptr UVHandle -> IO CInt

foreign import ccall unsafe hs_uv_udp_send
    :: Ptr UVHandle -> MBA# SocketAddr -> Ptr Word8 -> Int -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_udp_send_connected
    :: Ptr UVHandle -> Ptr Word8 -> Int -> IO UVSlotUnsafe
foreign import ccall unsafe uv_udp_getsockname
    :: Ptr UVHandle -> MBA# SocketAddr -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_udp_getpeername
    :: Ptr UVHandle -> MBA# SocketAddr -> MBA# CInt -> IO CInt


--------------------------------------------------------------------------------
-- tty

-- | Terminal mode.
--
-- When in 'TTY_MODE_RAW' mode, input is always available character-by-character,
-- not including modifiers. Additionally, all special processing of characters by the terminal is disabled,
-- including echoing input characters. Note that CTRL+C will no longer cause a SIGINT when in this mode.
type TTYMode = CInt

pattern TTY_MODE_NORMAL :: TTYMode
pattern TTY_MODE_NORMAL = 0
{-# LINE 241 "Z/IO/UV/FFI.hsc" #-}
pattern TTY_MODE_RAW :: TTYMode
pattern TTY_MODE_RAW = 1
{-# LINE 243 "Z/IO/UV/FFI.hsc" #-}
pattern TTY_MODE_IO :: TTYMode
pattern TTY_MODE_IO = 2
{-# LINE 245 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe uv_tty_init :: Ptr UVLoop -> Ptr UVHandle -> CInt -> IO CInt
foreign import ccall unsafe uv_tty_set_mode :: Ptr UVHandle -> TTYMode -> IO CInt
foreign import ccall unsafe uv_tty_get_winsize :: Ptr UVHandle -> MBA# CInt -> MBA# CInt -> IO CInt

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

type FileMode = CInt

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

-- | 00400 user has read permission
pattern S_IRUSR :: FileMode
pattern S_IRUSR = 256
{-# LINE 262 "Z/IO/UV/FFI.hsc" #-}

-- | 00200 user has write permission
pattern S_IWUSR :: FileMode
pattern S_IWUSR = 128
{-# LINE 266 "Z/IO/UV/FFI.hsc" #-}

-- | 00100 user has execute permission
pattern S_IXUSR :: FileMode
pattern S_IXUSR = 64
{-# LINE 270 "Z/IO/UV/FFI.hsc" #-}

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

-- | 00040 group has read permission
pattern S_IRGRP :: FileMode
pattern S_IRGRP = 32
{-# LINE 278 "Z/IO/UV/FFI.hsc" #-}

-- | 00020 group has write permission
pattern S_IWGRP :: FileMode
pattern S_IWGRP = 16
{-# LINE 282 "Z/IO/UV/FFI.hsc" #-}

-- | 00010 group has execute permission
pattern S_IXGRP :: FileMode
pattern S_IXGRP = 8
{-# LINE 286 "Z/IO/UV/FFI.hsc" #-}

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

-- | 00004 others have read permission
pattern S_IROTH :: FileMode
pattern S_IROTH = 4
{-# LINE 294 "Z/IO/UV/FFI.hsc" #-}

-- | 00002 others have write permission
pattern S_IWOTH :: FileMode
pattern S_IWOTH = 2
{-# LINE 298 "Z/IO/UV/FFI.hsc" #-}

-- | 00001 others have execute permission
pattern S_IXOTH :: FileMode
pattern S_IXOTH = 1
{-# LINE 302 "Z/IO/UV/FFI.hsc" #-}

-- | Default mode for file open, 0x666(readable and writable).
pattern DEFAULT_FILE_MODE :: FileMode
pattern DEFAULT_FILE_MODE = 0o644

-- | Default mode for open, 0x755.
pattern DEFAULT_DIR_MODE :: FileMode
pattern DEFAULT_DIR_MODE = 0o755

-- | This is the file type mask.
pattern S_IFMT :: FileMode
pattern S_IFMT = 61440
{-# LINE 314 "Z/IO/UV/FFI.hsc" #-}

-- | This is the file type constant of a symbolic link.
pattern S_IFLNK :: FileMode
pattern S_IFLNK = 40960
{-# LINE 318 "Z/IO/UV/FFI.hsc" #-}

-- | This is the file type constant of a directory file.
pattern S_IFDIR :: FileMode
pattern S_IFDIR = 16384
{-# LINE 322 "Z/IO/UV/FFI.hsc" #-}

-- | This is the file type constant of a regular file.
pattern S_IFREG :: FileMode
pattern S_IFREG = 32768
{-# LINE 326 "Z/IO/UV/FFI.hsc" #-}

-- non-threaded functions
foreign import ccall unsafe hs_uv_fs_open    :: BA# Word8 -> FileFlag -> FileMode -> IO FD
foreign import ccall unsafe hs_uv_fs_close   :: FD -> IO Int
foreign import ccall unsafe hs_uv_fs_read    :: FD -> Ptr Word8 -> Int -> Int64 -> IO Int
foreign import ccall unsafe hs_uv_fs_write   :: FD -> Ptr Word8 -> Int -> Int64 -> IO Int
foreign import ccall unsafe hs_uv_fs_unlink  :: BA# Word8 -> IO Int
foreign import ccall unsafe hs_uv_fs_mkdir   :: BA# Word8 -> FileMode -> IO Int
foreign import ccall unsafe hs_uv_fs_rmdir   :: BA# Word8 -> IO Int
foreign import ccall unsafe hs_uv_fs_mkdtemp :: BA# Word8 -> Int -> MBA# Word8 -> IO Int
foreign import ccall unsafe hs_uv_fs_mkstemp :: BA# Word8 -> Int -> MBA# Word8 -> IO Int

-- threaded functions
foreign import ccall unsafe hs_uv_fs_open_threaded
    :: BA# Word8 -> FileFlag -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_close_threaded
    :: FD -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_read_threaded
    :: FD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_write_threaded
    :: FD -> Ptr Word8 -> Int -> Int64 -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_unlink_threaded
    :: BA# Word8 -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_mkdir_threaded
    :: BA# Word8 -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_rmdir_threaded
    :: BA# Word8 -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_mkdtemp_threaded
    :: BA# Word8 -> Int -> MBA# Word8 -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_mkstemp_threaded
    :: BA# Word8 -> Int -> MBA# Word8 -> Ptr UVLoop -> IO UVSlotUnsafe

type FileFlag = CInt

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

-- | The file is created if it does not already exist.
pattern O_CREAT :: FileFlag
pattern O_CREAT = 64
{-# LINE 367 "Z/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 Z-IO's @BufferedIO@)
pattern O_DIRECT :: FileFlag
pattern O_DIRECT = 16384
{-# LINE 371 "Z/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 :: FileFlag
pattern O_DIRECTORY = 65536
{-# LINE 377 "Z/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 :: FileFlag
pattern O_DSYNC = 4096
{-# LINE 383 "Z/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 :: FileFlag
pattern O_EXCL = 128
{-# LINE 391 "Z/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 :: FileFlag
pattern O_EXLOCK = 0
{-# LINE 398 "Z/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 :: FileFlag
pattern O_NOATIME = 262144
{-# LINE 404 "Z/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 :: FileFlag
pattern O_NOCTTY = 256
{-# LINE 410 "Z/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 :: FileFlag
pattern O_NOFOLLOW = 131072
{-# LINE 416 "Z/IO/UV/FFI.hsc" #-}

-- | Open the file in nonblocking mode if possible. (Definitely not useful in Z-IO)
--
-- Note 'O_NONBLOCK' is not supported on Windows. (Not useful on regular file anyway)
pattern O_NONBLOCK :: FileFlag
pattern O_NONBLOCK = 2048
{-# LINE 422 "Z/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 :: FileFlag
pattern O_RANDOM = 0
{-# LINE 428 "Z/IO/UV/FFI.hsc" #-}

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

-- | Open the file for read-write access.
pattern O_RDWR :: FileFlag
pattern O_RDWR = 2
{-# LINE 436 "Z/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 :: FileFlag
pattern O_SEQUENTIAL = 0
{-# LINE 443 "Z/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 :: FileFlag
pattern O_SHORT_LIVED = 0
{-# LINE 449 "Z/IO/UV/FFI.hsc" #-}

-- | Open the symbolic link itself rather than the resource it points to.
pattern O_SYMLINK :: FileFlag
pattern O_SYMLINK = 0
{-# LINE 453 "Z/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 :: FileFlag
pattern O_SYNC = 1052672
{-# LINE 459 "Z/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 :: FileFlag
pattern O_TEMPORARY = 0
{-# LINE 465 "Z/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 :: FileFlag
pattern O_TRUNC = 512
{-# LINE 469 "Z/IO/UV/FFI.hsc" #-}

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


type Whence = CInt

-- | Beginning of the file.
pattern SEEK_SET :: Whence
pattern SEEK_SET = 0
{-# LINE 480 "Z/IO/UV/FFI.hsc" #-}
-- | Current position of the file pointer.
pattern SEEK_CUR :: Whence
pattern SEEK_CUR = 1
{-# LINE 483 "Z/IO/UV/FFI.hsc" #-}
-- | End of file.
pattern SEEK_END :: Whence
pattern SEEK_END = 2
{-# LINE 486 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_seek :: FD -> Int64 -> Whence -> IO Int64



{-# LINE 493 "Z/IO/UV/FFI.hsc" #-}
type UVDirEntType = CChar

{-# LINE 495 "Z/IO/UV/FFI.hsc" #-}

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

fromUVDirEntType :: UVDirEntType -> DirEntType
fromUVDirEntType t
    | t == 8 = DirEntFile
{-# LINE 511 "Z/IO/UV/FFI.hsc" #-}
    | t == 4 = DirEntDir
{-# LINE 512 "Z/IO/UV/FFI.hsc" #-}
    | t == 10 = DirEntLink
{-# LINE 513 "Z/IO/UV/FFI.hsc" #-}
    | t == 1 = DirEntFIFO
{-# LINE 514 "Z/IO/UV/FFI.hsc" #-}
    | t == 12 = DirEntSocket
{-# LINE 515 "Z/IO/UV/FFI.hsc" #-}
    | t == 2 = DirEntChar
{-# LINE 516 "Z/IO/UV/FFI.hsc" #-}
    | t == 6 = DirEntBlock
{-# LINE 517 "Z/IO/UV/FFI.hsc" #-}
    | otherwise          = DirEntUnknown

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

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

{-# LINE 525 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_scandir_cleanup
    :: Ptr (Ptr DirEntType) -> Int -> IO ()
foreign import ccall unsafe hs_uv_fs_scandir
    :: BA# Word8 -> MBA# (Ptr DirEntType) -> IO Int
foreign import ccall unsafe hs_uv_fs_scandir_extra_cleanup
    :: Ptr (Ptr (Ptr DirEntType)) -> Int -> IO ()
foreign import ccall unsafe hs_uv_fs_scandir_threaded
    :: BA# Word8 -> Ptr (Ptr (Ptr DirEntType)) -> Ptr UVLoop -> IO UVSlotUnsafe

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

instance Storable UVTimeSpec where
    sizeOf _  = (16)
{-# LINE 543 "Z/IO/UV/FFI.hsc" #-}
    alignment _ = 8
{-# LINE 544 "Z/IO/UV/FFI.hsc" #-}
    peek p = UVTimeSpec <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
{-# LINE 545 "Z/IO/UV/FFI.hsc" #-}
                        <*> ((\hsc_ptr -> peekByteOff hsc_ptr 8) p)
{-# LINE 546 "Z/IO/UV/FFI.hsc" #-}
    poke p (UVTimeSpec sec nsec) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0) p sec)
{-# LINE 548 "Z/IO/UV/FFI.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8) p nsec)
{-# LINE 549 "Z/IO/UV/FFI.hsc" #-}

data FStat = FStat
    { stDev      :: {-# UNPACK #-} !Word64
    , stMode     :: {-# UNPACK #-} !FileMode
    , stNlink    :: {-# UNPACK #-} !Word64
    , stUID      :: {-# UNPACK #-} !UID
    , stGID      :: {-# UNPACK #-} !GID
    , 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)
      deriving anyclass (Print, JSON)

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

peekUVStat :: Ptr FStat -> IO FStat
peekUVStat p = FStat
    <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0) p)
{-# LINE 576 "Z/IO/UV/FFI.hsc" #-}
    <*> (fromIntegral <$> ((\hsc_ptr -> peekByteOff hsc_ptr 8) p :: IO Word64))
{-# LINE 577 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 16) p)
{-# LINE 578 "Z/IO/UV/FFI.hsc" #-}
    <*> (fromIntegral <$> ((\hsc_ptr -> peekByteOff hsc_ptr 24) p :: IO Word64))
{-# LINE 579 "Z/IO/UV/FFI.hsc" #-}
    <*> (fromIntegral <$> ((\hsc_ptr -> peekByteOff hsc_ptr 32) p :: IO Word64))
{-# LINE 580 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 40) p)
{-# LINE 581 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 48) p)
{-# LINE 582 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 56) p)
{-# LINE 583 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 64) p)
{-# LINE 584 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 72) p)
{-# LINE 585 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 80) p)
{-# LINE 586 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 88) p)
{-# LINE 587 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 96) p)
{-# LINE 588 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 112) p)
{-# LINE 589 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 128) p)
{-# LINE 590 "Z/IO/UV/FFI.hsc" #-}
    <*> ((\hsc_ptr -> peekByteOff hsc_ptr 144) p)
{-# LINE 591 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_stat :: BA# Word8 -> Ptr FStat -> IO Int
foreign import ccall unsafe hs_uv_fs_fstat :: FD -> Ptr FStat -> IO Int
foreign import ccall unsafe hs_uv_fs_lstat :: BA# Word8 -> Ptr FStat -> IO Int
foreign import ccall unsafe hs_uv_fs_rename :: BA# Word8 -> BA# Word8 -> IO Int
foreign import ccall unsafe hs_uv_fs_fsync :: FD -> IO Int
foreign import ccall unsafe hs_uv_fs_fdatasync :: FD -> IO Int
foreign import ccall unsafe hs_uv_fs_ftruncate :: FD -> Int64 -> IO Int

foreign import ccall unsafe hs_uv_fs_stat_threaded
    :: BA# Word8 -> Ptr FStat -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_fstat_threaded
    :: FD -> Ptr FStat -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_lstat_threaded
    :: BA# Word8 -> Ptr FStat -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_rename_threaded
    :: BA# Word8 -> BA# Word8 -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_fsync_threaded
    :: FD -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_fdatasync_threaded
    :: FD -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_ftruncate_threaded
    :: FD -> 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.
--  * 'COPYFILE_FICLONE_FORCE': If present, uv_fs_copyfile() will attempt to create a copy-on-write reflink. If the underlying platform does not support copy-on-write, or an error occurs while attempting to use copy-on-write, then an error is returned.
type CopyFileFlag = CInt

pattern COPYFILE_DEFAULT :: CopyFileFlag
pattern COPYFILE_DEFAULT = 0

pattern COPYFILE_EXCL :: CopyFileFlag
pattern COPYFILE_EXCL = 1
{-# LINE 627 "Z/IO/UV/FFI.hsc" #-}

pattern COPYFILE_FICLONE :: CopyFileFlag
pattern COPYFILE_FICLONE = 2
{-# LINE 630 "Z/IO/UV/FFI.hsc" #-}

pattern COPYFILE_FICLONE_FORCE :: CopyFileFlag
pattern COPYFILE_FICLONE_FORCE = 4
{-# LINE 633 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_copyfile :: BA# Word8 -> BA# Word8 -> CopyFileFlag -> IO Int
foreign import ccall unsafe hs_uv_fs_copyfile_threaded
    :: BA# Word8 -> BA# Word8 -> CopyFileFlag -> Ptr UVLoop -> IO UVSlotUnsafe

type AccessMode = CInt

pattern F_OK :: AccessMode
pattern F_OK = 0
{-# LINE 642 "Z/IO/UV/FFI.hsc" #-}
pattern R_OK :: AccessMode
pattern R_OK = 4
{-# LINE 644 "Z/IO/UV/FFI.hsc" #-}
pattern W_OK :: AccessMode
pattern W_OK = 2
{-# LINE 646 "Z/IO/UV/FFI.hsc" #-}
pattern X_OK :: AccessMode
pattern X_OK = 1
{-# LINE 648 "Z/IO/UV/FFI.hsc" #-}

data AccessResult = NoExistence | NoPermission | AccessOK
    deriving (Show, Eq, Ord, Enum, Generic)
    deriving anyclass (Print, JSON)

foreign import ccall unsafe hs_uv_fs_access :: BA# Word8 -> AccessMode -> IO Int
foreign import ccall unsafe hs_uv_fs_access_threaded
    :: BA# Word8 -> AccessMode -> Ptr UVLoop -> IO UVSlotUnsafe

foreign import ccall unsafe hs_uv_fs_chmod :: BA# Word8 -> FileMode -> IO Int
foreign import ccall unsafe hs_uv_fs_chmod_threaded
    :: BA# Word8 -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe

foreign import ccall unsafe hs_uv_fs_fchmod :: FD -> FileMode -> IO Int
foreign import ccall unsafe hs_uv_fs_fchmod_threaded
    :: FD -> FileMode -> Ptr UVLoop -> IO UVSlotUnsafe

foreign import ccall unsafe hs_uv_fs_utime :: BA# Word8 -> Double -> Double -> IO Int
foreign import ccall unsafe hs_uv_fs_utime_threaded
    :: BA# Word8 -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnsafe

foreign import ccall unsafe hs_uv_fs_futime :: FD -> Double -> Double -> IO Int
foreign import ccall unsafe hs_uv_fs_futime_threaded
    :: FD -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnsafe

foreign import ccall unsafe hs_uv_fs_lutime :: BA# Word8 -> Double -> Double -> IO Int
foreign import ccall unsafe hs_uv_fs_lutime_threaded
    :: BA# Word8 -> Double -> Double -> Ptr UVLoop -> IO UVSlotUnsafe

-- | 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.
type SymlinkFlag = CInt

pattern SYMLINK_DEFAULT :: SymlinkFlag
pattern SYMLINK_DEFAULT = 0

pattern SYMLINK_DIR :: SymlinkFlag
pattern SYMLINK_DIR = 1
{-# LINE 688 "Z/IO/UV/FFI.hsc" #-}

pattern SYMLINK_JUNCTION :: SymlinkFlag
pattern SYMLINK_JUNCTION = 2
{-# LINE 691 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_fs_link :: BA# Word8 -> BA# Word8 -> IO Int
foreign import ccall unsafe hs_uv_fs_link_threaded
    :: BA# Word8 -> BA# Word8 -> Ptr UVLoop -> IO UVSlotUnsafe

foreign import ccall unsafe hs_uv_fs_symlink :: BA# Word8 -> BA# Word8 -> SymlinkFlag -> IO Int
foreign import ccall unsafe hs_uv_fs_symlink_threaded
    :: BA# Word8 -> BA# Word8 -> SymlinkFlag -> 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
    :: BA# Word8 -> MBA# CString -> IO Int
foreign import ccall unsafe hs_uv_fs_realpath
    :: BA# Word8  -> 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
    :: BA# Word8  -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_realpath_threaded
    :: BA# Word8  -> Ptr CString -> Ptr UVLoop -> IO UVSlotUnsafe

foreign import ccall unsafe hs_uv_fs_chown :: BA# Word8 -> UID -> GID -> IO Int
foreign import ccall unsafe hs_uv_fs_chown_threaded
    :: BA# Word8 -> UID -> GID -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_fchown :: FD -> UID -> GID -> IO Int
foreign import ccall unsafe hs_uv_fs_fchown_threaded
    :: FD -> UID -> GID -> Ptr UVLoop -> IO UVSlotUnsafe
foreign import ccall unsafe hs_uv_fs_lchown :: BA# Word8 -> UID -> GID -> IO Int
foreign import ccall unsafe hs_uv_fs_lchown_threaded
    :: BA# Word8 -> UID -> GID -> Ptr UVLoop -> IO UVSlotUnsafe

--------------------------------------------------------------------------------
-- process

newtype UID = UID

{-# LINE 731 "Z/IO/UV/FFI.hsc" #-}
    Word32

{-# LINE 733 "Z/IO/UV/FFI.hsc" #-}
   deriving (Eq, Ord, Show, Read, Generic)
   deriving newtype (Storable, Prim, Unaligned, Num, JSON)
   deriving anyclass Print

newtype GID = GID

{-# LINE 741 "Z/IO/UV/FFI.hsc" #-}
    Word32

{-# LINE 743 "Z/IO/UV/FFI.hsc" #-}
   deriving (Eq, Ord, Show, Read, Generic)
   deriving newtype (Storable, Prim, Unaligned, Num, JSON)
   deriving anyclass Print

type ProcessFlag = CUInt

-- | Set the child process' user id.
--
-- This is not supported on Windows, uv_spawn() will fail and set the error to UV_ENOTSUP.
pattern PROCESS_SETUID :: ProcessFlag
pattern PROCESS_SETUID = (1)
{-# LINE 754 "Z/IO/UV/FFI.hsc" #-}
-- | Set the child process' user id.
--
-- This is not supported on Windows, uv_spawn() will fail and set the error to UV_ENOTSUP.
pattern PROCESS_SETGID :: ProcessFlag
pattern PROCESS_SETGID = (2)
{-# LINE 759 "Z/IO/UV/FFI.hsc" #-}
-- | Do not wrap any arguments in quotes, or perform any other escaping, when
-- converting the argument list into a command line string.
--
-- This option is only meaningful on Windows systems. On Unix it is silently ignored.
pattern PROCESS_WINDOWS_VERBATIM_ARGUMENTS :: ProcessFlag
pattern PROCESS_WINDOWS_VERBATIM_ARGUMENTS = (4)
{-# LINE 765 "Z/IO/UV/FFI.hsc" #-}
-- | Spawn the child process in a detached state
--
-- This will make it a process group leader, and will effectively enable the child to keep running after
-- the parent exits.
pattern PROCESS_DETACHED :: ProcessFlag
pattern PROCESS_DETACHED = (8)
{-# LINE 771 "Z/IO/UV/FFI.hsc" #-}
-- | Hide the subprocess window that would normally be created.
--
-- This option is only meaningful on Windows systems. On Unix it is silently ignored.
pattern PROCESS_WINDOWS_HIDE :: ProcessFlag
pattern PROCESS_WINDOWS_HIDE = (16)
{-# LINE 776 "Z/IO/UV/FFI.hsc" #-}
-- | Hide the subprocess console window that would normally be created.
--
-- This option is only meaningful on Windows systems. On Unix it is silently ignored.
pattern PROCESS_WINDOWS_HIDE_CONSOLE :: ProcessFlag
pattern PROCESS_WINDOWS_HIDE_CONSOLE = (32)
{-# LINE 781 "Z/IO/UV/FFI.hsc" #-}
-- | Hide the subprocess GUI window that would normally be created.
--
-- This option is only meaningful on Windows systems. On Unix it is silently ignored.
pattern PROCESS_WINDOWS_HIDE_GUI :: ProcessFlag
pattern PROCESS_WINDOWS_HIDE_GUI = (64)
{-# LINE 786 "Z/IO/UV/FFI.hsc" #-}


{- typedef struct uv_process_options_s {
    uv_exit_cb exit_cb;
    const char* file;
    char** args;
    char** env;
    const char* cwd;
    unsigned int flags;
    int stdio_count;
    uv_stdio_container_t* stdio;
    uv_uid_t uid;
    uv_gid_t gid;
} uv_process_options_t;
-}

data ProcessOptions = ProcessOptions
    { processFile :: CBytes                     -- ^ Path pointing to the program to be executed.
    , processArgs :: [CBytes]                   -- ^ Command line arguments.
                                                -- On Windows this uses CreateProcess which concatenates
                                                -- the arguments into a string this can cause some strange errors.
                                                -- See the 'PROCESS_WINDOWS_VERBATIM_ARGUMENTS'.
    , processEnv  :: Maybe [(CBytes, CBytes)]   -- ^ Optional environment(otherwise inherit from the current process).
    , processCWD :: CBytes                      -- ^ Current working directory for the subprocess.
    , processFlags :: ProcessFlag               -- ^ Various flags that control how spawn behaves
    , processUID :: UID -- ^ This happens only when the appropriate bits are set in the flags fields.
    , processGID :: GID -- ^ This happens only when the appropriate bits are set in the flags fields.
    , processStdStreams :: (ProcessStdStream, ProcessStdStream, ProcessStdStream) -- ^ Specifying how (stdin, stdout, stderr) should be passed/created to the child, see 'ProcessStdStream'

    }   deriving (Eq, Ord, Show, Read, Generic)
        deriving anyclass (Print, JSON)

data ProcessStdStream
    = ProcessIgnore     -- ^ redirect process std stream to \/dev\/null
    | ProcessCreate     -- ^ create a new std stream
    | ProcessInherit FD -- ^ pass an existing FD to child process as std stream
  deriving  (Eq, Ord, Show, Read, Generic)
  deriving anyclass (Print, JSON)

processStdStreamFlag :: ProcessStdStream -> CInt
processStdStreamFlag ProcessIgnore = 0
{-# LINE 827 "Z/IO/UV/FFI.hsc" #-}
processStdStreamFlag ProcessCreate = (1)
{-# LINE 828 "Z/IO/UV/FFI.hsc" #-}
                            .|. (16)
{-# LINE 829 "Z/IO/UV/FFI.hsc" #-}
                            .|. (32)
{-# LINE 830 "Z/IO/UV/FFI.hsc" #-}
processStdStreamFlag (ProcessInherit _) = 2
{-# LINE 831 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe hs_uv_spawn :: Ptr UVLoop
                                        -> MBA# ProcessOptions         --  option
                                        -> BA# Word8                   --  file
                                        -> BAArray# Word8              --  all args
                                        -> Int                          --  args len
                                        -> BAArray# Word8              --  all envs
                                        -> Int                          --  envs len
                                        -> BA# Word8                   --  cwd
                                        -> MBA# ProcessStdStream       -- stdio
                                        -> IO Int

foreign import ccall unsafe uv_kill :: CInt -> CInt -> IO CInt

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

type UVHandleType = CInt

pattern UV_UNKNOWN_HANDLE :: UVHandleType
pattern UV_UNKNOWN_HANDLE = 0
{-# LINE 852 "Z/IO/UV/FFI.hsc" #-}
pattern UV_ASYNC :: UVHandleType
pattern UV_ASYNC = 1
{-# LINE 854 "Z/IO/UV/FFI.hsc" #-}
pattern UV_CHECK :: UVHandleType
pattern UV_CHECK = 2
{-# LINE 856 "Z/IO/UV/FFI.hsc" #-}
pattern UV_FS_EVENT :: UVHandleType
pattern UV_FS_EVENT = 3
{-# LINE 858 "Z/IO/UV/FFI.hsc" #-}
pattern UV_FS_POLL :: UVHandleType
pattern UV_FS_POLL = 4
{-# LINE 860 "Z/IO/UV/FFI.hsc" #-}
pattern UV_HANDLE :: UVHandleType
pattern UV_HANDLE = 5
{-# LINE 862 "Z/IO/UV/FFI.hsc" #-}
pattern UV_IDLE :: UVHandleType
pattern UV_IDLE = 6
{-# LINE 864 "Z/IO/UV/FFI.hsc" #-}
pattern UV_NAMED_PIPE :: UVHandleType
pattern UV_NAMED_PIPE = 7
{-# LINE 866 "Z/IO/UV/FFI.hsc" #-}
pattern UV_POLL :: UVHandleType
pattern UV_POLL = 8
{-# LINE 868 "Z/IO/UV/FFI.hsc" #-}
pattern UV_PREPARE :: UVHandleType
pattern UV_PREPARE = 9
{-# LINE 870 "Z/IO/UV/FFI.hsc" #-}
pattern UV_PROCESS :: UVHandleType
pattern UV_PROCESS = 10
{-# LINE 872 "Z/IO/UV/FFI.hsc" #-}
pattern UV_STREAM :: UVHandleType
pattern UV_STREAM = 11
{-# LINE 874 "Z/IO/UV/FFI.hsc" #-}
pattern UV_TCP :: UVHandleType
pattern UV_TCP = 12
{-# LINE 876 "Z/IO/UV/FFI.hsc" #-}
pattern UV_TIMER :: UVHandleType
pattern UV_TIMER = 13
{-# LINE 878 "Z/IO/UV/FFI.hsc" #-}
pattern UV_TTY :: UVHandleType
pattern UV_TTY = 14
{-# LINE 880 "Z/IO/UV/FFI.hsc" #-}
pattern UV_UDP :: UVHandleType
pattern UV_UDP = 15
{-# LINE 882 "Z/IO/UV/FFI.hsc" #-}
pattern UV_SIGNAL :: UVHandleType
pattern UV_SIGNAL = 16
{-# LINE 884 "Z/IO/UV/FFI.hsc" #-}
pattern UV_FILE :: UVHandleType
pattern UV_FILE = 17
{-# LINE 886 "Z/IO/UV/FFI.hsc" #-}

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

foreign import ccall unsafe uv_resident_set_memory :: MBA# CSize -> IO CInt
foreign import ccall unsafe uv_uptime :: MBA# Double -> IO CInt
foreign import ccall unsafe uv_getrusage :: MBA# a -> IO CInt

foreign import ccall unsafe uv_get_free_memory :: IO Word64
foreign import ccall unsafe uv_get_total_memory :: IO Word64
foreign import ccall unsafe uv_get_constrained_memory :: IO Word64

-- | Data type for storing times.
-- typedef struct { long tv_sec; long tv_usec; } uv_timeval_t;
data TimeVal = TimeVal
    { tv_sec  :: {-# UNPACK #-} !CLong
    , tv_usec :: {-# UNPACK #-} !CLong
    }   deriving (Show, Read, Eq, Ord, Generic)
        deriving anyclass (Print, JSON)

-- | Data type for resource usage results.
--
-- Members marked with (X) are unsupported on Windows.
-- See <https://man7.org/linux/man-pages/man2/getrusage.2.html getrusage(2)> for supported fields on Unix
data ResUsage = ResUsage
    { ru_utime    :: {-# UNPACK #-} !TimeVal   -- ^  user CPU time used, in microseconds
    , ru_stime    :: {-# UNPACK #-} !TimeVal   -- ^  system CPU time used, in microseconds
    , ru_maxrss   :: {-# UNPACK #-} !Word64    -- ^  maximum resident set size
    , ru_ixrss    :: {-# UNPACK #-} !Word64    -- ^  integral shared memory size (X)
    , ru_idrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared data size (X)
    , ru_isrss    :: {-# UNPACK #-} !Word64    -- ^  integral unshared stack size (X)
    , ru_minflt   :: {-# UNPACK #-} !Word64    -- ^  page reclaims (soft page faults) (X)
    , ru_majflt   :: {-# UNPACK #-} !Word64    -- ^  page faults (hard page faults)
    , ru_nswap    :: {-# UNPACK #-} !Word64    -- ^  swaps (X)
    , ru_inblock  :: {-# UNPACK #-} !Word64    -- ^  block input operations
    , ru_oublock  :: {-# UNPACK #-} !Word64    -- ^  block output operations
    , ru_msgsnd   :: {-# UNPACK #-} !Word64    -- ^  IPC messages sent (X)
    , ru_msgrcv   :: {-# UNPACK #-} !Word64    -- ^  IPC messages received (X)
    , ru_nsignals :: {-# UNPACK #-} !Word64    -- ^  signals received (X)
    , ru_nvcsw    :: {-# UNPACK #-} !Word64    -- ^  voluntary context switches (X)
    , ru_nivcsw   :: {-# UNPACK #-} !Word64    -- ^  involuntary context switches (X)
    }   deriving (Show, Read, Eq, Ord, Generic)
        deriving anyclass (Print, JSON)

sizeOfResUsage :: Int
sizeOfResUsage = (144)
{-# LINE 931 "Z/IO/UV/FFI.hsc" #-}

peekResUsage :: MBA# a -> IO ResUsage
peekResUsage mba = do
    utime_sec :: CLong <- peekMBA mba ((0))
{-# LINE 935 "Z/IO/UV/FFI.hsc" #-}
    utime_usec :: CLong <- peekMBA mba (((0)) + sizeOf (undefined :: CLong))
{-# LINE 936 "Z/IO/UV/FFI.hsc" #-}
    stime_sec :: CLong <- peekMBA mba ((16))
{-# LINE 937 "Z/IO/UV/FFI.hsc" #-}
    stime_usec :: CLong <- peekMBA mba (((16)) + sizeOf (undefined :: CLong))
{-# LINE 938 "Z/IO/UV/FFI.hsc" #-}
    maxrss   <- peekMBA mba ((32))
{-# LINE 939 "Z/IO/UV/FFI.hsc" #-}
    ixrss    <- peekMBA mba ((40))
{-# LINE 940 "Z/IO/UV/FFI.hsc" #-}
    idrss    <- peekMBA mba ((48))
{-# LINE 941 "Z/IO/UV/FFI.hsc" #-}
    isrss    <- peekMBA mba ((56))
{-# LINE 942 "Z/IO/UV/FFI.hsc" #-}
    minflt   <- peekMBA mba ((64))
{-# LINE 943 "Z/IO/UV/FFI.hsc" #-}
    majflt   <- peekMBA mba ((72))
{-# LINE 944 "Z/IO/UV/FFI.hsc" #-}
    nswap    <- peekMBA mba ((80))
{-# LINE 945 "Z/IO/UV/FFI.hsc" #-}
    inblock  <- peekMBA mba ((88))
{-# LINE 946 "Z/IO/UV/FFI.hsc" #-}
    oublock  <- peekMBA mba ((96))
{-# LINE 947 "Z/IO/UV/FFI.hsc" #-}
    msgsnd   <- peekMBA mba ((104))
{-# LINE 948 "Z/IO/UV/FFI.hsc" #-}
    msgrcv   <- peekMBA mba ((112))
{-# LINE 949 "Z/IO/UV/FFI.hsc" #-}
    nsignals <- peekMBA mba ((120))
{-# LINE 950 "Z/IO/UV/FFI.hsc" #-}
    nvcsw    <- peekMBA mba ((128))
{-# LINE 951 "Z/IO/UV/FFI.hsc" #-}
    nivcsw   <- peekMBA mba ((136))
{-# LINE 952 "Z/IO/UV/FFI.hsc" #-}
    return (ResUsage (TimeVal utime_sec utime_usec) (TimeVal stime_sec stime_usec)
                    maxrss ixrss idrss isrss minflt majflt nswap inblock
                    oublock msgsnd msgrcv nsignals nvcsw nivcsw)

foreign import ccall unsafe uv_os_getpid :: IO PID
foreign import ccall unsafe uv_os_getppid :: IO PID
foreign import ccall unsafe uv_os_getpriority :: PID -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_os_setpriority :: PID -> CInt -> IO CInt

newtype PID = PID CInt
    deriving (Eq, Ord, Show, Read, Generic)
    deriving newtype (Storable, Prim, Unaligned, JSON)
    deriving anyclass Print

type Priority = CInt
pattern PRIORITY_LOW          :: Priority
pattern PRIORITY_BELOW_NORMAL :: Priority
pattern PRIORITY_NORMAL       :: Priority
pattern PRIORITY_ABOVE_NORMAL :: Priority
pattern PRIORITY_HIGH         :: Priority
pattern PRIORITY_HIGHEST      :: Priority
pattern PRIORITY_LOW           = 19
{-# LINE 974 "Z/IO/UV/FFI.hsc" #-}
pattern PRIORITY_BELOW_NORMAL  = 10
{-# LINE 975 "Z/IO/UV/FFI.hsc" #-}
pattern PRIORITY_NORMAL        = 0
{-# LINE 976 "Z/IO/UV/FFI.hsc" #-}
pattern PRIORITY_ABOVE_NORMAL  = -7
{-# LINE 977 "Z/IO/UV/FFI.hsc" #-}
pattern PRIORITY_HIGH          = -14
{-# LINE 978 "Z/IO/UV/FFI.hsc" #-}
pattern PRIORITY_HIGHEST       = -20
{-# LINE 979 "Z/IO/UV/FFI.hsc" #-}

foreign import ccall unsafe uv_hrtime :: IO Word64

foreign import ccall unsafe uv_os_environ :: MBA# (Ptr a) -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_os_free_environ :: Ptr a -> CInt -> IO ()
foreign import ccall unsafe uv_os_getenv :: BA# Word8 -> MBA# Word8 -> MBA# CSize -> IO CInt
foreign import ccall unsafe uv_os_setenv :: BA# Word8 -> BA# Word8 -> IO CInt
foreign import ccall unsafe uv_os_unsetenv :: BA# Word8 -> IO CInt

pattern UV_MAXHOSTNAMESIZE :: CSize
pattern UV_MAXHOSTNAMESIZE = 65
{-# LINE 990 "Z/IO/UV/FFI.hsc" #-}
foreign import ccall unsafe uv_os_gethostname :: MBA# Word8 -> MBA# CSize -> IO CInt

-- | Data type for operating system name and version information.
data OSName = OSName
    { os_sysname :: CBytes
    , os_release :: CBytes
    , os_version :: CBytes
    , os_machine :: CBytes
    }   deriving (Eq, Ord, Show, Read, Generic)
        deriving anyclass (Print, JSON)

getOSName :: HasCallStack => IO OSName
getOSName = do
    (MutableByteArray mba#) <- newByteArray ((1024))
{-# LINE 1004 "Z/IO/UV/FFI.hsc" #-}
    throwUVIfMinus_ (uv_os_uname mba#)
    sn <- peekMBACBytes mba# ((0))
{-# LINE 1006 "Z/IO/UV/FFI.hsc" #-}
    re <- peekMBACBytes mba# ((256))
{-# LINE 1007 "Z/IO/UV/FFI.hsc" #-}
    ve <- peekMBACBytes mba# ((512))
{-# LINE 1008 "Z/IO/UV/FFI.hsc" #-}
    ma <- peekMBACBytes mba#  ((768))
{-# LINE 1009 "Z/IO/UV/FFI.hsc" #-}
    return (OSName sn re ve ma)

foreign import ccall unsafe uv_os_uname :: MBA# OSName -> IO CInt

foreign import ccall unsafe hs_uv_random :: MBA# Word8 -> CSize -> CInt -> IO CInt
foreign import ccall unsafe hs_uv_random_threaded :: Ptr Word8 -> CSize -> CInt -> Ptr UVLoop -> IO UVSlotUnsafe

-- | Data type for password file information.
data PassWD = PassWD
    { passwd_username :: CBytes
    , passwd_uid :: UID
    , passwd_gid :: GID
    , passwd_shell :: CBytes
    , passwd_homedir :: CBytes
    }   deriving (Eq, Ord, Show, Read, Generic)
        deriving anyclass (Print, JSON)

foreign import ccall unsafe uv_os_get_passwd :: MBA# PassWD -> IO CInt
foreign import ccall unsafe uv_os_free_passwd :: MBA# PassWD -> IO ()

-- | Gets a subset of the password file entry for the current effective uid (not the real uid).
--
-- The populated data includes the username, euid, gid, shell, and home directory.
-- On non-Windows systems, all data comes from getpwuid_r(3).
-- On Windows, uid and gid are set to -1 and have no meaning, and shell is empty.
getPassWD :: HasCallStack => IO PassWD
getPassWD =  bracket
    (do mpa@(MutableByteArray mba#) <- newByteArray ((40))
{-# LINE 1037 "Z/IO/UV/FFI.hsc" #-}
        throwUVIfMinus_ (uv_os_get_passwd mba#)
        return mpa)
    (\ (MutableByteArray mba#) -> uv_os_free_passwd mba#)
    (\ (MutableByteArray mba#) -> do
        username <- fromCString =<< peekMBA mba# ((0))
{-# LINE 1042 "Z/IO/UV/FFI.hsc" #-}
        uid <- fromIntegral <$> (peekMBA mba# ((8)) :: IO CLong)
{-# LINE 1043 "Z/IO/UV/FFI.hsc" #-}
        gid <- fromIntegral <$> (peekMBA mba# ((16)) :: IO CLong)
{-# LINE 1044 "Z/IO/UV/FFI.hsc" #-}
        shell <- fromCString =<< peekMBA mba# ((24))
{-# LINE 1045 "Z/IO/UV/FFI.hsc" #-}
        homedir <- fromCString =<< peekMBA mba# ((32))
{-# LINE 1046 "Z/IO/UV/FFI.hsc" #-}
        return (PassWD username uid gid shell homedir))

foreign import ccall unsafe uv_cwd :: MBA# Word8 -> MBA# CSize -> IO CInt
foreign import ccall unsafe uv_chdir :: BA# Word8 -> IO CInt
foreign import ccall unsafe uv_os_homedir :: MBA# Word8 -> MBA# CSize -> IO CInt
foreign import ccall unsafe uv_os_tmpdir :: MBA# Word8 -> MBA# CSize -> IO CInt

foreign import ccall unsafe uv_cpu_info      :: MBA# (Ptr CPUInfo) -> MBA# CInt -> IO CInt
foreign import ccall unsafe uv_free_cpu_info :: Ptr CPUInfo -> CInt -> IO ()

-- | Data type for CPU information.
data CPUInfo = CPUInfo
    { cpu_model :: CBytes
    , cpu_speed :: CInt
    , cpu_times_user :: Word64  -- ^ milliseconds
    , cpu_times_nice :: Word64  -- ^ milliseconds
    , cpu_times_sys  :: Word64  -- ^ milliseconds
    , cpu_times_idle :: Word64  -- ^ milliseconds
    , cpu_times_irq  :: Word64  -- ^ milliseconds
    }   deriving (Eq, Ord, Show, Read, Generic)
        deriving anyclass (Print, JSON)

-- | Gets information about the CPUs on the system.
getCPUInfo :: HasCallStack => IO [CPUInfo]
getCPUInfo = bracket
    (do (p, (len, _)) <-  allocPrimUnsafe $ \ pp ->
            allocPrimUnsafe $ \ plen ->
                throwUVIfMinus_ (uv_cpu_info pp plen)
        return (p, len))
    (\ (p, len) -> uv_free_cpu_info p len)
    (\ (p, len) -> forM [0..fromIntegral len-1] (peekCPUInfoOff p))

peekCPUInfoOff :: Ptr CPUInfo -> Int -> IO CPUInfo
peekCPUInfoOff p off = do
    let p' = p `plusPtr` (off * ((56)))
{-# LINE 1081 "Z/IO/UV/FFI.hsc" #-}
    model <- fromCString =<< ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 1082 "Z/IO/UV/FFI.hsc" #-}
    speed <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 1083 "Z/IO/UV/FFI.hsc" #-}
    user <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 1084 "Z/IO/UV/FFI.hsc" #-}
    nice <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 1085 "Z/IO/UV/FFI.hsc" #-}
    sys <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p'
{-# LINE 1086 "Z/IO/UV/FFI.hsc" #-}
    idle <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p'
{-# LINE 1087 "Z/IO/UV/FFI.hsc" #-}
    irq <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p'
{-# LINE 1088 "Z/IO/UV/FFI.hsc" #-}
    return (CPUInfo model speed user nice sys idle irq)

foreign import ccall unsafe uv_loadavg :: MBA# (Double, Double, Double) -> IO ()

-- | Gets the load average. See: <https://en.wikipedia.org/wiki/Load_(computing)>
getLoadAvg :: IO (Double, Double, Double)
getLoadAvg = do
    (arr, _) <- allocPrimArrayUnsafe 3 uv_loadavg
    return ( indexPrimArray arr 0
           , indexPrimArray arr 1
           , indexPrimArray arr 2)

-- | Alternative data type for storing times.
-- typedef struct { int64_t tv_sec; int32_t tv_usec; } uv_timeval64_t;
data TimeVal64 = TimeVal64
    { tv64_sec  :: {-# UNPACK #-} !Int64
    , tv64_usec :: {-# UNPACK #-} !Int32
    }   deriving (Show, Read, Eq, Ord, Generic)
        deriving anyclass (Print, JSON)

foreign import ccall unsafe uv_gettimeofday :: MBA# TimeVal64 -> IO CInt

-- | Cross-platform implementation of <https://man7.org/linux/man-pages/man2/gettimeofday.2.html gettimeofday(2)>.
-- The timezone argument to gettimeofday() is not supported, as it is considered obsolete.
getTimeOfDay :: HasCallStack => IO TimeVal64
getTimeOfDay = do
    (MutableByteArray mba#) <- newByteArray ((16))
{-# LINE 1115 "Z/IO/UV/FFI.hsc" #-}
    throwUVIfMinus_ (uv_gettimeofday mba#)
    s <- peekMBA mba# ((0))
{-# LINE 1117 "Z/IO/UV/FFI.hsc" #-}
    us <- peekMBA mba# ((8))
{-# LINE 1118 "Z/IO/UV/FFI.hsc" #-}
    return (TimeVal64 s us)

--------------------------------------------------------------------------------
-- fs event

foreign import ccall unsafe uv_fs_event_init :: Ptr UVLoop -> Ptr UVHandle -> IO CInt
foreign import ccall unsafe hs_uv_fs_event_start :: Ptr UVHandle -> BA# Word8 -> CUInt -> IO CInt
foreign import ccall unsafe uv_fs_event_stop :: Ptr UVHandle -> IO CInt
foreign import ccall unsafe hs_uv_fs_event_check_start :: Ptr UVHandle -> IO CInt

pattern UV_RENAME :: Word8
pattern UV_RENAME = 1
{-# LINE 1130 "Z/IO/UV/FFI.hsc" #-}

pattern UV_CHANGE :: Word8
pattern UV_CHANGE = 2
{-# LINE 1133 "Z/IO/UV/FFI.hsc" #-}

pattern UV_FS_EVENT_RECURSIVE :: CUInt
pattern UV_FS_EVENT_RECURSIVE = 4
{-# LINE 1136 "Z/IO/UV/FFI.hsc" #-}