module System.IO.Unsafe.GetContents
(unsafeHGetContents
,lazyRead)
where
import Prelude hiding (catch)
import Control.Exception.Extensible (catch)
import System.IO.Unsafe (unsafeInterleaveIO)
import Data.IORef
import GHC.Base
import GHC.Handle
import GHC.IOBase (Buffer(..), Handle__(..), Handle, RawBuffer, IO(IO), FD
,BufferMode(..), HandleType(..), IOException(..)
,IOErrorType(..), ioException, bufferEmpty)
unsafeHGetContents :: Handle -> IO String
unsafeHGetContents handle =
withHandle "unsafeHGetContents" handle $ \handle_ ->
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
AppendHandle -> ioe_notReadable
WriteHandle -> ioe_notReadable
_ -> do xs <- lazyRead handle
return (handle_{ haType=SemiClosedHandle}, xs )
lazyRead :: Handle -> IO String
lazyRead handle =
unsafeInterleaveIO $
withHandle "lazyRead" handle $ \ handle_ -> do
case haType handle_ of
SemiClosedHandle -> lazyRead' handle handle_
_ -> ioException
(IOError (Just handle) IllegalOperation "lazyRead"
"illegal handle type" Nothing)
lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])
lazyRead' h handle_ = do
let ref = haBuffer handle_
fd = haFD handle_
buf <- readIORef ref
if not (bufferEmpty buf)
then lazyReadHaveBuffer h handle_ fd ref buf
else do
case haBufferMode handle_ of
NoBuffering -> do
let raw = bufBuf buf
r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1
if r == 0
then do (handle_', _) <- hClose_help handle_
return (handle_', "")
else do (c,_) <- readCharFromBuffer raw 0
rest <- lazyRead h
return (handle_, c : rest)
LineBuffering -> lazyReadBuffered h handle_ fd ref buf
BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
lazyReadBuffered :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer
-> IO (Handle__, [Char])
lazyReadBuffered h handle_ fd ref buf =
catch
(do buf' <- fillReadBuffer fd True (haIsStream handle_) buf
lazyReadHaveBuffer h handle_ fd ref buf'
)
(\IOError{ioe_type=EOF} -> do (handle_', _) <- hClose_help handle_
return (handle_', "")
)
lazyReadHaveBuffer :: Handle -> Handle__ -> FD -> IORef Buffer -> Buffer -> IO (Handle__, [Char])
lazyReadHaveBuffer h handle_ _ ref buf = do
more <- lazyRead h
writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
return (handle_, s)
unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
unpackAcc _ _ 0 acc = return acc
unpackAcc buf (I# r) (I# len) acc0 = IO $ \s -> unpackRB acc0 (len -# 1#) s
where
unpackRB acc i s
| i <# r = (# s, acc #)
| otherwise =
case readCharArray# buf i s of
(# s', ch #) -> unpackRB (C# ch : acc) (i -# 1#) s'