{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
module Data.Text.IO
(
readFile
, writeFile
, appendFile
, hGetContents
, hGetChunk
, hGetLine
, hPutStr
, hPutStrLn
, 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(..), openFile, stdin, stdout,
withFile)
import qualified Control.Exception as E
import Control.Monad (liftM2, when)
import Data.IORef (readIORef)
import qualified Data.Text as T
import Data.Text.Internal.IO (hGetLineWith, readChunk, hPutStr, hPutStrLn)
import GHC.IO.Buffer (CharBuffer, isEmptyBuffer)
import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))
import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle)
import GHC.IO.Handle.Types (BufferMode(..), Handle__(..), HandleType(..))
import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
import System.IO.Error (isEOFError)
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO Text
hGetContents
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
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__ -> IOException -> IO (Text, Bool)
catchError FilePath
caller 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
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
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__)
..} IOException
err
| IOException -> Bool
isEOFError IOException
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 a. a -> IO a
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 = IOException -> IO (Text, Bool)
forall e a. Exception e => e -> IO a
E.throwIO (IOException -> FilePath -> Handle -> IOException
augmentIOError IOException
err FilePath
caller Handle
h)
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
t, Bool
False)
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 (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
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__)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: 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)
-> (IOException -> IO (Text, Bool)) -> IO (Text, Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` FilePath -> Handle -> Handle__ -> IOException -> IO (Text, Bool)
catchError FilePath
"hGetChunk" Handle
h Handle__
hh
(Handle__, Text) -> IO (Handle__, Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
hh, Text
t)
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 (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
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__)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: 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)
-> (IOException -> IO (Text, Bool)) -> IO (Text, Bool)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` FilePath -> Handle -> Handle__ -> IOException -> IO (Text, Bool)
catchError FilePath
"hGetContents" Handle
h Handle__
hh
if Bool
eof
then [Text] -> IO [Text]
forall a. a -> IO a
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 a b. (a -> b) -> IO a -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
hh'{haType=ClosedHandle}, [Text] -> Text
T.concat [Text]
ts)
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 -> (IOException -> 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)) ((IOException -> IO Integer) -> IO Integer)
-> (IOException -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \(IOException
e::IOException) ->
if IOException -> IOErrorType
ioe_type IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
InappropriateType
then Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
16384
else IOException -> IO Integer
forall e a. Exception e => e -> IO a
E.throwIO IOException
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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
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
getContents :: IO Text
getContents :: IO Text
getContents = Handle -> IO Text
hGetContents Handle
stdin
getLine :: IO Text
getLine :: IO Text
getLine = Handle -> IO Text
hGetLine Handle
stdin
putStr :: Text -> IO ()
putStr :: Text -> IO ()
putStr = Handle -> Text -> IO ()
hPutStr Handle
stdout
putStrLn :: Text -> IO ()
putStrLn :: Text -> IO ()
putStrLn = Handle -> Text -> IO ()
hPutStrLn Handle
stdout