-{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -fno-warn-unused-matches #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_HADDOCK hide #-}
#undef DEBUG_DUMP
stdin, stdout, stderr,
IOMode(..), openFile, openBinaryFile, fdToHandle_stat, fdToHandle, fdToHandle',
- hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
+ hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead, hLookAhead', hSetBuffering, hSetBinaryMode,
hFlush, hDuplicate, hDuplicateTo,
hClose, hClose_help,
) where
import Control.Monad
-import Data.Bits
import Data.Maybe
import Foreign
import Foreign.C
import GHC.IOBase
import GHC.Exception
import GHC.Enum
-import GHC.Num ( Integer(..), Num(..) )
+import GHC.Num ( Integer, Num(..) )
import GHC.Show
-import GHC.Real ( toInteger )
#if defined(DEBUG_DUMP)
import GHC.Pack
#endif
-- Are files opened by default in text or binary mode, if the user doesn't
-- specify?
-dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE :: Bool
+dEFAULT_OPEN_IN_BINARY_MODE = False
-- ---------------------------------------------------------------------------
-- Creating a new handle
block $ do
h_ <- takeMVar m
checkBufferInvariants h_
- (h',v) <- catchException (act h_)
- (\ err -> putMVar m h_ >>
- case err of
- IOException ex -> ioError (augmentIOError ex fun h)
- _ -> throw err)
+ (h',v) <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
+ `catchException` \ex -> ioError (augmentIOError ex fun h)
checkBufferInvariants h'
putMVar m h'
return v
block $ do
h_ <- takeMVar m
checkBufferInvariants h_
- v <- catchException (act h_)
- (\ err -> putMVar m h_ >>
- case err of
- IOException ex -> ioError (augmentIOError ex fun h)
- _ -> throw err)
+ v <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
+ `catchException` \ex -> ioError (augmentIOError ex fun h)
checkBufferInvariants h_
putMVar m h_
return v
withHandle__' fun h r act
withHandle__' fun h w act
+withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
+ -> IO ()
withHandle__' fun h m act =
block $ do
h_ <- takeMVar m
checkBufferInvariants h_
- h' <- catchException (act h_)
- (\ err -> putMVar m h_ >>
- case err of
- IOException ex -> ioError (augmentIOError ex fun h)
- _ -> throw err)
+ h' <- (act h_ `catchAny` \err -> putMVar m h_ >> throw err)
+ `catchException` \ex -> ioError (augmentIOError ex fun h)
checkBufferInvariants h'
putMVar m h'
return ()
-augmentIOError (IOError _ iot _ str fp) fun h
- = IOError (Just h) iot fun str filepath
+augmentIOError :: IOException -> String -> Handle -> IOException
+augmentIOError ioe@IOError{ ioe_filename = fp } fun h
+ = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
where filepath
| Just _ <- fp = fp
| otherwise = case h of
- FileHandle fp _ -> Just fp
- DuplexHandle fp _ _ -> Just fp
+ FileHandle path _ -> Just path
+ DuplexHandle path _ _ -> Just path
-- ---------------------------------------------------------------------------
-- Wrapper for write operations.
wantWritableHandle' fun h m act
= withHandle_' fun h m (checkWritableHandle act)
+checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkWritableHandle act handle_
= case haType handle_ of
ClosedHandle -> ioe_closedHandle
wantReadableHandle' fun h m act
= withHandle_' fun h m (checkReadableHandle act)
+checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkReadableHandle act handle_ =
case haType handle_ of
ClosedHandle -> ioe_closedHandle
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
ioException (IOError (Just h) IllegalOperation fun
- "handle is not seekable" Nothing)
+ "handle is not seekable" Nothing Nothing)
wantSeekableHandle fun h@(FileHandle _ m) act =
withHandle_' fun h m (checkSeekableHandle act)
+checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
checkSeekableHandle act handle_ =
case haType handle_ of
ClosedHandle -> ioe_closedHandle
ioe_closedHandle = ioException
(IOError Nothing IllegalOperation ""
- "handle is closed" Nothing)
+ "handle is closed" Nothing Nothing)
ioe_EOF = ioException
- (IOError Nothing EOF "" "" Nothing)
+ (IOError Nothing EOF "" "" Nothing Nothing)
ioe_notReadable = ioException
(IOError Nothing IllegalOperation ""
- "handle is not open for reading" Nothing)
+ "handle is not open for reading" Nothing Nothing)
ioe_notWritable = ioException
(IOError Nothing IllegalOperation ""
- "handle is not open for writing" Nothing)
+ "handle is not open for writing" Nothing Nothing)
ioe_notSeekable = ioException
(IOError Nothing IllegalOperation ""
- "handle is not seekable" Nothing)
+ "handle is not seekable" Nothing Nothing)
ioe_notSeekable_notBin = ioException
(IOError Nothing IllegalOperation ""
"seek operations on text-mode handles are not allowed on this platform"
- Nothing)
+ Nothing Nothing)
-ioe_finalizedHandle fp = throw (IOException
+ioe_finalizedHandle :: FilePath -> Handle__
+ioe_finalizedHandle fp = throw
(IOError Nothing IllegalOperation ""
- "handle is finalized" (Just fp)))
+ "handle is finalized" Nothing (Just fp))
ioe_bufsiz :: Int -> IO a
ioe_bufsiz n = ioException
(IOError Nothing InvalidArgument "hSetBuffering"
- ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
+ ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
-- 9 => should be parens'ified.
-- -----------------------------------------------------------------------------
handle_ <- takeMVar m
case haType handle_ of
ClosedHandle -> return ()
- _ -> do flushWriteBufferOnly handle_ `catchException` \_ -> return ()
+ _ -> do flushWriteBufferOnly handle_ `catchAny` \_ -> return ()
-- ignore errors and async exceptions, and close the
-- descriptor anyway...
hClose_handle_ handle_
-- ---------------------------------------------------------------------------
-- Grimy buffer operations
+checkBufferInvariants :: Handle__ -> IO ()
#ifdef DEBUG
checkBufferInvariants h_ = do
let ref = haBuffer h_
then error "buffer invariant violation"
else return ()
#else
-checkBufferInvariants h_ = return ()
+checkBufferInvariants _ = return ()
#endif
newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
allocateBuffer sz@(I# size) state = IO $ \s ->
-- We sometimes need to pass the address of this buffer to
-- a "safe" foreign call, hence it must be immovable.
- case newPinnedByteArray# size s of { (# s, b #) ->
- (# s, newEmptyBuffer b state sz #) }
+ case newPinnedByteArray# size s of { (# s', b #) ->
+ (# s', newEmptyBuffer b state sz #) }
writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
writeCharIntoBuffer slab (I# off) (C# c)
= IO $ \s -> case writeCharArray# slab off c s of
- s -> (# s, I# (off +# 1#) #)
+ s' -> (# s', I# (off +# 1#) #)
readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
readCharFromBuffer slab (I# off)
= IO $ \s -> case readCharArray# slab off s of
- (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
+ (# s', c #) -> (# s', (C# c, I# (off +# 1#)) #)
getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
getBuffer fd state = do
-- appears to be what GHC has done for a long time, and I suspect it
-- is more useful than line buffering in most cases.
+fillReadBufferLoop :: FD -> Bool -> Bool -> Buffer -> RawBuffer -> Int -> Int
+ -> IO Buffer
fillReadBufferLoop fd is_line is_stream buf b w size = do
let bytes = size - w
if bytes == 0 -- buffer full?
but that leaves a small race window where the data can be read
from the file descriptor before we issue our blocking read().
* readRawBufferNoBlock for a blocking FD
+
+NOTE [2363]:
+
+In the threaded RTS we could just make safe calls to read()/write()
+for file descriptors in blocking mode without worrying about blocking
+other threads, but the problem with this is that the thread will be
+uninterruptible while it is blocked in the foreign call. See #2363.
+So now we always call fdReady() before reading, and if fdReady
+indicates that there's no data, we call threadWaitRead.
+
-}
readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
readRawBuffer loc fd is_nonblock buf off len
- | is_nonblock = unsafe_read
- | threaded = safe_read
+ | is_nonblock = unsafe_read -- unsafe is ok, it can't block
| otherwise = do r <- throwErrnoIfMinus1 loc
- (fdReady (fromIntegral fd) 0 0 False)
+ (unsafe_fdReady (fromIntegral fd) 0 0 0)
if r /= 0
- then unsafe_read
- else do threadWaitRead (fromIntegral fd); unsafe_read
+ then read
+ else do threadWaitRead (fromIntegral fd); read
where
do_read call = throwErrnoIfMinus1RetryMayBlock loc call
(threadWaitRead (fromIntegral fd))
+ read = if threaded then safe_read else unsafe_read
unsafe_read = do_read (read_rawBuffer fd buf off len)
safe_read = do_read (safe_read_rawBuffer fd buf off len)
readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
readRawBufferPtr loc fd is_nonblock buf off len
- | is_nonblock = unsafe_read
- | threaded = safe_read
+ | is_nonblock = unsafe_read -- unsafe is ok, it can't block
| otherwise = do r <- throwErrnoIfMinus1 loc
- (fdReady (fromIntegral fd) 0 0 False)
+ (unsafe_fdReady (fromIntegral fd) 0 0 0)
if r /= 0
- then unsafe_read
- else do threadWaitRead (fromIntegral fd); unsafe_read
+ then read
+ else do threadWaitRead (fromIntegral fd); read
where
- do_read call = throwErrnoIfMinus1RetryMayBlock loc call
- (threadWaitRead (fromIntegral fd))
- unsafe_read = do_read (read_off fd buf off len)
- safe_read = do_read (safe_read_off fd buf off len)
+ do_read call = throwErrnoIfMinus1RetryMayBlock loc call
+ (threadWaitRead (fromIntegral fd))
+ read = if threaded then safe_read else unsafe_read
+ unsafe_read = do_read (read_off fd buf off len)
+ safe_read = do_read (safe_read_off fd buf off len)
readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
readRawBufferNoBlock loc fd is_nonblock buf off len
- | is_nonblock = unsafe_read
- | otherwise = do r <- fdReady (fromIntegral fd) 0 0 False
+ | is_nonblock = unsafe_read -- unsafe is ok, it can't block
+ | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 0 0 0
if r /= 0 then safe_read
else return 0
-- XXX see note [nonblock]
readRawBufferPtrNoBlock :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
readRawBufferPtrNoBlock loc fd is_nonblock buf off len
- | is_nonblock = unsafe_read
- | otherwise = do r <- fdReady (fromIntegral fd) 0 0 False
+ | is_nonblock = unsafe_read -- unsafe is ok, it can't block
+ | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 0 0 0
if r /= 0 then safe_read
else return 0
-- XXX see note [nonblock]
writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
writeRawBuffer loc fd is_nonblock buf off len
- | is_nonblock = unsafe_write
- | threaded = safe_write
- | otherwise = do r <- fdReady (fromIntegral fd) 1 0 False
+ | is_nonblock = unsafe_write -- unsafe is ok, it can't block
+ | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 1 0 0
if r /= 0
- then safe_write
- else do threadWaitWrite (fromIntegral fd); unsafe_write
+ then write
+ else do threadWaitWrite (fromIntegral fd); write
where
do_write call = throwErrnoIfMinus1RetryMayBlock loc call
(threadWaitWrite (fromIntegral fd))
+ write = if threaded then safe_write else unsafe_write
unsafe_write = do_write (write_rawBuffer fd buf off len)
safe_write = do_write (safe_write_rawBuffer (fromIntegral fd) buf off len)
writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
writeRawBufferPtr loc fd is_nonblock buf off len
- | is_nonblock = unsafe_write
- | threaded = safe_write
- | otherwise = do r <- fdReady (fromIntegral fd) 1 0 False
+ | is_nonblock = unsafe_write -- unsafe is ok, it can't block
+ | otherwise = do r <- unsafe_fdReady (fromIntegral fd) 1 0 0
if r /= 0
- then safe_write
- else do threadWaitWrite (fromIntegral fd); unsafe_write
+ then write
+ else do threadWaitWrite (fromIntegral fd); write
where
do_write call = throwErrnoIfMinus1RetryMayBlock loc call
(threadWaitWrite (fromIntegral fd))
+ write = if threaded then safe_write else unsafe_write
unsafe_write = do_write (write_off fd buf off len)
safe_write = do_write (safe_write_off (fromIntegral fd) buf off len)
foreign import ccall unsafe "__hscore_PrelHandle_write"
write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
-foreign import ccall safe "fdReady"
- fdReady :: CInt -> CInt -> CInt -> Bool -> IO CInt
+foreign import ccall unsafe "fdReady"
+ unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
#else /* mingw32_HOST_OS.... */
readRawBufferPtrNoBlock = readRawBufferPtr
-- Async versions of the read/write primitives, for the non-threaded RTS
+asyncReadRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt
+ -> IO CInt
asyncReadRawBuffer loc fd is_stream buf off len = do
(l, rc) <- asyncReadBA (fromIntegral fd) (if is_stream then 1 else 0)
(fromIntegral len) off buf
ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
else return (fromIntegral l)
+asyncReadRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt
+ -> IO CInt
asyncReadRawBufferPtr loc fd is_stream buf off len = do
(l, rc) <- asyncRead (fromIntegral fd) (if is_stream then 1 else 0)
(fromIntegral len) (buf `plusPtr` off)
ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
else return (fromIntegral l)
+asyncWriteRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt
+ -> IO CInt
asyncWriteRawBuffer loc fd is_stream buf off len = do
(l, rc) <- asyncWriteBA (fromIntegral fd) (if is_stream then 1 else 0)
(fromIntegral len) off buf
ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
else return (fromIntegral l)
+asyncWriteRawBufferPtr :: String -> FD -> Bool -> CString -> Int -> CInt
+ -> IO CInt
asyncWriteRawBufferPtr loc fd is_stream buf off len = do
(l, rc) <- asyncWrite (fromIntegral fd) (if is_stream then 1 else 0)
(fromIntegral len) (buf `plusPtr` off)
-- Blocking versions of the read/write primitives, for the threaded RTS
+blockingReadRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt
+ -> IO CInt
blockingReadRawBuffer loc fd True buf off len =
throwErrnoIfMinus1Retry loc $
safe_recv_rawBuffer fd buf off len
throwErrnoIfMinus1Retry loc $
safe_read_rawBuffer fd buf off len
+blockingReadRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt
+ -> IO CInt
blockingReadRawBufferPtr loc fd True buf off len =
throwErrnoIfMinus1Retry loc $
safe_recv_off fd buf off len
throwErrnoIfMinus1Retry loc $
safe_read_off fd buf off len
+blockingWriteRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt
+ -> IO CInt
blockingWriteRawBuffer loc fd True buf off len =
throwErrnoIfMinus1Retry loc $
safe_send_rawBuffer fd buf off len
throwErrnoIfMinus1Retry loc $
safe_write_rawBuffer fd buf off len
+blockingWriteRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt
+ -> IO CInt
blockingWriteRawBufferPtr loc fd True buf off len =
throwErrnoIfMinus1Retry loc $
safe_send_off fd buf off len
-- or output channel respectively. The third manages output to the
-- standard error channel. These handles are initially open.
-fd_stdin = 0 :: FD
-fd_stdout = 1 :: FD
-fd_stderr = 2 :: FD
+fd_stdin, fd_stdout, fd_stderr :: FD
+fd_stdin = 0
+fd_stdout = 1
+fd_stderr = 2
-- | A handle managing input from the Haskell program's standard input channel.
stdin :: Handle
-- ---------------------------------------------------------------------------
-- Opening and Closing Files
-addFilePathToIOError fun fp (IOError h iot _ str _)
- = IOError h iot fun str (Just fp)
+addFilePathToIOError :: String -> FilePath -> IOException -> IOException
+addFilePathToIOError fun fp ioe
+ = ioe{ ioe_location = fun, ioe_filename = Just fp }
-- | Computation 'openFile' @file mode@ allocates and returns a new, open
-- handle to manage the file @file@. It manages input if @mode@
(openFile' fp m True)
(\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
+openFile' :: String -> IOMode -> Bool -> IO Handle
openFile' filepath mode binary =
withCString filepath $ \ f ->
stat@(fd_type,_,_) <- fdStat fd
h <- fdToHandle_stat fd (Just stat) False filepath mode binary
- `catchException` \e -> do c_close fd; throw e
+ `catchAny` \e -> do c_close fd; throw e
-- NB. don't forget to close the FD if fdToHandle' fails, otherwise
-- this FD leaks.
-- ASSERT: if we just created the file, then fdToHandle' won't fail
return h
+std_flags, output_flags, read_flags, write_flags, rw_flags,
+ append_flags :: CInt
std_flags = o_NONBLOCK .|. o_NOCTTY
output_flags = std_flags .|. o_CREAT
read_flags = std_flags .|. o_RDONLY
case fd_type of
Directory ->
ioException (IOError Nothing InappropriateType "openFile"
- "is a directory" Nothing)
+ "is a directory" Nothing Nothing)
-- regular files need to be locked
RegularFile -> do
#ifndef mingw32_HOST_OS
+ -- On Windows we use explicit exclusion via sopen() to implement
+ -- this locking (see __hscore_open()); on Unix we have to
+ -- implment it in the RTS.
r <- lockFile fd dev ino (fromBool write)
when (r == -1) $
ioException (IOError Nothing ResourceBusy "openFile"
- "file is locked" Nothing)
+ "file is locked" Nothing Nothing)
#endif
mkFileHandle fd is_socket filepath ha_type binary
-- turn off buffering. We don't correctly handle the case of switching
-- from read mode to write mode on a buffered text-mode handle, see bug
-- \#679.
- bmode <- case ha_type of
- ReadWriteHandle | not binary -> return NoBuffering
- _other -> return bmode
+ bmode2 <- case ha_type of
+ ReadWriteHandle | not binary -> return NoBuffering
+ _other -> return bmode
+#else
+ let bmode2 = bmode
#endif
spares <- newIORef BufferListNil
haType = ha_type,
haIsBin = binary,
haIsStream = is_stream,
- haBufferMode = bmode,
+ haBufferMode = bmode2,
haBuffer = buf,
haBuffers = spares,
haOtherSide = Nothing
addMVarFinalizer write_side (handleFinalizer filepath write_side)
return (DuplexHandle filepath read_side write_side)
-
+initBufferState :: HandleType -> BufferState
initBufferState ReadHandle = ReadBuffer
initBufferState _ = WriteBuffer
Nothing -> return ()
Just e -> throwIO e
+hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
hClose' h m = withHandle' "hClose" h m $ hClose_help
-- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
-- 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 Exception)
+hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_help handle_ =
case haType handle_ of
ClosedHandle -> return (handle_,Nothing)
_ -> do flushWriteBufferOnly handle_ -- interruptible
hClose_handle_ handle_
+hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
hClose_handle_ handle_ = do
let fd = haFD handle_
maybe_exception)
{-# NOINLINE noBuffer #-}
+noBuffer :: Buffer
noBuffer = unsafePerformIO $ allocateBuffer 1 ReadBuffer
-----------------------------------------------------------------------------
if r /= -1
then return r
else ioException (IOError Nothing InappropriateType "hFileSize"
- "not a regular file" Nothing)
+ "not a regular file" Nothing Nothing)
-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
-- * 'isEOFError' if the end of file has been reached.
hLookAhead :: Handle -> IO Char
-hLookAhead handle = do
- wantReadableHandle "hLookAhead" handle $ \handle_ -> do
+hLookAhead handle =
+ wantReadableHandle "hLookAhead" handle hLookAhead'
+
+hLookAhead' :: Handle__ -> IO Char
+hLookAhead' handle_ = do
let ref = haBuffer handle_
fd = haFD handle_
- is_line = haBufferMode handle_ == LineBuffering
buf <- readIORef ref
-- fill up the read buffer if necessary
new_buf <- if bufferEmpty buf
then fillReadBuffer fd True (haIsStream handle_) buf
else return buf
-
+
writeIORef ref new_buf
(c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
Just r -> withHandle_' "dupHandle" h r (return . haFD)
dupHandle_ other_side h_ new_fd
+dupHandleTo :: Maybe (MVar Handle__) -> Handle__ -> Handle__
+ -> IO (Handle__, Handle__)
dupHandleTo other_side hto_ h_ = do
flushBuffer h_
-- Windows' dup2 does not return the new descriptor, unlike Unix
withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_)
hDuplicateTo h1 _ =
ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
- "handles are incompatible" Nothing)
+ "handles are incompatible" Nothing Nothing)
-- ---------------------------------------------------------------------------
-- showing Handles.
hShow h@(FileHandle path _) = showHandle' path False h
hShow h@(DuplexHandle path _ _) = showHandle' path True h
+showHandle' :: String -> Bool -> Handle -> IO String
showHandle' filepath is_duplex h =
withHandle_ "showHandle" h $ \hdl_ ->
let