{-# LINE 1 "src/SendFile/Internal.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LINE 2 "src/SendFile/Internal.hsc" #-}
module SendFile.Internal (
    sendFile,
    sendFileMode
    ) where
    
import Data.ByteString.Char8
import Prelude hiding (readFile)
import System.IO (Handle(..), hFlush)


{-# LINE 34 "src/SendFile/Internal.hsc" #-}

{-# LINE 35 "src/SendFile/Internal.hsc" #-}
import Foreign.C
import GHC.IOBase (haFD)
import GHC.Handle (withHandle_)

sendFileMode :: String
sendFileMode = "LINUX_SENDFILE"

sendFile :: Handle -> FilePath -> IO ()
sendFile outh infp = do
    -- flush outh before handing it sendFile
    hFlush outh
    withHandle_ "sendFile" outh $ \outh' -> do 
    withCString infp $ \in_fp -> do
    let out_fd = haFD outh'
    err <- c_sendfile_linux out_fd in_fp
    if err == 0
        then return ()
        else fail ("errno " ++ show err)
    
foreign import ccall
    c_sendfile_linux :: CInt -> CString -> IO Int

{-# LINE 66 "src/SendFile/Internal.hsc" #-}

{-# LINE 67 "src/SendFile/Internal.hsc" #-}