{-# 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.Internal.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.Internal.IO
import GHC.Internal.IO.IOMode
import GHC.Internal.IO.Encoding as Encoding
import GHC.Internal.IO.Encoding.Types (CodeBuffer)
import GHC.Internal.IO.Handle.Types
import GHC.Internal.IO.Buffer
import GHC.Internal.IO.BufferedIO (BufferedIO)
import GHC.Internal.IO.Exception
import GHC.Internal.IO.Device (IODevice, RawIO, SeekMode(..))
import GHC.Internal.IO.SubSystem ((<!>), isWindowsNativeIO)
import qualified GHC.Internal.IO.Device as IODevice
import qualified GHC.Internal.IO.BufferedIO as Buffered
import GHC.Internal.Conc.Sync
import GHC.Internal.Real
import GHC.Internal.Word
import GHC.Internal.Base
import GHC.Internal.Exception
import GHC.Internal.Num ( Num(..) )
import GHC.Internal.Show
import GHC.Internal.IORef
import GHC.Internal.MVar
import GHC.Internal.Ptr (castPtr)
import GHC.Internal.Data.Typeable
import GHC.Internal.Data.Maybe
import GHC.Internal.System.Posix.Internals hiding (FD)
import GHC.Internal.Foreign.C.String
c_DEBUG_DUMP :: Bool
c_DEBUG_DUMP :: Bool
c_DEBUG_DUMP = Bool
False
type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
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)
{-# 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
(h',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
checkHandleInvariants h'
putMVar m h'
return 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 <- Handle__ -> IO a
act Handle__
h_
return (h_,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
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
checkHandleInvariants h'
putMVar m h'
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
h_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
checkHandleInvariants h_
act h_ `catchException` handler 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
let SomeAsyncException
_ = SomeAsyncException
async_ex :: SomeAsyncException
t <- IO ThreadId
myThreadId
throwTo t e
do_operation fun h act m
()
_otherwise ->
SomeException -> IO a
forall e a. (?callStack::CallStack, Exception e) => e -> IO a
throwIO SomeException
e
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 = Just h, ioe_location = fun, ioe_filename = 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
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
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__)
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
..}
= 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
buf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
when (not (isWriteBuffer buf)) $ do
flushCharReadBuffer h_
flushByteReadBuffer h_
buf <- readIORef haCharBuffer
writeIORef haCharBuffer buf{ bufState = WriteBuffer }
buf <- readIORef haByteBuffer
buf' <- Buffered.emptyWriteBuffer haDevice buf
writeIORef haByteBuffer buf'
act h_
HandleType
AppendHandle -> Handle__ -> IO a
act Handle__
h_
HandleType
WriteHandle -> Handle__ -> IO a
act Handle__
h_
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
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
when (isWriteBuffer bbuf) $ do
when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_
cbuf' <- readIORef haCharBuffer
writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
bbuf <- readIORef haByteBuffer
writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
act h_
HandleType
_other -> Handle__ -> IO a
act Handle__
h_
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. (?callStack::CallStack) => 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 b <- dev -> IO Bool
forall a. IODevice a => a -> IO Bool
IODevice.isSeekable dev
dev
if b then act handle_
else ioe_notSeekable
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. (?callStack::CallStack) => 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. (?callStack::CallStack) => 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. (?callStack::CallStack) => 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. (?callStack::CallStack) => 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. (?callStack::CallStack) => 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. (?callStack::CallStack) => 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. (?callStack::CallStack) => 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. (?callStack::CallStack, 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. (?callStack::CallStack) => 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)
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
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
(why, from', 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
case 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
(from', 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'
go from' 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')
handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
handleFinalizer :: HandleFinalizer
handleFinalizer FilePath
fp MVar Handle__
m = do
handle_ <- MVar Handle__ -> IO Handle__
forall a. MVar a -> IO a
takeMVar MVar Handle__
m
(handle_', mb_exc) <- hClose_help handle_
putMVar m handle_'
case mb_exc of
Just SomeException
exc -> SomeException -> IO ()
forall e a. (?callStack::CallStack, Exception e) => e -> IO a
throwIO SomeException
exc
Maybe SomeException
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
dEFAULT_CHAR_BUFFER_SIZE :: Int
dEFAULT_CHAR_BUFFER_SIZE :: Int
dEFAULT_CHAR_BUFFER_SIZE = Int
2048
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 <- Int -> BufferState -> IO (Buffer Char)
newCharBuffer Int
dEFAULT_CHAR_BUFFER_SIZE BufferState
state
ioref <- newIORef buffer
is_tty <- IODevice.isTerminal dev
let buffer_mode
| Bool
is_tty = BufferMode
LineBuffering
| Bool
otherwise = Maybe Int -> BufferMode
BlockBuffering Maybe Int
forall a. Maybe a
Nothing
return (ioref, buffer_mode)
mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
mkUnBuffer :: BufferState -> IO (IORef (Buffer Char), BufferMode)
mkUnBuffer BufferState
state = do
buffer <- Int -> BufferState -> IO (Buffer Char)
newCharBuffer Int
dEFAULT_CHAR_BUFFER_SIZE BufferState
state
ref <- newIORef buffer
return (ref, NoBuffering)
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
buf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
case bufState buf of
BufferState
ReadBuffer -> do
Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
Handle__ -> IO ()
flushByteReadBuffer Handle__
h_
BufferState
WriteBuffer ->
Handle__ -> IO ()
flushByteWriteBuffer Handle__
h_
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
cbuf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
case bufState cbuf of
BufferState
ReadBuffer ->
Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
BufferState
WriteBuffer ->
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. (?callStack::CallStack) => FilePath -> a
error FilePath
"internal IO library error: Char buffer non-empty"
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
buf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
when (isWriteBuffer buf) $ flushByteWriteBuffer 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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
when (not (isEmptyBuffer bbuf)) $ do
bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
debugIO ("flushByteWriteBuffer: bbuf=" ++ summaryBuffer bbuf')
writeIORef haByteBuffer bbuf'
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf ++
" bbuf=" ++ summaryBuffer bbuf)
(cbuf',bbuf') <- case 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
debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++
" bbuf=" ++ summaryBuffer bbuf')
if isFullBuffer bbuf'
|| not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf
|| (case 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
bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'
writeIORef haByteBuffer bbuf''
debugIO ("writeCharBuffer after flushing: cbuf=" ++ summaryBuffer bbuf'')
else
writeIORef haByteBuffer bbuf'
if not (isEmptyBuffer cbuf')
then writeCharBuffer h_ cbuf'
else return ()
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
cbuf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
(codec_state, bbuf0) <- readIORef haLastDecode
cbuf0 <- readIORef haCharBuffer
writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
if bufL cbuf0 == 0
then do writeIORef haByteBuffer bbuf0
return ()
else do
case 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 = bufL bbuf0 + bufL cbuf0 }
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)
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
(bbuf1,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=0, bufR=0, bufSize = bufL cbuf0 }
writeIORef haByteBuffer bbuf1
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
if isEmptyBuffer bbuf then return () else do
seekable <- IODevice.isSeekable haDevice
when (not seekable) $ ioe_cannotFlushNotSeekable
let 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 = 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)
debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
debugIO ("flushByteReadBuffer: " ++ summaryBuffer bbuf)
let 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)
let 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)
_ <- mIOSeek <!> winIOSeek
writeIORef haByteBuffer bbuf{ bufL=0, bufR=0, bufOffset=offset }
mkHandleMVar :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
-> FilePath
-> HandleType
-> Bool
-> 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 (BufferCodec Char Word8 es)
-> Maybe (BufferCodec Word8 Char 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 (BufferCodec Char Word8 es)
-> Maybe (BufferCodec Word8 Char ds) -> IO (MVar Handle__))
-> IO (MVar Handle__))
-> (forall es ds.
Maybe (BufferCodec Char Word8 es)
-> Maybe (BufferCodec Word8 Char 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
!bbuf_no_offset <- (dev -> BufferState -> IO (Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> BufferState -> IO (Buffer Word8)
Buffered.newBuffer dev
dev BufferState
buf_state)
!buf_offset <- initHandleOffset
let !bbuf = Buffer Word8
bbuf_no_offset { bufOffset = buf_offset}
bbufref <- newIORef bbuf
last_decode <- newIORef (errorWithoutStackTrace "codec_state", bbuf)
(cbufref,bmode) <-
if buffered then getCharBuffer dev buf_state
else mkUnBuffer buf_state
spares <- newIORef BufferListNil
debugIO $ "making handle for " ++ filepath
newMVar $ Handle__ { haDevice = dev,
haType = ha_type,
haBufferMode = bmode,
haByteBuffer = bbufref,
haLastDecode = last_decode,
haCharBuffer = cbufref,
haBuffers = spares,
haEncoder = mb_encoder,
haDecoder = mb_decoder,
haCodec = mb_codec,
haInputNL = inputNL nl,
haOutputNL = outputNL nl,
haOtherSide = other_side
}
where
initHandleOffset :: IO Word64
initHandleOffset
| HandleType -> Bool
isAppendHandleType HandleType
ha_type
, Bool
isWindowsNativeIO = do
size <- dev -> IO Integer
forall a. IODevice a => a -> IO Integer
IODevice.getSize dev
dev
return (fromIntegral 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
-> 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
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 = FilePath -> MVar Handle__ -> Handle
FileHandle FilePath
filepath MVar Handle__
mv
case 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
pure handle
mkFileHandleNoFinalizer
:: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
=> dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> 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
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
Maybe TextEncoding
mb_codec
NewlineMode
tr_newlines
Maybe (MVar Handle__)
forall a. Maybe a
Nothing
pure (FileHandle filepath mv)
mkFileHandle :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev)
=> dev
-> FilePath
-> IOMode
-> Maybe TextEncoding
-> NewlineMode
-> 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
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
addHandleFinalizer h handleFinalizer
pure h
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
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
read_m <-
mkHandleMVar dev filepath ReadHandle True mb_codec
tr_newlines
(Just write_m)
return (DuplexHandle filepath read_m write_m)
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 <- 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
addHandleFinalizer handle handleFinalizer
pure 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)
mkTextEncoder :: ()
mkTextDecoder :: ()
textEncodingName :: TextEncoding -> FilePath
..}) HandleType
ha_type forall es ds.
Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a
cont = do
mb_decoder <- if HandleType -> Bool
isReadableHandleType HandleType
ha_type then do
decoder <- IO (TextDecoder dstate)
mkTextDecoder
return (Just 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
mb_encoder <- if isWritableHandleType ha_type then do
encoder <- mkTextEncoder
return (Just encoder)
else
return Nothing
cont mb_encoder 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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
hClose_impl :: Handle -> IO ()
hClose_impl :: Handle -> IO ()
hClose_impl h :: Handle
h@(FileHandle FilePath
_ MVar Handle__
m) = do
mb_exc <- Handle -> MVar Handle__ -> IO (Maybe SomeException)
hClose' Handle
h MVar Handle__
m
hClose_maybethrow mb_exc h
hClose_impl h :: Handle
h@(DuplexHandle FilePath
_ MVar Handle__
r MVar Handle__
w) = do
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]
hClose_maybethrow (listToMaybe (catMaybes excs)) 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. (?callStack::CallStack, 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 :: 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 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_
(h_, mb_exc2) <- hClose_handle_ handle_
return (h_, if isJust mb_exc1 then mb_exc1 else 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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
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
writeIORef haBuffers BufferListNil
writeIORef haCharBuffer noCharBuffer
writeIORef haByteBuffer noByteBuffer
closeTextCodecs h_
return (Handle__{ haType = ClosedHandle, .. }, 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
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
buf <- IORef (Buffer Char) -> IO (Buffer Char)
forall a. IORef a -> IO a
readIORef IORef (Buffer Char)
haCharBuffer
new_buf <- if isEmptyBuffer buf
then readTextDevice handle_ buf
else return buf
writeIORef haCharBuffer new_buf
peekCharBuf (bufRaw buf) (bufL buf)
debugIO :: String -> IO ()
debugIO :: FilePath -> IO ()
debugIO FilePath
s
| Bool
c_DEBUG_DUMP
= do _ <- 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)
return ()
| Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
traceIO :: String -> IO ()
traceIO :: FilePath -> IO ()
traceIO FilePath
s = do
_ <- 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)
return ()
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf0 <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
" bbuf=" ++ summaryBuffer bbuf0)
bbuf1 <- if not (isEmptyBuffer bbuf0)
then return bbuf0
else do
debugIO $ "readBuf at " ++ show (bufferOffset bbuf0)
(r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
debugIO $ "readBuf after " ++ show (bufferOffset bbuf1)
if r == 0 then ioe_EOF else do
return bbuf1
debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
(bbuf2,cbuf') <-
case 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
state <- TextDecoder dec_state -> IO dec_state
forall from to state. BufferCodec from to state -> IO state
getState TextDecoder dec_state
decoder
writeIORef haLastDecode (state, bbuf1)
(streamEncode decoder) bbuf1 cbuf
debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
" bbuf=" ++ summaryBuffer bbuf2)
writeIORef haByteBuffer bbuf2
if bufR cbuf' == bufR cbuf
then readTextDevice' h_ bbuf2 cbuf
else return cbuf'
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf1 <- Buffer Word8 -> IO (Buffer Word8)
slideContents Buffer Word8
bbuf0
let Just decoder = haDecoder
(r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
if r == 0
then do
if isEmptyBuffer bbuf2 then ioe_EOF else do
(bbuf3, cbuf1) <- recover decoder bbuf2 cbuf0
debugIO ("readTextDevice' after recovery: bbuf=" ++ summaryBuffer bbuf3 ++ ", cbuf=" ++ summaryBuffer cbuf1)
writeIORef haByteBuffer bbuf3
if bufR cbuf1 == bufR cbuf0
then readTextDevice h_ cbuf1
else return cbuf1
else do
debugIO ("readTextDevice' after reading: bbuf=" ++ summaryBuffer bbuf2)
(bbuf3,cbuf1) <- do
state <- getState decoder
writeIORef haLastDecode (state, bbuf2)
(streamEncode decoder) bbuf2 cbuf0
debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf1 ++
" bbuf=" ++ summaryBuffer bbuf3)
writeIORef haByteBuffer bbuf3
if bufR cbuf0 == bufR cbuf1
then readTextDevice' h_ bbuf3 cbuf1
else return cbuf1
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf0 <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
when (isEmptyBuffer bbuf0) $ do
(r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
if isNothing r then ioe_EOF else do
writeIORef haByteBuffer bbuf1
decodeByteBuf h_ cbuf
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
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
haDevice :: ()
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
bbuf0 <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
(bbuf2,cbuf') <-
case 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
state <- TextDecoder dec_state -> IO dec_state
forall from to state. BufferCodec from to state -> IO state
getState TextDecoder dec_state
decoder
writeIORef haLastDecode (state, bbuf0)
(streamEncode decoder) bbuf0 cbuf
writeIORef haByteBuffer bbuf2
return cbuf'