Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude           , RecordWildCards           , BangPatterns           , NondecreasingIndentation           , RankNTypes  #-}{-# OPTIONS_GHC -Wno-unused-matches #-}{-# OPTIONS_GHC -Wno-name-shadowing #-}{-# OPTIONS_HADDOCK hide #-}------------------------------------------------------------------------------- |-- Module      :  GHC.IO.Handle.Internals-- Copyright   :  (c) The University of Glasgow, 1994-2001-- License     :  see libraries/base/LICENSE---- Maintainer  :  libraries@haskell.org-- Stability   :  internal-- Portability :  non-portable---- This module defines the basic operations on I\/O \"handles\".  All-- of the operations defined here are independent of the underlying-- device.-------------------------------------------------------------------------------moduleGHC.IO.Handle.Internals(withHandle,withHandle',withHandle_,withHandle__',withHandle_',withAllHandles__,wantWritableHandle,wantReadableHandle,wantReadableHandle_,wantSeekableHandle,mkHandle,mkFileHandle,mkDuplexHandle,openTextEncoding,closeTextCodecs,initBufferState,dEFAULT_CHAR_BUFFER_SIZE,flushBuffer,flushWriteBuffer,flushCharReadBuffer,flushCharBuffer,flushByteReadBuffer,flushByteWriteBuffer,readTextDevice,writeCharBuffer,readTextDeviceNonBlocking,decodeByteBuf,augmentIOError,ioe_closedHandle,ioe_semiclosedHandle,ioe_EOF,ioe_notReadable,ioe_notWritable,ioe_finalizedHandle,ioe_bufsiz,hClose_help,hLookAhead_,HandleFinalizer,handleFinalizer,debugIO,)whereimportGHC.IOimportGHC.IO.IOModeimportGHC.IO.EncodingasEncodingimportGHC.IO.Encoding.Types(CodeBuffer)importGHC.IO.Handle.TypesimportGHC.IO.BufferimportGHC.IO.BufferedIO(BufferedIO)importGHC.IO.ExceptionimportGHC.IO.Device(IODevice,SeekMode(..))importqualifiedGHC.IO.DeviceasIODeviceimportqualifiedGHC.IO.BufferedIOasBufferedimportGHC.Conc.SyncimportGHC.RealimportGHC.BaseimportGHC.ExceptionimportGHC.Num(Num(..))importGHC.ShowimportGHC.IORefimportGHC.MVarimportData.TypeableimportData.MaybeimportForeignimportSystem.Posix.Internalshiding(FD)importForeign.Cc_DEBUG_DUMP::Boolc_DEBUG_DUMP=False-- ----------------------------------------------------------------------------- Creating a new handletypeHandleFinalizer=FilePath->MVarHandle__->IO()newFileHandle::FilePath->MaybeHandleFinalizer->Handle__->IOHandlenewFileHandlefilepathmb_finalizerhc=dom<-newMVarhccasemb_finalizerofJustfinalizer->addMVarFinalizerm(finalizerfilepathm)Nothing->return()return(FileHandlefilepathm)-- ----------------------------------------------------------------------------- Working with Handles{-In the concurrent world, handles are locked during use.  This is doneby wrapping an MVar around the handle which acts as a mutex overoperations on the handle.To avoid races, we use the following bracketing operations.  The ideais to obtain the lock, do some operation and replace the lock again,whether the operation succeeded or failed.  We also want to handle thecase where the thread receives an exception while processing the IOoperation: in these cases we also want to relinquish the lock.There are three versions of @withHandle@: corresponding to the threepossible combinations of:        - the operation may side-effect the handle        - the operation may return a resultIf the operation generates an error or an exception is raised, theoriginal handle is always replaced.-}{-# INLINEwithHandle#-}withHandle::String->Handle->(Handle__->IO(Handle__,a))->IOawithHandlefunh@(FileHandle_m)act=withHandle'funhmactwithHandlefunh@(DuplexHandle_m_)act=withHandle'funhmactwithHandle'::String->Handle->MVarHandle__->(Handle__->IO(Handle__,a))->IOawithHandle'funhmact=mask_$do(h',v)<-do_operationfunhactmcheckHandleInvariantsh'putMVarmh'returnv{-# INLINEwithHandle_#-}withHandle_::String->Handle->(Handle__->IOa)->IOawithHandle_funh@(FileHandle_m)act=withHandle_'funhmactwithHandle_funh@(DuplexHandle_m_)act=withHandle_'funhmactwithHandle_'::String->Handle->MVarHandle__->(Handle__->IOa)->IOawithHandle_'funhmact=withHandle'funhm$\h_->doa<-acth_return(h_,a)withAllHandles__::String->Handle->(Handle__->IOHandle__)->IO()withAllHandles__funh@(FileHandle_m)act=withHandle__'funhmactwithAllHandles__funh@(DuplexHandle_rw)act=dowithHandle__'funhractwithHandle__'funhwactwithHandle__'::String->Handle->MVarHandle__->(Handle__->IOHandle__)->IO()withHandle__'funhmact=mask_$doh'<-do_operationfunhactmcheckHandleInvariantsh'putMVarmh'return()do_operation::String->Handle->(Handle__->IOa)->MVarHandle__->IOado_operationfunhactm=doh_<-takeMVarmcheckHandleInvariantsh_acth_`catchException`handlerh_wherehandlerh_e=doputMVarmh_case()of_|Justioe<-fromExceptione->ioError(augmentIOErrorioefunh)_|Justasync_ex<-fromExceptione->do-- see Note [async]let_=async_ex::SomeAsyncExceptiont<-myThreadIdthrowTotedo_operationfunhactm_otherwise->throwIOe-- Note [async]---- If an asynchronous exception is raised during an I/O operation,-- normally it is fine to just re-throw the exception synchronously.-- However, if we are inside an unsafePerformIO or an-- unsafeInterleaveIO, this would replace the enclosing thunk with the-- exception raised, which is wrong (#3997).  We have to release the-- lock on the Handle, but what do we replace the thunk with?  What-- should happen when the thunk is subsequently demanded again?---- The only sensible choice we have is to re-do the IO operation on-- resumption, but then we have to be careful in the IO library that-- this is always safe to do.  In particular we should----    never perform any side-effects before an interruptible operation---- because the interruptible operation may raise an asynchronous-- exception, which may cause the operation and its side effects to be-- subsequently performed again.---- Re-doing the IO operation is achieved by:--   - using throwTo to re-throw the asynchronous exception asynchronously--     in the current thread--   - on resumption, it will be as if throwTo returns.  In that case, we--     recursively invoke the original operation (see do_operation above).---- Interruptible operations in the I/O library are:--    - threadWaitRead/threadWaitWrite--    - fillReadBuffer/flushWriteBuffer--    - readTextDevice/writeTextDeviceaugmentIOError::IOException->String->Handle->IOExceptionaugmentIOErrorioe@IOError{ioe_filename=fp}funh=ioe{ioe_handle=Justh,ioe_location=fun,ioe_filename=filepath}wherefilepath|Just_<-fp=fp|otherwise=casehofFileHandlepath_->JustpathDuplexHandlepath__->Justpath-- ----------------------------------------------------------------------------- Wrapper for write operations.wantWritableHandle::String->Handle->(Handle__->IOa)->IOawantWritableHandlefunh@(FileHandle_m)act=wantWritableHandle'funhmactwantWritableHandlefunh@(DuplexHandle__m)act=wantWritableHandle'funhmact-- we know it's not a ReadHandle or ReadWriteHandle, but we have to-- check for ClosedHandle/SemiClosedHandle. (#4808)wantWritableHandle'::String->Handle->MVarHandle__->(Handle__->IOa)->IOawantWritableHandle'funhmact=withHandle_'funhm(checkWritableHandleact)checkWritableHandle::(Handle__->IOa)->Handle__->IOacheckWritableHandleacth_@Handle__{..}=casehaTypeofClosedHandle->ioe_closedHandleSemiClosedHandle->ioe_semiclosedHandleReadHandle->ioe_notWritableReadWriteHandle->dobuf<-readIORefhaCharBufferwhen(not(isWriteBufferbuf))$doflushCharReadBufferh_flushByteReadBufferh_buf<-readIORefhaCharBufferwriteIORefhaCharBufferbuf{bufState=WriteBuffer}buf<-readIORefhaByteBufferbuf'<-Buffered.emptyWriteBufferhaDevicebufwriteIORefhaByteBufferbuf'acth__other->acth_-- ----------------------------------------------------------------------------- Wrapper for read operations.wantReadableHandle::String->Handle->(Handle__->IO(Handle__,a))->IOawantReadableHandlefunhact=withHandlefunh(checkReadableHandleact)wantReadableHandle_::String->Handle->(Handle__->IOa)->IOawantReadableHandle_funh@(FileHandle_m)act=wantReadableHandle'funhmactwantReadableHandle_funh@(DuplexHandle_m_)act=wantReadableHandle'funhmact-- we know it's not a WriteHandle or ReadWriteHandle, but we have to-- check for ClosedHandle/SemiClosedHandle. (#4808)wantReadableHandle'::String->Handle->MVarHandle__->(Handle__->IOa)->IOawantReadableHandle'funhmact=withHandle_'funhm(checkReadableHandleact)checkReadableHandle::(Handle__->IOa)->Handle__->IOacheckReadableHandleacth_@Handle__{..}=casehaTypeofClosedHandle->ioe_closedHandleSemiClosedHandle->ioe_semiclosedHandleAppendHandle->ioe_notReadableWriteHandle->ioe_notReadableReadWriteHandle->do-- a read/write handle and we want to read from it.  We must-- flush all buffered write data first.bbuf<-readIORefhaByteBufferwhen(isWriteBufferbbuf)$dowhen(not(isEmptyBufferbbuf))$flushByteWriteBufferh_cbuf'<-readIORefhaCharBufferwriteIORefhaCharBuffercbuf'{bufState=ReadBuffer}bbuf<-readIORefhaByteBufferwriteIORefhaByteBufferbbuf{bufState=ReadBuffer}acth__other->acth_-- ----------------------------------------------------------------------------- Wrapper for seek operations.wantSeekableHandle::String->Handle->(Handle__->IOa)->IOawantSeekableHandlefunh@(DuplexHandle___)_act=ioException(IOError(Justh)IllegalOperationfun"handle is not seekable"NothingNothing)wantSeekableHandlefunh@(FileHandle_m)act=withHandle_'funhm(checkSeekableHandleact)checkSeekableHandle::(Handle__->IOa)->Handle__->IOacheckSeekableHandleacthandle_@Handle__{haDevice=dev}=casehaTypehandle_ofClosedHandle->ioe_closedHandleSemiClosedHandle->ioe_semiclosedHandleAppendHandle->ioe_notSeekable_->dob<-IODevice.isSeekabledevifbthenacthandle_elseioe_notSeekable-- ------------------------------------------------------------------------------- Handy IOErrorsioe_closedHandle,ioe_semiclosedHandle,ioe_EOF,ioe_notReadable,ioe_notWritable,ioe_cannotFlushNotSeekable,ioe_notSeekable::IOaioe_closedHandle=ioException(IOErrorNothingIllegalOperation"""handle is closed"NothingNothing)ioe_semiclosedHandle=ioException(IOErrorNothingIllegalOperation"""handle is semi-closed"NothingNothing)ioe_EOF=ioException(IOErrorNothingEOF""""NothingNothing)ioe_notReadable=ioException(IOErrorNothingIllegalOperation"""handle is not open for reading"NothingNothing)ioe_notWritable=ioException(IOErrorNothingIllegalOperation"""handle is not open for writing"NothingNothing)ioe_notSeekable=ioException(IOErrorNothingIllegalOperation"""handle is not seekable"NothingNothing)ioe_cannotFlushNotSeekable=ioException(IOErrorNothingIllegalOperation"""cannot flush the read buffer: underlying device is not seekable"NothingNothing)ioe_finalizedHandle::FilePath->Handle__ioe_finalizedHandlefp=throw(IOErrorNothingIllegalOperation"""handle is finalized"Nothing(Justfp))ioe_bufsiz::Int->IOaioe_bufsizn=ioException(IOErrorNothingInvalidArgument"hSetBuffering"("illegal buffer size "++showsPrec9n[])NothingNothing)-- 9 => should be parens'ified.-- ----------------------------------------------------------------------------- Wrapper for Handle encoding/decoding.-- The interface for TextEncoding changed so that a TextEncoding doesn't raise-- an exception if it encounters an invalid sequnce. Furthermore, encoding-- returns a reason as to why encoding stopped, letting us know if it was due-- to input/output underflow or an invalid sequence.---- This code adapts this elaborated interface back to the original TextEncoding-- interface.---- FIXME: it is possible that Handle code using the haDecoder/haEncoder fields-- could be made clearer by using the 'encode' interface directly. I have not-- looked into this.streamEncode::BufferCodecfromtostate->Bufferfrom->Bufferto->IO(Bufferfrom,Bufferto)streamEncodecodecfromto=fmap(\(_,from',to')->(from',to'))$recoveringEncodecodecfromto-- | Just like 'encode', but interleaves calls to 'encode' with calls to 'recover' in order to make as much progress as possiblerecoveringEncode::BufferCodecfromtostate->CodeBufferfromtorecoveringEncodecodecfromto=gofromtowheregofromto=do(why,from',to')<-encodecodecfromto-- When we are dealing with Handles, we don't care about input/output-- underflow particularly, and we want to delay errors about invalid-- sequences as far as possible.casewhyofInvalidSequence|bufLfrom==bufLfrom'->do-- NB: it is OK to call recover here. Because we saw InvalidSequence, by the invariants-- on "encode" it must be the case that there is at least one elements available in the output-- buffer. Furthermore, clearly there is at least one element in the input buffer since we found-- something invalid there!(from',to')<-recovercodecfrom'to'gofrom'to'_->return(why,from',to')-- ------------------------------------------------------------------------------- Handle Finalizers-- For a duplex handle, we arrange that the read side points to the write side-- (and hence keeps it alive if the read side is alive).  This is done by-- having the haOtherSide field of the read side point to the read side.-- The finalizer is then placed on the write side, and the handle only gets-- finalized once, when both sides are no longer required.-- NOTE about finalized handles: It's possible that a handle can be-- finalized and then we try to use it later, for example if the-- handle is referenced from another finalizer, or from a thread that-- has become unreferenced and then resurrected (arguably in the-- latter case we shouldn't finalize the Handle...).  Anyway,-- we try to emit a helpful message which is better than nothing.---- [later; 8/2010] However, a program like this can yield a strange-- error message:----   main = writeFile "out" loop--   loop = let x = x in x---- because the main thread and the Handle are both unreachable at the-- same time, the Handle may get finalized before the main thread-- receives the NonTermination exception, and the exception handler-- will then report an error.  We'd rather this was not an error and-- the program just prints "<<loop>>".handleFinalizer::FilePath->MVarHandle__->IO()handleFinalizerfpm=dohandle_<-takeMVarm(handle_',_)<-hClose_helphandle_putMVarmhandle_'return()-- ----------------------------------------------------------------------------- Allocating buffers-- using an 8k char buffer instead of 32k improved performance for a-- basic "cat" program by ~30% for me.  --SDMdEFAULT_CHAR_BUFFER_SIZE::IntdEFAULT_CHAR_BUFFER_SIZE=2048-- 8k/sizeof(HsChar)getCharBuffer::IODevicedev=>dev->BufferState->IO(IORefCharBuffer,BufferMode)getCharBufferdevstate=dobuffer<-newCharBufferdEFAULT_CHAR_BUFFER_SIZEstateioref<-newIORefbufferis_tty<-IODevice.isTerminaldevletbuffer_mode|is_tty=LineBuffering|otherwise=BlockBufferingNothingreturn(ioref,buffer_mode)mkUnBuffer::BufferState->IO(IORefCharBuffer,BufferMode)mkUnBufferstate=dobuffer<-newCharBufferdEFAULT_CHAR_BUFFER_SIZEstate--  See [note Buffer Sizing], GHC.IO.Handle.Typesref<-newIORefbufferreturn(ref,NoBuffering)-- ------------------------------------------------------------------------------- Flushing buffers-- | syncs the file with the buffer, including moving the-- file pointer backwards in the case of a read buffer.  This can fail-- on a non-seekable read Handle.flushBuffer::Handle__->IO()flushBufferh_@Handle__{..}=dobuf<-readIORefhaCharBuffercasebufStatebufofReadBuffer->doflushCharReadBufferh_flushByteReadBufferh_WriteBuffer->doflushByteWriteBufferh_-- | flushes the Char buffer only.  Works on all Handles.flushCharBuffer::Handle__->IO()flushCharBufferh_@Handle__{..}=docbuf<-readIORefhaCharBuffercasebufStatecbufofReadBuffer->doflushCharReadBufferh_WriteBuffer->-- Nothing to do here. Char buffer on a write Handle is always empty-- between Handle operations.-- See [note Buffer Flushing], GHC.IO.Handle.Types.when(not(isEmptyBuffercbuf))$error"internal IO library error: Char buffer non-empty"-- ------------------------------------------------------------------------------- Writing data (flushing write buffers)-- flushWriteBuffer flushes the byte buffer iff it contains pending write-- data. Because the Char buffer on a write Handle is always empty between-- Handle operations (see [note Buffer Flushing], GHC.IO.Handle.Types),-- both buffers are empty after this.flushWriteBuffer::Handle__->IO()flushWriteBufferh_@Handle__{..}=dobuf<-readIORefhaByteBufferwhen(isWriteBufferbuf)$flushByteWriteBufferh_flushByteWriteBuffer::Handle__->IO()flushByteWriteBufferh_@Handle__{..}=dobbuf<-readIORefhaByteBufferwhen(not(isEmptyBufferbbuf))$dobbuf'<-Buffered.flushWriteBufferhaDevicebbufwriteIORefhaByteBufferbbuf'-- write the contents of the CharBuffer to the Handle__.-- The data will be encoded and pushed to the byte buffer,-- flushing if the buffer becomes full.writeCharBuffer::Handle__->CharBuffer->IO()writeCharBufferh_@Handle__{..}!cbuf=do--bbuf<-readIORefhaByteBufferdebugIO("writeCharBuffer: cbuf="++summaryBuffercbuf++" bbuf="++summaryBufferbbuf)(cbuf',bbuf')<-casehaEncoderofNothing->latin1_encodecbufbbufJustencoder->(streamEncodeencoder)cbufbbufdebugIO("writeCharBuffer after encoding: cbuf="++summaryBuffercbuf'++" bbuf="++summaryBufferbbuf')-- flush the byte buffer if it is fullifisFullBufferbbuf'--  or we made no progress||not(isEmptyBuffercbuf')&&bufLcbuf'==bufLcbuf-- or the byte buffer has more elements than the user wanted buffered||(casehaBufferModeofBlockBuffering(Justs)->bufferElemsbbuf'>=sNoBuffering->True_other->False)thendobbuf''<-Buffered.flushWriteBufferhaDevicebbuf'writeIORefhaByteBufferbbuf''elsewriteIORefhaByteBufferbbuf'ifnot(isEmptyBuffercbuf')thenwriteCharBufferh_cbuf'elsereturn()-- ------------------------------------------------------------------------------- Flushing read buffers-- It is always possible to flush the Char buffer back to the byte buffer.flushCharReadBuffer::Handle__->IO()flushCharReadBufferHandle__{..}=docbuf<-readIORefhaCharBufferifisWriteBuffercbuf||isEmptyBuffercbufthenreturn()elsedo-- haLastDecode is the byte buffer just before we did our last batch of-- decoding.  We're going to re-decode the bytes up to the current char,-- to find out where we should revert the byte buffer to.(codec_state,bbuf0)<-readIORefhaLastDecodecbuf0<-readIORefhaCharBufferwriteIORefhaCharBuffercbuf0{bufL=0,bufR=0}-- if we haven't used any characters from the char buffer, then just-- re-install the old byte buffer.ifbufLcbuf0==0thendowriteIORefhaByteBufferbbuf0return()elsedocasehaDecoderofNothing->dowriteIORefhaByteBufferbbuf0{bufL=bufLbbuf0+bufLcbuf0}-- no decoder: the number of bytes to decode is the same as the-- number of chars we have used up.Justdecoder->dodebugIO("flushCharReadBuffer re-decode, bbuf="++summaryBufferbbuf0++" cbuf="++summaryBuffercbuf0)-- restore the codec statesetStatedecodercodec_state(bbuf1,cbuf1)<-(streamEncodedecoder)bbuf0cbuf0{bufL=0,bufR=0,bufSize=bufLcbuf0}debugIO("finished, bbuf="++summaryBufferbbuf1++" cbuf="++summaryBuffercbuf1)writeIORefhaByteBufferbbuf1-- When flushing the byte read buffer, we seek backwards by the number-- of characters in the buffer.  The file descriptor must therefore be-- seekable: attempting to flush the read buffer on an unseekable-- handle is not allowed.flushByteReadBuffer::Handle__->IO()flushByteReadBufferh_@Handle__{..}=dobbuf<-readIORefhaByteBufferifisEmptyBufferbbufthenreturn()elsedoseekable<-IODevice.isSeekablehaDevicewhen(notseekable)$ioe_cannotFlushNotSeekableletseek=negate(bufRbbuf-bufLbbuf)debugIO("flushByteReadBuffer: new file offset = "++showseek)IODevice.seekhaDeviceRelativeSeek(fromIntegralseek)writeIORefhaByteBufferbbuf{bufL=0,bufR=0}-- ------------------------------------------------------------------------------ Making HandlesmkHandle::(IODevicedev,BufferedIOdev,Typeabledev)=>dev->FilePath->HandleType->Bool-- buffered?->MaybeTextEncoding->NewlineMode->MaybeHandleFinalizer->Maybe(MVarHandle__)->IOHandlemkHandledevfilepathha_typebufferedmb_codecnlfinalizerother_side=doopenTextEncodingmb_codecha_type$\mb_encodermb_decoder->doletbuf_state=initBufferStateha_typebbuf<-Buffered.newBufferdevbuf_statebbufref<-newIORefbbuflast_decode<-newIORef(errorWithoutStackTrace"codec_state",bbuf)(cbufref,bmode)<-ifbufferedthengetCharBufferdevbuf_stateelsemkUnBufferbuf_statespares<-newIORefBufferListNilnewFileHandlefilepathfinalizer(Handle__{haDevice=dev,haType=ha_type,haBufferMode=bmode,haByteBuffer=bbufref,haLastDecode=last_decode,haCharBuffer=cbufref,haBuffers=spares,haEncoder=mb_encoder,haDecoder=mb_decoder,haCodec=mb_codec,haInputNL=inputNLnl,haOutputNL=outputNLnl,haOtherSide=other_side})-- | makes a new 'Handle'mkFileHandle::(IODevicedev,BufferedIOdev,Typeabledev)=>dev-- ^ the underlying IO device, which must support-- 'IODevice', 'BufferedIO' and 'Typeable'->FilePath-- ^ a string describing the 'Handle', e.g. the file-- path for a file.  Used in error messages.->IOMode-- The mode in which the 'Handle' is to be used->MaybeTextEncoding-- Create the 'Handle' with no text encoding?->NewlineMode-- Translate newlines?->IOHandlemkFileHandledevfilepathiomodemb_codectr_newlines=domkHandledevfilepath(ioModeToHandleTypeiomode)True{-buffered-}mb_codectr_newlines(JusthandleFinalizer)Nothing{-other_side-}-- | like 'mkFileHandle', except that a 'Handle' is created with two-- independent buffers, one for reading and one for writing.  Used for-- full-duplex streams, such as network sockets.mkDuplexHandle::(IODevicedev,BufferedIOdev,Typeabledev)=>dev->FilePath->MaybeTextEncoding->NewlineMode->IOHandlemkDuplexHandledevfilepathmb_codectr_newlines=dowrite_side@(FileHandle_write_m)<-mkHandledevfilepathWriteHandleTruemb_codectr_newlines(JusthandleFinalizer)Nothing-- no othersieread_side@(FileHandle_read_m)<-mkHandledevfilepathReadHandleTruemb_codectr_newlinesNothing-- no finalizer(Justwrite_m)return(DuplexHandlefilepathread_mwrite_m)ioModeToHandleType::IOMode->HandleTypeioModeToHandleTypeReadMode=ReadHandleioModeToHandleTypeWriteMode=WriteHandleioModeToHandleTypeReadWriteMode=ReadWriteHandleioModeToHandleTypeAppendMode=AppendHandleinitBufferState::HandleType->BufferStateinitBufferStateReadHandle=ReadBufferinitBufferState_=WriteBufferopenTextEncoding::MaybeTextEncoding->HandleType->(forallesds.Maybe(TextEncoderes)->Maybe(TextDecoderds)->IOa)->IOaopenTextEncodingNothingha_typecont=contNothingNothingopenTextEncoding(JustTextEncoding{..})ha_typecont=domb_decoder<-ifisReadableHandleTypeha_typethendodecoder<-mkTextDecoderreturn(Justdecoder)elsereturnNothingmb_encoder<-ifisWritableHandleTypeha_typethendoencoder<-mkTextEncoderreturn(Justencoder)elsereturnNothingcontmb_encodermb_decodercloseTextCodecs::Handle__->IO()closeTextCodecsHandle__{..}=docasehaDecoderofNothing->return();Justd->Encoding.closedcasehaEncoderofNothing->return();Justd->Encoding.closed-- ----------------------------------------------------------------------------- closing Handles-- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when-- EOF is read or an IO error occurs on a lazy stream.  The-- semi-closed Handle is then closed immediately.  We have to be-- careful with DuplexHandles though: we have to leave the closing to-- the finalizer in that case, because the write side may still be in-- use.hClose_help::Handle__->IO(Handle__,MaybeSomeException)hClose_helphandle_=casehaTypehandle_ofClosedHandle->return(handle_,Nothing)_->domb_exc1<-trymaybe$flushWriteBufferhandle_-- interruptible-- it is important that hClose doesn't fail and-- leave the Handle open (#3128), so we catch-- exceptions when flushing the buffer.(h_,mb_exc2)<-hClose_handle_handle_return(h_,ifisJustmb_exc1thenmb_exc1elsemb_exc2)trymaybe::IO()->IO(MaybeSomeException)trymaybeio=(doio;returnNothing)`catchException`\e->return(Juste)hClose_handle_::Handle__->IO(Handle__,MaybeSomeException)hClose_handle_h_@Handle__{..}=do-- close the file descriptor, but not when this is the read-- side of a duplex handle.-- If an exception is raised by the close(), we want to continue-- to close the handle and release the lock if it has one, then-- we return the exception to the caller of hClose_help which can-- raise it if necessary.maybe_exception<-casehaOtherSideofNothing->trymaybe$IODevice.closehaDeviceJust_->returnNothing-- free the spare bufferswriteIORefhaBuffersBufferListNilwriteIORefhaCharBuffernoCharBufferwriteIORefhaByteBuffernoByteBuffer-- release our encoder/decodercloseTextCodecsh_-- we must set the fd to -1, because the finalizer is going-- to run eventually and try to close/unlock it.-- ToDo: necessary?  the handle will be marked ClosedHandle-- XXX GHC won't let us use record update here, hence wildcardsreturn(Handle__{haType=ClosedHandle,..},maybe_exception){-# NOINLINEnoCharBuffer#-}noCharBuffer::CharBuffernoCharBuffer=unsafePerformIO$newCharBuffer1ReadBuffer{-# NOINLINEnoByteBuffer#-}noByteBuffer::BufferWord8noByteBuffer=unsafePerformIO$newByteBuffer1ReadBuffer-- ----------------------------------------------------------------------------- Looking aheadhLookAhead_::Handle__->IOCharhLookAhead_handle_@Handle__{..}=dobuf<-readIORefhaCharBuffer-- fill up the read buffer if necessarynew_buf<-ifisEmptyBufferbufthenreadTextDevicehandle_bufelsereturnbufwriteIORefhaCharBuffernew_bufpeekCharBuf(bufRawbuf)(bufLbuf)-- ----------------------------------------------------------------------------- debuggingdebugIO::String->IO()debugIOs|c_DEBUG_DUMP=do_<-withCStringLen(s++"\n")$\(p,len)->c_write1(castPtrp)(fromIntegrallen)return()|otherwise=return()-- ------------------------------------------------------------------------------ Text input/output-- Read characters into the provided buffer.  Return when any-- characters are available; raise an exception if the end of-- file is reached.---- In uses of readTextDevice within base, the input buffer is either:--   * empty--   * or contains a single \r (when doing newline translation)---- The input character buffer must have a capacity at least 1 greater-- than the number of elements it currently contains.---- Users of this function expect that the buffer returned contains-- at least 1 more character than the input buffer.readTextDevice::Handle__->CharBuffer->IOCharBufferreadTextDeviceh_@Handle__{..}cbuf=do--bbuf0<-readIORefhaByteBufferdebugIO("readTextDevice: cbuf="++summaryBuffercbuf++" bbuf="++summaryBufferbbuf0)bbuf1<-ifnot(isEmptyBufferbbuf0)thenreturnbbuf0elsedo(r,bbuf1)<-Buffered.fillReadBufferhaDevicebbuf0ifr==0thenioe_EOFelsedo-- raise EOFreturnbbuf1debugIO("readTextDevice after reading: bbuf="++summaryBufferbbuf1)(bbuf2,cbuf')<-casehaDecoderofNothing->dowriteIORefhaLastDecode(errorWithoutStackTrace"codec_state",bbuf1)latin1_decodebbuf1cbufJustdecoder->dostate<-getStatedecoderwriteIORefhaLastDecode(state,bbuf1)(streamEncodedecoder)bbuf1cbufdebugIO("readTextDevice after decoding: cbuf="++summaryBuffercbuf'++" bbuf="++summaryBufferbbuf2)-- We can't return from readTextDevice without reading at least a single extra character,-- so check that we have managed to achieve thatwriteIORefhaByteBufferbbuf2ifbufRcbuf'==bufRcbuf-- we need more bytes to make a Char. NB: bbuf2 may be empty (even though bbuf1 wasn't) when we-- are using an encoding that can skip bytes without outputting characters, such as UTF8//IGNOREthenreadTextDevice'h_bbuf2cbufelsereturncbuf'-- we have an incomplete byte sequence at the end of the buffer: try to-- read more bytes.readTextDevice'::Handle__->BufferWord8->CharBuffer->IOCharBufferreadTextDevice'h_@Handle__{..}bbuf0cbuf0=do---- copy the partial sequence to the beginning of the buffer, so we have-- room to read more bytes.bbuf1<-slideContentsbbuf0-- readTextDevice only calls us if we got some bytes but not some characters.-- This can't occur if haDecoder is Nothing because latin1_decode accepts all bytes.letJustdecoder=haDecoder(r,bbuf2)<-Buffered.fillReadBufferhaDevicebbuf1ifr==0thendo-- bbuf2 can be empty here when we encounter an invalid byte sequence at the end of the input-- with a //IGNORE codec which consumes bytes without outputting charactersifisEmptyBufferbbuf2thenioe_EOFelsedo(bbuf3,cbuf1)<-recoverdecoderbbuf2cbuf0debugIO("readTextDevice' after recovery: bbuf="++summaryBufferbbuf3++", cbuf="++summaryBuffercbuf1)writeIORefhaByteBufferbbuf3-- We should recursively invoke readTextDevice after recovery,-- if recovery did not add at least one new character to the buffer:--  1. If we were using IgnoreCodingFailure it might be the case that--     cbuf1 is the same length as cbuf0 and we need to raise ioe_EOF--  2. If we were using TransliterateCodingFailure we might have *mutated*--     the byte buffer without changing the pointers into either buffer.--     We need to try and decode it again - it might just go through this time.ifbufRcbuf1==bufRcbuf0thenreadTextDeviceh_cbuf1elsereturncbuf1elsedodebugIO("readTextDevice' after reading: bbuf="++summaryBufferbbuf2)(bbuf3,cbuf1)<-dostate<-getStatedecoderwriteIORefhaLastDecode(state,bbuf2)(streamEncodedecoder)bbuf2cbuf0debugIO("readTextDevice' after decoding: cbuf="++summaryBuffercbuf1++" bbuf="++summaryBufferbbuf3)writeIORefhaByteBufferbbuf3ifbufRcbuf0==bufRcbuf1thenreadTextDevice'h_bbuf3cbuf1elsereturncbuf1-- Read characters into the provided buffer.  Do not block;-- return zero characters instead.  Raises an exception on end-of-file.readTextDeviceNonBlocking::Handle__->CharBuffer->IOCharBufferreadTextDeviceNonBlockingh_@Handle__{..}cbuf=do--bbuf0<-readIORefhaByteBufferwhen(isEmptyBufferbbuf0)$do(r,bbuf1)<-Buffered.fillReadBuffer0haDevicebbuf0ifisNothingrthenioe_EOFelsedo-- raise EOFwriteIORefhaByteBufferbbuf1decodeByteBufh_cbuf-- Decode bytes from the byte buffer into the supplied CharBuffer.decodeByteBuf::Handle__->CharBuffer->IOCharBufferdecodeByteBufh_@Handle__{..}cbuf=do--bbuf0<-readIORefhaByteBuffer(bbuf2,cbuf')<-casehaDecoderofNothing->dowriteIORefhaLastDecode(errorWithoutStackTrace"codec_state",bbuf0)latin1_decodebbuf0cbufJustdecoder->dostate<-getStatedecoderwriteIORefhaLastDecode(state,bbuf0)(streamEncodedecoder)bbuf0cbufwriteIORefhaByteBufferbbuf2returncbuf'