Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP           , NoImplicitPrelude           , RecordWildCards           , BangPatterns           , NondecreasingIndentation           , MagicHash  #-}{-# OPTIONS_GHC -Wno-name-shadowing #-}{-# OPTIONS_GHC -Wno-unused-matches #-}{-# OPTIONS_HADDOCK hide #-}------------------------------------------------------------------------------- |-- Module      :  GHC.IO.Text-- Copyright   :  (c) The University of Glasgow, 1992-2008-- License     :  see libraries/base/LICENSE---- Maintainer  :  libraries@haskell.org-- Stability   :  internal-- Portability :  non-portable---- String I\/O functions-------------------------------------------------------------------------------moduleGHC.IO.Handle.Text(hWaitForInput,hGetChar,hGetLine,hGetContents,hPutChar,hPutStr,commitBuffer',-- hack, see belowhGetBuf,hGetBufSome,hGetBufNonBlocking,hPutBuf,hPutBufNonBlocking,memcpy,hPutStrLn,)whereimportGHC.IOimportGHC.IO.FDimportGHC.IO.BufferimportqualifiedGHC.IO.BufferedIOasBufferedimportGHC.IO.ExceptionimportGHC.ExceptionimportGHC.IO.Handle.TypesimportGHC.IO.Handle.InternalsimportqualifiedGHC.IO.DeviceasIODeviceimportqualifiedGHC.IO.DeviceasRawIOimportForeignimportForeign.CimportqualifiedControl.ExceptionasExceptionimportData.TypeableimportSystem.IO.ErrorimportData.MaybeimportGHC.IORefimportGHC.BaseimportGHC.RealimportGHC.NumimportGHC.ShowimportGHC.List-- ----------------------------------------------------------------------------- Simple input operations-- If hWaitForInput finds anything in the Handle's buffer, it-- immediately returns.  If not, it tries to read from the underlying-- OS handle. Notice that for buffered Handles connected to terminals-- this means waiting until a complete line is available.-- | Computation 'hWaitForInput' @hdl t@-- waits until input is available on handle @hdl@.-- It returns 'True' as soon as input is available on @hdl@,-- or 'False' if no input is available within @t@ milliseconds.  Note that-- 'hWaitForInput' waits until one or more full /characters/ are available,-- which means that it needs to do decoding, and hence may fail-- with a decoding error.---- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.---- This operation may fail with:----  * 'isEOFError' if the end of file has been reached.----  * a decoding error, if the input begins with an invalid byte sequence--    in this Handle's encoding.---- NOTE for GHC users: unless you use the @-threaded@ flag,-- @hWaitForInput hdl t@ where @t >= 0@ will block all other Haskell-- threads for the duration of the call.  It behaves like a-- @safe@ foreign call in this respect.--hWaitForInput::Handle->Int->IOBoolhWaitForInputhmsecs=dowantReadableHandle_"hWaitForInput"h$\handle_@Handle__{..}->docbuf<-readIORefhaCharBufferifnot(isEmptyBuffercbuf)thenreturnTrueelsedoifmsecs<0thendocbuf'<-readTextDevicehandle_cbufwriteIORefhaCharBuffercbuf'returnTrueelsedo-- there might be bytes in the byte buffer waiting to be decodedcbuf'<-decodeByteBufhandle_cbufwriteIORefhaCharBuffercbuf'ifnot(isEmptyBuffercbuf')thenreturnTrueelsedor<-IODevice.readyhaDeviceFalse{-read-}msecsifrthendo-- Call hLookAhead' to throw an EOF-- exception if appropriate_<-hLookAhead_handle_returnTrueelsereturnFalse-- XXX we should only return when there are full characters-- not when there are only bytes.  That would mean looping-- and re-running IODevice.ready if we don't have any full-- characters; but we don't know how long we've waited-- so far.-- ----------------------------------------------------------------------------- hGetChar-- | Computation 'hGetChar' @hdl@ reads a character from the file or-- channel managed by @hdl@, blocking until a character is available.---- This operation may fail with:----  * 'isEOFError' if the end of file has been reached.hGetChar::Handle->IOCharhGetCharhandle=wantReadableHandle_"hGetChar"handle$\handle_@Handle__{..}->do-- buffering mode makes no difference: we just read whatever is available-- from the device (blocking only if there is nothing available), and then-- return the first character.-- See [note Buffered Reading] in GHC.IO.Handle.Typesbuf0<-readIORefhaCharBufferbuf1<-ifisEmptyBufferbuf0thenreadTextDevicehandle_buf0elsereturnbuf0(c1,i)<-readCharBuf(bufRawbuf1)(bufLbuf1)letbuf2=bufferAdjustLibuf1ifhaInputNL==CRLF&&c1=='\r'thendombuf3<-ifisEmptyBufferbuf2thenmaybeFillReadBufferhandle_buf2elsereturn(Justbuf2)casembuf3of-- EOF, so just return the '\r' we haveNothing->dowriteIORefhaCharBufferbuf2return'\r'Justbuf3->do(c2,i2)<-readCharBuf(bufRawbuf2)(bufLbuf2)ifc2=='\n'thendowriteIORefhaCharBuffer(bufferAdjustLi2buf3)return'\n'elsedo-- not a \r\n sequence, so just return the \rwriteIORefhaCharBufferbuf3return'\r'elsedowriteIORefhaCharBufferbuf2returnc1-- ----------------------------------------------------------------------------- hGetLine-- | Computation 'hGetLine' @hdl@ reads a line from the file or-- channel managed by @hdl@.---- This operation may fail with:----  * 'isEOFError' if the end of file is encountered when reading--    the /first/ character of the line.---- If 'hGetLine' encounters end-of-file at any other point while reading-- in a line, it is treated as a line terminator and the (partial)-- line is returned.hGetLine::Handle->IOStringhGetLineh=wantReadableHandle_"hGetLine"h$\handle_->dohGetLineBufferedhandle_hGetLineBuffered::Handle__->IOStringhGetLineBufferedhandle_@Handle__{..}=dobuf<-readIORefhaCharBufferhGetLineBufferedLoophandle_buf[]hGetLineBufferedLoop::Handle__->CharBuffer->[String]->IOStringhGetLineBufferedLoophandle_@Handle__{..}buf@Buffer{bufL=r0,bufR=w,bufRaw=raw0}xss=let-- find the end-of-line character, if there is onelooprawr|r==w=return(False,w)|otherwise=do(c,r')<-readCharBufrawrifc=='\n'thenreturn(True,r)-- NB. not r': don't include the '\n'elselooprawr'indo(eol,off)<-loopraw0r0debugIO("hGetLineBufferedLoop: r="++showr0++", w="++showw++", off="++showoff)(xs,r')<-ifhaInputNL==CRLFthenunpack_nlraw0r0off""elsedoxs<-unpackraw0r0off""return(xs,off)-- if eol == True, then off is the offset of the '\n'-- otherwise off == w and the buffer is now empty.ifeol-- r' == offthendowriteIORefhaCharBuffer(bufferAdjustL(off+1)buf)return(concat(reverse(xs:xss)))elsedoletbuf1=bufferAdjustLr'bufmaybe_buf<-maybeFillReadBufferhandle_buf1casemaybe_bufof-- Nothing indicates we caught an EOF, and we may have a-- partial line to return.Nothing->do-- we reached EOF.  There might be a lone \r left-- in the buffer, so check for that and-- append it to the line if necessary.--letpre=ifnot(isEmptyBufferbuf1)then"\r"else""writeIORefhaCharBufferbuf1{bufL=0,bufR=0}letstr=concat(reverse(pre:xs:xss))ifnot(nullstr)thenreturnstrelseioe_EOFJustnew_buf->hGetLineBufferedLoophandle_new_buf(xs:xss)maybeFillReadBuffer::Handle__->CharBuffer->IO(MaybeCharBuffer)maybeFillReadBufferhandle_buf=catchException(dobuf'<-getSomeCharactershandle_bufreturn(Justbuf'))(\e->doifisEOFErrorethenreturnNothingelseioErrore)-- See GHC.IO.Buffer#define CHARBUF_UTF32-- #define CHARBUF_UTF16-- NB. performance-critical code: eyeball the Core.unpack::RawCharBuffer->Int->Int->[Char]->IO[Char]unpack!buf!r!wacc0|r==w=returnacc0|otherwise=withRawBufferbuf$\pbuf->letunpackRBacc!i|i<r=returnacc|otherwise=do-- Here, we are rather careful to only put an *evaluated* character-- in the output string. Due to pointer tagging, this allows the consumer-- to avoid ping-ponging between the actual consumer code and the thunk code#if defined(CHARBUF_UTF16)-- reverse-order decoding of UTF-16c2<-peekElemOffpbufiif(c2<0xdc00||c2>0xdffff)thenunpackRB(unsafeChr(fromIntegralc2):acc)(i-1)elsedoc1<-peekElemOffpbuf(i-1)letc=(fromIntegralc1-0xd800)*0x400+(fromIntegralc2-0xdc00)+0x10000casedesurrogatifyRoundtripCharacter(unsafeChrc)of{C#c#->unpackRB(C#c#:acc)(i-2)}#elsec<-peekElemOffpbufiunpackRB(c:acc)(i-1)#endifinunpackRBacc0(w-1)-- NB. performance-critical code: eyeball the Core.unpack_nl::RawCharBuffer->Int->Int->[Char]->IO([Char],Int)unpack_nl!buf!r!wacc0|r==w=return(acc0,0)|otherwise=withRawBufferbuf$\pbuf->letunpackRBacc!i|i<r=returnacc|otherwise=doc<-peekElemOffpbufiif(c=='\n'&&i>r)thendoc1<-peekElemOffpbuf(i-1)if(c1=='\r')thenunpackRB('\n':acc)(i-2)elseunpackRB('\n':acc)(i-1)elsedounpackRB(c:acc)(i-1)indoc<-peekElemOffpbuf(w-1)if(c=='\r')thendo-- If the last char is a '\r', we need to know whether or-- not it is followed by a '\n', so leave it in the buffer-- for now and just unpack the rest.str<-unpackRBacc0(w-2)return(str,w-1)elsedostr<-unpackRBacc0(w-1)return(str,w)-- Note [#5536]---- We originally had----    let c' = desurrogatifyRoundtripCharacter c in--    c' `seq` unpackRB (c':acc) (i-1)---- but this resulted in Core like----    case (case x <# y of True -> C# e1; False -> C# e2) of c--      C# _ -> unpackRB (c:acc) (i-1)---- which compiles into a continuation for the outer case, with each-- branch of the inner case building a C# and then jumping to the-- continuation.  We'd rather not have this extra jump, which makes-- quite a difference to performance (see #5536) It turns out that-- matching on the C# directly causes GHC to do the case-of-case,-- giving much straighter code.-- ------------------------------------------------------------------------------- hGetContents-- hGetContents on a DuplexHandle only affects the read side: you can-- carry on writing to it afterwards.-- | Computation 'hGetContents' @hdl@ returns the list of characters-- corresponding to the unread portion of the channel or file managed-- by @hdl@, which is put into an intermediate state, /semi-closed/.-- In this state, @hdl@ is effectively closed,-- but items are read from @hdl@ on demand and accumulated in a special-- list returned by 'hGetContents' @hdl@.---- Any operation that fails because a handle is closed,-- also fails if a handle is semi-closed.  The only exception is 'hClose'.-- A semi-closed handle becomes closed:----  * if 'hClose' is applied to it;----  * if an I\/O error occurs when reading an item from the handle;----  * or once the entire contents of the handle has been read.---- Once a semi-closed handle becomes closed, the contents of the-- associated list becomes fixed.  The contents of this final list is-- only partially specified: it will contain at least all the items of-- the stream that were evaluated prior to the handle becoming closed.---- Any I\/O errors encountered while a handle is semi-closed are simply-- discarded.---- This operation may fail with:----  * 'isEOFError' if the end of file has been reached.hGetContents::Handle->IOStringhGetContentshandle=wantReadableHandle"hGetContents"handle$\handle_->doxs<-lazyReadhandlereturn(handle_{haType=SemiClosedHandle},xs)-- Note that someone may close the semi-closed handle (or change its-- buffering), so each time these lazy read functions are pulled on,-- they have to check whether the handle has indeed been closed.lazyRead::Handle->IOStringlazyReadhandle=unsafeInterleaveIO$withHandle"hGetContents"handle$\handle_->docasehaTypehandle_ofSemiClosedHandle->lazyReadBufferedhandlehandle_ClosedHandle->ioException(IOError(Justhandle)IllegalOperation"hGetContents""delayed read on closed handle"NothingNothing)_->ioException(IOError(Justhandle)IllegalOperation"hGetContents""illegal handle type"NothingNothing)lazyReadBuffered::Handle->Handle__->IO(Handle__,[Char])lazyReadBufferedhhandle_@Handle__{..}=dobuf<-readIORefhaCharBufferException.catch(dobuf'@Buffer{..}<-getSomeCharactershandle_buflazy_rest<-lazyReadh(s,r)<-ifhaInputNL==CRLFthenunpack_nlbufRawbufLbufRlazy_restelsedos<-unpackbufRawbufLbufRlazy_restreturn(s,bufR)writeIORefhaCharBuffer(bufferAdjustLrbuf')return(handle_,s))(\e->do(handle_',_)<-hClose_helphandle_debugIO("hGetContents caught: "++showe)-- We might have a \r cached in CRLF mode.  So we-- need to check for that and return it:letr=ifisEOFErrorethenifnot(isEmptyBufferbuf)then"\r"else""elsethrow(augmentIOErrore"hGetContents"h)return(handle_',r))-- ensure we have some characters in the buffergetSomeCharacters::Handle__->CharBuffer->IOCharBuffergetSomeCharactershandle_@Handle__{..}buf@Buffer{..}=casebufferElemsbufof-- buffer empty: read some more0->readTextDevicehandle_buf-- if the buffer has a single '\r' in it and we're doing newline-- translation: read some more1|haInputNL==CRLF->do(c,_)<-readCharBufbufRawbufLifc=='\r'thendo-- shuffle the '\r' to the beginning.  This is only safe-- if we're about to call readTextDevice, otherwise it-- would mess up flushCharBuffer.-- See [note Buffer Flushing], GHC.IO.Handle.Types_<-writeCharBufbufRaw0'\r'letbuf'=buf{bufL=0,bufR=1}readTextDevicehandle_buf'elsedoreturnbuf-- buffer has some chars in it already: just return it_otherwise->returnbuf-- ----------------------------------------------------------------------------- hPutChar-- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the-- file or channel managed by @hdl@.  Characters may be buffered if-- buffering is enabled for @hdl@.---- This operation may fail with:----  * 'isFullError' if the device is full; or----  * 'isPermissionError' if another system resource limit would be exceeded.hPutChar::Handle->Char->IO()hPutCharhandlec=doc`seq`return()wantWritableHandle"hPutChar"handle$\handle_->dohPutcBufferedhandle_chPutcBuffered::Handle__->Char->IO()hPutcBufferedhandle_@Handle__{..}c=dobuf<-readIORefhaCharBufferifc=='\n'thendobuf1<-ifhaOutputNL==CRLFthendobuf1<-putcbuf'\r'putcbuf1'\n'elsedoputcbuf'\n'writeCharBufferhandle_buf1whenis_line$flushByteWriteBufferhandle_elsedobuf1<-putcbufcwriteCharBufferhandle_buf1return()whereis_line=casehaBufferModeofLineBuffering->True_->Falseputcbuf@Buffer{bufRaw=raw,bufR=w}c=dodebugIO("putc: "++summaryBufferbuf)w'<-writeCharBufrawwcreturnbuf{bufR=w'}-- ----------------------------------------------------------------------------- hPutStr-- We go to some trouble to avoid keeping the handle locked while we're-- evaluating the string argument to hPutStr, in case doing so triggers another-- I/O operation on the same handle which would lead to deadlock.  The classic-- case is----              putStr (trace "hello" "world")---- so the basic scheme is this:----      * copy the string into a fresh buffer,--      * "commit" the buffer to the handle.---- Committing may involve simply copying the contents of the new-- buffer into the handle's buffer, flushing one or both buffers, or-- maybe just swapping the buffers over (if the handle's buffer was-- empty).  See commitBuffer below.-- | Computation 'hPutStr' @hdl s@ writes the string-- @s@ to the file or channel managed by @hdl@.---- This operation may fail with:----  * 'isFullError' if the device is full; or----  * 'isPermissionError' if another system resource limit would be exceeded.hPutStr::Handle->String->IO()hPutStrhandlestr=hPutStr'handlestrFalse-- | The same as 'hPutStr', but adds a newline character.hPutStrLn::Handle->String->IO()hPutStrLnhandlestr=hPutStr'handlestrTrue-- An optimisation: we treat hPutStrLn specially, to avoid the-- overhead of a single putChar '\n', which is quite high now that we-- have to encode eagerly.{-# NOINLINEhPutStr'#-}hPutStr'::Handle->String->Bool->IO()hPutStr'handlestradd_nl=do(buffer_mode,nl)<-wantWritableHandle"hPutStr"handle$\h_->dobmode<-getSpareBufferh_return(bmode,haOutputNLh_)casebuffer_modeof(NoBuffering,_)->dohPutCharshandlestr-- v. slow, but we don't carewhenadd_nl$hPutCharhandle'\n'(LineBuffering,buf)->dowriteBlockshandleTrueadd_nlnlbufstr(BlockBuffering_,buf)->dowriteBlockshandleFalseadd_nlnlbufstrhPutChars::Handle->[Char]->IO()hPutChars_[]=return()hPutCharshandle(c:cs)=hPutCharhandlec>>hPutCharshandlecsgetSpareBuffer::Handle__->IO(BufferMode,CharBuffer)getSpareBufferHandle__{haCharBuffer=ref,haBuffers=spare_ref,haBufferMode=mode}=docasemodeofNoBuffering->return(mode,errorWithoutStackTrace"no buffer!")_->dobufs<-readIORefspare_refbuf<-readIORefrefcasebufsofBufferListConsbrest->dowriteIORefspare_refrestreturn(mode,emptyBufferb(bufSizebuf)WriteBuffer)BufferListNil->donew_buf<-newCharBuffer(bufSizebuf)WriteBufferreturn(mode,new_buf)-- NB. performance-critical code: eyeball the Core.writeBlocks::Handle->Bool->Bool->Newline->BufferCharBufElem->String->IO()writeBlockshdlline_bufferedadd_nlnlbuf@Buffer{bufRaw=raw,bufSize=len}s=letshoveString::Int->[Char]->[Char]->IO()shoveString!n[][]=docommitBufferhdlrawlennFalse{-no flush-}True{-release-}shoveString!n[]rest=doshoveStringnrest[]shoveString!n(c:cs)rest-- n+1 so we have enough room to write '\r\n' if necessary|n+1>=len=docommitBufferhdlrawlennFalse{-flush-}FalseshoveString0(c:cs)rest|c=='\n'=don'<-ifnl==CRLFthendon1<-writeCharBufrawn'\r'writeCharBufrawn1'\n'elsedowriteCharBufrawncifline_bufferedthendo-- end of line, so write and flushcommitBufferhdlrawlenn'True{-flush-}FalseshoveString0csrestelsedoshoveStringn'csrest|otherwise=don'<-writeCharBufrawncshoveStringn'csrestinshoveString0s(ifadd_nlthen"\n"else"")-- ------------------------------------------------------------------------------- commitBuffer handle buf sz count flush release---- Write the contents of the buffer 'buf' ('sz' bytes long, containing-- 'count' bytes of data) to handle (handle must be block or line buffered).commitBuffer::Handle-- handle to commit to->RawCharBuffer->Int-- address and size (in bytes) of buffer->Int-- number of bytes of data in buffer->Bool-- True <=> flush the handle afterward->Bool-- release the buffer?->IO()commitBufferhdl!raw!sz!countflushrelease=wantWritableHandle"commitBuffer"hdl$\h_@Handle__{..}->dodebugIO("commitBuffer: sz="++showsz++", count="++showcount++", flush="++showflush++", release="++showrelease)writeCharBufferh_Buffer{bufRaw=raw,bufState=WriteBuffer,bufL=0,bufR=count,bufSize=sz}whenflush$flushByteWriteBufferh_-- release the buffer if necessarywhenrelease$do-- find size of current bufferold_buf@Buffer{bufSize=size}<-readIORefhaCharBufferwhen(sz==size)$dospare_bufs<-readIORefhaBufferswriteIORefhaBuffers(BufferListConsrawspare_bufs)return()-- backwards compatibility; the text package uses thiscommitBuffer'::RawCharBuffer->Int->Int->Bool->Bool->Handle__->IOCharBuffercommitBuffer'rawsz@(I#_)count@(I#_)flushreleaseh_@Handle__{..}=dodebugIO("commitBuffer: sz="++showsz++", count="++showcount++", flush="++showflush++", release="++showrelease)letthis_buf=Buffer{bufRaw=raw,bufState=WriteBuffer,bufL=0,bufR=count,bufSize=sz}writeCharBufferh_this_bufwhenflush$flushByteWriteBufferh_-- release the buffer if necessarywhenrelease$do-- find size of current bufferold_buf@Buffer{bufSize=size}<-readIORefhaCharBufferwhen(sz==size)$dospare_bufs<-readIORefhaBufferswriteIORefhaBuffers(BufferListConsrawspare_bufs)returnthis_buf-- ----------------------------------------------------------------------------- Reading/writing sequences of bytes.-- ----------------------------------------------------------------------------- hPutBuf-- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the-- buffer @buf@ to the handle @hdl@.  It returns ().---- 'hPutBuf' ignores any text encoding that applies to the 'Handle',-- writing the bytes directly to the underlying file or device.---- 'hPutBuf' ignores the prevailing 'TextEncoding' and-- 'NewlineMode' on the 'Handle', and writes bytes directly.---- This operation may fail with:----  * 'ResourceVanished' if the handle is a pipe or socket, and the--    reading end is closed.  (If this is a POSIX system, and the program--    has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered--    instead, whose default action is to terminate the program).hPutBuf::Handle-- handle to write to->Ptra-- address of buffer->Int-- number of bytes of data in buffer->IO()hPutBufhptrcount=do_<-hPutBuf'hptrcountTruereturn()hPutBufNonBlocking::Handle-- handle to write to->Ptra-- address of buffer->Int-- number of bytes of data in buffer->IOInt-- returns: number of bytes writtenhPutBufNonBlockinghptrcount=hPutBuf'hptrcountFalsehPutBuf'::Handle-- handle to write to->Ptra-- address of buffer->Int-- number of bytes of data in buffer->Bool-- allow blocking?->IOInthPutBuf'handleptrcountcan_block|count==0=return0|count<0=illegalBufferSizehandle"hPutBuf"count|otherwise=wantWritableHandle"hPutBuf"handle$\h_@Handle__{..}->dodebugIO("hPutBuf count="++showcount)r<-bufWriteh_(castPtrptr)countcan_block-- we must flush if this Handle is set to NoBuffering.  If-- it is set to LineBuffering, be conservative and flush-- anyway (we didn't check for newlines in the data).casehaBufferModeofBlockBuffering_->doreturn()_line_or_no_buffering->doflushWriteBufferh_returnrbufWrite::Handle__->PtrWord8->Int->Bool->IOIntbufWriteh_@Handle__{..}ptrcountcan_block=seqcount$do-- strictness hackold_buf@Buffer{bufRaw=old_raw,bufR=w,bufSize=size}<-readIORefhaByteBuffer-- TODO: Possible optimisation:--       If we know that `w + count > size`, we should write both the--       handle buffer and the `ptr` in a single `writev()` syscall.-- Need to buffer and enough room in handle buffer?-- There's no need to buffer if the data to be written is larger than-- the handle buffer (`count >= size`).if(count<size&&count<=size-w)-- We need to buffer and there's enough room in the buffer:-- just copy the data in and update bufR.thendodebugIO("hPutBuf: copying to buffer, w="++showw)copyToRawBufferold_rawwptrcountletcopied_buf=old_buf{bufR=w+count}-- If the write filled the buffer completely, we need to flush,-- to maintain the "INVARIANTS on Buffers" from-- GHC.IO.Buffer.checkBuffer: "a write buffer is never full".if(count==size-w)thendodebugIO"hPutBuf: flushing full buffer after writing"flushed_buf<-Buffered.flushWriteBufferhaDevicecopied_buf-- TODO: we should do a non-blocking flush herewriteIORefhaByteBufferflushed_bufelsedowriteIORefhaByteBuffercopied_bufreturncount-- else, we have to flush any existing handle buffer data-- and can then write out the data in `ptr` directly.elsedo-- No point flushing when there's nothing in the buffer.when(w>0)$dodebugIO"hPutBuf: flushing first"flushed_buf<-Buffered.flushWriteBufferhaDeviceold_buf-- TODO: we should do a non-blocking flush herewriteIORefhaByteBufferflushed_buf-- if we can fit in the buffer, then just loopifcount<sizethenbufWriteh_ptrcountcan_blockelseifcan_blockthendowriteChunkh_(castPtrptr)countreturncountelsewriteChunkNonBlockingh_(castPtrptr)countwriteChunk::Handle__->PtrWord8->Int->IO()writeChunkh_@Handle__{..}ptrbytes|Justfd<-casthaDevice=RawIO.write(fd::FD)ptrbytes|otherwise=error"Todo: hPutBuf"writeChunkNonBlocking::Handle__->PtrWord8->Int->IOIntwriteChunkNonBlockingh_@Handle__{..}ptrbytes|Justfd<-casthaDevice=RawIO.writeNonBlocking(fd::FD)ptrbytes|otherwise=error"Todo: hPutBuf"-- ----------------------------------------------------------------------------- hGetBuf-- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@-- into the buffer @buf@ until either EOF is reached or-- @count@ 8-bit bytes have been read.-- It returns the number of bytes actually read.  This may be zero if-- EOF was reached before any data was read (or if @count@ is zero).---- 'hGetBuf' never raises an EOF exception, instead it returns a value-- smaller than @count@.---- If the handle is a pipe or socket, and the writing end-- is closed, 'hGetBuf' will behave as if EOF was reached.---- 'hGetBuf' ignores the prevailing 'TextEncoding' and 'NewlineMode'-- on the 'Handle', and reads bytes directly.hGetBuf::Handle->Ptra->Int->IOInthGetBufhptrcount|count==0=return0|count<0=illegalBufferSizeh"hGetBuf"count|otherwise=wantReadableHandle_"hGetBuf"h$\h_@Handle__{..}->doflushCharReadBufferh_buf@Buffer{bufRaw=raw,bufR=w,bufL=r,bufSize=sz}<-readIORefhaByteBufferifisEmptyBufferbufthenbufReadEmptyh_buf(castPtrptr)0countelsebufReadNonEmptyh_buf(castPtrptr)0count-- small reads go through the buffer, large reads are satisfied by-- taking data first from the buffer and then direct from the file-- descriptor.bufReadNonEmpty::Handle__->BufferWord8->PtrWord8->Int->Int->IOIntbufReadNonEmptyh_@Handle__{..}buf@Buffer{bufRaw=raw,bufR=w,bufL=r,bufSize=sz}ptr!so_far!count=doletavail=w-rif(count<avail)thendocopyFromRawBufferptrrawrcountwriteIORefhaByteBufferbuf{bufL=r+count}return(so_far+count)elsedocopyFromRawBufferptrrawravailletbuf'=buf{bufR=0,bufL=0}writeIORefhaByteBufferbuf'letremaining=count-availso_far'=so_far+availptr'=ptr`plusPtr`availifremaining==0thenreturnso_far'elsebufReadEmptyh_buf'ptr'so_far'remainingbufReadEmpty::Handle__->BufferWord8->PtrWord8->Int->Int->IOIntbufReadEmptyh_@Handle__{..}buf@Buffer{bufRaw=raw,bufR=w,bufL=r,bufSize=sz}ptrso_farcount|count>sz,Justfd<-casthaDevice=loopfd0count|otherwise=do(r,buf')<-Buffered.fillReadBufferhaDevicebufifr==0thenreturnso_farelsedowriteIORefhaByteBufferbuf'bufReadNonEmptyh_buf'ptrso_farcountwhereloop::FD->Int->Int->IOIntloopfdoffbytes|bytes<=0=return(so_far+off)loopfdoffbytes=dor<-RawIO.read(fd::FD)(ptr`plusPtr`off)bytesifr==0thenreturn(so_far+off)elseloopfd(off+r)(bytes-r)-- ----------------------------------------------------------------------------- hGetBufSome-- | 'hGetBufSome' @hdl buf count@ reads data from the handle @hdl@-- into the buffer @buf@.  If there is any data available to read,-- then 'hGetBufSome' returns it immediately; it only blocks if there-- is no data to be read.---- It returns the number of bytes actually read.  This may be zero if-- EOF was reached before any data was read (or if @count@ is zero).---- 'hGetBufSome' never raises an EOF exception, instead it returns a value-- smaller than @count@.---- If the handle is a pipe or socket, and the writing end-- is closed, 'hGetBufSome' will behave as if EOF was reached.---- 'hGetBufSome' ignores the prevailing 'TextEncoding' and 'NewlineMode'-- on the 'Handle', and reads bytes directly.hGetBufSome::Handle->Ptra->Int->IOInthGetBufSomehptrcount|count==0=return0|count<0=illegalBufferSizeh"hGetBufSome"count|otherwise=wantReadableHandle_"hGetBufSome"h$\h_@Handle__{..}->doflushCharReadBufferh_buf@Buffer{bufSize=sz}<-readIORefhaByteBufferifisEmptyBufferbufthencasecount>szof-- large read? optimize it with a little special case:True|Justfd<-haFDh_->doRawIO.readfd(castPtrptr)count_->do(r,buf')<-Buffered.fillReadBufferhaDevicebufifr==0thenreturn0elsedowriteIORefhaByteBufferbuf'bufReadNBNonEmptyh_buf'(castPtrptr)0(minrcount)-- new count is  (min r count), so-- that bufReadNBNonEmpty will not-- issue another read.elseletcount'=mincount(bufferElemsbuf)inbufReadNBNonEmptyh_buf(castPtrptr)0count'haFD::Handle__->MaybeFDhaFDh_@Handle__{..}=casthaDevice-- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@-- into the buffer @buf@ until either EOF is reached, or-- @count@ 8-bit bytes have been read, or there is no more data available-- to read immediately.---- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will-- never block waiting for data to become available, instead it returns-- only whatever data is available.  To wait for data to arrive before-- calling 'hGetBufNonBlocking', use 'hWaitForInput'.---- If the handle is a pipe or socket, and the writing end-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.---- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and-- 'NewlineMode' on the 'Handle', and reads bytes directly.---- NOTE: on Windows, this function does not work correctly; it-- behaves identically to 'hGetBuf'.hGetBufNonBlocking::Handle->Ptra->Int->IOInthGetBufNonBlockinghptrcount|count==0=return0|count<0=illegalBufferSizeh"hGetBufNonBlocking"count|otherwise=wantReadableHandle_"hGetBufNonBlocking"h$\h_@Handle__{..}->doflushCharReadBufferh_buf@Buffer{bufRaw=raw,bufR=w,bufL=r,bufSize=sz}<-readIORefhaByteBufferifisEmptyBufferbufthenbufReadNBEmptyh_buf(castPtrptr)0countelsebufReadNBNonEmptyh_buf(castPtrptr)0countbufReadNBEmpty::Handle__->BufferWord8->PtrWord8->Int->Int->IOIntbufReadNBEmptyh_@Handle__{..}buf@Buffer{bufRaw=raw,bufR=w,bufL=r,bufSize=sz}ptrso_farcount|count>sz,Justfd<-casthaDevice=dom<-RawIO.readNonBlocking(fd::FD)ptrcountcasemofNothing->returnso_farJustn->return(so_far+n)|otherwise=dobuf<-readIORefhaByteBuffer(r,buf')<-Buffered.fillReadBuffer0haDevicebufcaserofNothing->returnso_farJust0->returnso_farJustr->dowriteIORefhaByteBufferbuf'bufReadNBNonEmptyh_buf'ptrso_far(mincountr)-- NOTE: new count is    min count r-- so we will just copy the contents of the-- buffer in the recursive call, and not-- loop again.bufReadNBNonEmpty::Handle__->BufferWord8->PtrWord8->Int->Int->IOIntbufReadNBNonEmptyh_@Handle__{..}buf@Buffer{bufRaw=raw,bufR=w,bufL=r,bufSize=sz}ptrso_farcount=doletavail=w-rif(count<avail)thendocopyFromRawBufferptrrawrcountwriteIORefhaByteBufferbuf{bufL=r+count}return(so_far+count)elsedocopyFromRawBufferptrrawravailletbuf'=buf{bufR=0,bufL=0}writeIORefhaByteBufferbuf'letremaining=count-availso_far'=so_far+availptr'=ptr`plusPtr`availifremaining==0thenreturnso_far'elsebufReadNBEmptyh_buf'ptr'so_far'remaining-- ----------------------------------------------------------------------------- memcpy wrapperscopyToRawBuffer::RawBuffere->Int->Ptre->Int->IO()copyToRawBufferrawoffptrbytes=withRawBufferraw$\praw->do_<-memcpy(praw`plusPtr`off)ptr(fromIntegralbytes)return()copyFromRawBuffer::Ptre->RawBuffere->Int->Int->IO()copyFromRawBufferptrrawoffbytes=withRawBufferraw$\praw->do_<-memcpyptr(praw`plusPtr`off)(fromIntegralbytes)return()foreignimportccallunsafe"memcpy"memcpy::Ptra->Ptra->CSize->IO(Ptr())------------------------------------------------------------------------------- Internal UtilsillegalBufferSize::Handle->String->Int->IOaillegalBufferSizehandlefnsz=ioException(IOError(Justhandle)InvalidArgumentfn("illegal buffer size "++showsPrec9sz[])NothingNothing)