{-# LANGUAGE BangPatterns, RecordWildCards #-}
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
hGetLineWith :: ([Text] -> t) -> Handle -> IO t
hGetLineWith :: forall t. ([Text] -> t) -> Handle -> IO t
hGetLineWith [Text] -> t
f Handle
h = 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 TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
IORef (dec_state, Buffer Word8)
IORef (BufferList CharBufElem)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haDevice :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> 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
..} = forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> t
f 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 TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
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
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haDevice :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> HandleType
..} = [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 forall a. Eq a => a -> a -> Bool
== Int
w = 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 forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'
then 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 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t,Int
off)
if Bool
eol
then do forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer (forall e. Int -> Buffer e -> Buffer e
bufferAdjustL (Int
offforall a. Num a => a -> a -> a
+Int
1) Buffer CharBufElem
buf)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (Text
tforall a. a -> [a] -> [a]
:[Text]
ts)
else do
let buf1 :: Buffer CharBufElem
buf1 = 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
Maybe (Buffer CharBufElem)
Nothing -> do
let pre :: Text
pre | forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf1 = Text
T.empty
| Bool
otherwise = CharBufElem -> Text
T.singleton CharBufElem
'\r'
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 = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall a b. (a -> b) -> a -> b
$ Text
preforall a. a -> [a] -> [a]
:Text
tforall a. a -> [a] -> [a]
:[Text]
ts
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
str
then forall a. IO a
ioe_EOF
else forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
str
Just Buffer CharBufElem
new_buf -> [Text] -> Buffer CharBufElem -> IO [Text]
go (Text
tforall a. a -> [a] -> [a]
:[Text]
ts) Buffer CharBufElem
new_buf
maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
maybeFillReadBuffer :: Handle__ -> Buffer CharBufElem -> IO (Maybe (Buffer CharBufElem))
maybeFillReadBuffer Handle__
handle_ Buffer CharBufElem
buf
= forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (forall a. a -> Maybe a
Just 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) forall a b. (a -> b) -> a -> b
$ \IOError
e ->
if IOError -> Bool
isEOFError IOError
e
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else 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 forall a. Eq a => a -> a -> Bool
/= Int
4 = forall a. String -> a
sizeError String
"unpack"
| Int
r forall a. Ord a => a -> a -> Bool
>= Int
w = forall (m :: * -> *) a. Monad m => a -> m a
return Text
T.empty
| Bool
otherwise = forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer CharBufElem
buf forall {m :: * -> *}. Monad m => Ptr CharBufElem -> m Text
go
where
go :: Ptr CharBufElem -> m Text
go Ptr CharBufElem
pbuf = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Stream CharBufElem -> Text
unstream (forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int CharBufElem
next Int
r (Int -> Size
exactSize (Int
wforall a. Num a => a -> a -> a
-Int
r)))
where
next :: Int -> Step Int CharBufElem
next !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
w = forall s a. Step s a
Done
| Bool
otherwise = forall s a. a -> s -> Step s a
Yield (Int -> CharBufElem
ix Int
i) (Int
iforall a. Num a => a -> a -> a
+Int
1)
ix :: Int -> CharBufElem
ix Int
i = forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
/= Int
4 = forall a. String -> a
sizeError String
"unpack_nl"
| Int
r forall a. Ord a => a -> a -> Bool
>= Int
w = forall (m :: * -> *) a. Monad m => a -> m a
return (Text
T.empty, Int
0)
| Bool
otherwise = forall e a. RawBuffer e -> (Ptr e -> IO a) -> IO a
withRawBuffer RawBuffer CharBufElem
buf forall a b. (a -> b) -> a -> b
$ 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 (forall a s. (s -> Step s a) -> s -> Size -> Stream a
Stream Int -> Step Int CharBufElem
next Int
r (Int -> Size
maxSize (Int
wforall a. Num a => a -> a -> a
-Int
r)))
w' :: Int
w' = Int
w forall a. Num a => a -> a -> a
- Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Int -> CharBufElem
ix Int
w' 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 forall a. Ord a => a -> a -> Bool
>= Int
w = forall s a. Step s a
Done
| CharBufElem
c forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r' = let i' :: Int
i' = Int
i forall a. Num a => a -> a -> a
+ Int
1
in if Int
i' forall a. Ord a => a -> a -> Bool
< Int
w
then if Int -> CharBufElem
ix Int
i' forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'
then forall s a. a -> s -> Step s a
Yield CharBufElem
'\n' (Int
iforall a. Num a => a -> a -> a
+Int
2)
else forall s a. a -> s -> Step s a
Yield CharBufElem
'\n' Int
i'
else forall s a. Step s a
Done
| Bool
otherwise = forall s a. a -> s -> Step s a
Yield CharBufElem
c (Int
iforall a. Num a => a -> a -> a
+Int
1)
where c :: CharBufElem
c = Int -> CharBufElem
ix Int
i
ix :: Int -> CharBufElem
ix Int
i = forall a. IO a -> a
inlinePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CharBufElem
pbuf Int
i
getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer
getSomeCharacters :: Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
getSomeCharacters handle_ :: Handle__
handle_@Handle__{dev
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
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
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haDevice :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> HandleType
..} buf :: Buffer CharBufElem
buf@Buffer{Int
Word64
RawBuffer CharBufElem
BufferState
bufOffset :: forall e. Buffer e -> Word64
bufSize :: forall e. Buffer e -> Int
bufState :: forall e. Buffer e -> BufferState
bufR :: Int
bufL :: Int
bufOffset :: Word64
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 forall e. Buffer e -> Int
bufferElems Buffer CharBufElem
buf of
Int
0 -> {-# SCC "readTextDevice" #-} Handle__ -> Buffer CharBufElem -> IO (Buffer CharBufElem)
readTextDevice Handle__
handle_ Buffer CharBufElem
buf
Int
1 | Newline
haInputNL 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 forall a. Eq a => a -> a -> Bool
== CharBufElem
'\r'
then do
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
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
buf
Int
_otherwise -> {-# SCC "otherwise" #-} forall (m :: * -> *) a. Monad m => a -> m a
return Buffer CharBufElem
buf
readChunk :: Handle__ -> CharBuffer -> IO Text
readChunk :: Handle__ -> Buffer CharBufElem -> IO Text
readChunk hh :: Handle__
hh@Handle__{dev
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe (MVar Handle__)
Newline
HandleType
BufferMode
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
haBufferMode :: Handle__ -> BufferMode
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haDevice :: ()
haEncoder :: ()
haInputNL :: Handle__ -> Newline
haLastDecode :: ()
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haType :: Handle__ -> HandleType
..} Buffer CharBufElem
buf = do
buf' :: Buffer CharBufElem
buf'@Buffer{Int
Word64
RawBuffer CharBufElem
BufferState
bufR :: Int
bufL :: Int
bufOffset :: Word64
bufSize :: Int
bufState :: BufferState
bufRaw :: RawBuffer CharBufElem
bufOffset :: forall e. Buffer e -> Word64
bufSize :: forall e. Buffer e -> Int
bufState :: forall e. Buffer e -> BufferState
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 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
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t,Int
bufR)
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer (forall e. Int -> Buffer e -> Buffer e
bufferAdjustL Int
r Buffer CharBufElem
buf')
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
sizeError :: String -> a
sizeError :: forall a. String -> a
sizeError String
loc = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Data.Text.IO." forall a. [a] -> [a] -> [a]
++ String
loc forall a. [a] -> [a] -> [a]
++ String
": bad internal buffer size"