{-# LANGUAGE BangPatterns, RecordWildCards #-}
-- |
-- Module      : Data.Text.Internal.IO
-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,
--               (c) 2009 Simon Marlow
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- /Warning/: this is an internal module, and does not have a stable
-- API or name. Functions in this module may not check or enforce
-- preconditions expected by public modules. Use at your own risk!
--
-- Low-level support for text I\/O.

module Data.Text.Internal.IO
    (
      hGetLineWith
    , readChunk
    ) where

import qualified Control.Exception as E
import Data.IORef (readIORef, writeIORef)
import Data.Text (Text)
import Data.Text.Internal.Fusion (unstream)
import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
import Data.Text.Internal.Fusion.Size (exactSize, maxSize)
import Data.Text.Unsafe (inlinePerformIO)
import Foreign.Storable (peekElemOff)
import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,
                      bufferElems, charSize, isEmptyBuffer, readCharBuf,
                      withRawBuffer, writeCharBuf)
import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)
import GHC.IO.Handle.Types (Handle__(..), Newline(..))
import System.IO (Handle)
import System.IO.Error (isEOFError)
import qualified Data.Text as T

-- | Read a single line of input from a handle, constructing a list of
-- decoded chunks as we go.  When we're done, transform them into the
-- destination type.
hGetLineWith :: ([Text] -> t) -> Handle -> IO t
hGetLineWith :: ([Text] -> t) -> Handle -> IO t
hGetLineWith [Text] -> t
f Handle
h = String -> Handle -> (Handle__ -> IO t) -> IO t
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hGetLine" Handle
h Handle__ -> IO t
go
  where
    go :: Handle__ -> IO t
go hh :: Handle__
hh@Handle__{dev
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
Maybe (MVar Handle__)
HandleType
BufferMode
Newline
IORef (dec_state, Buffer Word8)
IORef (BufferList CharBufElem)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
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
..} = IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer IO (Buffer CharBufElem) -> (Buffer CharBufElem -> IO t) -> IO t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Text] -> t) -> IO [Text] -> IO t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> t
f (IO [Text] -> IO t)
-> (Buffer CharBufElem -> IO [Text]) -> Buffer CharBufElem -> IO t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle__ -> [Text] -> Buffer CharBufElem -> IO [Text]
hGetLineLoop Handle__
hh []

hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]
hGetLineLoop :: Handle__ -> [Text] -> Buffer CharBufElem -> IO [Text]
hGetLineLoop hh :: Handle__
hh@Handle__{dev
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
Maybe (MVar Handle__)
HandleType
BufferMode
Newline
IORef (dec_state, Buffer Word8)
IORef (BufferList CharBufElem)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
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
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
..} = [Text] -> Buffer CharBufElem -> IO [Text]
go where
 go :: [Text] -> Buffer CharBufElem -> IO [Text]
go [Text]
ts 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=RawBuffer CharBufElem
raw0 } = do
  let findEOL :: RawBuffer CharBufElem -> Int -> IO (Bool, Int)
findEOL RawBuffer CharBufElem
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') <- RawBuffer CharBufElem -> Int -> IO (CharBufElem, Int)
readCharBuf RawBuffer CharBufElem
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)
          else RawBuffer CharBufElem -> Int -> IO (Bool, Int)
findEOL RawBuffer CharBufElem
raw Int
r'
  (Bool
eol, Int
off) <- RawBuffer CharBufElem -> Int -> IO (Bool, Int)
findEOL RawBuffer CharBufElem
raw0 Int
r0
  (Text
t,Int
r') <- if Newline
haInputNL Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF
            then RawBuffer CharBufElem -> Int -> Int -> IO (Text, Int)
unpack_nl RawBuffer CharBufElem
raw0 Int
r0 Int
off
            else do Text
t <- RawBuffer CharBufElem -> Int -> Int -> IO Text
unpack RawBuffer CharBufElem
raw0 Int
r0 Int
off
                    (Text, Int) -> IO (Text, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t,Int
off)
  if Bool
eol
    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)
            [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse (Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ts)
    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__
hh 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 :: Text
pre | Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf1 = Text
T.empty
                      | Bool
otherwise          = CharBufElem -> Text
T.singleton CharBufElem
'\r'
              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 :: [Text]
str = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
preText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ts
              if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
str
                then IO [Text]
forall a. IO a
ioe_EOF
                else [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
str
         Just Buffer CharBufElem
new_buf -> [Text] -> Buffer CharBufElem -> IO [Text]
go (Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ts) Buffer CharBufElem
new_buf

-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
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
E.catch (Buffer CharBufElem -> Maybe (Buffer CharBufElem)
forall a. a -> Maybe a
Just (Buffer CharBufElem -> Maybe (Buffer CharBufElem))
-> IO (Buffer CharBufElem) -> IO (Maybe (Buffer CharBufElem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
getSomeCharacters Handle__
handle_ Buffer CharBufElem
buf) ((IOError -> IO (Maybe (Buffer CharBufElem)))
 -> IO (Maybe (Buffer CharBufElem)))
-> (IOError -> IO (Maybe (Buffer CharBufElem)))
-> IO (Maybe (Buffer CharBufElem))
forall a b. (a -> b) -> a -> b
$ \IOError
e ->
      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

unpack :: RawCharBuffer -> Int -> Int -> IO Text
unpack :: RawBuffer CharBufElem -> Int -> Int -> IO Text
unpack !RawBuffer CharBufElem
buf !Int
r !Int
w
 | Int
charSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4 = String -> IO Text
forall a. String -> a
sizeError String
"unpack"
 | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w        = Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty
 | Bool
otherwise     = RawBuffer CharBufElem -> (Ptr CharBufElem -> IO Text) -> IO Text
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer CharBufElem
buf Ptr CharBufElem -> IO Text
forall (m :: * -> *). Monad m => Ptr CharBufElem -> m Text
go
 where
  go :: Ptr CharBufElem -> m Text
go Ptr CharBufElem
pbuf = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! Stream CharBufElem -> Text
unstream ((Int -> Step Int CharBufElem) -> Int -> Size -> Stream CharBufElem
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int CharBufElem
next Int
r (Int -> Size
exactSize (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r)))
   where
    next :: Int -> Step Int CharBufElem
next !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w    = Step Int CharBufElem
forall s a. Step s a
Done
            | Bool
otherwise = CharBufElem -> Int -> Step Int CharBufElem
forall s a. a -> s -> Step s a
Yield (Int -> CharBufElem
ix Int
i) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    ix :: Int -> CharBufElem
ix Int
i = IO CharBufElem -> CharBufElem
forall a. IO a -> a
inlinePerformIO (IO CharBufElem -> CharBufElem) -> IO CharBufElem -> CharBufElem
forall a b. (a -> b) -> a -> b
$ Ptr CharBufElem -> Int -> IO CharBufElem
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
pbuf Int
i

unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)
unpack_nl :: RawBuffer CharBufElem -> Int -> Int -> IO (Text, Int)
unpack_nl !RawBuffer CharBufElem
buf !Int
r !Int
w
 | Int
charSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4 = String -> IO (Text, Int)
forall a. String -> a
sizeError String
"unpack_nl"
 | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w        = (Text, Int) -> IO (Text, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
T.empty, Int
0)
 | Bool
otherwise     = RawBuffer CharBufElem
-> (Ptr CharBufElem -> IO (Text, Int)) -> IO (Text, Int)
forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer CharBufElem
buf ((Ptr CharBufElem -> IO (Text, Int)) -> IO (Text, Int))
-> (Ptr CharBufElem -> IO (Text, Int)) -> IO (Text, Int)
forall a b. (a -> b) -> a -> b
$ Ptr CharBufElem -> IO (Text, Int)
forall (m :: * -> *). Monad m => Ptr CharBufElem -> m (Text, Int)
go
 where
  go :: Ptr CharBufElem -> m (Text, Int)
go Ptr CharBufElem
pbuf = do
    let !t :: Text
t = Stream CharBufElem -> Text
unstream ((Int -> Step Int CharBufElem) -> Int -> Size -> Stream CharBufElem
forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int CharBufElem
next Int
r (Int -> Size
maxSize (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r)))
        w' :: Int
w' = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    (Text, Int) -> m (Text, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Int) -> m (Text, Int)) -> (Text, Int) -> m (Text, Int)
forall a b. (a -> b) -> a -> b
$ if Int -> CharBufElem
ix Int
w' CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r'
             then (Text
t,Int
w')
             else (Text
t,Int
w)
   where
    next :: Int -> Step Int CharBufElem
next !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = Step Int CharBufElem
forall s a. Step s a
Done
            | CharBufElem
c CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r' = let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                          in if Int
i' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w
                             then if Int -> CharBufElem
ix Int
i' CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'
                                  then CharBufElem -> Int -> Step Int CharBufElem
forall s a. a -> s -> Step s a
Yield CharBufElem
'\n' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
                                  else CharBufElem -> Int -> Step Int CharBufElem
forall s a. a -> s -> Step s a
Yield CharBufElem
'\n' Int
i'
                             else Step Int CharBufElem
forall s a. Step s a
Done
            | Bool
otherwise = CharBufElem -> Int -> Step Int CharBufElem
forall s a. a -> s -> Step s a
Yield CharBufElem
c (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            where c :: CharBufElem
c = Int -> CharBufElem
ix Int
i
    ix :: Int -> CharBufElem
ix Int
i = IO CharBufElem -> CharBufElem
forall a. IO a -> a
inlinePerformIO (IO CharBufElem -> CharBufElem) -> IO CharBufElem -> CharBufElem
forall a b. (a -> b) -> a -> b
$ Ptr CharBufElem -> Int -> IO CharBufElem
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
pbuf Int
i

-- This function is completely lifted from GHC.IO.Handle.Text.
getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer
getSomeCharacters :: Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
getSomeCharacters handle_ :: Handle__
handle_@Handle__{dev
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
Maybe (MVar Handle__)
HandleType
BufferMode
Newline
IORef (dec_state, Buffer Word8)
IORef (BufferList CharBufElem)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
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
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
..} buf :: Buffer CharBufElem
buf@Buffer{Int
RawBuffer CharBufElem
BufferState
bufState :: forall e. Buffer e -> BufferState
bufSize :: forall e. Buffer e -> Int
bufR :: Int
bufL :: Int
bufSize :: Int
bufState :: BufferState
bufRaw :: RawBuffer CharBufElem
bufRaw :: forall e. Buffer e -> RawBuffer e
bufR :: forall e. Buffer e -> Int
bufL :: forall e. Buffer e -> Int
..} =
  case Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufferElems Buffer CharBufElem
buf of
    -- buffer empty: read some more
    Int
0 -> {-# SCC "readTextDevice" #-} 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
_) <- RawBuffer CharBufElem -> Int -> IO (CharBufElem, Int)
readCharBuf RawBuffer CharBufElem
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
_ <- RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
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 -> {-# SCC "otherwise" #-} Buffer CharBufElem -> IO (Buffer CharBufElem)
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
buf

-- | Read a single chunk of strict text from a buffer. Used by both
-- the strict and lazy implementations of hGetContents.
readChunk :: Handle__ -> CharBuffer -> IO Text
readChunk :: Handle__ -> Buffer CharBufElem -> IO Text
readChunk hh :: Handle__
hh@Handle__{dev
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
Maybe (MVar Handle__)
HandleType
BufferMode
Newline
IORef (dec_state, Buffer Word8)
IORef (BufferList CharBufElem)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
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
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
..} Buffer CharBufElem
buf = do
  buf' :: Buffer CharBufElem
buf'@Buffer{Int
RawBuffer CharBufElem
BufferState
bufR :: Int
bufL :: Int
bufSize :: Int
bufState :: BufferState
bufRaw :: RawBuffer CharBufElem
bufState :: forall e. Buffer e -> BufferState
bufSize :: forall e. Buffer e -> Int
bufRaw :: forall e. Buffer e -> RawBuffer e
bufR :: forall e. Buffer e -> Int
bufL :: forall e. Buffer e -> Int
..} <- Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
getSomeCharacters Handle__
hh Buffer CharBufElem
buf
  (Text
t,Int
r) <- if Newline
haInputNL Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF
           then RawBuffer CharBufElem -> Int -> Int -> IO (Text, Int)
unpack_nl RawBuffer CharBufElem
bufRaw Int
bufL Int
bufR
           else do Text
t <- RawBuffer CharBufElem -> Int -> Int -> IO Text
unpack RawBuffer CharBufElem
bufRaw Int
bufL Int
bufR
                   (Text, Int) -> IO (Text, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t,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')
  Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t

sizeError :: String -> a
sizeError :: String -> a
sizeError String
loc = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.Text.IO." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": bad internal buffer size"