{-# LINE 1 "src/System/SendFile/Darwin.hsc" #-}
{-# LANGUAGE BangPatterns #-}
{-# LINE 2 "src/System/SendFile/Darwin.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.SendFile.Darwin
( sendFile
, sendFileImpl
, sendFileMode
) where
import Control.Concurrent (threadWaitWrite)
import Data.Int
import Data.Word
import Foreign.C.Error (throwErrnoIfMinus1RetryMayBlock_)
{-# LINE 16 "src/System/SendFile/Darwin.hsc" #-}
import Foreign.C.Types (CInt (CInt))
{-# LINE 20 "src/System/SendFile/Darwin.hsc" #-}
import Foreign.Marshal (alloca)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (peek, poke)
{-# LINE 24 "src/System/SendFile/Darwin.hsc" #-}
import System.Posix.Types (COff (COff), Fd (Fd))
{-# LINE 28 "src/System/SendFile/Darwin.hsc" #-}
sendFile :: Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFile = sendFileImpl c_sendfile threadWaitWrite
{-# INLINE sendFile #-}
sendFileImpl :: (Fd -> Fd -> COff -> Ptr COff -> IO CInt)
-> (Fd -> IO ())
-> Fd -> Fd -> Word64 -> Word64 -> IO Int64
sendFileImpl !rawSendFile !wait out_fd in_fd off count
| count == 0 = return 0
| otherwise = alloca $ \pbytes -> do
poke pbytes $ fromIntegral count
sbytes <- sendfile rawSendFile wait out_fd in_fd (fromIntegral off)
pbytes
return $ fromIntegral sbytes
{-# INLINE sendFileImpl #-}
sendfile :: (Fd -> Fd -> COff -> Ptr COff -> IO CInt)
-> (Fd -> IO ())
-> Fd -> Fd -> COff -> Ptr COff -> IO COff
sendfile rawSendFile wait out_fd in_fd off pbytes = do
throwErrnoIfMinus1RetryMayBlock_ "sendfile"
(rawSendFile out_fd in_fd off pbytes)
(wait out_fd)
peek pbytes
{-# INLINE sendfile #-}
foreign import ccall unsafe "sys/uio.h sendfile" c_sendfile_darwin
:: Fd -> Fd -> COff -> Ptr COff -> Ptr () -> CInt -> IO CInt
c_sendfile :: Fd -> Fd -> COff -> Ptr COff -> IO CInt
c_sendfile out_fd in_fd off pbytes =
c_sendfile_darwin in_fd out_fd off pbytes nullPtr 0
{-# INLINE c_sendfile #-}
sendFileMode :: String
sendFileMode = "DARWIN_SENDFILE"