{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
           , NoImplicitPrelude
           , BangPatterns
           , RankNTypes
  #-}
{-# OPTIONS_GHC -Wno-identities #-}
{-# OPTIONS_HADDOCK not-home #-}
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
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
data FD = FD {
  FD -> CInt
fdFD :: {-# UNPACK #-} !CInt,
#if defined(mingw32_HOST_OS)
  
  
  fdIsSocket_ :: {-# UNPACK #-} !Int
#else
  
  
  
  FD -> Int
fdIsNonBlocking :: {-# UNPACK #-} !Int
#endif
 }
#if defined(mingw32_HOST_OS)
fdIsSocket :: FD -> Bool
fdIsSocket fd = fdIsSocket_ fd /= 0
#endif
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
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
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
dEFAULT_FD_BUFFER_SIZE :: Int
dEFAULT_FD_BUFFER_SIZE :: Int
dEFAULT_FD_BUFFER_SIZE = Int
8192
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
openFileWith
  :: FilePath 
  -> IOMode   
  -> Bool     
  -> (FD -> IODeviceType -> IO r) 
                    
                    
                    
  -> ((forall x. IO x -> IO x) -> r -> IO s)
                    
                    
  -> 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
      
      
      
      CInt
oflags' <- CInt -> IO CInt
forall a. a -> IO a
evaluate CInt
oflags
      
      
      
      ((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
                                Bool
False
                                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
        
        
        
        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
openFile
  :: FilePath 
  -> IOMode   
  -> Bool     
  -> 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
mkFD :: CInt
     -> IOMode
     -> Maybe (IODeviceType, CDev, CIno)
     
     
     
     
     
     -> Bool   
     -> Bool   
     -> 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) 
    (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)
        
        IODeviceType
RegularFile -> do
           
           
           
           (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
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
   
   
   
#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
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)
     
     
     
     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 :: CInt
fdFD = CInt
newfd }
dup2 :: FD -> FD -> IO FD
dup2 :: FD -> FD -> IO FD
dup2 FD
fd FD
fdto = do
  
  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 :: CInt
fdFD = FD -> CInt
fdFD FD
fdto } 
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 :: Int
fdIsNonBlocking = Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
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
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)
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 ()
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)
#if !defined(mingw32_HOST_OS)
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
  | FD -> Bool
isNonBlocking FD
fd = IO Int
unsafe_read 
  | 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)
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
  | FD -> Bool
isNonBlocking FD
fd  = IO Int
unsafe_read 
  | 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
       
 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)
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
  | FD -> Bool
isNonBlocking FD
fd = IO CInt
unsafe_write 
  | 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)
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
  | FD -> Bool
isNonBlocking FD
fd = IO CInt
unsafe_write 
  | 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)
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
#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
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)
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
      
      
      
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
      
      
      
      
      
      
      
      
      
      
foreign import WINDOWS_CCONV safe "recv"
   c_safe_recv :: CInt -> Ptr Word8 -> CInt -> CInt -> IO CInt
foreign import WINDOWS_CCONV safe "send"
   c_safe_send :: CInt -> Ptr Word8 -> CInt -> CInt -> IO CInt
#endif
foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
#if !defined(mingw32_HOST_OS)
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
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