{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude
           , RecordWildCards
           , BangPatterns
           , NondecreasingIndentation
           , RankNTypes
  #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- 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.
--
-----------------------------------------------------------------------------

module GHC.IO.Handle.Internals (
  withHandle, withHandle', withHandle_,
  withHandle__', withHandle_', withAllHandles__,
  wantWritableHandle, wantReadableHandle, wantReadableHandle_,
  wantSeekableHandle,

  mkHandle,
  mkFileHandle, mkFileHandleNoFinalizer, mkDuplexHandle, mkDuplexHandleNoFinalizer,
  addHandleFinalizer,
  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_impl, hClose_help, hLookAhead_,

  HandleFinalizer, handleFinalizer,

  debugIO, traceIO
 ) where

import GHC.IO
import GHC.IO.IOMode
import GHC.IO.Encoding as Encoding
import GHC.IO.Encoding.Types (CodeBuffer)
import GHC.IO.Handle.Types
import GHC.IO.Buffer
import GHC.IO.BufferedIO (BufferedIO)
import GHC.IO.Exception
import GHC.IO.Device (IODevice, RawIO, SeekMode(..))
import GHC.IO.SubSystem ((<!>), isWindowsNativeIO)
import qualified GHC.IO.Device as IODevice
import qualified GHC.IO.BufferedIO as Buffered

import GHC.Conc.Sync
import GHC.Real
import GHC.Base
import GHC.Exception
import GHC.Num          ( Num(..) )
import GHC.Show
import GHC.IORef
import GHC.MVar
import Data.Typeable
import Data.Maybe
import Foreign
import System.Posix.Internals hiding (FD)

import Foreign.C

c_DEBUG_DUMP :: Bool
c_DEBUG_DUMP :: Bool
c_DEBUG_DUMP = Bool
False

-- ---------------------------------------------------------------------------
-- Creating a new handle

type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()

-- | Add a finalizer to a 'Handle'. Specifically, the finalizer
-- will be added to the 'MVar' of a file handle or the write-side
-- 'MVar' of a duplex handle. See Handle Finalizers for details.
addHandleFinalizer :: Handle -> HandleFinalizer -> IO ()
addHandleFinalizer :: Handle -> HandleFinalizer -> IO ()
addHandleFinalizer Handle
handle HandleFinalizer
finalizer = do
  FilePath -> IO ()
debugIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Registering finalizer: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
filepath
  MVar Handle__ -> IO () -> IO ()
forall a. MVar a -> IO () -> IO ()
addMVarFinalizer MVar Handle__
mv (HandleFinalizer
finalizer FilePath
filepath MVar Handle__
mv)
  where
    !(FilePath
filepath, !MVar Handle__
mv) = case Handle
handle of
      FileHandle FilePath
fp MVar Handle__
m -> (FilePath
fp, MVar Handle__
m)
      DuplexHandle FilePath
fp MVar Handle__
_ MVar Handle__
write_m -> (FilePath
fp, MVar Handle__
write_m)


-- ---------------------------------------------------------------------------
-- Working with Handles

{-
In the concurrent world, handles are locked during use.  This is done
by wrapping an MVar around the handle which acts as a mutex over
operations on the handle.

To avoid races, we use the following bracketing operations.  The idea
is to obtain the lock, do some operation and replace the lock again,
whether the operation succeeded or failed.  We also want to handle the
case where the thread receives an exception while processing the IO
operation: in these cases we also want to relinquish the lock.

There are three versions of @withHandle@: corresponding to the three
possible combinations of:

        - the operation may side-effect the handle
        - the operation may return a result

If the operation generates an error or an exception is raised, the
original handle is always replaced.
-}

{-# INLINE withHandle #-}
withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
withHandle :: forall a.
FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle FilePath
fun h :: Handle
h@(FileHandle FilePath
_ MVar Handle__
m)     Handle__ -> IO (Handle__, a)
act = FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
forall a.
FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO (Handle__, a)
act
withHandle FilePath
fun h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
m MVar Handle__
_) Handle__ -> IO (Handle__, a)
act = FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
forall a.
FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO (Handle__, a)
act

withHandle' :: String -> Handle -> MVar Handle__
   -> (Handle__ -> IO (Handle__,a)) -> IO a
withHandle' :: forall a.
FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO (Handle__, a)
act =
 IO a -> IO a
forall a. IO a -> IO a
mask_ (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
   (Handle__
h',a
v)  <- FilePath
-> Handle
-> (Handle__ -> IO (Handle__, a))
-> MVar Handle__
-> IO (Handle__, a)
forall a.
FilePath -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
do_operation FilePath
fun Handle
h Handle__ -> IO (Handle__, a)
act MVar Handle__
m
   Handle__ -> IO ()
checkHandleInvariants Handle__
h'
   MVar Handle__ -> Handle__ -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Handle__
m Handle__
h'
   a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v

{-# INLINE withHandle_ #-}
withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ :: forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ FilePath
fun h :: Handle
h@(FileHandle FilePath
_ MVar Handle__
m)     Handle__ -> IO a
act = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act
withHandle_ FilePath
fun h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
m MVar Handle__
_) Handle__ -> IO a
act = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act

withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' :: forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act = FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
forall a.
FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' FilePath
fun Handle
h MVar Handle__
m ((Handle__ -> IO (Handle__, a)) -> IO a)
-> (Handle__ -> IO (Handle__, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle__
h_ -> do
                              a
a <- Handle__ -> IO a
act Handle__
h_
                              (Handle__, a) -> IO (Handle__, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
h_,a
a)

withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
withAllHandles__ :: FilePath -> Handle -> (Handle__ -> IO Handle__) -> IO ()
withAllHandles__ FilePath
fun h :: Handle
h@(FileHandle FilePath
_ MVar Handle__
m)     Handle__ -> IO Handle__
act = FilePath
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO Handle__
act
withAllHandles__ FilePath
fun h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
r MVar Handle__
w) Handle__ -> IO Handle__
act = do
  FilePath
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' FilePath
fun Handle
h MVar Handle__
r Handle__ -> IO Handle__
act
  FilePath
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' FilePath
fun Handle
h MVar Handle__
w Handle__ -> IO Handle__
act

withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
              -> IO ()
withHandle__' :: FilePath
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO Handle__
act =
 IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   Handle__
h'  <- FilePath
-> Handle
-> (Handle__ -> IO Handle__)
-> MVar Handle__
-> IO Handle__
forall a.
FilePath -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
do_operation FilePath
fun Handle
h Handle__ -> IO Handle__
act MVar Handle__
m
   Handle__ -> IO ()
checkHandleInvariants Handle__
h'
   MVar Handle__ -> Handle__ -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Handle__
m Handle__
h'
   () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

do_operation :: String -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
do_operation :: forall a.
FilePath -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
do_operation FilePath
fun Handle
h Handle__ -> IO a
act MVar Handle__
m = do
  Handle__
h_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
  Handle__ -> IO ()
checkHandleInvariants Handle__
h_
  Handle__ -> IO a
act Handle__
h_ IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` Handle__ -> SomeException -> IO a
handler Handle__
h_
  where
    handler :: Handle__ -> SomeException -> IO a
handler Handle__
h_ SomeException
e = do
      MVar Handle__ -> Handle__ -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Handle__
m Handle__
h_
      case () of
        ()
_ | Just IOException
ioe <- SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e ->
            IOException -> IO a
forall a. IOException -> IO a
ioError (IOException -> FilePath -> Handle -> IOException
augmentIOError IOException
ioe FilePath
fun Handle
h)
        ()
_ | Just SomeAsyncException
async_ex <- SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e -> do -- see Note [async]
            let SomeAsyncException
_ = SomeAsyncException
async_ex :: SomeAsyncException
            ThreadId
t <- IO ThreadId
myThreadId
            ThreadId -> SomeException -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
t SomeException
e
            FilePath -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
forall a.
FilePath -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
do_operation FilePath
fun Handle
h Handle__ -> IO a
act MVar Handle__
m
        ()
_otherwise ->
            SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
e

-- 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/writeTextDevice

augmentIOError :: IOException -> String -> Handle -> IOException
augmentIOError :: IOException -> FilePath -> Handle -> IOException
augmentIOError ioe :: IOException
ioe@IOError{ ioe_filename :: IOException -> Maybe FilePath
ioe_filename = Maybe FilePath
fp } FilePath
fun Handle
h
  = IOException
ioe { ioe_handle :: Maybe Handle
ioe_handle = Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h, ioe_location :: FilePath
ioe_location = FilePath
fun, ioe_filename :: Maybe FilePath
ioe_filename = Maybe FilePath
filepath }
  where filepath :: Maybe FilePath
filepath
          | Just FilePath
_ <- Maybe FilePath
fp = Maybe FilePath
fp
          | Bool
otherwise = case Handle
h of
                          FileHandle FilePath
path MVar Handle__
_     -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path
                          DuplexHandle FilePath
path MVar Handle__
_ MVar Handle__
_ -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path

-- ---------------------------------------------------------------------------
-- Wrapper for write operations.

-- If we already have a writeable handle just run the action.
-- If we have a read only handle we throw an exception.
-- If we have a read/write handle in read mode we:
-- * Seek to the unread (from the users PoV) position and
--   change the handles buffer to a write buffer.
wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle :: forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle FilePath
fun h :: Handle
h@(FileHandle FilePath
_ MVar Handle__
m) Handle__ -> IO a
act
  = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
wantWritableHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act
wantWritableHandle FilePath
fun h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
_ MVar Handle__
m) Handle__ -> IO a
act
  = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
wantWritableHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act
    -- we know it's not a ReadHandle or ReadWriteHandle, but we have to
    -- check for ClosedHandle/SemiClosedHandle. (#4808)

wantWritableHandle'
        :: String -> Handle -> MVar Handle__
        -> (Handle__ -> IO a) -> IO a
wantWritableHandle' :: forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
wantWritableHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act
   = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
fun Handle
h MVar Handle__
m ((Handle__ -> IO a) -> Handle__ -> IO a
forall a. (Handle__ -> IO a) -> Handle__ -> IO a
checkWritableHandle Handle__ -> IO a
act)

checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkWritableHandle :: forall a. (Handle__ -> IO a) -> Handle__ -> IO a
checkWritableHandle Handle__ -> IO a
act h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
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 Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haInputNL :: Handle__ -> Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
..}
  = case HandleType
haType of
      HandleType
ClosedHandle         -> IO a
forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle     -> IO a
forall a. IO a
ioe_semiclosedHandle
      HandleType
ReadHandle           -> IO a
forall a. IO a
ioe_notWritable
      HandleType
ReadWriteHandle      -> do
        Buffer Char
buf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Buffer Char -> Bool
forall e. Buffer e -> Bool
isWriteBuffer Buffer Char
buf)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
           Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
           Handle__ -> IO ()
flushByteReadBuffer Handle__
h_
           Buffer Char
buf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
           IORef (Buffer Char) -> Buffer Char -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Char)
haCharBuffer Buffer Char
buf{ bufState :: BufferState
bufState = BufferState
WriteBuffer }
           Buffer Word8
buf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
           Buffer Word8
buf' <- dev -> Buffer Word8 -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
Buffered.emptyWriteBuffer dev
haDevice Buffer Word8
buf
           IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf'
        Handle__ -> IO a
act Handle__
h_
      HandleType
AppendHandle         -> Handle__ -> IO a
act Handle__
h_
      HandleType
WriteHandle          -> Handle__ -> IO a
act Handle__
h_

-- ---------------------------------------------------------------------------
-- Wrapper for read operations.

wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
wantReadableHandle :: forall a.
FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
wantReadableHandle FilePath
fun Handle
h Handle__ -> IO (Handle__, a)
act =
  FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
forall a.
FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle FilePath
fun Handle
h ((Handle__ -> IO (Handle__, a)) -> Handle__ -> IO (Handle__, a)
forall a. (Handle__ -> IO a) -> Handle__ -> IO a
checkReadableHandle Handle__ -> IO (Handle__, a)
act)

wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ :: forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ FilePath
fun h :: Handle
h@(FileHandle  FilePath
_ MVar Handle__
m)   Handle__ -> IO a
act
  = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
wantReadableHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act
wantReadableHandle_ FilePath
fun h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
m MVar Handle__
_) Handle__ -> IO a
act
  = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
wantReadableHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act
    -- we know it's not a WriteHandle or ReadWriteHandle, but we have to
    -- check for ClosedHandle/SemiClosedHandle. (#4808)

wantReadableHandle'
        :: String -> Handle -> MVar Handle__
        -> (Handle__ -> IO a) -> IO a
wantReadableHandle' :: forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
wantReadableHandle' FilePath
fun Handle
h MVar Handle__
m Handle__ -> IO a
act
  = FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
fun Handle
h MVar Handle__
m ((Handle__ -> IO a) -> Handle__ -> IO a
forall a. (Handle__ -> IO a) -> Handle__ -> IO a
checkReadableHandle Handle__ -> IO a
act)

checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkReadableHandle :: forall a. (Handle__ -> IO a) -> Handle__ -> IO a
checkReadableHandle Handle__ -> IO a
act h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} =
    case HandleType
haType of
      HandleType
ClosedHandle         -> IO a
forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle     -> IO a
forall a. IO a
ioe_semiclosedHandle
      HandleType
AppendHandle         -> IO a
forall a. IO a
ioe_notReadable
      HandleType
WriteHandle          -> IO a
forall a. IO a
ioe_notReadable
      HandleType
ReadWriteHandle      -> do
          -- a read/write handle and we want to read from it.  We must
          -- flush all buffered write data first.
          Buffer Word8
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isWriteBuffer Buffer Word8
bbuf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
bbuf)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushByteWriteBuffer Handle__
h_
             Buffer Char
cbuf' <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
             IORef (Buffer Char) -> Buffer Char -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Char)
haCharBuffer Buffer Char
cbuf'{ bufState :: BufferState
bufState = BufferState
ReadBuffer }
             Buffer Word8
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
             IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf{ bufState :: BufferState
bufState = BufferState
ReadBuffer }
          Handle__ -> IO a
act Handle__
h_
      HandleType
_other               -> Handle__ -> IO a
act Handle__
h_

-- ---------------------------------------------------------------------------
-- Wrapper for seek operations.

wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle :: forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle FilePath
fun h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
_ MVar Handle__
_) Handle__ -> IO a
_act =
  IOException -> IO a
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 FilePath
fun
                   FilePath
"handle is not seekable" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
wantSeekableHandle FilePath
fun h :: Handle
h@(FileHandle FilePath
_ MVar Handle__
m) Handle__ -> IO a
act =
  FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
FilePath -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' FilePath
fun Handle
h MVar Handle__
m ((Handle__ -> IO a) -> Handle__ -> IO a
forall a. (Handle__ -> IO a) -> Handle__ -> IO a
checkSeekableHandle Handle__ -> IO a
act)

checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkSeekableHandle :: forall a. (Handle__ -> IO a) -> Handle__ -> IO a
checkSeekableHandle Handle__ -> IO a
act handle_ :: Handle__
handle_@Handle__{haDevice :: ()
haDevice=dev
dev} =
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle      -> IO a
forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle  -> IO a
forall a. IO a
ioe_semiclosedHandle
      HandleType
AppendHandle      -> IO a
forall a. IO a
ioe_notSeekable
      HandleType
_ -> do Bool
b <- dev -> IO Bool
forall a. IODevice a => a -> IO Bool
IODevice.isSeekable dev
dev
              if Bool
b then Handle__ -> IO a
act Handle__
handle_
                   else IO a
forall a. IO a
ioe_notSeekable

-- -----------------------------------------------------------------------------
-- Handy IOErrors

ioe_closedHandle, ioe_semiclosedHandle, ioe_EOF,
  ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,
  ioe_notSeekable :: IO a

ioe_closedHandle :: forall a. IO a
ioe_closedHandle = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IllegalOperation FilePath
""
        FilePath
"handle is closed" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
ioe_semiclosedHandle :: forall a. IO a
ioe_semiclosedHandle = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IllegalOperation FilePath
""
        FilePath
"handle is semi-closed" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
ioe_EOF :: forall a. IO a
ioe_EOF = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
EOF FilePath
"" FilePath
"" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
ioe_notReadable :: forall a. IO a
ioe_notReadable = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IllegalOperation FilePath
""
        FilePath
"handle is not open for reading" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
ioe_notWritable :: forall a. IO a
ioe_notWritable = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IllegalOperation FilePath
""
        FilePath
"handle is not open for writing" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
ioe_notSeekable :: forall a. IO a
ioe_notSeekable = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IllegalOperation FilePath
""
        FilePath
"handle is not seekable" Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
ioe_cannotFlushNotSeekable :: forall a. IO a
ioe_cannotFlushNotSeekable = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IllegalOperation FilePath
""
      FilePath
"cannot flush the read buffer: underlying device is not seekable"
        Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)

ioe_finalizedHandle :: FilePath -> Handle__
ioe_finalizedHandle :: FilePath -> Handle__
ioe_finalizedHandle FilePath
fp = IOException -> Handle__
forall a e. Exception e => e -> a
throw
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
IllegalOperation FilePath
""
        FilePath
"handle is finalized" Maybe CInt
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fp))

ioe_bufsiz :: Int -> IO a
ioe_bufsiz :: forall a. Int -> IO a
ioe_bufsiz Int
n = IOException -> IO a
forall a. IOException -> IO a
ioException
   (Maybe Handle
-> IOErrorType
-> FilePath
-> FilePath
-> Maybe CInt
-> Maybe FilePath
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument FilePath
"hSetBuffering"
        (FilePath
"illegal buffer size " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> Int -> FilePath -> FilePath
forall a. Show a => Int -> a -> FilePath -> FilePath
showsPrec Int
9 Int
n []) Maybe CInt
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing)
                                -- 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 sequence. 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 :: BufferCodec from to state
             -> Buffer from -> Buffer to
             -> IO (Buffer from, Buffer to)
streamEncode :: forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
streamEncode BufferCodec from to state
codec Buffer from
from Buffer to
to = ((CodingProgress, Buffer from, Buffer to)
 -> (Buffer from, Buffer to))
-> IO (CodingProgress, Buffer from, Buffer to)
-> IO (Buffer from, Buffer to)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CodingProgress
_, Buffer from
from', Buffer to
to') -> (Buffer from
from', Buffer to
to')) (IO (CodingProgress, Buffer from, Buffer to)
 -> IO (Buffer from, Buffer to))
-> IO (CodingProgress, Buffer from, Buffer to)
-> IO (Buffer from, Buffer to)
forall a b. (a -> b) -> a -> b
$ BufferCodec from to state -> CodeBuffer from to
forall from to state.
BufferCodec from to state -> CodeBuffer from to
recoveringEncode BufferCodec from to state
codec Buffer from
from Buffer to
to

-- | Just like 'encode', but interleaves calls to 'encode' with calls to 'recover' in order to make as much progress as possible
recoveringEncode :: BufferCodec from to state -> CodeBuffer from to
recoveringEncode :: forall from to state.
BufferCodec from to state -> CodeBuffer from to
recoveringEncode BufferCodec from to state
codec Buffer from
from Buffer to
to = Buffer from
-> Buffer to -> IO (CodingProgress, Buffer from, Buffer to)
go Buffer from
from Buffer to
to
  where
    go :: Buffer from
-> Buffer to -> IO (CodingProgress, Buffer from, Buffer to)
go Buffer from
from Buffer to
to = do
      (CodingProgress
why, Buffer from
from', Buffer to
to') <- BufferCodec from to state
-> Buffer from
-> Buffer to
-> IO (CodingProgress, Buffer from, Buffer to)
forall from to state.
BufferCodec from to state -> CodeBuffer from to
encode BufferCodec from to state
codec Buffer from
from Buffer to
to
      -- 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.
      case CodingProgress
why of
        CodingProgress
InvalidSequence | Buffer from -> Int
forall e. Buffer e -> Int
bufL Buffer from
from Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer from -> Int
forall e. Buffer e -> Int
bufL Buffer from
from' -> 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!
          (Buffer from
from', Buffer to
to') <- BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
recover BufferCodec from to state
codec Buffer from
from' Buffer to
to'
          Buffer from
-> Buffer to -> IO (CodingProgress, Buffer from, Buffer to)
go Buffer from
from' Buffer to
to'
        CodingProgress
_ -> (CodingProgress, Buffer from, Buffer to)
-> IO (CodingProgress, Buffer from, Buffer to)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodingProgress
why, Buffer from
from', Buffer to
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 -> MVar Handle__ -> IO ()
handleFinalizer :: HandleFinalizer
handleFinalizer FilePath
fp MVar Handle__
m = do
  Handle__
handle_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
  (Handle__
handle_', Maybe SomeException
_) <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
handle_
  MVar Handle__ -> Handle__ -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Handle__
m Handle__
handle_'
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- ---------------------------------------------------------------------------
-- Allocating buffers

-- using an 8k char buffer instead of 32k improved performance for a
-- basic "cat" program by ~30% for me.  --SDM
dEFAULT_CHAR_BUFFER_SIZE :: Int
dEFAULT_CHAR_BUFFER_SIZE :: Int
dEFAULT_CHAR_BUFFER_SIZE = Int
2048 -- 8k/sizeof(HsChar)

getCharBuffer :: IODevice dev => dev -> BufferState
              -> IO (IORef CharBuffer, BufferMode)
getCharBuffer :: forall dev.
IODevice dev =>
dev -> BufferState -> IO (IORef (Buffer Char), BufferMode)
getCharBuffer dev
dev BufferState
state = do
  Buffer Char
buffer <- Int -> BufferState -> IO (Buffer Char)
newCharBuffer Int
dEFAULT_CHAR_BUFFER_SIZE BufferState
state
  IORef (Buffer Char)
ioref  <- Buffer Char -> IO (IORef (Buffer Char))
forall a. a -> IO (IORef a)
newIORef Buffer Char
buffer
  Bool
is_tty <- dev -> IO Bool
forall a. IODevice a => a -> IO Bool
IODevice.isTerminal dev
dev

  let buffer_mode :: BufferMode
buffer_mode
         | Bool
is_tty    = BufferMode
LineBuffering
         | Bool
otherwise = Maybe Int -> BufferMode
BlockBuffering Maybe Int
forall a. Maybe a
Nothing

  (IORef (Buffer Char), BufferMode)
-> IO (IORef (Buffer Char), BufferMode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef (Buffer Char)
ioref, BufferMode
buffer_mode)

mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
mkUnBuffer :: BufferState -> IO (IORef (Buffer Char), BufferMode)
mkUnBuffer BufferState
state = do
  Buffer Char
buffer <- Int -> BufferState -> IO (Buffer Char)
newCharBuffer Int
dEFAULT_CHAR_BUFFER_SIZE BufferState
state
              --  See [note Buffer Sizing], GHC.IO.Handle.Types
  IORef (Buffer Char)
ref <- Buffer Char -> IO (IORef (Buffer Char))
forall a. a -> IO (IORef a)
newIORef Buffer Char
buffer
  (IORef (Buffer Char), BufferMode)
-> IO (IORef (Buffer Char), BufferMode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef (Buffer Char)
ref, BufferMode
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 ()
flushBuffer :: Handle__ -> IO ()
flushBuffer h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
  Buffer Char
buf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
  case Buffer Char -> BufferState
forall e. Buffer e -> BufferState
bufState Buffer Char
buf of
    BufferState
ReadBuffer -> do
        Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
        Handle__ -> IO ()
flushByteReadBuffer Handle__
h_
    BufferState
WriteBuffer ->
        Handle__ -> IO ()
flushByteWriteBuffer Handle__
h_

-- | flushes the Char buffer only.  Works on all Handles.
flushCharBuffer :: Handle__ -> IO ()
flushCharBuffer :: Handle__ -> IO ()
flushCharBuffer h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
  Buffer Char
cbuf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
  case Buffer Char -> BufferState
forall e. Buffer e -> BufferState
bufState Buffer Char
cbuf of
    BufferState
ReadBuffer ->
        Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
    BufferState
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.
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Buffer Char -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Char
cbuf)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
           FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"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 ()
flushWriteBuffer :: Handle__ -> IO ()
flushWriteBuffer h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
  Buffer Word8
buf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isWriteBuffer Buffer Word8
buf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushByteWriteBuffer Handle__
h_

flushByteWriteBuffer :: Handle__ -> IO ()
flushByteWriteBuffer :: Handle__ -> IO ()
flushByteWriteBuffer h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
  Buffer Word8
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
bbuf)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Buffer Word8
bbuf' <- dev -> Buffer Word8 -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
Buffered.flushWriteBuffer dev
haDevice Buffer Word8
bbuf
    FilePath -> IO ()
debugIO (FilePath
"flushByteWriteBuffer: bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf')
    IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf'

-- 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.
-- Data is written to the handles current buffer offset.
writeCharBuffer :: Handle__ -> CharBuffer -> IO ()
writeCharBuffer :: Handle__ -> Buffer Char -> IO ()
writeCharBuffer h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} !Buffer Char
cbuf = do
  --
  Buffer Word8
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer

  FilePath -> IO ()
debugIO (FilePath
"writeCharBuffer: cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Char -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Char
cbuf FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FilePath
" bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf)

  (Buffer Char
cbuf',Buffer Word8
bbuf') <- case Maybe (TextEncoder enc_state)
haEncoder of
    Maybe (TextEncoder enc_state)
Nothing      -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
latin1_encode Buffer Char
cbuf Buffer Word8
bbuf
    Just TextEncoder enc_state
encoder -> (TextEncoder enc_state
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
streamEncode TextEncoder enc_state
encoder) Buffer Char
cbuf Buffer Word8
bbuf

  FilePath -> IO ()
debugIO (FilePath
"writeCharBuffer after encoding: cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Char -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Char
cbuf' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FilePath
" bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf')

          -- flush the byte buffer if it is full
  if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isFullBuffer Buffer Word8
bbuf'
          --  or we made no progress
     Bool -> Bool -> Bool
|| Bool -> Bool
not (Buffer Char -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Char
cbuf') Bool -> Bool -> Bool
&& Buffer Char -> Int
forall e. Buffer e -> Int
bufL Buffer Char
cbuf' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer Char -> Int
forall e. Buffer e -> Int
bufL Buffer Char
cbuf
          -- or the byte buffer has more elements than the user wanted buffered
     Bool -> Bool -> Bool
|| (case BufferMode
haBufferMode of
          BlockBuffering (Just Int
s) -> Buffer Word8 -> Int
forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s
          BufferMode
NoBuffering -> Bool
True
          BufferMode
_other -> Bool
False)
    then do
      Buffer Word8
bbuf'' <- dev -> Buffer Word8 -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
Buffered.flushWriteBuffer dev
haDevice Buffer Word8
bbuf'
      IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf''
      FilePath -> IO ()
debugIO (FilePath
"writeCharBuffer after flushing: cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf'')
    else
      IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf'

  if Bool -> Bool
not (Buffer Char -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Char
cbuf')
     then Handle__ -> Buffer Char -> IO ()
writeCharBuffer Handle__
h_ Buffer Char
cbuf'
     else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- -----------------------------------------------------------------------------
-- Flushing read buffers

-- It is always possible to flush the Char buffer back to the byte buffer.
flushCharReadBuffer :: Handle__ -> IO ()
flushCharReadBuffer :: Handle__ -> IO ()
flushCharReadBuffer Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
  Buffer Char
cbuf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
  if Buffer Char -> Bool
forall e. Buffer e -> Bool
isWriteBuffer Buffer Char
cbuf Bool -> Bool -> Bool
|| Buffer Char -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Char
cbuf then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () else do

  -- 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.
  (dec_state
codec_state, Buffer Word8
bbuf0) <- IORef (dec_state, Buffer Word8) -> IO (dec_state, Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (dec_state, Buffer Word8)
haLastDecode

  Buffer Char
cbuf0 <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
  IORef (Buffer Char) -> Buffer Char -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Char)
haCharBuffer Buffer Char
cbuf0{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }

  -- if we haven't used any characters from the char buffer, then just
  -- re-install the old byte buffer.
  if Buffer Char -> Int
forall e. Buffer e -> Int
bufL Buffer Char
cbuf0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
     then do IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf0
             () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else do

  case Maybe (TextDecoder dec_state)
haDecoder of
    Maybe (TextDecoder dec_state)
Nothing ->
      IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf0 { bufL :: Int
bufL = Buffer Word8 -> Int
forall e. Buffer e -> Int
bufL Buffer Word8
bbuf0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Buffer Char -> Int
forall e. Buffer e -> Int
bufL Buffer Char
cbuf0 }
      -- no decoder: the number of bytes to decode is the same as the
      -- number of chars we have used up.

    Just TextDecoder dec_state
decoder -> do
      FilePath -> IO ()
debugIO (FilePath
"flushCharReadBuffer re-decode, bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf0 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
               FilePath
" cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Char -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Char
cbuf0)

      -- restore the codec state
      TextDecoder dec_state -> dec_state -> IO ()
forall from to state. BufferCodec from to state -> state -> IO ()
setState TextDecoder dec_state
decoder dec_state
codec_state

      (Buffer Word8
bbuf1,Buffer Char
cbuf1) <- (TextDecoder dec_state
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
streamEncode TextDecoder dec_state
decoder) Buffer Word8
bbuf0
                               Buffer Char
cbuf0{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0, bufSize :: Int
bufSize = Buffer Char -> Int
forall e. Buffer e -> Int
bufL Buffer Char
cbuf0 }

      -- We should not need to update the offset here. The bytebuffer contains the
      -- offset for the next read after it's used up. But this function only flushes
      -- the char buffer.
      -- let bbuf2 = bbuf1 -- {bufOffset = bufOffset bbuf1 - fromIntegral (bufL bbuf1)}
      -- debugIO ("finished, bbuf=" ++ summaryBuffer bbuf2 ++
      --          " cbuf=" ++ summaryBuffer cbuf1)

      IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf1


-- 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 ()
flushByteReadBuffer :: Handle__ -> IO ()
flushByteReadBuffer h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
  Buffer Word8
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer

  if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
bbuf then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () else do

  Bool
seekable <- dev -> IO Bool
forall a. IODevice a => a -> IO Bool
IODevice.isSeekable dev
haDevice
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
seekable) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
forall a. IO a
ioe_cannotFlushNotSeekable

  let seek :: Int
seek = Int -> Int
forall a. Num a => a -> a
negate (Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
bbuf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Buffer Word8 -> Int
forall e. Buffer e -> Int
bufL Buffer Word8
bbuf)
  let offset :: Word64
offset = Buffer Word8 -> Word64
forall e. Buffer e -> Word64
bufOffset Buffer Word8
bbuf Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Buffer Word8 -> Int
forall e. Buffer e -> Int
bufR Buffer Word8
bbuf Int -> Int -> Int
forall a. Num a => a -> a -> a
- Buffer Word8 -> Int
forall e. Buffer e -> Int
bufL Buffer Word8
bbuf)

  FilePath -> IO ()
debugIO (FilePath
"flushByteReadBuffer: new file offset = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
seek)
  FilePath -> IO ()
debugIO (FilePath
"flushByteReadBuffer: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf)

  let mIOSeek :: IO Integer
mIOSeek   = dev -> SeekMode -> Integer -> IO Integer
forall a. IODevice a => a -> SeekMode -> Integer -> IO Integer
IODevice.seek dev
haDevice SeekMode
RelativeSeek (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seek)
  -- win-io doesn't need this, but it allows us to error out on invalid offsets
  let winIOSeek :: IO Integer
winIOSeek = dev -> SeekMode -> Integer -> IO Integer
forall a. IODevice a => a -> SeekMode -> Integer -> IO Integer
IODevice.seek dev
haDevice SeekMode
AbsoluteSeek (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset)

  Integer
_ <- IO Integer
mIOSeek IO Integer -> IO Integer -> IO Integer
forall a. a -> a -> a
<!> IO Integer
winIOSeek  -- execute one of these two seek functions

  IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0, bufOffset :: Word64
bufOffset=Word64
offset }

-- ----------------------------------------------------------------------------
-- Making Handles

{- Note [Making offsets for append]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  The WINIO subysstem keeps track of offsets for handles
  on the Haskell side of things instead of letting the OS
  handle it. This requires us to establish the correct offset
  for a handle on creation. This is usually zero but slightly
  more tedious for append modes. There we fall back on IODevice
  functionality to establish the size of the file and then set
  the offset accordingly. This is only required for WINIO.
-}

-- | Make an @'MVar' 'Handle__'@ for use in a 'Handle'. This function
-- does not install a finalizer; that must be done by the caller.
mkHandleMVar :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
         -> FilePath
         -> HandleType
         -> Bool                     -- buffered?
         -> Maybe TextEncoding
         -> NewlineMode
         -> Maybe (MVar Handle__)
         -> IO (MVar Handle__)
mkHandleMVar :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
mkHandleMVar dev
dev FilePath
filepath HandleType
ha_type Bool
buffered Maybe TextEncoding
mb_codec NewlineMode
nl Maybe (MVar Handle__)
other_side =
   Maybe TextEncoding
-> HandleType
-> (forall {es} {ds}.
    Maybe (TextEncoder es)
    -> Maybe (TextDecoder ds) -> IO (MVar Handle__))
-> IO (MVar Handle__)
forall a.
Maybe TextEncoding
-> HandleType
-> (forall es ds.
    Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
-> IO a
openTextEncoding Maybe TextEncoding
mb_codec HandleType
ha_type ((forall {es} {ds}.
  Maybe (TextEncoder es)
  -> Maybe (TextDecoder ds) -> IO (MVar Handle__))
 -> IO (MVar Handle__))
-> (forall {es} {ds}.
    Maybe (TextEncoder es)
    -> Maybe (TextDecoder ds) -> IO (MVar Handle__))
-> IO (MVar Handle__)
forall a b. (a -> b) -> a -> b
$ \ Maybe (TextEncoder es)
mb_encoder Maybe (TextDecoder ds)
mb_decoder -> do

   let !buf_state :: BufferState
buf_state = HandleType -> BufferState
initBufferState HandleType
ha_type
   !Buffer Word8
bbuf_no_offset <- (dev -> BufferState -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> BufferState -> IO (Buffer Word8)
Buffered.newBuffer dev
dev BufferState
buf_state)
   !Word64
buf_offset <- IO Word64
initHandleOffset
   let !bbuf :: Buffer Word8
bbuf = Buffer Word8
bbuf_no_offset { bufOffset :: Word64
bufOffset = Word64
buf_offset}

   IORef (Buffer Word8)
bbufref <- Buffer Word8 -> IO (IORef (Buffer Word8))
forall a. a -> IO (IORef a)
newIORef Buffer Word8
bbuf
   IORef (ds, Buffer Word8)
last_decode <- (ds, Buffer Word8) -> IO (IORef (ds, Buffer Word8))
forall a. a -> IO (IORef a)
newIORef (FilePath -> ds
forall a. FilePath -> a
errorWithoutStackTrace FilePath
"codec_state", Buffer Word8
bbuf)

   (IORef (Buffer Char)
cbufref,BufferMode
bmode) <-
         if Bool
buffered then dev -> BufferState -> IO (IORef (Buffer Char), BufferMode)
forall dev.
IODevice dev =>
dev -> BufferState -> IO (IORef (Buffer Char), BufferMode)
getCharBuffer dev
dev BufferState
buf_state
                     else BufferState -> IO (IORef (Buffer Char), BufferMode)
mkUnBuffer BufferState
buf_state

   IORef (BufferList Char)
spares <- BufferList Char -> IO (IORef (BufferList Char))
forall a. a -> IO (IORef a)
newIORef BufferList Char
forall e. BufferList e
BufferListNil
   FilePath -> IO ()
debugIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"making handle for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
filepath
   Handle__ -> IO (MVar Handle__)
forall a. a -> IO (MVar a)
newMVar (Handle__ -> IO (MVar Handle__)) -> Handle__ -> IO (MVar Handle__)
forall a b. (a -> b) -> a -> b
$ Handle__ { haDevice :: dev
haDevice = dev
dev,
                        haType :: HandleType
haType = HandleType
ha_type,
                        haBufferMode :: BufferMode
haBufferMode = BufferMode
bmode,
                        haByteBuffer :: IORef (Buffer Word8)
haByteBuffer = IORef (Buffer Word8)
bbufref,
                        haLastDecode :: IORef (ds, Buffer Word8)
haLastDecode = IORef (ds, Buffer Word8)
last_decode,
                        haCharBuffer :: IORef (Buffer Char)
haCharBuffer = IORef (Buffer Char)
cbufref,
                        haBuffers :: IORef (BufferList Char)
haBuffers = IORef (BufferList Char)
spares,
                        haEncoder :: Maybe (TextEncoder es)
haEncoder = Maybe (TextEncoder es)
mb_encoder,
                        haDecoder :: Maybe (TextDecoder ds)
haDecoder = Maybe (TextDecoder ds)
mb_decoder,
                        haCodec :: Maybe TextEncoding
haCodec = Maybe TextEncoding
mb_codec,
                        haInputNL :: Newline
haInputNL = NewlineMode -> Newline
inputNL NewlineMode
nl,
                        haOutputNL :: Newline
haOutputNL = NewlineMode -> Newline
outputNL NewlineMode
nl,
                        haOtherSide :: Maybe (MVar Handle__)
haOtherSide = Maybe (MVar Handle__)
other_side
                      }
  where
    -- See Note [Making offsets for append]
    initHandleOffset :: IO Word64
initHandleOffset
      | HandleType -> Bool
isAppendHandleType HandleType
ha_type
      , Bool
isWindowsNativeIO = do
          Integer
size <- dev -> IO Integer
forall a. IODevice a => a -> IO Integer
IODevice.getSize dev
dev
          Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size :: Word64)
      | Bool
otherwise = Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
0

mkHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
         -> FilePath
         -> HandleType
         -> Bool                     -- buffered?
         -> Maybe TextEncoding
         -> NewlineMode
         -> Maybe HandleFinalizer
         -> Maybe (MVar Handle__)
         -> IO Handle
mkHandle :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle dev
dev FilePath
filepath HandleType
ha_type Bool
buffered Maybe TextEncoding
mb_codec NewlineMode
nl Maybe HandleFinalizer
mb_finalizer Maybe (MVar Handle__)
other_side = do
  MVar Handle__
mv <- dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
mkHandleMVar dev
dev FilePath
filepath HandleType
ha_type Bool
buffered Maybe TextEncoding
mb_codec NewlineMode
nl Maybe (MVar Handle__)
other_side
  let handle :: Handle
handle = FilePath -> MVar Handle__ -> Handle
FileHandle FilePath
filepath MVar Handle__
mv
  case Maybe HandleFinalizer
mb_finalizer of
    Maybe HandleFinalizer
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just HandleFinalizer
finalizer -> Handle -> HandleFinalizer -> IO ()
addHandleFinalizer Handle
handle HandleFinalizer
finalizer
  Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
handle

-- | makes a new 'Handle' without a finalizer.
mkFileHandleNoFinalizer
             :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
             => 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
             -> Maybe TextEncoding
                    -- Create the 'Handle' with no text encoding?
             -> NewlineMode
                    -- Translate newlines?
             -> IO Handle
mkFileHandleNoFinalizer :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
mkFileHandleNoFinalizer dev
dev FilePath
filepath IOMode
iomode Maybe TextEncoding
mb_codec NewlineMode
tr_newlines = do
   MVar Handle__
mv <- dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
mkHandleMVar dev
dev FilePath
filepath (IOMode -> HandleType
ioModeToHandleType IOMode
iomode) Bool
True{-buffered-}
                      Maybe TextEncoding
mb_codec
                      NewlineMode
tr_newlines
                      Maybe (MVar Handle__)
forall a. Maybe a
Nothing{-other_side-}
   Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> MVar Handle__ -> Handle
FileHandle FilePath
filepath MVar Handle__
mv)

-- | makes a new 'Handle'
mkFileHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
             => 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
             -> Maybe TextEncoding
                    -- Create the 'Handle' with no text encoding?
             -> NewlineMode
                    -- Translate newlines?
             -> IO Handle

mkFileHandle :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
mkFileHandle dev
dev FilePath
filepath IOMode
iomode Maybe TextEncoding
mb_codec NewlineMode
tr_newlines = do
   Handle
h <- dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> IO Handle
mkFileHandleNoFinalizer dev
dev FilePath
filepath IOMode
iomode Maybe TextEncoding
mb_codec NewlineMode
tr_newlines
   Handle -> HandleFinalizer -> IO ()
addHandleFinalizer Handle
h HandleFinalizer
handleFinalizer
   Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
h

-- | 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.
mkDuplexHandleNoFinalizer ::
  (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
     => dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandleNoFinalizer :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandleNoFinalizer dev
dev FilePath
filepath Maybe TextEncoding
mb_codec NewlineMode
tr_newlines = do

  MVar Handle__
write_m <-
       dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
mkHandleMVar dev
dev FilePath
filepath HandleType
WriteHandle Bool
True Maybe TextEncoding
mb_codec
                        NewlineMode
tr_newlines
                        Maybe (MVar Handle__)
forall a. Maybe a
Nothing -- no other side

  MVar Handle__
read_m <-
      dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> FilePath
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe (MVar Handle__)
-> IO (MVar Handle__)
mkHandleMVar dev
dev FilePath
filepath HandleType
ReadHandle Bool
True Maybe TextEncoding
mb_codec
                        NewlineMode
tr_newlines
                        (MVar Handle__ -> Maybe (MVar Handle__)
forall a. a -> Maybe a
Just MVar Handle__
write_m)

  Handle -> IO Handle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> MVar Handle__ -> MVar Handle__ -> Handle
DuplexHandle FilePath
filepath MVar Handle__
read_m MVar Handle__
write_m)

-- | 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 :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
               -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandle :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandle dev
dev FilePath
filepath Maybe TextEncoding
mb_codec NewlineMode
tr_newlines = do
  Handle
handle <- dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
mkDuplexHandleNoFinalizer dev
dev FilePath
filepath Maybe TextEncoding
mb_codec NewlineMode
tr_newlines
  Handle -> HandleFinalizer -> IO ()
addHandleFinalizer Handle
handle HandleFinalizer
handleFinalizer
  Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
handle

ioModeToHandleType :: IOMode -> HandleType
ioModeToHandleType :: IOMode -> HandleType
ioModeToHandleType IOMode
ReadMode      = HandleType
ReadHandle
ioModeToHandleType IOMode
WriteMode     = HandleType
WriteHandle
ioModeToHandleType IOMode
ReadWriteMode = HandleType
ReadWriteHandle
ioModeToHandleType IOMode
AppendMode    = HandleType
AppendHandle

initBufferState :: HandleType -> BufferState
initBufferState :: HandleType -> BufferState
initBufferState HandleType
ReadHandle = BufferState
ReadBuffer
initBufferState HandleType
_          = BufferState
WriteBuffer

openTextEncoding
   :: Maybe TextEncoding
   -> HandleType
   -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
   -> IO a

openTextEncoding :: forall a.
Maybe TextEncoding
-> HandleType
-> (forall es ds.
    Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
-> IO a
openTextEncoding Maybe TextEncoding
Nothing   HandleType
ha_type forall es ds.
Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a
cont = Maybe (TextEncoder Any) -> Maybe (TextDecoder Any) -> IO a
forall es ds.
Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a
cont Maybe (TextEncoder Any)
forall a. Maybe a
Nothing Maybe (TextDecoder Any)
forall a. Maybe a
Nothing
openTextEncoding (Just TextEncoding{FilePath
IO (TextEncoder estate)
IO (TextDecoder dstate)
textEncodingName :: FilePath
mkTextDecoder :: IO (TextDecoder dstate)
mkTextEncoder :: IO (TextEncoder estate)
textEncodingName :: TextEncoding -> FilePath
mkTextDecoder :: ()
mkTextEncoder :: ()
..}) HandleType
ha_type forall es ds.
Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a
cont = do
    Maybe (TextDecoder dstate)
mb_decoder <- if HandleType -> Bool
isReadableHandleType HandleType
ha_type then do
                     TextDecoder dstate
decoder <- IO (TextDecoder dstate)
mkTextDecoder
                     Maybe (TextDecoder dstate) -> IO (Maybe (TextDecoder dstate))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TextDecoder dstate -> Maybe (TextDecoder dstate)
forall a. a -> Maybe a
Just TextDecoder dstate
decoder)
                  else
                     Maybe (TextDecoder dstate) -> IO (Maybe (TextDecoder dstate))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TextDecoder dstate)
forall a. Maybe a
Nothing
    Maybe (TextEncoder estate)
mb_encoder <- if HandleType -> Bool
isWritableHandleType HandleType
ha_type then do
                     TextEncoder estate
encoder <- IO (TextEncoder estate)
mkTextEncoder
                     Maybe (TextEncoder estate) -> IO (Maybe (TextEncoder estate))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TextEncoder estate -> Maybe (TextEncoder estate)
forall a. a -> Maybe a
Just TextEncoder estate
encoder)
                  else
                     Maybe (TextEncoder estate) -> IO (Maybe (TextEncoder estate))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (TextEncoder estate)
forall a. Maybe a
Nothing
    Maybe (TextEncoder estate) -> Maybe (TextDecoder dstate) -> IO a
forall es ds.
Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a
cont Maybe (TextEncoder estate)
mb_encoder Maybe (TextDecoder dstate)
mb_decoder

closeTextCodecs :: Handle__ -> IO ()
closeTextCodecs :: Handle__ -> IO ()
closeTextCodecs Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
  case Maybe (TextDecoder dec_state)
haDecoder of Maybe (TextDecoder dec_state)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (); Just TextDecoder dec_state
d -> TextDecoder dec_state -> IO ()
forall from to state. BufferCodec from to state -> IO ()
Encoding.close TextDecoder dec_state
d
  case Maybe (TextEncoder enc_state)
haEncoder of Maybe (TextEncoder enc_state)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (); Just TextEncoder enc_state
d -> TextEncoder enc_state -> IO ()
forall from to state. BufferCodec from to state -> IO ()
Encoding.close TextEncoder enc_state
d

-- ---------------------------------------------------------------------------
-- Closing a handle

-- | This function exists temporarily to avoid an unused import warning in
-- `bytestring`.
hClose_impl :: Handle -> IO ()
hClose_impl :: Handle -> IO ()
hClose_impl h :: Handle
h@(FileHandle FilePath
_ MVar Handle__
m)     = do
  Maybe SomeException
mb_exc <- Handle -> MVar Handle__ -> IO (Maybe SomeException)
hClose' Handle
h MVar Handle__
m
  Maybe SomeException -> Handle -> IO ()
hClose_maybethrow Maybe SomeException
mb_exc Handle
h
hClose_impl h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
r MVar Handle__
w) = do
  [Maybe SomeException]
excs <- (MVar Handle__ -> IO (Maybe SomeException))
-> [MVar Handle__] -> IO [Maybe SomeException]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Handle -> MVar Handle__ -> IO (Maybe SomeException)
hClose' Handle
h) [MVar Handle__
r,MVar Handle__
w]
  Maybe SomeException -> Handle -> IO ()
hClose_maybethrow ([SomeException] -> Maybe SomeException
forall a. [a] -> Maybe a
listToMaybe ([Maybe SomeException] -> [SomeException]
forall a. [Maybe a] -> [a]
catMaybes [Maybe SomeException]
excs)) Handle
h

hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
hClose_maybethrow Maybe SomeException
Nothing  Handle
h = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hClose_maybethrow (Just SomeException
e) Handle
h = SomeException -> Handle -> IO ()
hClose_rethrow SomeException
e Handle
h

hClose_rethrow :: SomeException -> Handle -> IO ()
hClose_rethrow :: SomeException -> Handle -> IO ()
hClose_rethrow SomeException
e Handle
h =
  case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just IOException
ioe -> IOException -> IO ()
forall a. IOException -> IO a
ioError (IOException -> FilePath -> Handle -> IOException
augmentIOError IOException
ioe FilePath
"hClose" Handle
h)
    Maybe IOException
Nothing  -> SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
e

hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
hClose' Handle
h MVar Handle__
m = FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, Maybe SomeException))
-> IO (Maybe SomeException)
forall a.
FilePath
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' FilePath
"hClose" Handle
h MVar Handle__
m ((Handle__ -> IO (Handle__, Maybe SomeException))
 -> IO (Maybe SomeException))
-> (Handle__ -> IO (Handle__, Maybe SomeException))
-> IO (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help

-- 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__, Maybe SomeException)
hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help Handle__
handle_ =
  case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle -> (Handle__, Maybe SomeException)
-> IO (Handle__, Maybe SomeException)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
handle_,Maybe SomeException
forall a. Maybe a
Nothing)
      HandleType
_ -> do Maybe SomeException
mb_exc1 <- IO () -> IO (Maybe SomeException)
trymaybe (IO () -> IO (Maybe SomeException))
-> IO () -> IO (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushWriteBuffer Handle__
handle_ -- interruptible
                    -- it is important that hClose doesn't fail and
                    -- leave the Handle open (#3128), so we catch
                    -- exceptions when flushing the buffer.
              (Handle__
h_, Maybe SomeException
mb_exc2) <- Handle__ -> IO (Handle__, Maybe SomeException)
hClose_handle_ Handle__
handle_
              (Handle__, Maybe SomeException)
-> IO (Handle__, Maybe SomeException)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
h_, if Maybe SomeException -> Bool
forall a. Maybe a -> Bool
isJust Maybe SomeException
mb_exc1 then Maybe SomeException
mb_exc1 else Maybe SomeException
mb_exc2)


trymaybe :: IO () -> IO (Maybe SomeException)
trymaybe :: IO () -> IO (Maybe SomeException)
trymaybe IO ()
io = (do IO ()
io; Maybe SomeException -> IO (Maybe SomeException)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SomeException
forall a. Maybe a
Nothing) IO (Maybe SomeException)
-> (SomeException -> IO (Maybe SomeException))
-> IO (Maybe SomeException)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` \SomeException
e -> Maybe SomeException -> IO (Maybe SomeException)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e)

hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_handle_ h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar 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 SomeException
maybe_exception <-
      case Maybe (MVar Handle__)
haOtherSide of
        Maybe (MVar Handle__)
Nothing -> IO () -> IO (Maybe SomeException)
trymaybe (IO () -> IO (Maybe SomeException))
-> IO () -> IO (Maybe SomeException)
forall a b. (a -> b) -> a -> b
$ dev -> IO ()
forall a. IODevice a => a -> IO ()
IODevice.close dev
haDevice
        Just MVar Handle__
_  -> Maybe SomeException -> IO (Maybe SomeException)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SomeException
forall a. Maybe a
Nothing

    -- free the spare buffers
    IORef (BufferList Char) -> BufferList Char -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (BufferList Char)
haBuffers BufferList Char
forall e. BufferList e
BufferListNil
    IORef (Buffer Char) -> Buffer Char -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Char)
haCharBuffer Buffer Char
noCharBuffer
    IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
noByteBuffer

    -- release our encoder/decoder
    Handle__ -> IO ()
closeTextCodecs Handle__
h_

    -- 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 wildcards
    (Handle__, Maybe SomeException)
-> IO (Handle__, Maybe SomeException)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{ haType :: HandleType
haType = HandleType
ClosedHandle, dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
haDevice :: dev
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haDevice :: dev
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
.. }, Maybe SomeException
maybe_exception)

{-# NOINLINE noCharBuffer #-}
noCharBuffer :: CharBuffer
noCharBuffer :: Buffer Char
noCharBuffer = IO (Buffer Char) -> Buffer Char
forall a. IO a -> a
unsafePerformIO (IO (Buffer Char) -> Buffer Char)
-> IO (Buffer Char) -> Buffer Char
forall a b. (a -> b) -> a -> b
$ Int -> BufferState -> IO (Buffer Char)
newCharBuffer Int
1 BufferState
ReadBuffer

{-# NOINLINE noByteBuffer #-}
noByteBuffer :: Buffer Word8
noByteBuffer :: Buffer Word8
noByteBuffer = IO (Buffer Word8) -> Buffer Word8
forall a. IO a -> a
unsafePerformIO (IO (Buffer Word8) -> Buffer Word8)
-> IO (Buffer Word8) -> Buffer Word8
forall a b. (a -> b) -> a -> b
$ Int -> BufferState -> IO (Buffer Word8)
newByteBuffer Int
1 BufferState
ReadBuffer

-- ---------------------------------------------------------------------------
-- Looking ahead

hLookAhead_ :: Handle__ -> IO Char
hLookAhead_ :: Handle__ -> IO Char
hLookAhead_ handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} = do
    Buffer Char
buf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer

    -- fill up the read buffer if necessary
    Buffer Char
new_buf <- if Buffer Char -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Char
buf
                  then Handle__ -> Buffer Char -> IO (Buffer Char)
readTextDevice Handle__
handle_ Buffer Char
buf
                  else Buffer Char -> IO (Buffer Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Char
buf
    IORef (Buffer Char) -> Buffer Char -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Char)
haCharBuffer Buffer Char
new_buf

    RawCharBuffer -> Int -> IO Char
peekCharBuf (Buffer Char -> RawCharBuffer
forall e. Buffer e -> RawBuffer e
bufRaw Buffer Char
buf) (Buffer Char -> Int
forall e. Buffer e -> Int
bufL Buffer Char
buf)

-- ---------------------------------------------------------------------------
-- debugging

debugIO :: String -> IO ()
-- debugIO s = traceEventIO s
debugIO :: FilePath -> IO ()
debugIO FilePath
s
 | Bool
c_DEBUG_DUMP
    = do CSsize
_ <- FilePath -> (CStringLen -> IO CSsize) -> IO CSsize
forall a. FilePath -> (CStringLen -> IO a) -> IO a
withCStringLen (FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") ((CStringLen -> IO CSsize) -> IO CSsize)
-> (CStringLen -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$
                  \(Ptr CChar
p, Int
len) -> CInt -> Ptr Word8 -> CSize -> IO CSsize
c_write CInt
1 (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
         () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
 | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- For development, like debugIO but always on.
traceIO :: String -> IO ()
traceIO :: FilePath -> IO ()
traceIO FilePath
s = do
         CSsize
_ <- FilePath -> (CStringLen -> IO CSsize) -> IO CSsize
forall a. FilePath -> (CStringLen -> IO a) -> IO a
withCStringLen (FilePath
s FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") ((CStringLen -> IO CSsize) -> IO CSsize)
-> (CStringLen -> IO CSsize) -> IO CSsize
forall a b. (a -> b) -> a -> b
$
                  \(Ptr CChar
p, Int
len) -> CInt -> Ptr Word8 -> CSize -> IO CSsize
c_write CInt
1 (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
         () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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 -> IO CharBuffer
readTextDevice :: Handle__ -> Buffer Char -> IO (Buffer Char)
readTextDevice h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} Buffer Char
cbuf = do
  --
  Buffer Word8
bbuf0 <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer

  FilePath -> IO ()
debugIO (FilePath
"readTextDevice: cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Char -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Char
cbuf FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FilePath
" bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf0)

  Buffer Word8
bbuf1 <- if Bool -> Bool
not (Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
bbuf0)
              then Buffer Word8 -> IO (Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
bbuf0
              else do
                   FilePath -> IO ()
debugIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"readBuf at " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Word64 -> FilePath
forall a. Show a => a -> FilePath
show (Buffer Word8 -> Word64
forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf0)
                   (Int
r,Buffer Word8
bbuf1) <- dev -> Buffer Word8 -> IO (Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
bbuf0
                   FilePath -> IO ()
debugIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"readBuf after " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Word64 -> FilePath
forall a. Show a => a -> FilePath
show (Buffer Word8 -> Word64
forall e. Buffer e -> Word64
bufferOffset Buffer Word8
bbuf1)
                   if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then IO (Buffer Word8)
forall a. IO a
ioe_EOF else do  -- raise EOF
                   Buffer Word8 -> IO (Buffer Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
bbuf1

  FilePath -> IO ()
debugIO (FilePath
"readTextDevice after reading: bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf1)

  (Buffer Word8
bbuf2,Buffer Char
cbuf') <-
      case Maybe (TextDecoder dec_state)
haDecoder of
          Maybe (TextDecoder dec_state)
Nothing      -> do
               IORef (dec_state, Buffer Word8)
-> (dec_state, Buffer Word8) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (dec_state, Buffer Word8)
haLastDecode (FilePath -> dec_state
forall a. FilePath -> a
errorWithoutStackTrace FilePath
"codec_state", Buffer Word8
bbuf1)
               Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
latin1_decode Buffer Word8
bbuf1 Buffer Char
cbuf
          Just TextDecoder dec_state
decoder -> do
               dec_state
state <- TextDecoder dec_state -> IO dec_state
forall from to state. BufferCodec from to state -> IO state
getState TextDecoder dec_state
decoder
               IORef (dec_state, Buffer Word8)
-> (dec_state, Buffer Word8) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (dec_state, Buffer Word8)
haLastDecode (dec_state
state, Buffer Word8
bbuf1)
               (TextDecoder dec_state
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
streamEncode TextDecoder dec_state
decoder) Buffer Word8
bbuf1 Buffer Char
cbuf

  FilePath -> IO ()
debugIO (FilePath
"readTextDevice after decoding: cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Char -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Char
cbuf' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
        FilePath
" bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf2)

  -- We can't return from readTextDevice without reading at least a single extra character,
  -- so check that we have managed to achieve that
  IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf2
  if Buffer Char -> Int
forall e. Buffer e -> Int
bufR Buffer Char
cbuf' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer Char -> Int
forall e. Buffer e -> Int
bufR Buffer Char
cbuf
     -- 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//IGNORE
     then Handle__ -> Buffer Word8 -> Buffer Char -> IO (Buffer Char)
readTextDevice' Handle__
h_ Buffer Word8
bbuf2 Buffer Char
cbuf
     else Buffer Char -> IO (Buffer Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Char
cbuf'

-- we have an incomplete byte sequence at the end of the buffer: try to
-- read more bytes.
readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
readTextDevice' :: Handle__ -> Buffer Word8 -> Buffer Char -> IO (Buffer Char)
readTextDevice' h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} Buffer Word8
bbuf0 Buffer Char
cbuf0 = do
  --
  -- copy the partial sequence to the beginning of the buffer, so we have
  -- room to read more bytes.
  Buffer Word8
bbuf1 <- Buffer Word8 -> IO (Buffer Word8)
slideContents Buffer Word8
bbuf0

  -- 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.
  let Just TextDecoder dec_state
decoder = Maybe (TextDecoder dec_state)
haDecoder

  (Int
r,Buffer Word8
bbuf2) <- dev -> Buffer Word8 -> IO (Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
bbuf1
  if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
   then do
     -- 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 characters
     if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
bbuf2 then IO (Buffer Char)
forall a. IO a
ioe_EOF else do
     (Buffer Word8
bbuf3, Buffer Char
cbuf1) <- TextDecoder dec_state
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
recover TextDecoder dec_state
decoder Buffer Word8
bbuf2 Buffer Char
cbuf0
     FilePath -> IO ()
debugIO (FilePath
"readTextDevice' after recovery: bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf3 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Char -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Char
cbuf1)
     IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf3
     -- 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.
     if Buffer Char -> Int
forall e. Buffer e -> Int
bufR Buffer Char
cbuf1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer Char -> Int
forall e. Buffer e -> Int
bufR Buffer Char
cbuf0
      then Handle__ -> Buffer Char -> IO (Buffer Char)
readTextDevice Handle__
h_ Buffer Char
cbuf1
      else Buffer Char -> IO (Buffer Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Char
cbuf1
   else do
    FilePath -> IO ()
debugIO (FilePath
"readTextDevice' after reading: bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf2)

    (Buffer Word8
bbuf3,Buffer Char
cbuf1) <- do
       dec_state
state <- TextDecoder dec_state -> IO dec_state
forall from to state. BufferCodec from to state -> IO state
getState TextDecoder dec_state
decoder
       IORef (dec_state, Buffer Word8)
-> (dec_state, Buffer Word8) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (dec_state, Buffer Word8)
haLastDecode (dec_state
state, Buffer Word8
bbuf2)
       (TextDecoder dec_state
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
streamEncode TextDecoder dec_state
decoder) Buffer Word8
bbuf2 Buffer Char
cbuf0

    FilePath -> IO ()
debugIO (FilePath
"readTextDevice' after decoding: cbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Char -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Char
cbuf1 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
          FilePath
" bbuf=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Buffer Word8 -> FilePath
forall a. Buffer a -> FilePath
summaryBuffer Buffer Word8
bbuf3)

    IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf3
    if Buffer Char -> Int
forall e. Buffer e -> Int
bufR Buffer Char
cbuf0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer Char -> Int
forall e. Buffer e -> Int
bufR Buffer Char
cbuf1
       then Handle__ -> Buffer Word8 -> Buffer Char -> IO (Buffer Char)
readTextDevice' Handle__
h_ Buffer Word8
bbuf3 Buffer Char
cbuf1
       else Buffer Char -> IO (Buffer Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Char
cbuf1

-- Read characters into the provided buffer.  Do not block;
-- return zero characters instead.  Raises an exception on end-of-file.
readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
readTextDeviceNonBlocking :: Handle__ -> Buffer Char -> IO (Buffer Char)
readTextDeviceNonBlocking h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} Buffer Char
cbuf = do
  --
  Buffer Word8
bbuf0 <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
bbuf0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
     (Maybe Int
r,Buffer Word8
bbuf1) <- dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
Buffered.fillReadBuffer0 dev
haDevice Buffer Word8
bbuf0
     if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
r then IO ()
forall a. IO a
ioe_EOF else do  -- raise EOF
     IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf1

  Handle__ -> Buffer Char -> IO (Buffer Char)
decodeByteBuf Handle__
h_ Buffer Char
cbuf

-- Decode bytes from the byte buffer into the supplied CharBuffer.
decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
decodeByteBuf :: Handle__ -> Buffer Char -> IO (Buffer Char)
decodeByteBuf h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBufferMode :: Handle__ -> BufferMode
haLastDecode :: ()
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haBuffers :: Handle__ -> IORef (BufferList Char)
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 Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} Buffer Char
cbuf = do
  --
  Buffer Word8
bbuf0 <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer

  (Buffer Word8
bbuf2,Buffer Char
cbuf') <-
      case Maybe (TextDecoder dec_state)
haDecoder of
          Maybe (TextDecoder dec_state)
Nothing      -> do
               IORef (dec_state, Buffer Word8)
-> (dec_state, Buffer Word8) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (dec_state, Buffer Word8)
haLastDecode (FilePath -> dec_state
forall a. FilePath -> a
errorWithoutStackTrace FilePath
"codec_state", Buffer Word8
bbuf0)
               Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
latin1_decode Buffer Word8
bbuf0 Buffer Char
cbuf
          Just TextDecoder dec_state
decoder -> do
               dec_state
state <- TextDecoder dec_state -> IO dec_state
forall from to state. BufferCodec from to state -> IO state
getState TextDecoder dec_state
decoder
               IORef (dec_state, Buffer Word8)
-> (dec_state, Buffer Word8) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (dec_state, Buffer Word8)
haLastDecode (dec_state
state, Buffer Word8
bbuf0)
               (TextDecoder dec_state
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
forall from to state.
BufferCodec from to state
-> Buffer from -> Buffer to -> IO (Buffer from, Buffer to)
streamEncode TextDecoder dec_state
decoder) Buffer Word8
bbuf0 Buffer Char
cbuf

  IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf2
  Buffer Char -> IO (Buffer Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Char
cbuf'