{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
-- |
-- Module      : Data.Text.IO
-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,
--               (c) 2009 Simon Marlow
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Portability : GHC
--
-- Efficient locale-sensitive support for text I\/O.
--
-- The functions in this module obey the runtime system's locale,
-- character set encoding, and line ending conversion settings.
--
-- If you know in advance that you will be working with data that has
-- a specific encoding (e.g. UTF-8), and your application is highly
-- performance sensitive, you may find that it is faster to perform
-- I\/O with bytestrings and to encode and decode yourself than to use
-- the functions in this module.

module Data.Text.IO
    (
    -- * File-at-a-time operations
      readFile
    , writeFile
    , appendFile
    -- * Operations on handles
    , hGetContents
    , hGetChunk
    , hGetLine
    , hPutStr
    , hPutStrLn
    -- * Special cases for standard input and output
    , interact
    , getContents
    , getLine
    , putStr
    , putStrLn
    ) where

import Data.Text (Text)
import Prelude hiding (appendFile, getContents, getLine, interact,
                       putStr, putStrLn, readFile, writeFile)
import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
                  withFile)
import qualified Control.Exception as E
import Control.Monad (liftM2, when)
import Data.IORef (readIORef, writeIORef)
import qualified Data.Text as T
import Data.Text.Internal.Fusion (stream)
import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
import Data.Text.Internal.IO (hGetLineWith, readChunk)
import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
                      RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
                      writeCharBuf)
import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))
import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,
                                wantWritableHandle)
import GHC.IO.Handle.Text (commitBuffer')
import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
                            HandleType(..), Newline(..))
import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
import System.IO.Error (isEOFError)

-- | The 'readFile' function reads a file and returns the contents of
-- the file as a string.  The entire file is read strictly, as with
-- 'getContents'.
--
-- Beware that this function (similarly to 'Prelude.readFile') is locale-dependent.
-- Unexpected system locale may cause your application to read corrupted data or
-- throw runtime exceptions about "invalid argument (invalid byte sequence)"
-- or "invalid argument (invalid character)". This is also slow, because GHC
-- first converts an entire input to UTF-32, which is afterwards converted to UTF-8.
--
-- If your data is UTF-8,
-- using 'Data.Text.Encoding.decodeUtf8' '.' 'Data.ByteString.readFile'
-- is a much faster and safer alternative.
readFile :: FilePath -> IO Text
readFile :: FilePath -> IO Text
readFile FilePath
name = FilePath -> IOMode -> IO Handle
openFile FilePath
name IOMode
ReadMode IO Handle -> (Handle -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Text
hGetContents

-- | Write a string to a file.  The file is truncated to zero length
-- before writing begins.
writeFile :: FilePath -> Text -> IO ()
writeFile :: FilePath -> Text -> IO ()
writeFile FilePath
p = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
p IOMode
WriteMode ((Handle -> IO ()) -> IO ())
-> (Text -> Handle -> IO ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> Text -> IO ()) -> Text -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> Text -> IO ()
hPutStr

-- | Write a string to the end of a file.
appendFile :: FilePath -> Text -> IO ()
appendFile :: FilePath -> Text -> IO ()
appendFile FilePath
p = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
p IOMode
AppendMode ((Handle -> IO ()) -> IO ())
-> (Text -> Handle -> IO ()) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> Text -> IO ()) -> Text -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> Text -> IO ()
hPutStr

catchError :: String -> Handle -> Handle__ -> IOError -> IO (Text, Bool)
catchError :: FilePath -> Handle -> Handle__ -> IOError -> IO (Text, Bool)
catchError FilePath
caller Handle
h 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
..} IOError
err
    | IOError -> Bool
isEOFError IOError
err = do
        Buffer CharBufElem
buf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
        (Text, Bool) -> IO (Text, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Text, Bool) -> IO (Text, Bool))
-> (Text, Bool) -> IO (Text, Bool)
forall a b. (a -> b) -> a -> b
$ if Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf
                 then (Text
T.empty, Bool
True)
                 else (CharBufElem -> Text
T.singleton CharBufElem
'\r', Bool
True)
    | Bool
otherwise = IOError -> IO (Text, Bool)
forall e a. Exception e => e -> IO a
E.throwIO (IOError -> FilePath -> Handle -> IOError
augmentIOError IOError
err FilePath
caller Handle
h)

-- | Wrap readChunk and return a value indicating if we're reached the EOF.
-- This is needed because unpack_nl is unable to discern the difference
-- between a buffer with just \r due to EOF or because not enough data was left
-- for decoding. e.g. the final character decoded from the byte buffer was \r.
readChunkEof :: Handle__ -> CharBuffer -> IO (Text, Bool)
readChunkEof :: Handle__ -> Buffer CharBufElem -> IO (Text, Bool)
readChunkEof Handle__
hh Buffer CharBufElem
buf = do Text
t <- Handle__ -> Buffer CharBufElem -> IO Text
readChunk Handle__
hh Buffer CharBufElem
buf
                         (Text, Bool) -> IO (Text, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t, Bool
False)

-- | /Experimental./ Read a single chunk of strict text from a
-- 'Handle'. The size of the chunk depends on the amount of input
-- currently buffered.
--
-- This function blocks only if there is no data available, and EOF
-- has not yet been reached. Once EOF is reached, this function
-- returns an empty string instead of throwing an exception.
hGetChunk :: Handle -> IO Text
hGetChunk :: Handle -> IO Text
hGetChunk Handle
h = FilePath -> Handle -> (Handle__ -> IO (Handle__, Text)) -> IO Text
forall a.
FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
wantReadableHandle FilePath
"hGetChunk" Handle
h Handle__ -> IO (Handle__, Text)
readSingleChunk
 where
  readSingleChunk :: Handle__ -> IO (Handle__, Text)
readSingleChunk 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__)
..} = do
    Buffer CharBufElem
buf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
    (Text
t, Bool
_) <- Handle__ -> Buffer CharBufElem -> IO (Text, Bool)
readChunkEof Handle__
hh Buffer CharBufElem
buf IO (Text, Bool) -> (IOError -> IO (Text, Bool)) -> IO (Text, Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` FilePath -> Handle -> Handle__ -> IOError -> IO (Text, Bool)
catchError FilePath
"hGetChunk" Handle
h Handle__
hh
    (Handle__, Text) -> IO (Handle__, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
hh, Text
t)

-- | Read the remaining contents of a 'Handle' as a string.  The
-- 'Handle' is closed once the contents have been read, or if an
-- exception is thrown.
--
-- Internally, this function reads a chunk at a time from the
-- lower-level buffering abstraction, and concatenates the chunks into
-- a single string once the entire file has been read.
--
-- As a result, it requires approximately twice as much memory as its
-- result to construct its result.  For files more than a half of
-- available RAM in size, this may result in memory exhaustion.
hGetContents :: Handle -> IO Text
hGetContents :: Handle -> IO Text
hGetContents Handle
h = do
  Handle -> IO ()
chooseGoodBuffering Handle
h
  FilePath -> Handle -> (Handle__ -> IO (Handle__, Text)) -> IO Text
forall a.
FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
wantReadableHandle FilePath
"hGetContents" Handle
h Handle__ -> IO (Handle__, Text)
readAll
 where
  readAll :: Handle__ -> IO (Handle__, Text)
readAll 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__)
..} = do
    let readChunks :: IO [Text]
readChunks = do
          Buffer CharBufElem
buf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
          (Text
t, Bool
eof) <- Handle__ -> Buffer CharBufElem -> IO (Text, Bool)
readChunkEof Handle__
hh Buffer CharBufElem
buf
                         IO (Text, Bool) -> (IOError -> IO (Text, Bool)) -> IO (Text, Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` FilePath -> Handle -> Handle__ -> IOError -> IO (Text, Bool)
catchError FilePath
"hGetContents" Handle
h Handle__
hh
          if Bool
eof
            then [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text
t]
            else (Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> IO [Text] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO [Text]
readChunks
    [Text]
ts <- IO [Text]
readChunks
    (Handle__
hh', Maybe SomeException
_) <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
hh
    (Handle__, Text) -> IO (Handle__, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
hh'{haType :: HandleType
haType=HandleType
ClosedHandle}, [Text] -> Text
T.concat [Text]
ts)

-- | Use a more efficient buffer size if we're reading in
-- block-buffered mode with the default buffer size.  When we can
-- determine the size of the handle we're reading, set the buffer size
-- to that, so that we can read the entire file in one chunk.
-- Otherwise, use a buffer size of at least 16KB.
chooseGoodBuffering :: Handle -> IO ()
chooseGoodBuffering :: Handle -> IO ()
chooseGoodBuffering Handle
h = do
  BufferMode
bufMode <- Handle -> IO BufferMode
hGetBuffering Handle
h
  case BufferMode
bufMode of
    BlockBuffering Maybe Int
Nothing -> do
      Integer
d <- IO Integer -> (IOError -> IO Integer) -> IO Integer
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch ((Integer -> Integer -> Integer)
-> IO Integer -> IO Integer -> IO Integer
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (-) (Handle -> IO Integer
hFileSize Handle
h) (Handle -> IO Integer
hTell Handle
h)) ((IOError -> IO Integer) -> IO Integer)
-> (IOError -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \(IOError
e::IOException) ->
           if IOError -> IOErrorType
ioe_type IOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
InappropriateType
           then Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
16384 -- faster than the 2KB default
           else IOError -> IO Integer
forall e a. Exception e => e -> IO a
E.throwIO IOError
e
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) (IO () -> IO ()) -> (Integer -> IO ()) -> Integer -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> BufferMode -> IO ()
hSetBuffering Handle
h (BufferMode -> IO ())
-> (Integer -> BufferMode) -> Integer -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> BufferMode
BlockBuffering (Maybe Int -> BufferMode)
-> (Integer -> Maybe Int) -> Integer -> BufferMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Integer -> Int) -> Integer -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer
d
    BufferMode
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Read a single line from a handle.
hGetLine :: Handle -> IO Text
hGetLine :: Handle -> IO Text
hGetLine = ([Text] -> Text) -> Handle -> IO Text
forall t. ([Text] -> t) -> Handle -> IO t
hGetLineWith [Text] -> Text
T.concat

-- | Write a string to a handle.
hPutStr :: Handle -> Text -> IO ()
-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
hPutStr :: Handle -> Text -> IO ()
hPutStr Handle
h Text
t = do
  ((BufferMode, Buffer CharBufElem)
buffer_mode, Newline
nl) <-
       FilePath
-> Handle
-> (Handle__ -> IO ((BufferMode, Buffer CharBufElem), Newline))
-> IO ((BufferMode, Buffer CharBufElem), Newline)
forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle FilePath
"hPutStr" Handle
h ((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_)
  let str :: Stream CharBufElem
str = Text -> Stream CharBufElem
stream Text
t
  case (BufferMode, Buffer CharBufElem)
buffer_mode of
     (BufferMode
NoBuffering, Buffer CharBufElem
_)        -> Handle -> Stream CharBufElem -> IO ()
hPutChars Handle
h Stream CharBufElem
str
     (BufferMode
LineBuffering, Buffer CharBufElem
buf)    -> Handle
-> Newline -> Buffer CharBufElem -> Stream CharBufElem -> IO ()
writeLines Handle
h Newline
nl Buffer CharBufElem
buf Stream CharBufElem
str
     (BlockBuffering Maybe Int
_, Buffer CharBufElem
buf)
         | Newline
nl Newline -> Newline -> Bool
forall a. Eq a => a -> a -> Bool
== Newline
CRLF        -> Handle -> Buffer CharBufElem -> Stream CharBufElem -> IO ()
writeBlocksCRLF Handle
h Buffer CharBufElem
buf Stream CharBufElem
str
         | Bool
otherwise         -> Handle -> Buffer CharBufElem -> Stream CharBufElem -> IO ()
writeBlocksRaw Handle
h Buffer CharBufElem
buf Stream CharBufElem
str

hPutChars :: Handle -> Stream Char -> IO ()
hPutChars :: Handle -> Stream CharBufElem -> IO ()
hPutChars Handle
h (Stream s -> Step s CharBufElem
next0 s
s0 Size
_len) = s -> IO ()
loop s
s0
  where
    loop :: s -> IO ()
loop !s
s = case s -> Step s CharBufElem
next0 s
s of
                Step s CharBufElem
Done       -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Skip s
s'    -> s -> IO ()
loop s
s'
                Yield CharBufElem
x s
s' -> Handle -> CharBufElem -> IO ()
hPutChar Handle
h CharBufElem
x IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> s -> IO ()
loop s
s'

-- The following functions are largely lifted from GHC.IO.Handle.Text,
-- but adapted to a coinductive stream of data instead of an inductive
-- list.
--
-- We have several variations of more or less the same code for
-- performance reasons.  Splitting the original buffered write
-- function into line- and block-oriented versions gave us a 2.1x
-- performance improvement.  Lifting out the raw/cooked newline
-- handling gave a few more percent on top.

writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
writeLines :: Handle
-> Newline -> Buffer CharBufElem -> Stream CharBufElem -> IO ()
writeLines Handle
h Newline
nl Buffer CharBufElem
buf0 (Stream s -> Step s CharBufElem
next0 s
s0 Size
_len) = s -> Buffer CharBufElem -> IO ()
outer s
s0 Buffer CharBufElem
buf0
 where
  outer :: s -> Buffer CharBufElem -> IO ()
outer s
s1 Buffer{bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer CharBufElem
raw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
len} = s -> Int -> IO ()
inner s
s1 (Int
0::Int)
   where
    inner :: s -> Int -> IO ()
inner !s
s !Int
n =
      case s -> Step s CharBufElem
next0 s
s of
        Step s CharBufElem
Done -> Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit Int
n Bool
False{-no flush-} Bool
True{-release-} IO (Buffer CharBufElem) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Skip s
s' -> s -> Int -> IO ()
inner s
s' Int
n
        Yield CharBufElem
x s
s'
          | 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 -> Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit Int
n Bool
True{-needs flush-} Bool
False IO (Buffer CharBufElem) -> (Buffer CharBufElem -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Buffer CharBufElem -> IO ()
outer s
s
          | CharBufElem
x 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 <- RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n CharBufElem
'\r'
                                 RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n1 CharBufElem
'\n'
                         else RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n CharBufElem
x
                   Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit Int
n' Bool
True{-needs flush-} Bool
False IO (Buffer CharBufElem) -> (Buffer CharBufElem -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Buffer CharBufElem -> IO ()
outer s
s'
          | Bool
otherwise    -> RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n CharBufElem
x IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Int -> IO ()
inner s
s'
    commit :: Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit = Handle
-> RawBuffer CharBufElem
-> Int
-> Int
-> Bool
-> Bool
-> IO (Buffer CharBufElem)
commitBuffer Handle
h RawBuffer CharBufElem
raw Int
len

writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream CharBufElem -> IO ()
writeBlocksCRLF Handle
h Buffer CharBufElem
buf0 (Stream s -> Step s CharBufElem
next0 s
s0 Size
_len) = s -> Buffer CharBufElem -> IO ()
outer s
s0 Buffer CharBufElem
buf0
 where
  outer :: s -> Buffer CharBufElem -> IO ()
outer s
s1 Buffer{bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer CharBufElem
raw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
len} = s -> Int -> IO ()
inner s
s1 (Int
0::Int)
   where
    inner :: s -> Int -> IO ()
inner !s
s !Int
n =
      case s -> Step s CharBufElem
next0 s
s of
        Step s CharBufElem
Done -> Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit Int
n Bool
False{-no flush-} Bool
True{-release-} IO (Buffer CharBufElem) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Skip s
s' -> s -> Int -> IO ()
inner s
s' Int
n
        Yield CharBufElem
x s
s'
          | 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 -> Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit Int
n Bool
True{-needs flush-} Bool
False IO (Buffer CharBufElem) -> (Buffer CharBufElem -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Buffer CharBufElem -> IO ()
outer s
s
          | CharBufElem
x CharBufElem -> CharBufElem -> Bool
forall a. Eq a => a -> a -> Bool
== CharBufElem
'\n'    -> do Int
n1 <- RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n CharBufElem
'\r'
                               RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n1 CharBufElem
'\n' IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Int -> IO ()
inner s
s'
          | Bool
otherwise    -> RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n CharBufElem
x IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Int -> IO ()
inner s
s'
    commit :: Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit = Handle
-> RawBuffer CharBufElem
-> Int
-> Int
-> Bool
-> Bool
-> IO (Buffer CharBufElem)
commitBuffer Handle
h RawBuffer CharBufElem
raw Int
len

writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream CharBufElem -> IO ()
writeBlocksRaw Handle
h Buffer CharBufElem
buf0 (Stream s -> Step s CharBufElem
next0 s
s0 Size
_len) = s -> Buffer CharBufElem -> IO ()
outer s
s0 Buffer CharBufElem
buf0
 where
  outer :: s -> Buffer CharBufElem -> IO ()
outer s
s1 Buffer{bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer CharBufElem
raw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
len} = s -> Int -> IO ()
inner s
s1 (Int
0::Int)
   where
    inner :: s -> Int -> IO ()
inner !s
s !Int
n =
      case s -> Step s CharBufElem
next0 s
s of
        Step s CharBufElem
Done -> Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit Int
n Bool
False{-no flush-} Bool
True{-release-} IO (Buffer CharBufElem) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Skip s
s' -> s -> Int -> IO ()
inner s
s' Int
n
        Yield CharBufElem
x s
s'
          | 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 -> Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit Int
n Bool
True{-needs flush-} Bool
False IO (Buffer CharBufElem) -> (Buffer CharBufElem -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Buffer CharBufElem -> IO ()
outer s
s
          | Bool
otherwise    -> RawBuffer CharBufElem -> Int -> CharBufElem -> IO Int
writeCharBuf RawBuffer CharBufElem
raw Int
n CharBufElem
x IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Int -> IO ()
inner s
s'
    commit :: Int -> Bool -> Bool -> IO (Buffer CharBufElem)
commit = Handle
-> RawBuffer CharBufElem
-> Int
-> Int
-> Bool
-> Bool
-> IO (Buffer CharBufElem)
commitBuffer Handle
h RawBuffer CharBufElem
raw Int
len

-- This function is completely lifted from GHC.IO.Handle.Text.
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, FilePath -> Buffer CharBufElem
forall a. HasCallStack => FilePath -> a
error FilePath
"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 RawBuffer CharBufElem
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, RawBuffer CharBufElem -> Int -> BufferState -> Buffer CharBufElem
forall e. RawBuffer e -> Int -> BufferState -> Buffer e
emptyBuffer RawBuffer CharBufElem
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)


-- This function is completely lifted from GHC.IO.Handle.Text.
commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
             -> IO CharBuffer
commitBuffer :: Handle
-> RawBuffer CharBufElem
-> Int
-> Int
-> Bool
-> Bool
-> IO (Buffer CharBufElem)
commitBuffer Handle
hdl !RawBuffer CharBufElem
raw !Int
sz !Int
count Bool
flush Bool
release =
  FilePath
-> Handle
-> (Handle__ -> IO (Buffer CharBufElem))
-> IO (Buffer CharBufElem)
forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle FilePath
"commitAndReleaseBuffer" Handle
hdl ((Handle__ -> IO (Buffer CharBufElem)) -> IO (Buffer CharBufElem))
-> (Handle__ -> IO (Buffer CharBufElem)) -> IO (Buffer CharBufElem)
forall a b. (a -> b) -> a -> b
$
     RawBuffer CharBufElem
-> Int
-> Int
-> Bool
-> Bool
-> Handle__
-> IO (Buffer CharBufElem)
commitBuffer' RawBuffer CharBufElem
raw Int
sz Int
count Bool
flush Bool
release
{-# INLINE commitBuffer #-}

-- | Write a string to a handle, followed by a newline.
hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn Handle
h Text
t = Handle -> Text -> IO ()
hPutStr Handle
h Text
t IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> CharBufElem -> IO ()
hPutChar Handle
h CharBufElem
'\n'

-- | The 'interact' function takes a function of type @Text -> Text@
-- as its argument. The entire input from the standard input device is
-- passed to this function as its argument, and the resulting string
-- is output on the standard output device.
interact :: (Text -> Text) -> IO ()
interact :: (Text -> Text) -> IO ()
interact Text -> Text
f = Text -> IO ()
putStr (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text
getContents

-- | Read all user input on 'stdin' as a single string.
getContents :: IO Text
getContents :: IO Text
getContents = Handle -> IO Text
hGetContents Handle
stdin

-- | Read a single line of user input from 'stdin'.
getLine :: IO Text
getLine :: IO Text
getLine = Handle -> IO Text
hGetLine Handle
stdin

-- | Write a string to 'stdout'.
putStr :: Text -> IO ()
putStr :: Text -> IO ()
putStr = Handle -> Text -> IO ()
hPutStr Handle
stdout

-- | Write a string to 'stdout', followed by a newline.
putStrLn :: Text -> IO ()
putStrLn :: Text -> IO ()
putStrLn = Handle -> Text -> IO ()
hPutStrLn Handle
stdout