{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
           , NoImplicitPrelude
           , RecordWildCards
           , BangPatterns
           , NondecreasingIndentation
           , MagicHash
  #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Text
-- Copyright   :  (c) The University of Glasgow, 1992-2008
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  internal
-- Portability :  non-portable
--
-- String I\/O functions
--
-----------------------------------------------------------------------------

module GHC.IO.Handle.Text (
        hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
        commitBuffer',       -- hack, see below
        hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,
        memcpy, hPutStrLn,
    ) where

import GHC.IO
import GHC.IO.FD
import GHC.IO.Buffer
import qualified GHC.IO.BufferedIO as Buffered
import GHC.IO.Exception
import GHC.Exception
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
import qualified GHC.IO.Device as IODevice
import qualified GHC.IO.Device as RawIO

import Foreign
import Foreign.C

import qualified Control.Exception as Exception
import Data.Typeable
import System.IO.Error
import Data.Maybe

import GHC.IORef
import GHC.Base
import GHC.Real
import GHC.Num
import GHC.Show
import GHC.List

-- ---------------------------------------------------------------------------
-- Simple input operations

-- If hWaitForInput finds anything in the Handle's buffer, it
-- immediately returns.  If not, it tries to read from the underlying
-- OS handle. Notice that for buffered Handles connected to terminals
-- this means waiting until a complete line is available.

-- | Computation 'hWaitForInput' @hdl t@
-- waits until input is available on handle @hdl@.
-- It returns 'True' as soon as input is available on @hdl@,
-- or 'False' if no input is available within @t@ milliseconds.  Note that
-- 'hWaitForInput' waits until one or more full /characters/ are available,
-- which means that it needs to do decoding, and hence may fail
-- with a decoding error.
--
-- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.
--
-- This operation may fail with:
--
--  * 'isEOFError' if the end of file has been reached.
--
--  * a decoding error, if the input begins with an invalid byte sequence
--    in this Handle's encoding.
--
-- NOTE for GHC users: unless you use the @-threaded@ flag,
-- @hWaitForInput hdl t@ where @t >= 0@ will block all other Haskell
-- threads for the duration of the call.  It behaves like a
-- @safe@ foreign call in this respect.
--

hWaitForInput :: Handle -> Int -> IO Bool
hWaitForInput :: Handle -> Int -> IO Bool
hWaitForInput Handle
h Int
msecs = do
  String -> Handle -> (Handle__ -> IO Bool) -> IO Bool
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hWaitForInput" Handle
h ((Handle__ -> IO Bool) -> IO Bool)
-> (Handle__ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
..} -> do
  Buffer CharBufElem
cbuf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer

  if Bool -> Bool
not (Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
cbuf) then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else do

  if Int
msecs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
        then do Buffer CharBufElem
cbuf' <- Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
readTextDevice Handle__
handle_ Buffer CharBufElem
cbuf
                IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer Buffer CharBufElem
cbuf'
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
               -- there might be bytes in the byte buffer waiting to be decoded
               Buffer CharBufElem
cbuf' <- Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
decodeByteBuf Handle__
handle_ Buffer CharBufElem
cbuf
               IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer Buffer CharBufElem
cbuf'

               if Bool -> Bool
not (Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
cbuf') then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else do

                Bool
r <- dev -> Bool -> Int -> IO Bool
forall a. IODevice a => a -> Bool -> Int -> IO Bool
IODevice.ready dev
haDevice Bool
False{-read-} Int
msecs
                if Bool
r then do -- Call hLookAhead' to throw an EOF
                             -- exception if appropriate
                             CharBufElem
_ <- Handle__ -> IO CharBufElem
hLookAhead_ Handle__
handle_
                             Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                     else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                -- XXX we should only return when there are full characters
                -- not when there are only bytes.  That would mean looping
                -- and re-running IODevice.ready if we don't have any full
                -- characters; but we don't know how long we've waited
                -- so far.

-- ---------------------------------------------------------------------------
-- hGetChar

-- | Computation 'hGetChar' @hdl@ reads a character from the file or
-- channel managed by @hdl@, blocking until a character is available.
--
-- This operation may fail with:
--
--  * 'isEOFError' if the end of file has been reached.

hGetChar :: Handle -> IO Char
hGetChar :: Handle -> IO CharBufElem
hGetChar Handle
handle =
  String -> Handle -> (Handle__ -> IO CharBufElem) -> IO CharBufElem
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hGetChar" Handle
handle ((Handle__ -> IO CharBufElem) -> IO CharBufElem)
-> (Handle__ -> IO CharBufElem) -> IO CharBufElem
forall a b. (a -> b) -> a -> b
$ \handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do

  -- buffering mode makes no difference: we just read whatever is available
  -- from the device (blocking only if there is nothing available), and then
  -- return the first character.
  -- See [note Buffered Reading] in GHC.IO.Handle.Types
  Buffer CharBufElem
buf0 <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer

  Buffer CharBufElem
buf1 <- if Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf0
             then Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
readTextDevice Handle__
handle_ Buffer CharBufElem
buf0
             else Buffer CharBufElem -> IO (Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
buf0

  (CharBufElem
c1,Int
i) <- RawCharBuffer -> Int -> IO (CharBufElem, Int)
readCharBuf (Buffer CharBufElem -> RawCharBuffer
forall e. Buffer e -> RawBuffer e
bufRaw Buffer CharBufElem
buf1) (Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufL Buffer CharBufElem
buf1)
  let buf2 :: Buffer CharBufElem
buf2 = Int -> Buffer CharBufElem -> Buffer CharBufElem
forall e. Int -> Buffer e -> Buffer e
bufferAdjustL Int
i Buffer CharBufElem
buf1

  if Newline
haInputNL Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF Bool -> Bool -> Bool
&& CharBufElem
c1 CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r'
     then do
            Maybe (Buffer CharBufElem)
mbuf3 <- if Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf2
                      then Handle__ -> Buffer CharBufElem -> IO (Maybe (Buffer CharBufElem))
maybeFillReadBuffer Handle__
handle_ Buffer CharBufElem
buf2
                      else Maybe (Buffer CharBufElem) -> IO (Maybe (Buffer CharBufElem))
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer CharBufElem -> Maybe (Buffer CharBufElem)
forall a. a -> Maybe a
Just Buffer CharBufElem
buf2)

            case Maybe (Buffer CharBufElem)
mbuf3 of
               -- EOF, so just return the '\r' we have
               Maybe (Buffer CharBufElem)
Nothing -> do
                  IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer Buffer CharBufElem
buf2
                  CharBufElem -> IO CharBufElem
forall (m :: * -> *) a. Monad m => a -> m a
return CharBufElem
'\r'
               Just Buffer CharBufElem
buf3 -> do
                  (CharBufElem
c2,Int
i2) <- RawCharBuffer -> Int -> IO (CharBufElem, Int)
readCharBuf (Buffer CharBufElem -> RawCharBuffer
forall e. Buffer e -> RawBuffer e
bufRaw Buffer CharBufElem
buf2) (Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufL Buffer CharBufElem
buf2)
                  if CharBufElem
c2 CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'
                     then do
                       IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer (Int -> Buffer CharBufElem -> Buffer CharBufElem
forall e. Int -> Buffer e -> Buffer e
bufferAdjustL Int
i2 Buffer CharBufElem
buf3)
                       CharBufElem -> IO CharBufElem
forall (m :: * -> *) a. Monad m => a -> m a
return CharBufElem
'\n'
                     else do
                       -- not a \r\n sequence, so just return the \r
                       IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer Buffer CharBufElem
buf3
                       CharBufElem -> IO CharBufElem
forall (m :: * -> *) a. Monad m => a -> m a
return CharBufElem
'\r'
     else do
            IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer Buffer CharBufElem
buf2
            CharBufElem -> IO CharBufElem
forall (m :: * -> *) a. Monad m => a -> m a
return CharBufElem
c1

-- ---------------------------------------------------------------------------
-- hGetLine

-- | Computation 'hGetLine' @hdl@ reads a line from the file or
-- channel managed by @hdl@.
--
-- This operation may fail with:
--
--  * 'isEOFError' if the end of file is encountered when reading
--    the /first/ character of the line.
--
-- If 'hGetLine' encounters end-of-file at any other point while reading
-- in a line, it is treated as a line terminator and the (partial)
-- line is returned.

hGetLine :: Handle -> IO String
hGetLine :: Handle -> IO String
hGetLine Handle
h =
  String -> Handle -> (Handle__ -> IO String) -> IO String
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hGetLine" Handle
h ((Handle__ -> IO String) -> IO String)
-> (Handle__ -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
     Handle__ -> IO String
hGetLineBuffered Handle__
handle_

hGetLineBuffered :: Handle__ -> IO String
hGetLineBuffered :: Handle__ -> IO String
hGetLineBuffered handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} = do
  Buffer CharBufElem
buf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
  Handle__ -> Buffer CharBufElem -> [String] -> IO String
hGetLineBufferedLoop Handle__
handle_ Buffer CharBufElem
buf []

hGetLineBufferedLoop :: Handle__
                     -> CharBuffer -> [String]
                     -> IO String
hGetLineBufferedLoop :: Handle__ -> Buffer CharBufElem -> [String] -> IO String
hGetLineBufferedLoop handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..}
        buf :: Buffer CharBufElem
buf@Buffer{ bufL :: forall e. Buffer e -> Int
bufL=Int
r0, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawCharBuffer
raw0 } [String]
xss =
  let
        -- find the end-of-line character, if there is one
        loop :: RawCharBuffer -> Int -> IO (Bool, Int)
loop RawCharBuffer
raw Int
r
           | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w = (Bool, Int) -> IO (Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Int
w)
           | Bool
otherwise =  do
                (CharBufElem
c,Int
r') <- RawCharBuffer -> Int -> IO (CharBufElem, Int)
readCharBuf RawCharBuffer
raw Int
r
                if CharBufElem
c CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'
                   then (Bool, Int) -> IO (Bool, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Int
r) -- NB. not r': don't include the '\n'
                   else RawCharBuffer -> Int -> IO (Bool, Int)
loop RawCharBuffer
raw Int
r'
  in do
  (Bool
eol, Int
off) <- RawCharBuffer -> Int -> IO (Bool, Int)
loop RawCharBuffer
raw0 Int
r0

  String -> IO ()
debugIO (String
"hGetLineBufferedLoop: r=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
r0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", w=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", off=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
off)

  (String
xs,Int
r') <- if Newline
haInputNL Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF
                then RawCharBuffer -> Int -> Int -> String -> IO (String, Int)
unpack_nl RawCharBuffer
raw0 Int
r0 Int
off String
""
                else do String
xs <- RawCharBuffer -> Int -> Int -> String -> IO String
unpack RawCharBuffer
raw0 Int
r0 Int
off String
""
                        (String, Int) -> IO (String, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
xs,Int
off)

  -- if eol == True, then off is the offset of the '\n'
  -- otherwise off == w and the buffer is now empty.
  if Bool
eol -- r' == off
        then do IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer (Int -> Buffer CharBufElem -> Buffer CharBufElem
forall e. Int -> Buffer e -> Buffer e
bufferAdjustL (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Buffer CharBufElem
buf)
                String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
forall a. [[a]] -> [a]
concat ([String] -> [String]
forall a. [a] -> [a]
reverse (String
xsString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xss)))
        else do
             let buf1 :: Buffer CharBufElem
buf1 = Int -> Buffer CharBufElem -> Buffer CharBufElem
forall e. Int -> Buffer e -> Buffer e
bufferAdjustL Int
r' Buffer CharBufElem
buf
             Maybe (Buffer CharBufElem)
maybe_buf <- Handle__ -> Buffer CharBufElem -> IO (Maybe (Buffer CharBufElem))
maybeFillReadBuffer Handle__
handle_ Buffer CharBufElem
buf1
             case Maybe (Buffer CharBufElem)
maybe_buf of
                -- Nothing indicates we caught an EOF, and we may have a
                -- partial line to return.
                Maybe (Buffer CharBufElem)
Nothing -> do
                     -- we reached EOF.  There might be a lone \r left
                     -- in the buffer, so check for that and
                     -- append it to the line if necessary.
                     --
                     let pre :: String
pre = if Bool -> Bool
not (Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf1) then String
"\r" else String
""
                     IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer Buffer CharBufElem
buf1{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
                     let str :: String
str = [String] -> String
forall a. [[a]] -> [a]
concat ([String] -> [String]
forall a. [a] -> [a]
reverse (String
preString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
xsString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xss))
                     if Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
null String
str)
                        then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
                        else IO String
forall a. IO a
ioe_EOF
                Just Buffer CharBufElem
new_buf ->
                     Handle__ -> Buffer CharBufElem -> [String] -> IO String
hGetLineBufferedLoop Handle__
handle_ Buffer CharBufElem
new_buf (String
xsString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xss)

maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
maybeFillReadBuffer :: Handle__ -> Buffer CharBufElem -> IO (Maybe (Buffer CharBufElem))
maybeFillReadBuffer Handle__
handle_ Buffer CharBufElem
buf
  = IO (Maybe (Buffer CharBufElem))
-> (IOError -> IO (Maybe (Buffer CharBufElem)))
-> IO (Maybe (Buffer CharBufElem))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catchException
     (do Buffer CharBufElem
buf' <- Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
getSomeCharacters Handle__
handle_ Buffer CharBufElem
buf
         Maybe (Buffer CharBufElem) -> IO (Maybe (Buffer CharBufElem))
forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer CharBufElem -> Maybe (Buffer CharBufElem)
forall a. a -> Maybe a
Just Buffer CharBufElem
buf')
     )
     (\IOError
e -> do if IOError -> Bool
isEOFError IOError
e
                  then Maybe (Buffer CharBufElem) -> IO (Maybe (Buffer CharBufElem))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Buffer CharBufElem)
forall a. Maybe a
Nothing
                  else IOError -> IO (Maybe (Buffer CharBufElem))
forall a. IOError -> IO a
ioError IOError
e)

-- See GHC.IO.Buffer
#define CHARBUF_UTF32
-- #define CHARBUF_UTF16

-- NB. performance-critical code: eyeball the Core.
unpack :: RawCharBuffer -> Int -> Int -> [Char] -> IO [Char]
unpack :: RawCharBuffer -> Int -> Int -> String -> IO String
unpack !RawCharBuffer
buf !Int
r !Int
w String
acc0
 | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w    = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
acc0
 | Bool
otherwise =
  RawCharBuffer -> (Ptr CharBufElem -> IO String) -> IO String
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawCharBuffer
buf ((Ptr CharBufElem -> IO String) -> IO String)
-> (Ptr CharBufElem -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr CharBufElem
pbuf ->
    let
        unpackRB :: String -> Int -> IO String
unpackRB String
acc !Int
i
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
r  = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
acc
         | Bool
otherwise = do
              -- Here, we are rather careful to only put an *evaluated* character
              -- in the output string. Due to pointer tagging, this allows the consumer
              -- to avoid ping-ponging between the actual consumer code and the thunk code
#if defined(CHARBUF_UTF16)
              -- reverse-order decoding of UTF-16
              c2 <- peekElemOff pbuf i
              if (c2 < 0xdc00 || c2 > 0xdffff)
                 then unpackRB (unsafeChr (fromIntegral c2) : acc) (i-1)
                 else do c1 <- peekElemOff pbuf (i-1)
                         let c = (fromIntegral c1 - 0xd800) * 0x400 +
                                 (fromIntegral c2 - 0xdc00) + 0x10000
                         case desurrogatifyRoundtripCharacter (unsafeChr c) of
                           { C# c# -> unpackRB (C# c# : acc) (i-2) }
#else
              CharBufElem
c <- Ptr CharBufElem -> Int -> IO CharBufElem
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
pbuf Int
i
              String -> Int -> IO String
unpackRB (CharBufElem
c CharBufElem -> String -> String
forall a. a -> [a] -> [a]
: String
acc) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
#endif
     in
     String -> Int -> IO String
unpackRB String
acc0 (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

-- NB. performance-critical code: eyeball the Core.
unpack_nl :: RawCharBuffer -> Int -> Int -> [Char] -> IO ([Char],Int)
unpack_nl :: RawCharBuffer -> Int -> Int -> String -> IO (String, Int)
unpack_nl !RawCharBuffer
buf !Int
r !Int
w String
acc0
 | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w    =  (String, Int) -> IO (String, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
acc0, Int
0)
 | Bool
otherwise =
  RawCharBuffer
-> (Ptr CharBufElem -> IO (String, Int)) -> IO (String, Int)
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawCharBuffer
buf ((Ptr CharBufElem -> IO (String, Int)) -> IO (String, Int))
-> (Ptr CharBufElem -> IO (String, Int)) -> IO (String, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CharBufElem
pbuf ->
    let
        unpackRB :: String -> Int -> IO String
unpackRB String
acc !Int
i
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
r  = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
acc
         | Bool
otherwise = do
              CharBufElem
c <- Ptr CharBufElem -> Int -> IO CharBufElem
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
pbuf Int
i
              if (CharBufElem
c CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n' Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
r)
                 then do
                         CharBufElem
c1 <- Ptr CharBufElem -> Int -> IO CharBufElem
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
pbuf (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                         if (CharBufElem
c1 CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r')
                            then String -> Int -> IO String
unpackRB (CharBufElem
'\n'CharBufElem -> String -> String
forall a. a -> [a] -> [a]
:String
acc) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
                            else String -> Int -> IO String
unpackRB (CharBufElem
'\n'CharBufElem -> String -> String
forall a. a -> [a] -> [a]
:String
acc) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                 else do
                         String -> Int -> IO String
unpackRB (CharBufElem
c CharBufElem -> String -> String
forall a. a -> [a] -> [a]
: String
acc) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
     in do
     CharBufElem
c <- Ptr CharBufElem -> Int -> IO CharBufElem
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
pbuf (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
     if (CharBufElem
c CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r')
        then do
                -- If the last char is a '\r', we need to know whether or
                -- not it is followed by a '\n', so leave it in the buffer
                -- for now and just unpack the rest.
                String
str <- String -> Int -> IO String
unpackRB String
acc0 (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
                (String, Int) -> IO (String, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
str, Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        else do
                String
str <- String -> Int -> IO String
unpackRB String
acc0 (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                (String, Int) -> IO (String, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
str, Int
w)

-- Note [#5536]
--
-- We originally had
--
--    let c' = desurrogatifyRoundtripCharacter c in
--    c' `seq` unpackRB (c':acc) (i-1)
--
-- but this resulted in Core like
--
--    case (case x <# y of True -> C# e1; False -> C# e2) of c
--      C# _ -> unpackRB (c:acc) (i-1)
--
-- which compiles into a continuation for the outer case, with each
-- branch of the inner case building a C# and then jumping to the
-- continuation.  We'd rather not have this extra jump, which makes
-- quite a difference to performance (see #5536) It turns out that
-- matching on the C# directly causes GHC to do the case-of-case,
-- giving much straighter code.

-- -----------------------------------------------------------------------------
-- hGetContents

-- hGetContents on a DuplexHandle only affects the read side: you can
-- carry on writing to it afterwards.

-- | Computation 'hGetContents' @hdl@ returns the list of characters
-- corresponding to the unread portion of the channel or file managed
-- by @hdl@, which is put into an intermediate state, /semi-closed/.
-- In this state, @hdl@ is effectively closed,
-- but items are read from @hdl@ on demand and accumulated in a special
-- list returned by 'hGetContents' @hdl@.
--
-- Any operation that fails because a handle is closed,
-- also fails if a handle is semi-closed.  The only exception is
-- 'System.IO.hClose'.  A semi-closed handle becomes closed:
--
--  * if 'System.IO.hClose' is applied to it;
--
--  * if an I\/O error occurs when reading an item from the handle;
--
--  * or once the entire contents of the handle has been read.
--
-- Once a semi-closed handle becomes closed, the contents of the
-- associated list becomes fixed.  The contents of this final list is
-- only partially specified: it will contain at least all the items of
-- the stream that were evaluated prior to the handle becoming closed.
--
-- Any I\/O errors encountered while a handle is semi-closed are simply
-- discarded.
--
-- This operation may fail with:
--
--  * 'isEOFError' if the end of file has been reached.

hGetContents :: Handle -> IO String
hGetContents :: Handle -> IO String
hGetContents Handle
handle =
   String
-> Handle -> (Handle__ -> IO (Handle__, String)) -> IO String
forall a.
String -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
wantReadableHandle String
"hGetContents" Handle
handle ((Handle__ -> IO (Handle__, String)) -> IO String)
-> (Handle__ -> IO (Handle__, String)) -> IO String
forall a b. (a -> b) -> a -> b
$ \Handle__
handle_ -> do
      String
xs <- Handle -> IO String
lazyRead Handle
handle
      (Handle__, String) -> IO (Handle__, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
handle_{ haType :: HandleType
haType=HandleType
SemiClosedHandle}, String
xs )

-- Note that someone may close the semi-closed handle (or change its
-- buffering), so each time these lazy read functions are pulled on,
-- they have to check whether the handle has indeed been closed.

lazyRead :: Handle -> IO String
lazyRead :: Handle -> IO String
lazyRead Handle
handle =
   IO String -> IO String
forall a. IO a -> IO a
unsafeInterleaveIO (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$
        String
-> Handle -> (Handle__ -> IO (Handle__, String)) -> IO String
forall a.
String -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle String
"hGetContents" Handle
handle ((Handle__ -> IO (Handle__, String)) -> IO String)
-> (Handle__ -> IO (Handle__, String)) -> IO String
forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
        case Handle__ -> HandleType
haType Handle__
handle_ of
          HandleType
SemiClosedHandle -> Handle -> Handle__ -> IO (Handle__, String)
lazyReadBuffered Handle
handle Handle__
handle_
          HandleType
ClosedHandle
            -> IOError -> IO (Handle__, String)
forall a. IOError -> IO a
ioException
                  (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) IOErrorType
IllegalOperation String
"hGetContents"
                        String
"delayed read on closed handle" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
          HandleType
_ -> IOError -> IO (Handle__, String)
forall a. IOError -> IO a
ioException
                  (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) IOErrorType
IllegalOperation String
"hGetContents"
                        String
"illegal handle type" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)

lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])
lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, String)
lazyReadBuffered Handle
h handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} = do
   Buffer CharBufElem
buf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
   IO (Handle__, String)
-> (IOError -> IO (Handle__, String)) -> IO (Handle__, String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch
        (do
            buf' :: Buffer CharBufElem
buf'@Buffer{Int
RawCharBuffer
BufferState
bufSize :: forall e. Buffer e -> Int
bufState :: forall e. Buffer e -> BufferState
bufR :: Int
bufL :: Int
bufSize :: Int
bufState :: BufferState
bufRaw :: RawCharBuffer
bufR :: forall e. Buffer e -> Int
bufL :: forall e. Buffer e -> Int
bufRaw :: forall e. Buffer e -> RawBuffer e
..} <- Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
getSomeCharacters Handle__
handle_ Buffer CharBufElem
buf
            String
lazy_rest <- Handle -> IO String
lazyRead Handle
h
            (String
s,Int
r) <- if Newline
haInputNL Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF
                         then RawCharBuffer -> Int -> Int -> String -> IO (String, Int)
unpack_nl RawCharBuffer
bufRaw Int
bufL Int
bufR String
lazy_rest
                         else do String
s <- RawCharBuffer -> Int -> Int -> String -> IO String
unpack RawCharBuffer
bufRaw Int
bufL Int
bufR String
lazy_rest
                                 (String, Int) -> IO (String, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
s,Int
bufR)
            IORef (Buffer CharBufElem) -> Buffer CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer (Int -> Buffer CharBufElem -> Buffer CharBufElem
forall e. Int -> Buffer e -> Buffer e
bufferAdjustL Int
r Buffer CharBufElem
buf')
            (Handle__, String) -> IO (Handle__, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
handle_, String
s)
        )
        (\IOError
e -> do (Handle__
handle_', Maybe SomeException
_) <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
handle_
                  String -> IO ()
debugIO (String
"hGetContents caught: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ IOError -> String
forall a. Show a => a -> String
show IOError
e)
                  -- We might have a \r cached in CRLF mode.  So we
                  -- need to check for that and return it:
                  let r :: String
r = if IOError -> Bool
isEOFError IOError
e
                             then if Bool -> Bool
not (Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf)
                                     then String
"\r"
                                     else String
""
                             else
                                  IOError -> String
forall a e. Exception e => e -> a
throw (IOError -> String -> Handle -> IOError
augmentIOError IOError
e String
"hGetContents" Handle
h)

                  (Handle__, String) -> IO (Handle__, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
handle_', String
r)
        )

-- ensure we have some characters in the buffer
getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer
getSomeCharacters :: Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
getSomeCharacters handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} buf :: Buffer CharBufElem
buf@Buffer{Int
RawCharBuffer
BufferState
bufR :: Int
bufL :: Int
bufSize :: Int
bufState :: BufferState
bufRaw :: RawCharBuffer
bufSize :: forall e. Buffer e -> Int
bufState :: forall e. Buffer e -> BufferState
bufR :: forall e. Buffer e -> Int
bufL :: forall e. Buffer e -> Int
bufRaw :: forall e. Buffer e -> RawBuffer e
..} =
  case Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufferElems Buffer CharBufElem
buf of

    -- buffer empty: read some more
    Int
0 -> Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
readTextDevice Handle__
handle_ Buffer CharBufElem
buf

    -- if the buffer has a single '\r' in it and we're doing newline
    -- translation: read some more
    Int
1 | Newline
haInputNL Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF -> do
      (CharBufElem
c,Int
_) <- RawCharBuffer -> Int -> IO (CharBufElem, Int)
readCharBuf RawCharBuffer
bufRaw Int
bufL
      if CharBufElem
c CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r'
         then do -- shuffle the '\r' to the beginning.  This is only safe
                 -- if we're about to call readTextDevice, otherwise it
                 -- would mess up flushCharBuffer.
                 -- See [note Buffer Flushing], GHC.IO.Handle.Types
                 Int
_ <- RawCharBuffer -> Int -> CharBufElem -> IO Int
writeCharBuf RawCharBuffer
bufRaw Int
0 CharBufElem
'\r'
                 let buf' :: Buffer CharBufElem
buf' = Buffer CharBufElem
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
1 }
                 Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
readTextDevice Handle__
handle_ Buffer CharBufElem
buf'
         else do
                 Buffer CharBufElem -> IO (Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
buf

    -- buffer has some chars in it already: just return it
    Int
_otherwise ->
      Buffer CharBufElem -> IO (Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
buf

-- ---------------------------------------------------------------------------
-- hPutChar

-- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the
-- file or channel managed by @hdl@.  Characters may be buffered if
-- buffering is enabled for @hdl@.
--
-- This operation may fail with:
--
--  * 'isFullError' if the device is full; or
--
--  * 'isPermissionError' if another system resource limit would be exceeded.

hPutChar :: Handle -> Char -> IO ()
hPutChar :: Handle -> CharBufElem -> IO ()
hPutChar Handle
handle CharBufElem
c = do
    CharBufElem
c CharBufElem -> IO () -> IO ()
`seq` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    String -> Handle -> (Handle__ -> IO ()) -> IO ()
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle String
"hPutChar" Handle
handle ((Handle__ -> IO ()) -> IO ()) -> (Handle__ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_  -> do
     Handle__ -> CharBufElem -> IO ()
hPutcBuffered Handle__
handle_ CharBufElem
c

hPutcBuffered :: Handle__ -> Char -> IO ()
hPutcBuffered :: Handle__ -> CharBufElem -> IO ()
hPutcBuffered handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} CharBufElem
c = do
  Buffer CharBufElem
buf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
  if CharBufElem
c CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'
     then do Buffer CharBufElem
buf1 <- if Newline
haOutputNL Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF
                        then do
                          Buffer CharBufElem
buf1 <- Buffer CharBufElem -> CharBufElem -> IO (Buffer CharBufElem)
putc Buffer CharBufElem
buf CharBufElem
'\r'
                          Buffer CharBufElem -> CharBufElem -> IO (Buffer CharBufElem)
putc Buffer CharBufElem
buf1 CharBufElem
'\n'
                        else do
                          Buffer CharBufElem -> CharBufElem -> IO (Buffer CharBufElem)
putc Buffer CharBufElem
buf CharBufElem
'\n'
             Handle__ -> Buffer CharBufElem -> IO ()
writeCharBuffer Handle__
handle_ Buffer CharBufElem
buf1
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
is_line (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushByteWriteBuffer Handle__
handle_
      else do
          Buffer CharBufElem
buf1 <- Buffer CharBufElem -> CharBufElem -> IO (Buffer CharBufElem)
putc Buffer CharBufElem
buf CharBufElem
c
          Handle__ -> Buffer CharBufElem -> IO ()
writeCharBuffer Handle__
handle_ Buffer CharBufElem
buf1
          () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    is_line :: Bool
is_line = case BufferMode
haBufferMode of
                BufferMode
LineBuffering -> Bool
True
                BufferMode
_             -> Bool
False

    putc :: Buffer CharBufElem -> CharBufElem -> IO (Buffer CharBufElem)
putc buf :: Buffer CharBufElem
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawCharBuffer
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w } CharBufElem
c = do
       String -> IO ()
debugIO (String
"putc: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Buffer CharBufElem -> String
forall a. Buffer a -> String
summaryBuffer Buffer CharBufElem
buf)
       Int
w'  <- RawCharBuffer -> Int -> CharBufElem -> IO Int
writeCharBuf RawCharBuffer
raw Int
w CharBufElem
c
       Buffer CharBufElem -> IO (Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
buf{ bufR :: Int
bufR = Int
w' }

-- ---------------------------------------------------------------------------
-- hPutStr

-- We go to some trouble to avoid keeping the handle locked while we're
-- evaluating the string argument to hPutStr, in case doing so triggers another
-- I/O operation on the same handle which would lead to deadlock.  The classic
-- case is
--
--              putStr (trace "hello" "world")
--
-- so the basic scheme is this:
--
--      * copy the string into a fresh buffer,
--      * "commit" the buffer to the handle.
--
-- Committing may involve simply copying the contents of the new
-- buffer into the handle's buffer, flushing one or both buffers, or
-- maybe just swapping the buffers over (if the handle's buffer was
-- empty).  See commitBuffer below.

-- | Computation 'hPutStr' @hdl s@ writes the string
-- @s@ to the file or channel managed by @hdl@.
--
-- This operation may fail with:
--
--  * 'isFullError' if the device is full; or
--
--  * 'isPermissionError' if another system resource limit would be exceeded.

hPutStr :: Handle -> String -> IO ()
hPutStr :: Handle -> String -> IO ()
hPutStr Handle
handle String
str = Handle -> String -> Bool -> IO ()
hPutStr' Handle
handle String
str Bool
False

-- | The same as 'hPutStr', but adds a newline character.
hPutStrLn :: Handle -> String -> IO ()
hPutStrLn :: Handle -> String -> IO ()
hPutStrLn Handle
handle String
str = Handle -> String -> Bool -> IO ()
hPutStr' Handle
handle String
str Bool
True
  -- An optimisation: we treat hPutStrLn specially, to avoid the
  -- overhead of a single putChar '\n', which is quite high now that we
  -- have to encode eagerly.

{-# NOINLINE hPutStr' #-}
hPutStr' :: Handle -> String -> Bool -> IO ()
hPutStr' :: Handle -> String -> Bool -> IO ()
hPutStr' Handle
handle String
str Bool
add_nl =
  do
    ((BufferMode, Buffer CharBufElem)
buffer_mode, Newline
nl) <-
         String
-> Handle
-> (Handle__ -> IO ((BufferMode, Buffer CharBufElem), Newline))
-> IO ((BufferMode, Buffer CharBufElem), Newline)
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle String
"hPutStr" Handle
handle ((Handle__ -> IO ((BufferMode, Buffer CharBufElem), Newline))
 -> IO ((BufferMode, Buffer CharBufElem), Newline))
-> (Handle__ -> IO ((BufferMode, Buffer CharBufElem), Newline))
-> IO ((BufferMode, Buffer CharBufElem), Newline)
forall a b. (a -> b) -> a -> b
$ \Handle__
h_ -> do
                       (BufferMode, Buffer CharBufElem)
bmode <- Handle__ -> IO (BufferMode, Buffer CharBufElem)
getSpareBuffer Handle__
h_
                       ((BufferMode, Buffer CharBufElem), Newline)
-> IO ((BufferMode, Buffer CharBufElem), Newline)
forall (m :: * -> *) a. Monad m => a -> m a
return ((BufferMode, Buffer CharBufElem)
bmode, Handle__ -> Newline
haOutputNL Handle__
h_)

    case (BufferMode, Buffer CharBufElem)
buffer_mode of
       (BufferMode
NoBuffering, Buffer CharBufElem
_) -> do
            Handle -> String -> IO ()
hPutChars Handle
handle String
str        -- v. slow, but we don't care
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
add_nl (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> CharBufElem -> IO ()
hPutChar Handle
handle CharBufElem
'\n'
       (BufferMode
LineBuffering, Buffer CharBufElem
buf) -> do
            Handle
-> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()
writeBlocks Handle
handle Bool
True  Bool
add_nl Newline
nl Buffer CharBufElem
buf String
str
       (BlockBuffering Maybe Int
_, Buffer CharBufElem
buf) -> do
            Handle
-> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()
writeBlocks Handle
handle Bool
False Bool
add_nl Newline
nl Buffer CharBufElem
buf String
str

hPutChars :: Handle -> [Char] -> IO ()
hPutChars :: Handle -> String -> IO ()
hPutChars Handle
_      [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hPutChars Handle
handle (CharBufElem
c:String
cs) = Handle -> CharBufElem -> IO ()
hPutChar Handle
handle CharBufElem
c IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutChars Handle
handle String
cs

getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer CharBufElem)
getSpareBuffer Handle__{haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haCharBuffer=IORef (Buffer CharBufElem)
ref,
                        haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBuffers=IORef (BufferList CharBufElem)
spare_ref,
                        haBufferMode :: Handle__ -> BufferMode
haBufferMode=BufferMode
mode}
 = do
   case BufferMode
mode of
     BufferMode
NoBuffering -> (BufferMode, Buffer CharBufElem)
-> IO (BufferMode, Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferMode
mode, String -> Buffer CharBufElem
forall a. String -> a
errorWithoutStackTrace String
"no buffer!")
     BufferMode
_ -> do
          BufferList CharBufElem
bufs <- IORef (BufferList CharBufElem) -> IO (BufferList CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (BufferList CharBufElem)
spare_ref
          Buffer CharBufElem
buf  <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
ref
          case BufferList CharBufElem
bufs of
            BufferListCons RawCharBuffer
b BufferList CharBufElem
rest -> do
                IORef (BufferList CharBufElem) -> BufferList CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (BufferList CharBufElem)
spare_ref BufferList CharBufElem
rest
                (BufferMode, Buffer CharBufElem)
-> IO (BufferMode, Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return ( BufferMode
mode, RawCharBuffer -> Int -> BufferState -> Buffer CharBufElem
forall e. RawBuffer e -> Int -> BufferState -> Buffer e
emptyBuffer RawCharBuffer
b (Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufSize Buffer CharBufElem
buf) BufferState
WriteBuffer)
            BufferList CharBufElem
BufferListNil -> do
                Buffer CharBufElem
new_buf <- Int -> BufferState -> IO (Buffer CharBufElem)
newCharBuffer (Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufSize Buffer CharBufElem
buf) BufferState
WriteBuffer
                (BufferMode, Buffer CharBufElem)
-> IO (BufferMode, Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferMode
mode, Buffer CharBufElem
new_buf)


-- NB. performance-critical code: eyeball the Core.
writeBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()
writeBlocks :: Handle
-> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO ()
writeBlocks Handle
hdl Bool
line_buffered Bool
add_nl Newline
nl
            buf :: Buffer CharBufElem
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawCharBuffer
raw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
len } String
s =
  let
   shoveString :: Int -> [Char] -> [Char] -> IO ()
   shoveString :: Int -> String -> String -> IO ()
shoveString !Int
n [] [] = do
        Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool -> IO ()
commitBuffer Handle
hdl RawCharBuffer
raw Int
len Int
n Bool
False{-no flush-} Bool
True{-release-}
   shoveString !Int
n [] String
rest = do
        Int -> String -> String -> IO ()
shoveString Int
n String
rest []
   shoveString !Int
n (CharBufElem
c:String
cs) String
rest
     -- n+1 so we have enough room to write '\r\n' if necessary
     | Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = do
        Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool -> IO ()
commitBuffer Handle
hdl RawCharBuffer
raw Int
len Int
n Bool
False{-flush-} Bool
False
        Int -> String -> String -> IO ()
shoveString Int
0 (CharBufElem
cCharBufElem -> String -> String
forall a. a -> [a] -> [a]
:String
cs) String
rest
     | CharBufElem
c CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'  =  do
        Int
n' <- if Newline
nl Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF
                 then do
                    Int
n1 <- RawCharBuffer -> Int -> CharBufElem -> IO Int
writeCharBuf RawCharBuffer
raw Int
n  CharBufElem
'\r'
                    RawCharBuffer -> Int -> CharBufElem -> IO Int
writeCharBuf RawCharBuffer
raw Int
n1 CharBufElem
'\n'
                 else do
                    RawCharBuffer -> Int -> CharBufElem -> IO Int
writeCharBuf RawCharBuffer
raw Int
n CharBufElem
c
        if Bool
line_buffered
           then do
                -- end of line, so write and flush
               Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool -> IO ()
commitBuffer Handle
hdl RawCharBuffer
raw Int
len Int
n' Bool
True{-flush-} Bool
False
               Int -> String -> String -> IO ()
shoveString Int
0 String
cs String
rest
           else do
               Int -> String -> String -> IO ()
shoveString Int
n' String
cs String
rest
     | Bool
otherwise = do
        Int
n' <- RawCharBuffer -> Int -> CharBufElem -> IO Int
writeCharBuf RawCharBuffer
raw Int
n CharBufElem
c
        Int -> String -> String -> IO ()
shoveString Int
n' String
cs String
rest
  in
  Int -> String -> String -> IO ()
shoveString Int
0 String
s (if Bool
add_nl then String
"\n" else String
"")

-- -----------------------------------------------------------------------------
-- commitBuffer handle buf sz count flush release
--
-- Write the contents of the buffer 'buf' ('sz' bytes long, containing
-- 'count' bytes of data) to handle (handle must be block or line buffered).

commitBuffer
        :: Handle                       -- handle to commit to
        -> RawCharBuffer -> Int         -- address and size (in bytes) of buffer
        -> Int                          -- number of bytes of data in buffer
        -> Bool                         -- True <=> flush the handle afterward
        -> Bool                         -- release the buffer?
        -> IO ()

commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool -> IO ()
commitBuffer Handle
hdl !RawCharBuffer
raw !Int
sz !Int
count Bool
flush Bool
release =
  String -> Handle -> (Handle__ -> IO ()) -> IO ()
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle String
"commitBuffer" Handle
hdl ((Handle__ -> IO ()) -> IO ()) -> (Handle__ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
      String -> IO ()
debugIO (String
"commitBuffer: sz=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", flush=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
flush String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", release=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
release)

      Handle__ -> Buffer CharBufElem -> IO ()
writeCharBuffer Handle__
h_ Buffer :: forall e.
RawBuffer e -> BufferState -> Int -> Int -> Int -> Buffer e
Buffer{ bufRaw :: RawCharBuffer
bufRaw=RawCharBuffer
raw, bufState :: BufferState
bufState=BufferState
WriteBuffer,
                                 bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
count, bufSize :: Int
bufSize=Int
sz }

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
flush (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushByteWriteBuffer Handle__
h_

      -- release the buffer if necessary
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
release (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          -- find size of current buffer
          old_buf :: Buffer CharBufElem
old_buf@Buffer{ bufSize :: forall e. Buffer e -> Int
bufSize=Int
size } <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
               BufferList CharBufElem
spare_bufs <- IORef (BufferList CharBufElem) -> IO (BufferList CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (BufferList CharBufElem)
haBuffers
               IORef (BufferList CharBufElem) -> BufferList CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (BufferList CharBufElem)
haBuffers (RawCharBuffer -> BufferList CharBufElem -> BufferList CharBufElem
forall e. RawBuffer e -> BufferList e -> BufferList e
BufferListCons RawCharBuffer
raw BufferList CharBufElem
spare_bufs)

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

-- backwards compatibility; the text package uses this
commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__
              -> IO CharBuffer
commitBuffer' :: RawCharBuffer
-> Int
-> Int
-> Bool
-> Bool
-> Handle__
-> IO (Buffer CharBufElem)
commitBuffer' RawCharBuffer
raw sz :: Int
sz@(I# Int#
_) count :: Int
count@(I# Int#
_) Bool
flush Bool
release h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..}
   = do
      String -> IO ()
debugIO (String
"commitBuffer: sz=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", flush=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
flush String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", release=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
release)

      let this_buf :: Buffer CharBufElem
this_buf = Buffer :: forall e.
RawBuffer e -> BufferState -> Int -> Int -> Int -> Buffer e
Buffer{ bufRaw :: RawCharBuffer
bufRaw=RawCharBuffer
raw, bufState :: BufferState
bufState=BufferState
WriteBuffer,
                             bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
count, bufSize :: Int
bufSize=Int
sz }

      Handle__ -> Buffer CharBufElem -> IO ()
writeCharBuffer Handle__
h_ Buffer CharBufElem
this_buf

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
flush (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushByteWriteBuffer Handle__
h_

      -- release the buffer if necessary
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
release (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          -- find size of current buffer
          old_buf :: Buffer CharBufElem
old_buf@Buffer{ bufSize :: forall e. Buffer e -> Int
bufSize=Int
size } <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
               BufferList CharBufElem
spare_bufs <- IORef (BufferList CharBufElem) -> IO (BufferList CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (BufferList CharBufElem)
haBuffers
               IORef (BufferList CharBufElem) -> BufferList CharBufElem -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (BufferList CharBufElem)
haBuffers (RawCharBuffer -> BufferList CharBufElem -> BufferList CharBufElem
forall e. RawBuffer e -> BufferList e -> BufferList e
BufferListCons RawCharBuffer
raw BufferList CharBufElem
spare_bufs)

      Buffer CharBufElem -> IO (Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
this_buf

-- ---------------------------------------------------------------------------
-- Reading/writing sequences of bytes.

-- ---------------------------------------------------------------------------
-- hPutBuf

-- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the
-- buffer @buf@ to the handle @hdl@.  It returns ().
--
-- 'hPutBuf' ignores any text encoding that applies to the 'Handle',
-- writing the bytes directly to the underlying file or device.
--
-- 'hPutBuf' ignores the prevailing 'System.IO.TextEncoding' and
-- 'NewlineMode' on the 'Handle', and writes bytes directly.
--
-- This operation may fail with:
--
--  * 'ResourceVanished' if the handle is a pipe or socket, and the
--    reading end is closed.  (If this is a POSIX system, and the program
--    has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered
--    instead, whose default action is to terminate the program).

hPutBuf :: Handle                       -- handle to write to
        -> Ptr a                        -- address of buffer
        -> Int                          -- number of bytes of data in buffer
        -> IO ()
hPutBuf :: Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr a
ptr Int
count = do Int
_ <- Handle -> Ptr a -> Int -> Bool -> IO Int
forall a. Handle -> Ptr a -> Int -> Bool -> IO Int
hPutBuf' Handle
h Ptr a
ptr Int
count Bool
True
                         () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

hPutBufNonBlocking
        :: Handle                       -- handle to write to
        -> Ptr a                        -- address of buffer
        -> Int                          -- number of bytes of data in buffer
        -> IO Int                       -- returns: number of bytes written
hPutBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
hPutBufNonBlocking Handle
h Ptr a
ptr Int
count = Handle -> Ptr a -> Int -> Bool -> IO Int
forall a. Handle -> Ptr a -> Int -> Bool -> IO Int
hPutBuf' Handle
h Ptr a
ptr Int
count Bool
False

hPutBuf':: Handle                       -- handle to write to
        -> Ptr a                        -- address of buffer
        -> Int                          -- number of bytes of data in buffer
        -> Bool                         -- allow blocking?
        -> IO Int
hPutBuf' :: Handle -> Ptr a -> Int -> Bool -> IO Int
hPutBuf' Handle
handle Ptr a
ptr Int
count Bool
can_block
  | Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
  | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0 = Handle -> String -> Int -> IO Int
forall a. Handle -> String -> Int -> IO a
illegalBufferSize Handle
handle String
"hPutBuf" Int
count
  | Bool
otherwise =
    String -> Handle -> (Handle__ -> IO Int) -> IO Int
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle String
"hPutBuf" Handle
handle ((Handle__ -> IO Int) -> IO Int) -> (Handle__ -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$
      \ h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
          String -> IO ()
debugIO (String
"hPutBuf count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count)

          Int
r <- Handle__ -> Ptr Word8 -> Int -> Bool -> IO Int
bufWrite Handle__
h_ (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
count Bool
can_block

          -- we must flush if this Handle is set to NoBuffering.  If
          -- it is set to LineBuffering, be conservative and flush
          -- anyway (we didn't check for newlines in the data).
          case BufferMode
haBufferMode of
             BlockBuffering Maybe Int
_      -> do () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             BufferMode
_line_or_no_buffering -> do Handle__ -> IO ()
flushWriteBuffer Handle__
h_
          Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
r

bufWrite :: Handle__-> Ptr Word8 -> Int -> Bool -> IO Int
bufWrite :: Handle__ -> Ptr Word8 -> Int -> Bool -> IO Int
bufWrite h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} Ptr Word8
ptr Int
count Bool
can_block =
  Int -> IO Int -> IO Int
seq Int
count (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do  -- strictness hack
  old_buf :: Buffer Word8
old_buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
old_raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufSize :: forall e. Buffer e -> Int
bufSize=Int
size }
     <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer

  -- TODO: Possible optimisation:
  --       If we know that `w + count > size`, we should write both the
  --       handle buffer and the `ptr` in a single `writev()` syscall.

  -- Need to buffer and enough room in handle buffer?
  -- There's no need to buffer if the data to be written is larger than
  -- the handle buffer (`count >= size`).
  if (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size Bool -> Bool -> Bool
&& Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
        -- We need to buffer and there's enough room in the buffer:
        -- just copy the data in and update bufR.
        then do String -> IO ()
debugIO (String
"hPutBuf: copying to buffer, w=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w)
                RawBuffer Word8 -> Int -> Ptr Word8 -> Int -> IO ()
forall e. RawBuffer e -> Int -> Ptr e -> Int -> IO ()
copyToRawBuffer RawBuffer Word8
old_raw Int
w Ptr Word8
ptr Int
count
                let copied_buf :: Buffer Word8
copied_buf = Buffer Word8
old_buf{ bufR :: Int
bufR = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count }
                -- If the write filled the buffer completely, we need to flush,
                -- to maintain the "INVARIANTS on Buffers" from
                -- GHC.IO.Buffer.checkBuffer: "a write buffer is never full".
                if (Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
                  then do
                    String -> IO ()
debugIO String
"hPutBuf: flushing full buffer after writing"
                    Buffer Word8
flushed_buf <- dev -> Buffer Word8 -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
Buffered.flushWriteBuffer dev
haDevice Buffer Word8
copied_buf
                            -- TODO: we should do a non-blocking flush here
                    IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
flushed_buf
                  else do
                    IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
copied_buf
                Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
count

        -- else, we have to flush any existing handle buffer data
        -- and can then write out the data in `ptr` directly.
        else do -- No point flushing when there's nothing in the buffer.
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                  String -> IO ()
debugIO String
"hPutBuf: flushing first"
                  Buffer Word8
flushed_buf <- dev -> Buffer Word8 -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
Buffered.flushWriteBuffer dev
haDevice Buffer Word8
old_buf
                          -- TODO: we should do a non-blocking flush here
                  IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
flushed_buf
                -- if we can fit in the buffer, then just loop
                if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
                   then Handle__ -> Ptr Word8 -> Int -> Bool -> IO Int
bufWrite Handle__
h_ Ptr Word8
ptr Int
count Bool
can_block
                   else if Bool
can_block
                           then do Handle__ -> Ptr Word8 -> Int -> IO ()
writeChunk Handle__
h_ (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Int
count
                                   Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
count
                           else Handle__ -> Ptr Word8 -> Int -> IO Int
writeChunkNonBlocking Handle__
h_ (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Int
count

writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()
writeChunk :: Handle__ -> Ptr Word8 -> Int -> IO ()
writeChunk h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} Ptr Word8
ptr Int
bytes
  | Just FD
fd <- dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice  =  FD -> Ptr Word8 -> Int -> IO ()
forall a. RawIO a => a -> Ptr Word8 -> Int -> IO ()
RawIO.write (FD
fd::FD) Ptr Word8
ptr Int
bytes
  | Bool
otherwise = String -> IO ()
forall a. HasCallStack => String -> a
error String
"Todo: hPutBuf"

writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int
writeChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int
writeChunkNonBlocking h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} Ptr Word8
ptr Int
bytes
  | Just FD
fd <- dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice  =  FD -> Ptr Word8 -> Int -> IO Int
forall a. RawIO a => a -> Ptr Word8 -> Int -> IO Int
RawIO.writeNonBlocking (FD
fd::FD) Ptr Word8
ptr Int
bytes
  | Bool
otherwise = String -> IO Int
forall a. HasCallStack => String -> a
error String
"Todo: hPutBuf"

-- ---------------------------------------------------------------------------
-- hGetBuf

-- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@
-- into the buffer @buf@ until either EOF is reached or
-- @count@ 8-bit bytes have been read.
-- It returns the number of bytes actually read.  This may be zero if
-- EOF was reached before any data was read (or if @count@ is zero).
--
-- 'hGetBuf' never raises an EOF exception, instead it returns a value
-- smaller than @count@.
--
-- If the handle is a pipe or socket, and the writing end
-- is closed, 'hGetBuf' will behave as if EOF was reached.
--
-- 'hGetBuf' ignores the prevailing 'System.IO.TextEncoding' and 'NewlineMode'
-- on the 'Handle', and reads bytes directly.

hGetBuf :: Handle -> Ptr a -> Int -> IO Int
hGetBuf :: Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h !Ptr a
ptr Int
count
  | Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
  | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0 = Handle -> String -> Int -> IO Int
forall a. Handle -> String -> Int -> IO a
illegalBufferSize Handle
h String
"hGetBuf" Int
count
  | Bool
otherwise =
      String -> Handle -> (Handle__ -> IO Int) -> IO Int
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hGetBuf" Handle
h ((Handle__ -> IO Int) -> IO Int) -> (Handle__ -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
         Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
         buf :: Buffer Word8
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufL :: forall e. Buffer e -> Int
bufL=Int
r, bufSize :: forall e. Buffer e -> Int
bufSize=Int
sz }
            <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
         if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
buf
            then Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadEmpty    Handle__
h_ Buffer Word8
buf (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
0 Int
count
            else Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNonEmpty Handle__
h_ Buffer Word8
buf (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
0 Int
count

-- small reads go through the buffer, large reads are satisfied by
-- taking data first from the buffer and then direct from the file
-- descriptor.

bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNonEmpty h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..}
                buf :: Buffer Word8
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufL :: forall e. Buffer e -> Int
bufL=Int
r, bufSize :: forall e. Buffer e -> Int
bufSize=Int
sz }
                Ptr Word8
ptr !Int
so_far !Int
count
 = do
        let avail :: Int
avail = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
        if (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
avail)
           then do
                Ptr Word8 -> RawBuffer Word8 -> Int -> Int -> IO ()
forall e. Ptr e -> RawBuffer e -> Int -> Int -> IO ()
copyFromRawBuffer Ptr Word8
ptr RawBuffer Word8
raw Int
r Int
count
                IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufL :: Int
bufL = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count }
                Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
so_far Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count)
           else do

        Ptr Word8 -> RawBuffer Word8 -> Int -> Int -> IO ()
forall e. Ptr e -> RawBuffer e -> Int -> Int -> IO ()
copyFromRawBuffer Ptr Word8
ptr RawBuffer Word8
raw Int
r Int
avail
        let buf' :: Buffer Word8
buf' = Buffer Word8
buf{ bufR :: Int
bufR=Int
0, bufL :: Int
bufL=Int
0 }
        IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf'
        let remaining :: Int
remaining = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
avail
            so_far' :: Int
so_far' = Int
so_far Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
avail
            ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
avail

        if Int
remaining Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
           then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
so_far'
           else Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadEmpty Handle__
h_ Buffer Word8
buf' Ptr Word8
forall b. Ptr b
ptr' Int
so_far' Int
remaining


bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadEmpty h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..}
             buf :: Buffer Word8
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufL :: forall e. Buffer e -> Int
bufL=Int
r, bufSize :: forall e. Buffer e -> Int
bufSize=Int
sz }
             Ptr Word8
ptr Int
so_far Int
count
 | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz, Just FD
fd <- dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice = FD -> Int -> Int -> IO Int
loop FD
fd Int
0 Int
count
 | Bool
otherwise = do
     (Int
r,Buffer Word8
buf') <- dev -> Buffer Word8 -> IO (Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
buf
     if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
so_far
        else do IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf'
                Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNonEmpty Handle__
h_ Buffer Word8
buf' Ptr Word8
ptr Int
so_far Int
count
 where
  loop :: FD -> Int -> Int -> IO Int
  loop :: FD -> Int -> Int -> IO Int
loop FD
fd Int
off Int
bytes | Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
so_far Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off)
  loop FD
fd Int
off Int
bytes = do
    Int
r <- FD -> Ptr Word8 -> Int -> IO Int
forall a. RawIO a => a -> Ptr Word8 -> Int -> IO Int
RawIO.read (FD
fd::FD) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) Int
bytes
    if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
so_far Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off)
        else FD -> Int -> Int -> IO Int
loop FD
fd (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r) (Int
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)

-- ---------------------------------------------------------------------------
-- hGetBufSome

-- | 'hGetBufSome' @hdl buf count@ reads data from the handle @hdl@
-- into the buffer @buf@.  If there is any data available to read,
-- then 'hGetBufSome' returns it immediately; it only blocks if there
-- is no data to be read.
--
-- It returns the number of bytes actually read.  This may be zero if
-- EOF was reached before any data was read (or if @count@ is zero).
--
-- 'hGetBufSome' never raises an EOF exception, instead it returns a value
-- smaller than @count@.
--
-- If the handle is a pipe or socket, and the writing end
-- is closed, 'hGetBufSome' will behave as if EOF was reached.
--
-- 'hGetBufSome' ignores the prevailing 'System.IO.TextEncoding' and
-- 'NewlineMode' on the 'Handle', and reads bytes directly.

hGetBufSome :: Handle -> Ptr a -> Int -> IO Int
hGetBufSome :: Handle -> Ptr a -> Int -> IO Int
hGetBufSome Handle
h !Ptr a
ptr Int
count
  | Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
  | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0 = Handle -> String -> Int -> IO Int
forall a. Handle -> String -> Int -> IO a
illegalBufferSize Handle
h String
"hGetBufSome" Int
count
  | Bool
otherwise =
      String -> Handle -> (Handle__ -> IO Int) -> IO Int
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hGetBufSome" Handle
h ((Handle__ -> IO Int) -> IO Int) -> (Handle__ -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
         Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
         buf :: Buffer Word8
buf@Buffer{ bufSize :: forall e. Buffer e -> Int
bufSize=Int
sz } <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
         if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
buf
            then case Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz of  -- large read? optimize it with a little special case:
                    Bool
True | Just FD
fd <- Handle__ -> Maybe FD
haFD Handle__
h_ -> do FD -> Ptr Word8 -> Int -> IO Int
forall a. RawIO a => a -> Ptr Word8 -> Int -> IO Int
RawIO.read FD
fd (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
count
                    Bool
_ -> do (Int
r,Buffer Word8
buf') <- dev -> Buffer Word8 -> IO (Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
buf
                            if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                               then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
                               else do IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf'
                                       Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBNonEmpty Handle__
h_ Buffer Word8
buf' (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
r Int
count)
                                        -- new count is  (min r count), so
                                        -- that bufReadNBNonEmpty will not
                                        -- issue another read.
            else
              let count' :: Int
count' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count (Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferElems Buffer Word8
buf)
              in Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBNonEmpty Handle__
h_ Buffer Word8
buf (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
0 Int
count'

haFD :: Handle__ -> Maybe FD
haFD :: Handle__ -> Maybe FD
haFD h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} = dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice

-- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@
-- into the buffer @buf@ until either EOF is reached, or
-- @count@ 8-bit bytes have been read, or there is no more data available
-- to read immediately.
--
-- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will
-- never block waiting for data to become available, instead it returns
-- only whatever data is available.  To wait for data to arrive before
-- calling 'hGetBufNonBlocking', use 'hWaitForInput'.
--
-- If the handle is a pipe or socket, and the writing end
-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
--
-- 'hGetBufNonBlocking' ignores the prevailing 'System.IO.TextEncoding' and
-- 'NewlineMode' on the 'Handle', and reads bytes directly.
--
-- NOTE: on Windows, this function does not work correctly; it
-- behaves identically to 'hGetBuf'.

hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking Handle
h !Ptr a
ptr Int
count
  | Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
  | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0 = Handle -> String -> Int -> IO Int
forall a. Handle -> String -> Int -> IO a
illegalBufferSize Handle
h String
"hGetBufNonBlocking" Int
count
  | Bool
otherwise =
      String -> Handle -> (Handle__ -> IO Int) -> IO Int
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hGetBufNonBlocking" Handle
h ((Handle__ -> IO Int) -> IO Int) -> (Handle__ -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
         Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
         buf :: Buffer Word8
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufL :: forall e. Buffer e -> Int
bufL=Int
r, bufSize :: forall e. Buffer e -> Int
bufSize=Int
sz }
            <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
         if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
buf
            then Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBEmpty    Handle__
h_ Buffer Word8
buf (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
0 Int
count
            else Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBNonEmpty Handle__
h_ Buffer Word8
buf (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr) Int
0 Int
count

bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBEmpty   h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..}
                 buf :: Buffer Word8
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufL :: forall e. Buffer e -> Int
bufL=Int
r, bufSize :: forall e. Buffer e -> Int
bufSize=Int
sz }
                 Ptr Word8
ptr Int
so_far Int
count
  | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sz,
    Just FD
fd <- dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice = do
       Maybe Int
m <- FD -> Ptr Word8 -> Int -> IO (Maybe Int)
forall a. RawIO a => a -> Ptr Word8 -> Int -> IO (Maybe Int)
RawIO.readNonBlocking (FD
fd::FD) Ptr Word8
ptr Int
count
       case Maybe Int
m of
         Maybe Int
Nothing -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
so_far
         Just Int
n  -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
so_far Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

 | Bool
otherwise = do
     Buffer Word8
buf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
     (Maybe Int
r,Buffer Word8
buf') <- dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
Buffered.fillReadBuffer0 dev
haDevice Buffer Word8
buf
     case Maybe Int
r of
       Maybe Int
Nothing -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
so_far
       Just Int
0  -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
so_far
       Just Int
r  -> do
         IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf'
         Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBNonEmpty Handle__
h_ Buffer Word8
buf' Ptr Word8
ptr Int
so_far (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count Int
r)
                          -- NOTE: new count is    min count r
                          -- so we will just copy the contents of the
                          -- buffer in the recursive call, and not
                          -- loop again.


bufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBNonEmpty h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..}
                  buf :: Buffer Word8
buf@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufL :: forall e. Buffer e -> Int
bufL=Int
r, bufSize :: forall e. Buffer e -> Int
bufSize=Int
sz }
                  Ptr Word8
ptr Int
so_far Int
count
  = do
        let avail :: Int
avail = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
        if (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
avail)
           then do
                Ptr Word8 -> RawBuffer Word8 -> Int -> Int -> IO ()
forall e. Ptr e -> RawBuffer e -> Int -> Int -> IO ()
copyFromRawBuffer Ptr Word8
ptr RawBuffer Word8
raw Int
r Int
count
                IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufL :: Int
bufL = Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count }
                Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
so_far Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count)
           else do

        Ptr Word8 -> RawBuffer Word8 -> Int -> Int -> IO ()
forall e. Ptr e -> RawBuffer e -> Int -> Int -> IO ()
copyFromRawBuffer Ptr Word8
ptr RawBuffer Word8
raw Int
r Int
avail
        let buf' :: Buffer Word8
buf' = Buffer Word8
buf{ bufR :: Int
bufR=Int
0, bufL :: Int
bufL=Int
0 }
        IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf'
        let remaining :: Int
remaining = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
avail
            so_far' :: Int
so_far' = Int
so_far Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
avail
            ptr' :: Ptr b
ptr' = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
avail

        if Int
remaining Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
           then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
so_far'
           else Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int
bufReadNBEmpty Handle__
h_ Buffer Word8
buf' Ptr Word8
forall b. Ptr b
ptr' Int
so_far' Int
remaining

-- ---------------------------------------------------------------------------
-- memcpy wrappers

copyToRawBuffer :: RawBuffer e -> Int -> Ptr e -> Int -> IO ()
copyToRawBuffer :: RawBuffer e -> Int -> Ptr e -> Int -> IO ()
copyToRawBuffer RawBuffer e
raw Int
off Ptr e
ptr Int
bytes =
 RawBuffer e -> (Ptr e -> IO ()) -> IO ()
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer e
raw ((Ptr e -> IO ()) -> IO ()) -> (Ptr e -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr e
praw ->
   do Ptr ()
_ <- Ptr e -> Ptr e -> CSize -> IO (Ptr ())
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr ())
memcpy (Ptr e
praw Ptr e -> Int -> Ptr e
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) Ptr e
ptr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytes)
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

copyFromRawBuffer :: Ptr e -> RawBuffer e -> Int -> Int -> IO ()
copyFromRawBuffer :: Ptr e -> RawBuffer e -> Int -> Int -> IO ()
copyFromRawBuffer Ptr e
ptr RawBuffer e
raw Int
off Int
bytes =
 RawBuffer e -> (Ptr e -> IO ()) -> IO ()
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer e
raw ((Ptr e -> IO ()) -> IO ()) -> (Ptr e -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr e
praw ->
   do Ptr ()
_ <- Ptr e -> Ptr e -> CSize -> IO (Ptr ())
forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr ())
memcpy Ptr e
ptr (Ptr e
praw Ptr e -> Int -> Ptr e
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytes)
      () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

foreign import ccall unsafe "memcpy"
   memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr ())

-----------------------------------------------------------------------------
-- Internal Utils

illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize Handle
handle String
fn Int
sz =
        IOError -> IO a
forall a. IOError -> IO a
ioException (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOError
IOError (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle)
                            IOErrorType
InvalidArgument  String
fn
                            (String
"illegal buffer size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
9 Int
sz [])
                            Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)