    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE CPP
               , NoImplicitPrelude
               , BangPatterns
               , RankNTypes
      #-}
    {-# OPTIONS_GHC -Wno-identities #-}
    -- Whether there are identities depends on the platform
    {-# OPTIONS_HADDOCK not-home #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.IO.FD
    -- Copyright   :  (c) The University of Glasgow, 1994-2008
    -- License     :  see libraries/base/LICENSE
    --
    -- Maintainer  :  libraries@haskell.org
    -- Stability   :  internal
    -- Portability :  non-portable
    --
    -- Raw read/write operations on file descriptors
    --
    -----------------------------------------------------------------------------

    module GHC.IO.FD (
            FD(..),
            openFileWith, openFile, mkFD, release,
            setNonBlockingMode,
            readRawBufferPtr, readRawBufferPtrNoBlock, writeRawBufferPtr,
            stdin, stdout, stderr
        ) where

    import GHC.Base
    import GHC.Num
    import GHC.Real
    import GHC.Show
    import GHC.Enum

    import GHC.IO
    import GHC.IO.IOMode
    import GHC.IO.Buffer
    import GHC.IO.BufferedIO
    import qualified GHC.IO.Device
    import GHC.IO.Device (SeekMode(..), IODeviceType(..))
    import GHC.Conc.IO
    import GHC.IO.Exception
    #if defined(mingw32_HOST_OS)
    import GHC.Windows
    import Data.Bool
    import GHC.IO.SubSystem ((<!>))
    #endif

    import Foreign
    import Foreign.C
    import qualified System.Posix.Internals
    import System.Posix.Internals hiding (FD, setEcho, getEcho)
    import System.Posix.Types

    #if defined(mingw32_HOST_OS)
    # if defined(i386_HOST_ARCH)
    #  define WINDOWS_CCONV stdcall
    # elif defined(x86_64_HOST_ARCH)
    #  define WINDOWS_CCONV ccall
    # else
    #  error Unknown mingw32 arch
    # endif
    #endif

    c_DEBUG_DUMP :: Bool
    c_DEBUG_DUMP :: Bool
    c_DEBUG_DUMP = Bool
    False

    -- Darwin limits the length of writes to 2GB. See #17414.
    -- Moreover, Linux will only transfer up to 0x7ffff000 and interpreting the
    -- result of write/read is tricky above 2GB due to its signed type. For
    -- simplicity we therefore clamp on all platforms.
    clampWriteSize, clampReadSize :: Int -> Int
    clampWriteSize :: Int -> Int
    clampWriteSize = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    0x7ffff000
    clampReadSize :: Int -> Int
    clampReadSize  = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    0x7ffff000

    -- -----------------------------------------------------------------------------
    -- The file-descriptor IO device

    data FD = FD {
      FD -> CInt
    fdFD :: {-# UNPACK #-} !CInt,
    #if defined(mingw32_HOST_OS)
      -- On Windows, a socket file descriptor needs to be read and written
      -- using different functions (send/recv).
      fdIsSocket_ :: {-# UNPACK #-} !Int
    #else
      -- On Unix we need to know whether this FD has O_NONBLOCK set.
      -- If it has, then we can use more efficient routines to read/write to it.
      -- It is always safe for this to be off.
      FD -> Int
    fdIsNonBlocking :: {-# UNPACK #-} !Int
    #endif
     }

    #if defined(mingw32_HOST_OS)
    fdIsSocket :: FD -> Bool
    fdIsSocket fd = fdIsSocket_ fd /= 0
    #endif

    -- | @since 4.1.0.0
    instance Show FD where
      show :: FD -> String
    show FD
    fd = CInt -> String
    forall a. Show a => a -> String
    show (FD -> CInt
    fdFD FD
    fd)

    {-# INLINE ifSupported #-}
    ifSupported :: String -> a -> a
    #if defined(mingw32_HOST_OS)
    ifSupported s a = a <!> (error $ "FD:" ++ s ++ " not supported")
    #else
    ifSupported :: forall a. String -> a -> a
    ifSupported String
    _ = a -> a
    forall a. a -> a
    id
    #endif

    -- | @since 4.1.0.0
    instance GHC.IO.Device.RawIO FD where
      read :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    read             = String
    -> (FD -> Ptr Word8 -> Word64 -> Int -> IO Int)
    -> FD
    -> Ptr Word8
    -> Word64
    -> Int
    -> IO Int
    forall a. String -> a -> a
    ifSupported String
    "fdRead" FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    fdRead
      readNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
    readNonBlocking  = String
    -> (FD -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int))
    -> FD
    -> Ptr Word8
    -> Word64
    -> Int
    -> IO (Maybe Int)
    forall a. String -> a -> a
    ifSupported String
    "fdReadNonBlocking" FD -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
    fdReadNonBlocking
      write :: FD -> Ptr Word8 -> Word64 -> Int -> IO ()
    write            = String
    -> (FD -> Ptr Word8 -> Word64 -> Int -> IO ())
    -> FD
    -> Ptr Word8
    -> Word64
    -> Int
    -> IO ()
    forall a. String -> a -> a
    ifSupported String
    "fdWrite" FD -> Ptr Word8 -> Word64 -> Int -> IO ()
    fdWrite
      writeNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    writeNonBlocking = String
    -> (FD -> Ptr Word8 -> Word64 -> Int -> IO Int)
    -> FD
    -> Ptr Word8
    -> Word64
    -> Int
    -> IO Int
    forall a. String -> a -> a
    ifSupported String
    "fdWriteNonBlocking" FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    fdWriteNonBlocking

    -- | @since 4.1.0.0
    instance GHC.IO.Device.IODevice FD where
      ready :: FD -> Bool -> Int -> IO Bool
    ready         = String
    -> (FD -> Bool -> Int -> IO Bool) -> FD -> Bool -> Int -> IO Bool
    forall a. String -> a -> a
    ifSupported String
    "ready" FD -> Bool -> Int -> IO Bool
    ready
      close :: FD -> IO ()
    close         = String -> (FD -> IO ()) -> FD -> IO ()
    forall a. String -> a -> a
    ifSupported String
    "close" FD -> IO ()
    close
      isTerminal :: FD -> IO Bool
    isTerminal    = String -> (FD -> IO Bool) -> FD -> IO Bool
    forall a. String -> a -> a
    ifSupported String
    "isTerm" FD -> IO Bool
    isTerminal
      isSeekable :: FD -> IO Bool
    isSeekable    = String -> (FD -> IO Bool) -> FD -> IO Bool
    forall a. String -> a -> a
    ifSupported String
    "isSeek" FD -> IO Bool
    isSeekable
      seek :: FD -> SeekMode -> Integer -> IO Integer
    seek          = String
    -> (FD -> SeekMode -> Integer -> IO Integer)
    -> FD
    -> SeekMode
    -> Integer
    -> IO Integer
    forall a. String -> a -> a
    ifSupported String
    "seek" FD -> SeekMode -> Integer -> IO Integer
    seek
      tell :: FD -> IO Integer
    tell          = String -> (FD -> IO Integer) -> FD -> IO Integer
    forall a. String -> a -> a
    ifSupported String
    "tell" FD -> IO Integer
    tell
      getSize :: FD -> IO Integer
    getSize       = String -> (FD -> IO Integer) -> FD -> IO Integer
    forall a. String -> a -> a
    ifSupported String
    "getSize" FD -> IO Integer
    getSize
      setSize :: FD -> Integer -> IO ()
    setSize       = String -> (FD -> Integer -> IO ()) -> FD -> Integer -> IO ()
    forall a. String -> a -> a
    ifSupported String
    "setSize" FD -> Integer -> IO ()
    setSize
      setEcho :: FD -> Bool -> IO ()
    setEcho       = String -> (FD -> Bool -> IO ()) -> FD -> Bool -> IO ()
    forall a. String -> a -> a
    ifSupported String
    "setEcho" FD -> Bool -> IO ()
    setEcho
      getEcho :: FD -> IO Bool
    getEcho       = String -> (FD -> IO Bool) -> FD -> IO Bool
    forall a. String -> a -> a
    ifSupported String
    "getEcho" FD -> IO Bool
    getEcho
      setRaw :: FD -> Bool -> IO ()
    setRaw        = String -> (FD -> Bool -> IO ()) -> FD -> Bool -> IO ()
    forall a. String -> a -> a
    ifSupported String
    "setRaw" FD -> Bool -> IO ()
    setRaw
      devType :: FD -> IO IODeviceType
    devType       = String -> (FD -> IO IODeviceType) -> FD -> IO IODeviceType
    forall a. String -> a -> a
    ifSupported String
    "devType" FD -> IO IODeviceType
    devType
      dup :: FD -> IO FD
    dup           = String -> (FD -> IO FD) -> FD -> IO FD
    forall a. String -> a -> a
    ifSupported String
    "dup" FD -> IO FD
    dup
      dup2 :: FD -> FD -> IO FD
    dup2          = String -> (FD -> FD -> IO FD) -> FD -> FD -> IO FD
    forall a. String -> a -> a
    ifSupported String
    "dup2" FD -> FD -> IO FD
    dup2

    -- We used to use System.Posix.Internals.dEFAULT_BUFFER_SIZE, which is
    -- taken from the value of BUFSIZ on the current platform.  This value
    -- varies too much though: it is 512 on Windows, 1024 on OS X and 8192
    -- on Linux.  So let's just use a decent size on every platform:
    dEFAULT_FD_BUFFER_SIZE :: Int
    dEFAULT_FD_BUFFER_SIZE :: Int
    dEFAULT_FD_BUFFER_SIZE = Int
    8192

    -- | @since 4.1.0.0
    instance BufferedIO FD where
      newBuffer :: FD -> BufferState -> IO (Buffer Word8)
    newBuffer FD
    _dev BufferState
    state = String -> IO (Buffer Word8) -> IO (Buffer Word8)
    forall a. String -> a -> a
    ifSupported String
    "newBuf" (IO (Buffer Word8) -> IO (Buffer Word8))
    -> IO (Buffer Word8) -> IO (Buffer Word8)
    forall a b. (a -> b) -> a -> b
    $ Int -> BufferState -> IO (Buffer Word8)
    newByteBuffer Int
    dEFAULT_FD_BUFFER_SIZE BufferState
    state
      fillReadBuffer :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)
    fillReadBuffer    FD
    fd Buffer Word8
    buf = String -> IO (Int, Buffer Word8) -> IO (Int, Buffer Word8)
    forall a. String -> a -> a
    ifSupported String
    "readBuf" (IO (Int, Buffer Word8) -> IO (Int, Buffer Word8))
    -> IO (Int, Buffer Word8) -> IO (Int, Buffer Word8)
    forall a b. (a -> b) -> a -> b
    $ FD -> Buffer Word8 -> IO (Int, Buffer Word8)
    readBuf' FD
    fd Buffer Word8
    buf
      fillReadBuffer0 :: FD -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
    fillReadBuffer0   FD
    fd Buffer Word8
    buf = String
    -> IO (Maybe Int, Buffer Word8) -> IO (Maybe Int, Buffer Word8)
    forall a. String -> a -> a
    ifSupported String
    "readBufNonBlock" (IO (Maybe Int, Buffer Word8) -> IO (Maybe Int, Buffer Word8))
    -> IO (Maybe Int, Buffer Word8) -> IO (Maybe Int, Buffer Word8)
    forall a b. (a -> b) -> a -> b
    $ FD -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
    forall dev.
    RawIO dev =>
    dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
    readBufNonBlocking FD
    fd Buffer Word8
    buf
      flushWriteBuffer :: FD -> Buffer Word8 -> IO (Buffer Word8)
    flushWriteBuffer  FD
    fd Buffer Word8
    buf = String -> IO (Buffer Word8) -> IO (Buffer Word8)
    forall a. String -> a -> a
    ifSupported String
    "writeBuf" (IO (Buffer Word8) -> IO (Buffer Word8))
    -> IO (Buffer Word8) -> IO (Buffer Word8)
    forall a b. (a -> b) -> a -> b
    $ FD -> Buffer Word8 -> IO (Buffer Word8)
    writeBuf' FD
    fd Buffer Word8
    buf
      flushWriteBuffer0 :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)
    flushWriteBuffer0 FD
    fd Buffer Word8
    buf = String -> IO (Int, Buffer Word8) -> IO (Int, Buffer Word8)
    forall a. String -> a -> a
    ifSupported String
    "writeBufNonBlock" (IO (Int, Buffer Word8) -> IO (Int, Buffer Word8))
    -> IO (Int, Buffer Word8) -> IO (Int, Buffer Word8)
    forall a b. (a -> b) -> a -> b
    $ FD -> Buffer Word8 -> IO (Int, Buffer Word8)
    forall dev.
    RawIO dev =>
    dev -> Buffer Word8 -> IO (Int, Buffer Word8)
    writeBufNonBlocking FD
    fd Buffer Word8
    buf

    readBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)
    readBuf' :: FD -> Buffer Word8 -> IO (Int, Buffer Word8)
    readBuf' FD
    fd Buffer Word8
    buf = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    c_DEBUG_DUMP (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          String -> IO ()
    puts (String
    "readBuf fd=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FD -> String
    forall a. Show a => a -> String
    show FD
    fd String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Buffer Word8 -> String
    forall a. Buffer a -> String
    summaryBuffer Buffer Word8
    buf String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")
      (Int
    r,Buffer Word8
    buf') <- FD -> Buffer Word8 -> IO (Int, Buffer Word8)
    forall dev.
    RawIO dev =>
    dev -> Buffer Word8 -> IO (Int, Buffer Word8)
    readBuf FD
    fd Buffer Word8
    buf
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    c_DEBUG_DUMP (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          String -> IO ()
    puts (String
    "after: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Buffer Word8 -> String
    forall a. Buffer a -> String
    summaryBuffer Buffer Word8
    buf' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")
      (Int, Buffer Word8) -> IO (Int, Buffer Word8)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    r,Buffer Word8
    buf')

    writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8)
    writeBuf' :: FD -> Buffer Word8 -> IO (Buffer Word8)
    writeBuf' FD
    fd Buffer Word8
    buf = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    c_DEBUG_DUMP (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          String -> IO ()
    puts (String
    "writeBuf fd=" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FD -> String
    forall a. Show a => a -> String
    show FD
    fd String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Buffer Word8 -> String
    forall a. Buffer a -> String
    summaryBuffer Buffer Word8
    buf String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")
      FD -> Buffer Word8 -> IO (Buffer Word8)
    forall dev. RawIO dev => dev -> Buffer Word8 -> IO (Buffer Word8)
    writeBuf FD
    fd Buffer Word8
    buf

    -- -----------------------------------------------------------------------------
    -- opening files

    -- | Open a file and make an 'FD' for it. Truncates the file to zero size when
    -- the `IOMode` is `WriteMode`.
    --
    -- `openFileWith` takes two actions, @act1@ and @act2@, to perform after
    -- opening the file.
    --
    -- @act1@ is passed a file descriptor and I/O device type for the newly opened
    -- file. If an exception occurs in @act1@, then the file will be closed.
    -- @act1@ /must not/ close the file itself. If it does so and then receives an
    -- exception, then the exception handler will attempt to close it again, which
    -- is impermissible.
    --
    -- @act2@ is performed with asynchronous exceptions masked. It is passed a
    -- function to restore the masking state and the result of @act1@.  It /must
    -- not/ throw an exception (or deliver one via an interruptible operation)
    -- without first closing the file or arranging for it to be closed. @act2@
    -- /may/ close the file, but is not required to do so.  If @act2@ leaves the
    -- file open, then the file will remain open on return from `openFileWith`.
    --
    -- Code calling `openFileWith` that wishes to install a finalizer to close
    -- the file should do so in @act2@. Doing so in @act1@ could potentially close
    -- the file in the finalizer first and then in the exception handler. See
    -- 'GHC.IO.Handle.FD.openFile'' for an example of this use. Regardless, the
    -- caller is responsible for ensuring that the file is eventually closed,
    -- perhaps using 'Control.Exception.bracket'.

    openFileWith
      :: FilePath -- ^ file to open
      -> IOMode   -- ^ mode in which to open the file
      -> Bool     -- ^ open the file in non-blocking mode?
      -> (FD -> IODeviceType -> IO r) -- ^ @act1@: An action to perform
                        -- on the file descriptor with the masking state
                        -- restored and an exception handler that closes
                        -- the file on exception.
      -> ((forall x. IO x -> IO x) -> r -> IO s)
                        -- ^ @act2@: An action to perform with async exceptions
                        -- masked and no exception handler.
      -> IO s
    openFileWith :: forall r s.
    String
    -> IOMode
    -> Bool
    -> (FD -> IODeviceType -> IO r)
    -> ((forall x. IO x -> IO x) -> r -> IO s)
    -> IO s
    openFileWith String
    filepath IOMode
    iomode Bool
    non_blocking FD -> IODeviceType -> IO r
    act1 (forall x. IO x -> IO x) -> r -> IO s
    act2 =
      String -> (CString -> IO s) -> IO s
    forall a. String -> (CString -> IO a) -> IO a
    withFilePath String
    filepath ((CString -> IO s) -> IO s) -> (CString -> IO s) -> IO s
    forall a b. (a -> b) -> a -> b
    $ \ CString
    f ->
        let
          oflags1 :: CInt
    oflags1 = case IOMode
    iomode of
                      IOMode
    ReadMode      -> CInt
    read_flags
                      IOMode
    WriteMode     -> CInt
    write_flags
                      IOMode
    ReadWriteMode -> CInt
    rw_flags
                      IOMode
    AppendMode    -> CInt
    append_flags

    #if defined(mingw32_HOST_OS)
          binary_flags = o_BINARY
    #else
          binary_flags :: CInt
    binary_flags = CInt
    0
    #endif

          oflags2 :: CInt
    oflags2 = CInt
    oflags1 CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    binary_flags

          oflags :: CInt
    oflags | Bool
    non_blocking = CInt
    oflags2 CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    nonblock_flags
                 | Bool
    otherwise    = CInt
    oflags2
        in do
          -- We want to be sure all the arguments to c_interruptible_open
          -- are fully evaluated *before* it slips under a mask (assuming we're
          -- not already under a user-imposed mask).
          CInt
    oflags' <- CInt -> IO CInt
    forall a. a -> IO a
    evaluate CInt
    oflags
          -- NB. always use a safe open(), because we don't know whether open()
          -- will be fast or not.  It can be slow on NFS and FUSE filesystems,
          -- for example.

          ((forall x. IO x -> IO x) -> IO s) -> IO s
    forall b. ((forall x. IO x -> IO x) -> IO b) -> IO b
    mask (((forall x. IO x -> IO x) -> IO s) -> IO s)
    -> ((forall x. IO x -> IO x) -> IO s) -> IO s
    forall a b. (a -> b) -> a -> b
    $ \forall x. IO x -> IO x
    restore -> do
            CInt
    fileno <- String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1Retry String
    "openFile" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
    forall a b. (a -> b) -> a -> b
    $
                    CString -> CInt -> CMode -> IO CInt
    c_interruptible_open CString
    f CInt
    oflags' CMode
    0o666

            (FD
    fD,IODeviceType
    fd_type) <- CInt
    -> IOMode
    -> Maybe (IODeviceType, CDev, CIno)
    -> Bool
    -> Bool
    -> IO (FD, IODeviceType)
    mkFD CInt
    fileno IOMode
    iomode Maybe (IODeviceType, CDev, CIno)
    forall a. Maybe a
    Nothing{-no stat-}
                                    Bool
    False{-not a socket-}
                                    Bool
    non_blocking IO (FD, IODeviceType) -> IO CInt -> IO (FD, IODeviceType)
    forall a b. IO a -> IO b -> IO a
    `onException` CInt -> IO CInt
    c_close CInt
    fileno

            -- we want to truncate() if this is an open in WriteMode, but only
            -- if the target is a RegularFile.  ftruncate() fails on special files
            -- like /dev/null.

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (IOMode
    iomode IOMode -> IOMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == IOMode
    WriteMode Bool -> Bool -> Bool
    && IODeviceType
    fd_type IODeviceType -> IODeviceType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IODeviceType
    RegularFile) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              FD -> Integer -> IO ()
    setSize FD
    fD Integer
    0 IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO a
    `onException` FD -> IO ()
    close FD
    fD

            r
    carry <- IO r -> IO r
    forall x. IO x -> IO x
    restore (FD -> IODeviceType -> IO r
    act1 FD
    fD IODeviceType
    fd_type) IO r -> IO () -> IO r
    forall a b. IO a -> IO b -> IO a
    `onException` FD -> IO ()
    close FD
    fD

            (forall x. IO x -> IO x) -> r -> IO s
    act2 IO x -> IO x
    forall x. IO x -> IO x
    restore r
    carry

    -- | Open a file and make an 'FD' for it.  Truncates the file to zero
    -- size when the `IOMode` is `WriteMode`. This function is difficult
    -- to use without potentially leaking the file descriptor on exception.
    -- In particular, it must be used with exceptions masked, which is a
    -- bit rude because the thread will be uninterruptible while the file
    -- path is being encoded. Use 'openFileWith' instead.
    openFile
      :: FilePath -- ^ file to open
      -> IOMode   -- ^ mode in which to open the file
      -> Bool     -- ^ open the file in non-blocking mode?
      -> IO (FD,IODeviceType)
    openFile :: String -> IOMode -> Bool -> IO (FD, IODeviceType)
    openFile String
    filepath IOMode
    iomode Bool
    non_blocking =
      String
    -> IOMode
    -> Bool
    -> (FD -> IODeviceType -> IO (FD, IODeviceType))
    -> ((forall x. IO x -> IO x)
        -> (FD, IODeviceType) -> IO (FD, IODeviceType))
    -> IO (FD, IODeviceType)
    forall r s.
    String
    -> IOMode
    -> Bool
    -> (FD -> IODeviceType -> IO r)
    -> ((forall x. IO x -> IO x) -> r -> IO s)
    -> IO s
    openFileWith String
    filepath IOMode
    iomode Bool
    non_blocking
        (\ FD
    fd IODeviceType
    fd_type -> (FD, IODeviceType) -> IO (FD, IODeviceType)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FD
    fd, IODeviceType
    fd_type)) (\forall x. IO x -> IO x
    _ (FD, IODeviceType)
    r -> (FD, IODeviceType) -> IO (FD, IODeviceType)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (FD, IODeviceType)
    r)

    std_flags, output_flags, read_flags, write_flags, rw_flags,
        append_flags, nonblock_flags :: CInt
    std_flags :: CInt
    std_flags    = CInt
    o_NOCTTY
    output_flags :: CInt
    output_flags = CInt
    std_flags    CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_CREAT
    read_flags :: CInt
    read_flags   = CInt
    std_flags    CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_RDONLY
    write_flags :: CInt
    write_flags  = CInt
    output_flags CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_WRONLY
    rw_flags :: CInt
    rw_flags     = CInt
    output_flags CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_RDWR
    append_flags :: CInt
    append_flags = CInt
    write_flags  CInt -> CInt -> CInt
    forall a. Bits a => a -> a -> a
    .|. CInt
    o_APPEND
    nonblock_flags :: CInt
    nonblock_flags = CInt
    o_NONBLOCK

    -- | Make a 'FD' from an existing file descriptor.  Fails if the FD
    -- refers to a directory.  If the FD refers to a file, `mkFD` locks
    -- the file according to the Haskell 2010 single writer/multiple reader
    -- locking semantics (this is why we need the `IOMode` argument too).
    mkFD :: CInt
         -> IOMode
         -> Maybe (IODeviceType, CDev, CIno)
         -- the results of fdStat if we already know them, or we want
         -- to prevent fdToHandle_stat from doing its own stat.
         -- These are used for:
         --   - we fail if the FD refers to a directory
         --   - if the FD refers to a file, we lock it using (cdev,cino)
         -> Bool   -- ^ is a socket (on Windows)
         -> Bool   -- ^ is in non-blocking mode on Unix
         -> IO (FD,IODeviceType)

    mkFD :: CInt
    -> IOMode
    -> Maybe (IODeviceType, CDev, CIno)
    -> Bool
    -> Bool
    -> IO (FD, IODeviceType)
    mkFD CInt
    fd IOMode
    iomode Maybe (IODeviceType, CDev, CIno)
    mb_stat Bool
    is_socket Bool
    is_nonblock = do

        let (Bool, Bool)
    _ = (Bool
    is_socket, Bool
    is_nonblock) -- warning suppression

        (IODeviceType
    fd_type,CDev
    dev,CIno
    ino) <-
            case Maybe (IODeviceType, CDev, CIno)
    mb_stat of
              Maybe (IODeviceType, CDev, CIno)
    Nothing   -> CInt -> IO (IODeviceType, CDev, CIno)
    fdStat CInt
    fd
              Just (IODeviceType, CDev, CIno)
    stat -> (IODeviceType, CDev, CIno) -> IO (IODeviceType, CDev, CIno)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IODeviceType, CDev, CIno)
    stat

        let write :: Bool
    write = case IOMode
    iomode of
                       IOMode
    ReadMode -> Bool
    False
                       IOMode
    _ -> Bool
    True

        case IODeviceType
    fd_type of
            IODeviceType
    Directory ->
               IOException -> IO ()
    forall a. IOException -> IO a
    ioException (Maybe Handle
    -> IOErrorType
    -> String
    -> String
    -> Maybe CInt
    -> Maybe String
    -> IOException
    IOError Maybe Handle
    forall a. Maybe a
    Nothing IOErrorType
    InappropriateType String
    "openFile"
                               String
    "is a directory" Maybe CInt
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing)

            -- regular files need to be locked
            IODeviceType
    RegularFile -> do
               -- On Windows we need an additional call to get a unique device id
               -- and inode, since fstat just returns 0 for both.
               -- See also Note [RTS File locking]
               (Word64
    unique_dev, Word64
    unique_ino) <- CInt -> CDev -> CIno -> IO (Word64, Word64)
    getUniqueFileInfo CInt
    fd CDev
    dev CIno
    ino
               CInt
    r <- Word64 -> Word64 -> Word64 -> CInt -> IO CInt
    lockFile (CInt -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    fd) Word64
    unique_dev Word64
    unique_ino
                             (Bool -> CInt
    forall a. Num a => Bool -> a
    fromBool Bool
    write)
               Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CInt
    r CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    == -CInt
    1)  (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    IOException -> IO ()
    forall a. IOException -> IO a
    ioException (Maybe Handle
    -> IOErrorType
    -> String
    -> String
    -> Maybe CInt
    -> Maybe String
    -> IOException
    IOError Maybe Handle
    forall a. Maybe a
    Nothing IOErrorType
    ResourceBusy String
    "openFile"
                                       String
    "file is locked" Maybe CInt
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing)

            IODeviceType
    _other_type -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    #if defined(mingw32_HOST_OS)
        when (not is_socket) $ setmode fd True >> return ()
    #endif

        (FD, IODeviceType) -> IO (FD, IODeviceType)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FD{ fdFD :: CInt
    fdFD = CInt
    fd,
    #if !defined(mingw32_HOST_OS)
                    fdIsNonBlocking :: Int
    fdIsNonBlocking = Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum Bool
    is_nonblock
    #else
                    fdIsSocket_ = fromEnum is_socket
    #endif
                  },
                IODeviceType
    fd_type)

    getUniqueFileInfo :: CInt -> CDev -> CIno -> IO (Word64, Word64)
    #if !defined(mingw32_HOST_OS)
    getUniqueFileInfo :: CInt -> CDev -> CIno -> IO (Word64, Word64)
    getUniqueFileInfo CInt
    _ CDev
    dev CIno
    ino = (Word64, Word64) -> IO (Word64, Word64)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CDev -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CDev
    dev, CIno -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CIno
    ino)
    #else
    getUniqueFileInfo fd _ _ = do
      with 0 $ \devptr -> do
        with 0 $ \inoptr -> do
          c_getUniqueFileInfo fd devptr inoptr
          liftM2 (,) (peek devptr) (peek inoptr)
    #endif

    #if defined(mingw32_HOST_OS)
    foreign import ccall unsafe "__hscore_setmode"
      setmode :: CInt -> Bool -> IO CInt
    #endif

    -- -----------------------------------------------------------------------------
    -- Standard file descriptors

    stdFD :: CInt -> FD
    stdFD :: CInt -> FD
    stdFD CInt
    fd = FD { fdFD :: CInt
    fdFD = CInt
    fd,
    #if defined(mingw32_HOST_OS)
                    fdIsSocket_ = 0
    #else
                    fdIsNonBlocking :: Int
    fdIsNonBlocking = Int
    0
       -- We don't set non-blocking mode on standard handles, because it may
       -- confuse other applications attached to the same TTY/pipe
       -- see Note [nonblock]
    #endif
                    }

    stdin, stdout, stderr :: FD
    stdin :: FD
    stdin  = CInt -> FD
    stdFD CInt
    0
    stdout :: FD
    stdout = CInt -> FD
    stdFD CInt
    1
    stderr :: FD
    stderr = CInt -> FD
    stdFD CInt
    2

    -- -----------------------------------------------------------------------------
    -- Operations on file descriptors

    close :: FD -> IO ()
    close :: FD -> IO ()
    close FD
    fd =
      do let closer :: a -> IO ()
    closer a
    realFd =
               String -> IO CInt -> IO ()
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwErrnoIfMinus1Retry_ String
    "GHC.IO.FD.close" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    #if defined(mingw32_HOST_OS)
               if fdIsSocket fd then
                 c_closesocket (fromIntegral realFd)
               else
    #endif
                 CInt -> IO CInt
    c_close (a -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    realFd)

         -- release the lock *first*, because otherwise if we're preempted
         -- after closing but before releasing, the FD may have been reused.
         -- (#7646)
         FD -> IO ()
    release FD
    fd

         (Fd -> IO ()) -> Fd -> IO ()
    closeFdWith Fd -> IO ()
    forall {a}. Integral a => a -> IO ()
    closer (CInt -> Fd
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FD -> CInt
    fdFD FD
    fd))

    release :: FD -> IO ()
    release :: FD -> IO ()
    release FD
    fd = do CInt
    _ <- Word64 -> IO CInt
    unlockFile (CInt -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CInt -> Word64) -> CInt -> Word64
    forall a b. (a -> b) -> a -> b
    $ FD -> CInt
    fdFD FD
    fd)
                    () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    #if defined(mingw32_HOST_OS)
    foreign import WINDOWS_CCONV unsafe "HsBase.h closesocket"
       c_closesocket :: CInt -> IO CInt
    #endif

    isSeekable :: FD -> IO Bool
    isSeekable :: FD -> IO Bool
    isSeekable FD
    fd = do
      IODeviceType
    t <- FD -> IO IODeviceType
    devType FD
    fd
      Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IODeviceType
    t IODeviceType -> IODeviceType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IODeviceType
    RegularFile Bool -> Bool -> Bool
    || IODeviceType
    t IODeviceType -> IODeviceType -> Bool
    forall a. Eq a => a -> a -> Bool
    == IODeviceType
    RawDevice)

    seek :: FD -> SeekMode -> Integer -> IO Integer
    seek :: FD -> SeekMode -> Integer -> IO Integer
    seek FD
    fd SeekMode
    mode Integer
    off = COff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (COff -> Integer) -> IO COff -> IO Integer
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap`
      (String -> IO COff -> IO COff
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1Retry String
    "seek" (IO COff -> IO COff) -> IO COff -> IO COff
    forall a b. (a -> b) -> a -> b
    $
         CInt -> COff -> CInt -> IO COff
    c_lseek (FD -> CInt
    fdFD FD
    fd) (Integer -> COff
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    off) CInt
    seektype)
     where
        seektype :: CInt
        seektype :: CInt
    seektype = case SeekMode
    mode of
                       SeekMode
    AbsoluteSeek -> CInt
    sEEK_SET
                       SeekMode
    RelativeSeek -> CInt
    sEEK_CUR
                       SeekMode
    SeekFromEnd  -> CInt
    sEEK_END

    tell :: FD -> IO Integer
    tell :: FD -> IO Integer
    tell FD
    fd =
     COff -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (COff -> Integer) -> IO COff -> IO Integer
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap`
       (String -> IO COff -> IO COff
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1Retry String
    "hGetPosn" (IO COff -> IO COff) -> IO COff -> IO COff
    forall a b. (a -> b) -> a -> b
    $
          CInt -> COff -> CInt -> IO COff
    c_lseek (FD -> CInt
    fdFD FD
    fd) COff
    0 CInt
    sEEK_CUR)

    getSize :: FD -> IO Integer
    getSize :: FD -> IO Integer
    getSize FD
    fd = CInt -> IO Integer
    fdFileSize (FD -> CInt
    fdFD FD
    fd)

    setSize :: FD -> Integer -> IO ()
    setSize :: FD -> Integer -> IO ()
    setSize FD
    fd Integer
    size =
      (CInt -> Bool) -> String -> IO CInt -> IO ()
    forall a. (a -> Bool) -> String -> IO a -> IO ()
    throwErrnoIf_ (CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    /=CInt
    0) String
    "GHC.IO.FD.setSize" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $
         CInt -> COff -> IO CInt
    c_ftruncate (FD -> CInt
    fdFD FD
    fd) (Integer -> COff
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    size)

    devType :: FD -> IO IODeviceType
    devType :: FD -> IO IODeviceType
    devType FD
    fd = do (IODeviceType
    ty,CDev
    _,CIno
    _) <- CInt -> IO (IODeviceType, CDev, CIno)
    fdStat (FD -> CInt
    fdFD FD
    fd); IODeviceType -> IO IODeviceType
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return IODeviceType
    ty

    dup :: FD -> IO FD
    dup :: FD -> IO FD
    dup FD
    fd = do
      CInt
    newfd <- String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1 String
    "GHC.IO.FD.dup" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ CInt -> IO CInt
    c_dup (FD -> CInt
    fdFD FD
    fd)
      FD -> IO FD
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FD
    fd{ fdFD = newfd }

    dup2 :: FD -> FD -> IO FD
    dup2 :: FD -> FD -> IO FD
    dup2 FD
    fd FD
    fdto = do
      -- Windows' dup2 does not return the new descriptor, unlike Unix
      String -> IO CInt -> IO ()
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwErrnoIfMinus1_ String
    "GHC.IO.FD.dup2" (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        CInt -> CInt -> IO CInt
    c_dup2 (FD -> CInt
    fdFD FD
    fd) (FD -> CInt
    fdFD FD
    fdto)
      FD -> IO FD
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FD
    fd{ fdFD = fdFD fdto } -- original FD, with the new fdFD

    setNonBlockingMode :: FD -> Bool -> IO FD
    setNonBlockingMode :: FD -> Bool -> IO FD
    setNonBlockingMode FD
    fd Bool
    set = do
      CInt -> Bool -> IO ()
    setNonBlockingFD (FD -> CInt
    fdFD FD
    fd) Bool
    set
    #if defined(mingw32_HOST_OS)
      return fd
    #else
      FD -> IO FD
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FD
    fd{ fdIsNonBlocking = fromEnum set }
    #endif

    ready :: FD -> Bool -> Int -> IO Bool
    ready :: FD -> Bool -> Int -> IO Bool
    ready FD
    fd Bool
    write Int
    msecs = do
      CInt
    r <- String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1Retry String
    "GHC.IO.FD.ready" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
    forall a b. (a -> b) -> a -> b
    $
              CInt -> CBool -> Int64 -> CBool -> IO CInt
    fdReady (FD -> CInt
    fdFD FD
    fd) (Int -> CBool
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CBool) -> Int -> CBool
    forall a b. (a -> b) -> a -> b
    $ Bool -> Int
    forall a. Enum a => a -> Int
    fromEnum (Bool -> Int) -> Bool -> Int
    forall a b. (a -> b) -> a -> b
    $ Bool
    write)
                                (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    msecs)
    #if defined(mingw32_HOST_OS)
                              (fromIntegral $ fromEnum $ fdIsSocket fd)
    #else
                              CBool
    0
    #endif
      Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Bool
    forall a. Enum a => Int -> a
    toEnum (CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    r))

    foreign import ccall safe "fdReady"
      fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt

    -- ---------------------------------------------------------------------------
    -- Terminal-related stuff

    isTerminal :: FD -> IO Bool
    isTerminal :: FD -> IO Bool
    isTerminal FD
    fd =
    #if defined(mingw32_HOST_OS)
        if fdIsSocket fd then return False
                         else is_console (fdFD fd) >>= return.toBool
    #else
        CInt -> IO CInt
    c_isatty (FD -> CInt
    fdFD FD
    fd) IO CInt -> (CInt -> IO Bool) -> IO Bool
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Bool -> IO Bool) -> (CInt -> Bool) -> CInt -> IO Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .CInt -> Bool
    forall a. (Eq a, Num a) => a -> Bool
    toBool
    #endif

    setEcho :: FD -> Bool -> IO ()
    setEcho :: FD -> Bool -> IO ()
    setEcho FD
    fd Bool
    on = CInt -> Bool -> IO ()
    System.Posix.Internals.setEcho (FD -> CInt
    fdFD FD
    fd) Bool
    on

    getEcho :: FD -> IO Bool
    getEcho :: FD -> IO Bool
    getEcho FD
    fd = CInt -> IO Bool
    System.Posix.Internals.getEcho (FD -> CInt
    fdFD FD
    fd)

    setRaw :: FD -> Bool -> IO ()
    setRaw :: FD -> Bool -> IO ()
    setRaw FD
    fd Bool
    raw = CInt -> Bool -> IO ()
    System.Posix.Internals.setCooked (FD -> CInt
    fdFD FD
    fd) (Bool -> Bool
    not Bool
    raw)

    -- -----------------------------------------------------------------------------
    -- Reading and Writing

    fdRead :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    fdRead :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    fdRead FD
    fd Ptr Word8
    ptr Word64
    _offset Int
    bytes
      = do { Int
    r <- String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
    readRawBufferPtr String
    "GHC.IO.FD.fdRead" FD
    fd Ptr Word8
    ptr Int
    0
                    (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CSize) -> Int -> CSize
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    clampReadSize Int
    bytes)
           ; Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    r) }

    fdReadNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
    fdReadNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
    fdReadNonBlocking FD
    fd Ptr Word8
    ptr Word64
    _offset Int
    bytes = do
      Int
    r <- String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
    readRawBufferPtrNoBlock String
    "GHC.IO.FD.fdReadNonBlocking" FD
    fd Ptr Word8
    ptr
               Int
    0 (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CSize) -> Int -> CSize
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    clampReadSize Int
    bytes)
      case Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    r of
        (-1) -> Maybe Int -> IO (Maybe Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Int
    forall a. Maybe a
    Nothing)
        Int
    n    -> Maybe Int -> IO (Maybe Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    n)

    fdWrite :: FD -> Ptr Word8 -> Word64 -> Int -> IO ()
    fdWrite :: FD -> Ptr Word8 -> Word64 -> Int -> IO ()
    fdWrite FD
    fd Ptr Word8
    ptr Word64
    _offset Int
    bytes = do
      CInt
    res <- String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtr String
    "GHC.IO.FD.fdWrite" FD
    fd Ptr Word8
    ptr Int
    0
              (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CSize) -> Int -> CSize
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    clampWriteSize Int
    bytes)
      let res' :: Int
    res' = CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    res
      if Int
    res' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    bytes
         then FD -> Ptr Word8 -> Word64 -> Int -> IO ()
    fdWrite FD
    fd (Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    res') (Word64
    _offset Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    + Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    res') (Int
    bytes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    res')
         else () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- XXX ToDo: this isn't non-blocking
    fdWriteNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    fdWriteNonBlocking :: FD -> Ptr Word8 -> Word64 -> Int -> IO Int
    fdWriteNonBlocking FD
    fd Ptr Word8
    ptr Word64
    _offset Int
    bytes = do
      CInt
    res <- String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtrNoBlock String
    "GHC.IO.FD.fdWriteNonBlocking" FD
    fd Ptr Word8
    ptr Int
    0
                (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> CSize) -> Int -> CSize
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    clampWriteSize Int
    bytes)
      Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    res)

    -- -----------------------------------------------------------------------------
    -- FD operations

    -- Low level routines for reading/writing to (raw)buffers:

    #if !defined(mingw32_HOST_OS)

    {-
    Note [nonblock]
    ~~~~~~~~~~~~~~~
    Unix has broken semantics when it comes to non-blocking I/O: you can
    set the O_NONBLOCK flag on an FD, but it applies to the all other FDs
    attached to the same underlying file, pipe or TTY; there's no way to
    have private non-blocking behaviour for an FD.  See bug #724.

    We fix this by only setting O_NONBLOCK on FDs that we create; FDs that
    come from external sources or are exposed externally are left in
    blocking mode.  This solution has some problems though.  We can't
    completely simulate a non-blocking read without O_NONBLOCK: several
    cases are wrong here.  The cases that are wrong:

      * reading/writing to a blocking FD in non-threaded mode.
        In threaded mode, we just make a safe call to read().
        In non-threaded mode we call select() before attempting to read,
        but that leaves a small race window where the data can be read
        from the file descriptor before we issue our blocking read().
      * readRawBufferNoBlock for a blocking FD

    NOTE [2363]:

    In the threaded RTS we could just make safe calls to read()/write()
    for file descriptors in blocking mode without worrying about blocking
    other threads, but the problem with this is that the thread will be
    uninterruptible while it is blocked in the foreign call.  See #2363.
    So now we always call fdReady() before reading, and if fdReady
    indicates that there's no data, we call threadWaitRead.

    -}

    readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
    readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
    readRawBufferPtr String
    loc !FD
    fd !Ptr Word8
    buf !Int
    off !CSize
    len
    #if defined(javascript_HOST_ARCH)
      = fmap fromIntegral . uninterruptibleMask_ $
        throwErrnoIfMinus1 loc (c_read (fdFD fd) (buf `plusPtr` off) len)
    #else
      | FD -> Bool
    isNonBlocking FD
    fd = IO Int
    unsafe_read -- unsafe is ok, it can't block
      | Bool
    otherwise    = do CInt
    r <- String -> IO CInt -> IO CInt
    forall a. (Eq a, Num a) => String -> IO a -> IO a
    throwErrnoIfMinus1 String
    loc
                                    (CInt -> CBool -> Int64 -> CBool -> IO CInt
    unsafe_fdReady (FD -> CInt
    fdFD FD
    fd) CBool
    0 Int64
    0 CBool
    0)
                          if CInt
    r CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CInt
    0
                            then IO Int
    read
                            else do Fd -> IO ()
    threadWaitRead (CInt -> Fd
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FD -> CInt
    fdFD FD
    fd)); IO Int
    read
      where
        do_read :: IO a -> IO b
    do_read IO a
    call = a -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> b) -> IO a -> IO b
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap`
                          String -> IO a -> IO () -> IO a
    forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO a
    throwErrnoIfMinus1RetryMayBlock String
    loc IO a
    call
                                (Fd -> IO ()
    threadWaitRead (CInt -> Fd
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FD -> CInt
    fdFD FD
    fd)))
        read :: IO Int
    read        = if Bool
    threaded then IO Int
    safe_read else IO Int
    unsafe_read
        unsafe_read :: IO Int
    unsafe_read = IO CSsize -> IO Int
    forall {a} {b}. (Integral a, Num b) => IO a -> IO b
    do_read (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_read (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
        safe_read :: IO Int
    safe_read   = IO CSsize -> IO Int
    forall {a} {b}. (Integral a, Num b) => IO a -> IO b
    do_read (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_safe_read (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
    #endif

    -- return: -1 indicates EOF, >=0 is bytes read
    readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
    readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int
    readRawBufferPtrNoBlock String
    loc !FD
    fd !Ptr Word8
    buf !Int
    off !CSize
    len
    #if defined(javascript_HOST_ARCH)
      = uninterruptibleMask_ $ do
          r <- throwErrnoIfMinus1 loc (c_read (fdFD fd) (buf `plusPtr` off) len)
          case r of
           (-1) -> return 0
           0    -> return (-1)
           n    -> return (fromIntegral n)
    #else
      | FD -> Bool
    isNonBlocking FD
    fd  = IO Int
    unsafe_read -- unsafe is ok, it can't block
      | Bool
    otherwise    = do CInt
    r <- CInt -> CBool -> Int64 -> CBool -> IO CInt
    unsafe_fdReady (FD -> CInt
    fdFD FD
    fd) CBool
    0 Int64
    0 CBool
    0
                          if CInt
    r CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CInt
    0 then IO Int
    safe_read
                                    else Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    0
           -- XXX see note [nonblock]
     where
       do_read :: IO CSsize -> IO b
    do_read IO CSsize
    call = do CSsize
    r <- String -> IO CSsize -> IO CSsize -> IO CSsize
    throwErrnoIfMinus1RetryOnBlock String
    loc IO CSsize
    call (CSsize -> IO CSsize
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (-CSsize
    1))
                         case CSsize
    r of
                           (-1) -> b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    0
                           CSsize
    0    -> b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (-b
    1)
                           CSsize
    n    -> b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CSsize -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CSsize
    n)
       unsafe_read :: IO Int
    unsafe_read  = IO CSsize -> IO Int
    forall {b}. Num b => IO CSsize -> IO b
    do_read (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_read (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
       safe_read :: IO Int
    safe_read    = IO CSsize -> IO Int
    forall {b}. Num b => IO CSsize -> IO b
    do_read (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_safe_read (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
    #endif

    writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtr String
    loc !FD
    fd !Ptr Word8
    buf !Int
    off !CSize
    len
    #if defined(javascript_HOST_ARCH)
      = fmap fromIntegral . uninterruptibleMask_ $
        throwErrnoIfMinus1 loc (c_write (fdFD fd) (buf `plusPtr` off) len)
    #else
      | FD -> Bool
    isNonBlocking FD
    fd = IO CInt
    unsafe_write -- unsafe is ok, it can't block
      | Bool
    otherwise   = do CInt
    r <- CInt -> CBool -> Int64 -> CBool -> IO CInt
    unsafe_fdReady (FD -> CInt
    fdFD FD
    fd) CBool
    1 Int64
    0 CBool
    0
                         if CInt
    r CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CInt
    0
                            then IO CInt
    write
                            else do Fd -> IO ()
    threadWaitWrite (CInt -> Fd
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FD -> CInt
    fdFD FD
    fd)); IO CInt
    write
      where
        do_write :: IO a -> IO b
    do_write IO a
    call = a -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (a -> b) -> IO a -> IO b
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap`
                          String -> IO a -> IO () -> IO a
    forall a b. (Eq a, Num a) => String -> IO a -> IO b -> IO a
    throwErrnoIfMinus1RetryMayBlock String
    loc IO a
    call
                            (Fd -> IO ()
    threadWaitWrite (CInt -> Fd
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FD -> CInt
    fdFD FD
    fd)))
        write :: IO CInt
    write         = if Bool
    threaded then IO CInt
    safe_write else IO CInt
    unsafe_write
        unsafe_write :: IO CInt
    unsafe_write  = IO CSsize -> IO CInt
    forall {a} {b}. (Integral a, Num b) => IO a -> IO b
    do_write (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_write (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
        safe_write :: IO CInt
    safe_write    = IO CSsize -> IO CInt
    forall {a} {b}. (Integral a, Num b) => IO a -> IO b
    do_write (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_safe_write (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
    #endif

    writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtrNoBlock String
    loc !FD
    fd !Ptr Word8
    buf !Int
    off !CSize
    len
    #if defined(javascript_HOST_ARCH)
      = uninterruptibleMask_ $ do
          r <- throwErrnoIfMinus1 loc (c_write (fdFD fd) (buf `plusPtr` off) len)
          case r of
            (-1) -> return 0
            n    -> return (fromIntegral n)
    #else
      | FD -> Bool
    isNonBlocking FD
    fd = IO CInt
    unsafe_write -- unsafe is ok, it can't block
      | Bool
    otherwise   = do CInt
    r <- CInt -> CBool -> Int64 -> CBool -> IO CInt
    unsafe_fdReady (FD -> CInt
    fdFD FD
    fd) CBool
    1 Int64
    0 CBool
    0
                         if CInt
    r CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CInt
    0 then IO CInt
    write
                                   else CInt -> IO CInt
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CInt
    0
      where
        do_write :: IO CSsize -> IO b
    do_write IO CSsize
    call = do CSsize
    r <- String -> IO CSsize -> IO CSsize -> IO CSsize
    throwErrnoIfMinus1RetryOnBlock String
    loc IO CSsize
    call (CSsize -> IO CSsize
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (-CSsize
    1))
                           case CSsize
    r of
                             (-1) -> b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    0
                             CSsize
    n    -> b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CSsize -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CSsize
    n)
        write :: IO CInt
    write         = if Bool
    threaded then IO CInt
    safe_write else IO CInt
    unsafe_write
        unsafe_write :: IO CInt
    unsafe_write  = IO CSsize -> IO CInt
    forall {b}. Num b => IO CSsize -> IO b
    do_write (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_write (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
        safe_write :: IO CInt
    safe_write    = IO CSsize -> IO CInt
    forall {b}. Num b => IO CSsize -> IO b
    do_write (CInt -> Ptr Word8 -> CSize -> IO CSsize
    c_safe_write (FD -> CInt
    fdFD FD
    fd) (Ptr Word8
    buf Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off) CSize
    len)
    #endif

    #if !defined(javascript_HOST_ARCH)
    isNonBlocking :: FD -> Bool
    isNonBlocking :: FD -> Bool
    isNonBlocking FD
    fd = FD -> Int
    fdIsNonBlocking FD
    fd Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0

    foreign import ccall unsafe "fdReady"
      unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt
    #endif

    #else /* mingw32_HOST_OS.... */

    readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    readRawBufferPtr loc !fd !buf !off !len
      | threaded  = blockingReadRawBufferPtr loc fd buf off len
      | otherwise = asyncReadRawBufferPtr    loc fd buf off len

    writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtr loc !fd !buf !off !len
      | threaded  = blockingWriteRawBufferPtr loc fd buf off len
      | otherwise = asyncWriteRawBufferPtr    loc fd buf off len

    readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    readRawBufferPtrNoBlock = readRawBufferPtr

    writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    writeRawBufferPtrNoBlock = writeRawBufferPtr

    -- Async versions of the read/write primitives, for the non-threaded RTS

    asyncReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    asyncReadRawBufferPtr loc !fd !buf !off !len = do
        (l, rc) <- asyncRead (fromIntegral (fdFD fd)) (fdIsSocket_ fd)
                            (fromIntegral len) (buf `plusPtr` off)
        if l == (-1)
          then let sock_errno = c_maperrno_func (fromIntegral rc)
                   non_sock_errno = Errno (fromIntegral rc)
                   errno = bool non_sock_errno sock_errno (fdIsSocket fd)
               in  ioError (errnoToIOError loc errno Nothing Nothing)
          else return (fromIntegral l)

    asyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    asyncWriteRawBufferPtr loc !fd !buf !off !len = do
        (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd)
                      (fromIntegral len) (buf `plusPtr` off)
        if l == (-1)
          then let sock_errno = c_maperrno_func (fromIntegral rc)
                   non_sock_errno = Errno (fromIntegral rc)
                   errno = bool non_sock_errno sock_errno (fdIsSocket fd)
               in  ioError (errnoToIOError loc errno Nothing Nothing)
          else return (fromIntegral l)

    -- Blocking versions of the read/write primitives, for the threaded RTS

    blockingReadRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt
    blockingReadRawBufferPtr loc !fd !buf !off !len
      = throwErrnoIfMinus1Retry loc $ do
            let start_ptr = buf `plusPtr` off
                recv_ret = c_safe_recv (fdFD fd) start_ptr (fromIntegral len) 0
                read_ret = c_safe_read (fdFD fd) start_ptr (fromIntegral len)
            r <- bool read_ret recv_ret (fdIsSocket fd)
            when ((fdIsSocket fd) && (r == -1)) c_maperrno
            return r
          -- We trust read() to give us the correct errno but recv(), as a
          -- Winsock function, doesn't do the errno conversion so if the fd
          -- is for a socket, we do it from GetLastError() ourselves.

    blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt
    blockingWriteRawBufferPtr loc !fd !buf !off !len
      = throwErrnoIfMinus1Retry loc $ do
            let start_ptr = buf `plusPtr` off
                send_ret = c_safe_send  (fdFD fd) start_ptr (fromIntegral len) 0
                write_ret = c_safe_write (fdFD fd) start_ptr (fromIntegral len)
            r <- bool write_ret send_ret (fdIsSocket fd)
            when (r == -1) c_maperrno
            return r
          -- We don't trust write() to give us the correct errno, and
          -- instead do the errno conversion from GetLastError()
          -- ourselves. The main reason is that we treat ERROR_NO_DATA
          -- (pipe is closing) as EPIPE, whereas write() returns EINVAL
          -- for this case. We need to detect EPIPE correctly, because it
          -- shouldn't be reported as an error when it happens on stdout.
          -- As for send()'s case, Winsock functions don't do errno
          -- conversion in any case so we have to do it ourselves.
          -- That means we're doing the errno conversion no matter if the
          -- fd is from a socket or not.

    -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.
    -- These calls may block, but that's ok.

    foreign import WINDOWS_CCONV safe "recv"
       c_safe_recv :: CInt -> Ptr Word8 -> CInt -> CInt{-flags-} -> IO CInt

    foreign import WINDOWS_CCONV safe "send"
       c_safe_send :: CInt -> Ptr Word8 -> CInt -> CInt{-flags-} -> IO CInt

    #endif

    #if !defined(javascript_HOST_ARCH)
    foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
    #endif

    -- -----------------------------------------------------------------------------
    -- utils

    #if !defined(mingw32_HOST_OS) && !defined(javascript_HOST_ARCH)
    throwErrnoIfMinus1RetryOnBlock  :: String -> IO CSsize -> IO CSsize -> IO CSsize
    throwErrnoIfMinus1RetryOnBlock :: String -> IO CSsize -> IO CSsize -> IO CSsize
    throwErrnoIfMinus1RetryOnBlock String
    loc IO CSsize
    f IO CSsize
    on_block  =
      do
        CSsize
    res <- IO CSsize
    f
        if (CSsize
    res :: CSsize) CSsize -> CSsize -> Bool
    forall a. Eq a => a -> a -> Bool
    == -CSsize
    1
          then do
            Errno
    err <- IO Errno
    getErrno
            if Errno
    err Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eINTR
              then String -> IO CSsize -> IO CSsize -> IO CSsize
    throwErrnoIfMinus1RetryOnBlock String
    loc IO CSsize
    f IO CSsize
    on_block
              else if Errno
    err Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eWOULDBLOCK Bool -> Bool -> Bool
    || Errno
    err Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eAGAIN
                     then IO CSsize
    on_block
                     else String -> IO CSsize
    forall a. String -> IO a
    throwErrno String
    loc
          else CSsize -> IO CSsize
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CSsize
    res
    #endif

    -- -----------------------------------------------------------------------------
    -- Locking/unlocking

    foreign import ccall unsafe "lockFile"
      lockFile :: Word64 -> Word64 -> Word64 -> CInt -> IO CInt

    foreign import ccall unsafe "unlockFile"
      unlockFile :: Word64 -> IO CInt

    #if defined(mingw32_HOST_OS)
    foreign import ccall unsafe "get_unique_file_info"
      c_getUniqueFileInfo :: CInt -> Ptr Word64 -> Ptr Word64 -> IO ()
    #endif