{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Text.Lazy.IO
(
readFile
, writeFile
, appendFile
, hGetContents
, hGetLine
, hPutStr
, hPutStrLn
, interact
, getContents
, getLine
, putStr
, putStrLn
) where
import Data.Text.Lazy (Text)
import Prelude hiding (appendFile, getContents, getLine, interact,
putStr, putStrLn, readFile, writeFile)
import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
withFile)
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as L
import qualified Control.Exception as E
import Control.Monad (when)
import Data.IORef (readIORef)
import Data.Text.Internal.IO (hGetLineWith, readChunk)
import Data.Text.Internal.Lazy (chunk, empty)
import GHC.IO.Buffer (isEmptyBuffer)
import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
import GHC.IO.Handle.Internals (augmentIOError, hClose_help,
wantReadableHandle, withHandle)
import GHC.IO.Handle.Types (Handle__(..), HandleType(..))
import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)
import System.IO.Error (isEOFError)
import System.IO.Unsafe (unsafeInterleaveIO)
readFile :: FilePath -> IO Text
readFile :: FilePath -> IO Text
readFile name :: 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
writeFile :: FilePath -> Text -> IO ()
writeFile :: FilePath -> Text -> IO ()
writeFile p :: 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 p :: 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
hGetContents :: Handle -> IO Text
hGetContents :: Handle -> IO Text
hGetContents h :: 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 "hGetContents" Handle
h ((Handle__ -> IO (Handle__, Text)) -> IO Text)
-> (Handle__ -> IO (Handle__, Text)) -> IO Text
forall a b. (a -> b) -> a -> b
$ \hh :: Handle__
hh -> do
Text
ts <- Handle -> IO Text
lazyRead Handle
h
(Handle__, Text) -> IO (Handle__, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
hh{haType :: HandleType
haType=HandleType
SemiClosedHandle}, Text
ts)
chooseGoodBuffering :: Handle -> IO ()
chooseGoodBuffering :: Handle -> IO ()
chooseGoodBuffering h :: Handle
h = do
BufferMode
bufMode <- Handle -> IO BufferMode
hGetBuffering Handle
h
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BufferMode
bufMode BufferMode -> BufferMode -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int -> BufferMode
BlockBuffering Maybe Int
forall a. Maybe a
Nothing) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h (Maybe Int -> BufferMode
BlockBuffering (Int -> Maybe Int
forall a. a -> Maybe a
Just 16384))
lazyRead :: Handle -> IO Text
lazyRead :: Handle -> IO Text
lazyRead h :: Handle
h = IO Text -> IO Text
forall a. IO a -> IO a
unsafeInterleaveIO (IO Text -> IO Text) -> IO Text -> IO Text
forall a b. (a -> b) -> a -> b
$
FilePath -> Handle -> (Handle__ -> IO (Handle__, Text)) -> IO Text
forall a.
FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle "hGetContents" Handle
h ((Handle__ -> IO (Handle__, Text)) -> IO Text)
-> (Handle__ -> IO (Handle__, Text)) -> IO Text
forall a b. (a -> b) -> a -> b
$ \hh :: Handle__
hh -> do
case Handle__ -> HandleType
haType Handle__
hh of
ClosedHandle -> (Handle__, Text) -> IO (Handle__, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
hh, Text
L.empty)
SemiClosedHandle -> Handle -> Handle__ -> IO (Handle__, Text)
lazyReadBuffered Handle
h Handle__
hh
_ -> IOException -> IO (Handle__, Text)
forall a. IOException -> IO a
ioException
(Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h) IOErrorType
IllegalOperation "hGetContents"
"illegal handle type" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, Text)
lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, Text)
lazyReadBuffered h :: Handle
h hh :: Handle__
hh@Handle__{..} = do
Buffer CharBufElem
buf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
(do Text
t <- Handle__ -> Buffer CharBufElem -> IO Text
readChunk Handle__
hh Buffer CharBufElem
buf
Text
ts <- Handle -> IO Text
lazyRead Handle
h
(Handle__, Text) -> IO (Handle__, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
hh, Text -> Text -> Text
chunk Text
t Text
ts)) IO (Handle__, Text)
-> (IOException -> IO (Handle__, Text)) -> IO (Handle__, Text)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \e :: IOException
e -> do
(hh' :: Handle__
hh', _) <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
hh
if IOException -> Bool
isEOFError IOException
e
then (Handle__, Text) -> IO (Handle__, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Handle__, Text) -> IO (Handle__, Text))
-> (Handle__, Text) -> IO (Handle__, Text)
forall a b. (a -> b) -> a -> b
$ if Buffer CharBufElem -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
buf
then (Handle__
hh', Text
empty)
else (Handle__
hh', CharBufElem -> Text
L.singleton '\r')
else IOException -> IO (Handle__, Text)
forall e a. Exception e => e -> IO a
E.throwIO (IOException -> FilePath -> Handle -> IOException
augmentIOError IOException
e "hGetContents" Handle
h)
hGetLine :: Handle -> IO Text
hGetLine :: Handle -> IO Text
hGetLine = ([Text] -> Text) -> Handle -> IO Text
forall t. ([Text] -> t) -> Handle -> IO t
hGetLineWith [Text] -> Text
L.fromChunks
hPutStr :: Handle -> Text -> IO ()
hPutStr :: Handle -> Text -> IO ()
hPutStr h :: Handle
h = (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Text -> IO ()
T.hPutStr Handle
h) ([Text] -> IO ()) -> (Text -> [Text]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
L.toChunks
hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn :: Handle -> Text -> IO ()
hPutStrLn h :: Handle
h t :: 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 '\n'
interact :: (Text -> Text) -> IO ()
interact :: (Text -> Text) -> IO ()
interact f :: 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