{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP
           , NoImplicitPrelude
           , RecordWildCards
           , NondecreasingIndentation
  #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Handle
-- Copyright   :  (c) The University of Glasgow, 1994-2009
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable
--
-- External API for GHC's Handle implementation
--
-----------------------------------------------------------------------------

module GHC.IO.Handle (
   Handle,
   BufferMode(..),

   mkFileHandle, mkDuplexHandle,

   hFileSize, hSetFileSize, hIsEOF, isEOF, hLookAhead,
   hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,
   hFlush, hFlushAll, hDuplicate, hDuplicateTo,

   hClose, hClose_help,

   LockMode(..), hLock, hTryLock,

   HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
   SeekMode(..), hSeek, hTell,

   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
   hSetEcho, hGetEcho, hIsTerminalDevice,

   hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,
   noNewlineTranslation, universalNewlineMode, nativeNewlineMode,

   hShow,

   hWaitForInput, hGetChar, hGetLine, hGetContents, hGetContents', hPutChar, hPutStr,

   hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking
 ) where

import GHC.IO
import GHC.IO.Exception
import GHC.IO.Encoding
import GHC.IO.Buffer
import GHC.IO.BufferedIO ( BufferedIO )
import GHC.IO.Device as IODevice
import GHC.IO.StdHandles
import GHC.IO.SubSystem
import GHC.IO.Handle.Lock
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Text
import qualified GHC.IO.BufferedIO as Buffered

import GHC.Base
import GHC.Exception
import GHC.MVar
import GHC.IORef
import GHC.Show
import GHC.Num
import GHC.Real
import Data.Maybe
import Data.Typeable

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

-- | Computation 'hClose' @hdl@ makes handle @hdl@ closed.  Before the
-- computation finishes, if @hdl@ is writable its buffer is flushed as
-- for 'hFlush'.
-- Performing 'hClose' on a handle that has already been closed has no effect;
-- doing so is not an error.  All other operations on a closed handle will fail.
-- If 'hClose' fails for any reason, any further operations (apart from
-- 'hClose') on the handle will still fail as if @hdl@ had been successfully
-- closed.
--
-- 'hClose' is an /interruptible operation/ in the sense described in
-- "Control.Exception". If 'hClose' is interrupted by an asynchronous
-- exception in the process of flushing its buffers, then the I/O device
-- (e.g., file) will be closed anyway.
hClose :: Handle -> IO ()
hClose :: Handle -> IO ()
hClose = Handle -> IO ()
hClose_impl

-----------------------------------------------------------------------------
-- Detecting and changing the size of a file

-- | For a handle @hdl@ which attached to a physical file,
-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.

hFileSize :: Handle -> IO Integer
hFileSize :: Handle -> IO Integer
hFileSize Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hFileSize" Handle
handle forall a b. (a -> b) -> a -> b
$ \ handle_ :: Handle__
handle_@Handle__{haDevice :: ()
haDevice=dev
dev} -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle              -> forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle          -> forall a. IO a
ioe_semiclosedHandle
      HandleType
_ -> do Handle__ -> IO ()
flushWriteBuffer Handle__
handle_
              Integer
r <- forall a. IODevice a => a -> IO Integer
IODevice.getSize dev
dev
              String -> IO ()
debugIO forall a b. (a -> b) -> a -> b
$ String
"hFileSize: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
r forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Handle
handle
              if Integer
r forall a. Eq a => a -> a -> Bool
/= -Integer
1
                then forall (m :: * -> *) a. Monad m => a -> m a
return Integer
r
                else forall a. IOException -> IO a
ioException (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError forall a. Maybe a
Nothing IOErrorType
InappropriateType String
"hFileSize"
                                  String
"not a regular file" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)



-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.

hSetFileSize :: Handle -> Integer -> IO ()
hSetFileSize :: Handle -> Integer -> IO ()
hSetFileSize Handle
handle Integer
size =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hSetFileSize" Handle
handle forall a b. (a -> b) -> a -> b
$ \ handle_ :: Handle__
handle_@Handle__{haDevice :: ()
haDevice=dev
dev} -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle              -> forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle          -> forall a. IO a
ioe_semiclosedHandle
      HandleType
_ -> do Handle__ -> IO ()
flushWriteBuffer Handle__
handle_
              forall a. IODevice a => a -> Integer -> IO ()
IODevice.setSize dev
dev Integer
size
              forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- ---------------------------------------------------------------------------
-- Detecting the End of Input

-- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
-- 'True' if no further input can be taken from @hdl@ or for a
-- physical file, if the current I\/O position is equal to the length of
-- the file.  Otherwise, it returns 'False'.
--
-- NOTE: 'hIsEOF' may block, because it has to attempt to read from
-- the stream to determine whether there is any more data to be read.

hIsEOF :: Handle -> IO Bool
hIsEOF :: Handle -> IO Bool
hIsEOF Handle
handle = forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hIsEOF" Handle
handle forall a b. (a -> b) -> a -> b
$ \Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do

  Buffer CharBufElem
cbuf <- forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
  if Bool -> Bool
not (forall e. Buffer e -> Bool
isEmptyBuffer Buffer CharBufElem
cbuf) then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do

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

  -- NB. do no decoding, just fill the byte buffer; see #3808
  (Int
r,Buffer Word8
bbuf') <- forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
bbuf
  if Int
r forall a. Eq a => a -> a -> Bool
== Int
0
     then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
     else do forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf'
             forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- ---------------------------------------------------------------------------
-- isEOF

-- | The computation 'isEOF' is identical to 'hIsEOF',
-- except that it works only on 'stdin'.

isEOF :: IO Bool
isEOF :: IO Bool
isEOF = Handle -> IO Bool
hIsEOF Handle
stdin

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

-- | Computation 'hLookAhead' returns the next character from the handle
-- without removing it from the input buffer, blocking until a character
-- is available.
--
-- This operation may fail with:
--
--  * 'System.IO.Error.isEOFError' if the end of file has been reached.

hLookAhead :: Handle -> IO Char
hLookAhead :: Handle -> IO CharBufElem
hLookAhead Handle
handle =
  forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hLookAhead"  Handle
handle Handle__ -> IO CharBufElem
hLookAhead_

-- ---------------------------------------------------------------------------
-- Buffering Operations

-- Three kinds of buffering are supported: line-buffering,
-- block-buffering or no-buffering.  See GHC.IO.Handle for definition and
-- further explanation of what the type represent.

-- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
-- handle @hdl@ on subsequent reads and writes.
--
-- If the buffer mode is changed from 'BlockBuffering' or
-- 'LineBuffering' to 'NoBuffering', then
--
--  * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
--
--  * if @hdl@ is not writable, the contents of the buffer is discarded.
--
-- This operation may fail with:
--
--  * 'System.IO.Error.isPermissionError' if the handle has already been used
--    for reading or writing and the implementation does not allow the
--    buffering mode to be changed.

hSetBuffering :: Handle -> BufferMode -> IO ()
hSetBuffering :: Handle -> BufferMode -> IO ()
hSetBuffering Handle
handle BufferMode
mode =
  String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
withAllHandles__ String
"hSetBuffering" Handle
handle forall a b. (a -> b) -> a -> b
$ \ handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
  case HandleType
haType of
    HandleType
ClosedHandle -> forall a. IO a
ioe_closedHandle
    HandleType
_ -> do
         if BufferMode
mode forall a. Eq a => a -> a -> Bool
== BufferMode
haBufferMode then forall (m :: * -> *) a. Monad m => a -> m a
return Handle__
handle_ else do

         -- See [note Buffer Sizing] in GHC.IO.Handle.Types

          -- check for errors:
          case BufferMode
mode of
              BlockBuffering (Just Int
n) | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0    -> forall a. Int -> IO a
ioe_bufsiz Int
n
              BufferMode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

          -- for input terminals we need to put the terminal into
          -- cooked or raw mode depending on the type of buffering.
          Bool
is_tty <- forall a. IODevice a => a -> IO Bool
IODevice.isTerminal dev
haDevice
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
is_tty Bool -> Bool -> Bool
&& HandleType -> Bool
isReadableHandleType HandleType
haType) forall a b. (a -> b) -> a -> b
$
                case BufferMode
mode of
#if !defined(mingw32_HOST_OS)
        -- 'raw' mode under win32 is a bit too specialised (and troublesome
        -- for most common uses), so simply disable its use here when not using
        -- WinIO.
                  BufferMode
NoBuffering -> forall a. IODevice a => a -> Bool -> IO ()
IODevice.setRaw dev
haDevice Bool
True
#else
                  NoBuffering -> return () <!> IODevice.setRaw haDevice True
#endif
                  BufferMode
_           -> forall a. IODevice a => a -> Bool -> IO ()
IODevice.setRaw dev
haDevice Bool
False

          -- throw away spare buffers, they might be the wrong size
          forall a. IORef a -> a -> IO ()
writeIORef IORef (BufferList CharBufElem)
haBuffers forall e. BufferList e
BufferListNil

          forall (m :: * -> *) a. Monad m => a -> m a
return Handle__{ haBufferMode :: BufferMode
haBufferMode = BufferMode
mode,dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haLastDecode :: IORef (dec_state, Buffer Word8)
haInputNL :: Newline
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haCharBuffer :: IORef (Buffer CharBufElem)
haByteBuffer :: IORef (Buffer Word8)
haBuffers :: IORef (BufferList CharBufElem)
haType :: HandleType
haDevice :: dev
.. }

-- -----------------------------------------------------------------------------
-- hSetEncoding

-- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding
-- for the handle @hdl@ to @encoding@.  The default encoding when a 'Handle' is
-- created is 'System.IO.localeEncoding', namely the default encoding for the
-- current locale.
--
-- To create a 'Handle' with no encoding at all, use 'openBinaryFile'.  To
-- stop further encoding or decoding on an existing 'Handle', use
-- 'hSetBinaryMode'.
--
-- 'hSetEncoding' may need to flush buffered data in order to change
-- the encoding.
--
hSetEncoding :: Handle -> TextEncoding -> IO ()
hSetEncoding :: Handle -> TextEncoding -> IO ()
hSetEncoding Handle
hdl TextEncoding
encoding =
  String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
withAllHandles__ String
"hSetEncoding" Handle
hdl forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
    Handle__ -> IO ()
flushCharBuffer Handle__
h_
    Handle__ -> IO ()
closeTextCodecs Handle__
h_
    forall a.
Maybe TextEncoding
-> HandleType
-> (forall es ds.
    Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
-> IO a
openTextEncoding (forall a. a -> Maybe a
Just TextEncoding
encoding) HandleType
haType forall a b. (a -> b) -> a -> b
$ \ Maybe (TextEncoder es)
mb_encoder Maybe (TextDecoder ds)
mb_decoder -> do
    Buffer Word8
bbuf <- forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
    IORef (ds, Buffer Word8)
ref <- forall a. a -> IO (IORef a)
newIORef (forall a. String -> a
errorWithoutStackTrace String
"last_decode")
    forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{ haLastDecode :: IORef (ds, Buffer Word8)
haLastDecode = IORef (ds, Buffer Word8)
ref,
                      haDecoder :: Maybe (TextDecoder ds)
haDecoder = Maybe (TextDecoder ds)
mb_decoder,
                      haEncoder :: Maybe (TextEncoder es)
haEncoder = Maybe (TextEncoder es)
mb_encoder,
                      haCodec :: Maybe TextEncoding
haCodec   = forall a. a -> Maybe a
Just TextEncoding
encoding, dev
Maybe (MVar Handle__)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haInputNL :: Newline
haCharBuffer :: IORef (Buffer CharBufElem)
haByteBuffer :: IORef (Buffer Word8)
haBuffers :: IORef (BufferList CharBufElem)
haBufferMode :: BufferMode
haType :: HandleType
haDevice :: dev
.. })

-- | Return the current 'TextEncoding' for the specified 'Handle', or
-- 'Nothing' if the 'Handle' is in binary mode.
--
-- Note that the 'TextEncoding' remembers nothing about the state of
-- the encoder/decoder in use on this 'Handle'.  For example, if the
-- encoding in use is UTF-16, then using 'hGetEncoding' and
-- 'hSetEncoding' to save and restore the encoding may result in an
-- extra byte-order-mark being written to the file.
--
hGetEncoding :: Handle -> IO (Maybe TextEncoding)
hGetEncoding :: Handle -> IO (Maybe TextEncoding)
hGetEncoding Handle
hdl =
  forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hGetEncoding" Handle
hdl forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextEncoding
haCodec

-- -----------------------------------------------------------------------------
-- hFlush

-- | The action 'hFlush' @hdl@ causes any items buffered for output
-- in handle @hdl@ to be sent immediately to the operating system.
--
-- This operation may fail with:
--
--  * 'System.IO.Error.isFullError' if the device is full;
--
--  * 'System.IO.Error.isPermissionError' if a system resource limit would be
--    exceeded. It is unspecified whether the characters in the buffer are
--    discarded or retained under these circumstances.

hFlush :: Handle -> IO ()
hFlush :: Handle -> IO ()
hFlush Handle
handle = forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantWritableHandle String
"hFlush" Handle
handle Handle__ -> IO ()
flushWriteBuffer

-- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,
-- including any buffered read data.  Buffered read data is flushed
-- by seeking the file position back to the point before the bufferred
-- data was read, and hence only works if @hdl@ is seekable (see
-- 'hIsSeekable').
--
-- This operation may fail with:
--
--  * 'System.IO.Error.isFullError' if the device is full;
--
--  * 'System.IO.Error.isPermissionError' if a system resource limit would be
--    exceeded. It is unspecified whether the characters in the buffer are
--    discarded or retained under these circumstances;
--
--  * 'System.IO.Error.isIllegalOperation' if @hdl@ has buffered read data, and
--    is not seekable.

hFlushAll :: Handle -> IO ()
hFlushAll :: Handle -> IO ()
hFlushAll Handle
handle = forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hFlushAll" Handle
handle Handle__ -> IO ()
flushBuffer

-- -----------------------------------------------------------------------------
-- Repositioning Handles

data HandlePosn = HandlePosn Handle HandlePosition

-- | @since 4.1.0.0
instance Eq HandlePosn where
    (HandlePosn Handle
h1 Integer
p1) == :: HandlePosn -> HandlePosn -> Bool
== (HandlePosn Handle
h2 Integer
p2) = Integer
p1forall a. Eq a => a -> a -> Bool
==Integer
p2 Bool -> Bool -> Bool
&& Handle
h1forall a. Eq a => a -> a -> Bool
==Handle
h2

-- | @since 4.1.0.0
instance Show HandlePosn where
   showsPrec :: Int -> HandlePosn -> ShowS
showsPrec Int
p (HandlePosn Handle
h Integer
pos) =
        forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" at position " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Integer
pos

  -- HandlePosition is the Haskell equivalent of POSIX' off_t.
  -- We represent it as an Integer on the Haskell side, but
  -- cheat slightly in that hGetPosn calls upon a C helper
  -- that reports the position back via (merely) an Int.
type HandlePosition = Integer

-- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
-- @hdl@ as a value of the abstract type 'HandlePosn'.

hGetPosn :: Handle -> IO HandlePosn
hGetPosn :: Handle -> IO HandlePosn
hGetPosn Handle
handle = do
    Integer
posn <- Handle -> IO Integer
hTell Handle
handle
    forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Integer -> HandlePosn
HandlePosn Handle
handle Integer
posn)

-- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
-- then computation 'hSetPosn' @p@ sets the position of @hdl@
-- to the position it held at the time of the call to 'hGetPosn'.
--
-- This operation may fail with:
--
--  * 'System.IO.Error.isPermissionError' if a system resource limit would be
--    exceeded.

hSetPosn :: HandlePosn -> IO ()
hSetPosn :: HandlePosn -> IO ()
hSetPosn (HandlePosn Handle
h Integer
i) = Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
i

-- ---------------------------------------------------------------------------
-- hSeek

{- Note:
 - when seeking using `SeekFromEnd', positive offsets (>=0) means
   seeking at or past EOF.

 - we possibly deviate from the report on the issue of seeking within
   the buffer and whether to flush it or not.  The report isn't exactly
   clear here.
-}

-- | Computation 'hSeek' @hdl mode i@ sets the position of handle
-- @hdl@ depending on @mode@.
-- The offset @i@ is given in terms of 8-bit bytes.
--
-- If @hdl@ is block- or line-buffered, then seeking to a position which is not
-- in the current buffer will first cause any items in the output buffer to be
-- written to the device, and then cause the input buffer to be discarded.
-- Some handles may not be seekable (see 'hIsSeekable'), or only support a
-- subset of the possible positioning operations (for instance, it may only
-- be possible to seek to the end of a tape, or to a positive offset from
-- the beginning or current position).
-- It is not possible to set a negative I\/O position, or for
-- a physical file, an I\/O position beyond the current end-of-file.
--
-- This operation may fail with:
--
--  * 'System.IO.Error.isIllegalOperationError' if the Handle is not seekable,
--    or does not support the requested seek mode.
--
--  * 'System.IO.Error.isPermissionError' if a system resource limit would be
--    exceeded.

hSeek :: Handle -> SeekMode -> Integer -> IO ()
hSeek :: Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
handle SeekMode
mode Integer
offset =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle String
"hSeek" Handle
handle forall a b. (a -> b) -> a -> b
$ \ handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
    String -> IO ()
debugIO (String
"hSeek " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SeekMode
mode,Integer
offset))
    Buffer CharBufElem
cbuf <- forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
    Buffer Word8
bbuf <- forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
    String -> IO ()
debugIO forall a b. (a -> b) -> a -> b
$ String
"hSeek - bbuf:" forall a. [a] -> [a] -> [a]
++ forall a. Buffer a -> String
summaryBuffer Buffer Word8
bbuf
    String -> IO ()
debugIO forall a b. (a -> b) -> a -> b
$ String
"hSeek - cbuf:" forall a. [a] -> [a] -> [a]
++ forall a. Buffer a -> String
summaryBuffer Buffer CharBufElem
cbuf

    if forall e. Buffer e -> Bool
isWriteBuffer Buffer CharBufElem
cbuf
        then do Handle__ -> IO ()
flushWriteBuffer Handle__
handle_
                Integer
new_offset <- forall a. IODevice a => a -> SeekMode -> Integer -> IO Integer
IODevice.seek dev
haDevice SeekMode
mode Integer
offset
                -- buffer has been updated, need to re-read it
                Buffer Word8
bbuf1 <- forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
                let bbuf2 :: Buffer Word8
bbuf2 = Buffer Word8
bbuf1{ bufOffset :: Word64
bufOffset = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
new_offset }
                String -> IO ()
debugIO forall a b. (a -> b) -> a -> b
$ String
"hSeek - seek:: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
offset forall a. [a] -> [a] -> [a]
++
                          String
" - " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
new_offset
                String -> IO ()
debugIO forall a b. (a -> b) -> a -> b
$ String
"hSeek - wr flush bbuf1:" forall a. [a] -> [a] -> [a]
++ forall a. Buffer a -> String
summaryBuffer Buffer Word8
bbuf2
                forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf2
        else do

    let r :: Int
r = forall e. Buffer e -> Int
bufL Buffer CharBufElem
cbuf; w :: Int
w = forall e. Buffer e -> Int
bufR Buffer CharBufElem
cbuf
    if SeekMode
mode forall a. Eq a => a -> a -> Bool
== SeekMode
RelativeSeek Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe (TextDecoder dec_state)
haDecoder Bool -> Bool -> Bool
&&
       Integer
offset forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
offset forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w forall a. Num a => a -> a -> a
- Int
r)
        then forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer CharBufElem)
haCharBuffer Buffer CharBufElem
cbuf{ bufL :: Int
bufL = Int
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset }
        else do

    Handle__ -> IO ()
flushCharReadBuffer Handle__
handle_
    Handle__ -> IO ()
flushByteReadBuffer Handle__
handle_
    -- read the updated values
    Buffer Word8
bbuf2 <- forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
    Integer
new_offset <- forall a. IODevice a => a -> SeekMode -> Integer -> IO Integer
IODevice.seek dev
haDevice SeekMode
mode Integer
offset
    String -> IO ()
debugIO forall a b. (a -> b) -> a -> b
$ String
"hSeek after: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
new_offset
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
bbuf2{ bufOffset :: Word64
bufOffset = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
new_offset }


-- | Computation 'hTell' @hdl@ returns the current position of the
-- handle @hdl@, as the number of bytes from the beginning of
-- the file.  The value returned may be subsequently passed to
-- 'hSeek' to reposition the handle to the current position.
--
-- This operation may fail with:
--
--  * 'System.IO.Error.isIllegalOperationError' if the Handle is not seekable.
--
hTell :: Handle -> IO Integer
hTell :: Handle -> IO Integer
hTell Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle String
"hGetPosn" Handle
handle forall a b. (a -> b) -> a -> b
$ \ handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do

      -- TODO: Guard these on Windows
      Integer
posn <- if IoSubSystem
ioSubSystem forall a. Eq a => a -> a -> Bool
== IoSubSystem
IoNative
                         then (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Buffer e -> Word64
bufOffset) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
                         else forall a. IODevice a => a -> IO Integer
IODevice.tell dev
haDevice

      -- we can't tell the real byte offset if there are buffered
      -- Chars, so must flush first:
      Handle__ -> IO ()
flushCharBuffer Handle__
handle_

      Buffer Word8
bbuf <- forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
      String -> IO ()
debugIO (String
"hTell bbuf (elems=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf) forall a. [a] -> [a] -> [a]
++ String
")"
               forall a. [a] -> [a] -> [a]
++ forall a. Buffer a -> String
summaryBuffer Buffer Word8
bbuf)

      let real_posn :: Integer
real_posn
           | forall e. Buffer e -> Bool
isWriteBuffer Buffer Word8
bbuf = Integer
posn forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf)
           | Bool
otherwise          = Integer
posn forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall e. Buffer e -> Int
bufferElems Buffer Word8
bbuf)

      Buffer CharBufElem
cbuf <- forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
      String -> IO ()
debugIO (String
"\nhGetPosn: (posn, real_posn) = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Integer
posn, Integer
real_posn))
      String -> IO ()
debugIO (String
"   cbuf: " forall a. [a] -> [a] -> [a]
++ forall a. Buffer a -> String
summaryBuffer Buffer CharBufElem
cbuf forall a. [a] -> [a] -> [a]
++
               String
"   bbuf: " forall a. [a] -> [a] -> [a]
++ forall a. Buffer a -> String
summaryBuffer Buffer Word8
bbuf)

      forall (m :: * -> *) a. Monad m => a -> m a
return Integer
real_posn

-- -----------------------------------------------------------------------------
-- Handle Properties

-- A number of operations return information about the properties of a
-- handle.  Each of these operations returns `True' if the handle has
-- the specified property, and `False' otherwise.

hIsOpen :: Handle -> IO Bool
hIsOpen :: Handle -> IO Bool
hIsOpen Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsOpen" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      HandleType
SemiClosedHandle     -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      HandleType
_                    -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

hIsClosed :: Handle -> IO Bool
hIsClosed :: Handle -> IO Bool
hIsClosed Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsClosed" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      HandleType
_                    -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

{- not defined, nor exported, but mentioned
   here for documentation purposes:

    hSemiClosed :: Handle -> IO Bool
    hSemiClosed h = do
       ho <- hIsOpen h
       hc <- hIsClosed h
       return (not (ho || hc))
-}

hIsReadable :: Handle -> IO Bool
hIsReadable :: Handle -> IO Bool
hIsReadable (DuplexHandle String
_ MVar Handle__
_ MVar Handle__
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
hIsReadable Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsReadable" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle     -> forall a. IO a
ioe_semiclosedHandle
      HandleType
htype                -> forall (m :: * -> *) a. Monad m => a -> m a
return (HandleType -> Bool
isReadableHandleType HandleType
htype)

hIsWritable :: Handle -> IO Bool
hIsWritable :: Handle -> IO Bool
hIsWritable (DuplexHandle String
_ MVar Handle__
_ MVar Handle__
_) = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
hIsWritable Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsWritable" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle     -> forall a. IO a
ioe_semiclosedHandle
      HandleType
htype                -> forall (m :: * -> *) a. Monad m => a -> m a
return (HandleType -> Bool
isWritableHandleType HandleType
htype)

-- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
-- for @hdl@.

hGetBuffering :: Handle -> IO BufferMode
hGetBuffering :: Handle -> IO BufferMode
hGetBuffering Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hGetBuffering" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> forall a. IO a
ioe_closedHandle
      HandleType
_ ->
           -- We're being non-standard here, and allow the buffering
           -- of a semi-closed handle to be queried.   -- sof 6/98
          forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__ -> BufferMode
haBufferMode Handle__
handle_)  -- could be stricter..

hIsSeekable :: Handle -> IO Bool
hIsSeekable :: Handle -> IO Bool
hIsSeekable Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsSeekable" Handle
handle forall a b. (a -> b) -> a -> b
$ \ handle_ :: Handle__
handle_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
    case HandleType
haType of
      HandleType
ClosedHandle         -> forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle     -> forall a. IO a
ioe_semiclosedHandle
      HandleType
AppendHandle         -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      HandleType
_                    -> forall a. IODevice a => a -> IO Bool
IODevice.isSeekable dev
haDevice

-- -----------------------------------------------------------------------------
-- Changing echo status

-- | Set the echoing status of a handle connected to a terminal.

hSetEcho :: Handle -> Bool -> IO ()
hSetEcho :: Handle -> Bool -> IO ()
hSetEcho Handle
handle Bool
on = do
    Bool
isT   <- Handle -> IO Bool
hIsTerminalDevice Handle
handle
    if Bool -> Bool
not Bool
isT
     then forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else
      forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hSetEcho" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
      case HandleType
haType of
         HandleType
ClosedHandle -> forall a. IO a
ioe_closedHandle
         HandleType
_            -> forall a. IODevice a => a -> Bool -> IO ()
IODevice.setEcho dev
haDevice Bool
on

-- | Get the echoing status of a handle connected to a terminal.

hGetEcho :: Handle -> IO Bool
hGetEcho :: Handle -> IO Bool
hGetEcho Handle
handle = do
    Bool
isT   <- Handle -> IO Bool
hIsTerminalDevice Handle
handle
    if Bool -> Bool
not Bool
isT
     then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
     else
       forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hGetEcho" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
       case HandleType
haType of
         HandleType
ClosedHandle -> forall a. IO a
ioe_closedHandle
         HandleType
_            -> forall a. IODevice a => a -> IO Bool
IODevice.getEcho dev
haDevice

-- | Is the handle connected to a terminal?

hIsTerminalDevice :: Handle -> IO Bool
hIsTerminalDevice :: Handle -> IO Bool
hIsTerminalDevice Handle
handle =
    forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsTerminalDevice" Handle
handle forall a b. (a -> b) -> a -> b
$ \ Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} -> do
     case HandleType
haType of
       HandleType
ClosedHandle -> forall a. IO a
ioe_closedHandle
       HandleType
_            -> forall a. IODevice a => a -> IO Bool
IODevice.isTerminal dev
haDevice

-- -----------------------------------------------------------------------------
-- hSetBinaryMode

-- | Select binary mode ('True') or text mode ('False') on a open handle.
-- (See also 'openBinaryFile'.)
--
-- This has the same effect as calling 'hSetEncoding' with 'char8', together
-- with 'hSetNewlineMode' with 'noNewlineTranslation'.
--
hSetBinaryMode :: Handle -> Bool -> IO ()
hSetBinaryMode :: Handle -> Bool -> IO ()
hSetBinaryMode Handle
handle Bool
bin =
  String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
withAllHandles__ String
"hSetBinaryMode" Handle
handle forall a b. (a -> b) -> a -> b
$ \ h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} ->
    do
         Handle__ -> IO ()
flushCharBuffer Handle__
h_
         Handle__ -> IO ()
closeTextCodecs Handle__
h_

         Maybe TextEncoding
mb_te <- if Bool
bin then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                         else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding

         forall a.
Maybe TextEncoding
-> HandleType
-> (forall es ds.
    Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
-> IO a
openTextEncoding Maybe TextEncoding
mb_te HandleType
haType forall a b. (a -> b) -> a -> b
$ \ Maybe (TextEncoder es)
mb_encoder Maybe (TextDecoder ds)
mb_decoder -> do

         -- should match the default newline mode, whatever that is
         let nl :: NewlineMode
nl    | Bool
bin       = NewlineMode
noNewlineTranslation
                   | Bool
otherwise = NewlineMode
nativeNewlineMode

         Buffer Word8
bbuf <- forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
         IORef (ds, Buffer Word8)
ref <- forall a. a -> IO (IORef a)
newIORef (forall a. String -> a
errorWithoutStackTrace String
"codec_state", Buffer Word8
bbuf)

         forall (m :: * -> *) a. Monad m => a -> m a
return Handle__{ haLastDecode :: IORef (ds, Buffer Word8)
haLastDecode = IORef (ds, Buffer Word8)
ref,
                          haEncoder :: Maybe (TextEncoder es)
haEncoder  = Maybe (TextEncoder es)
mb_encoder,
                          haDecoder :: Maybe (TextDecoder ds)
haDecoder  = Maybe (TextDecoder ds)
mb_decoder,
                          haCodec :: Maybe TextEncoding
haCodec    = Maybe TextEncoding
mb_te,
                          haInputNL :: Newline
haInputNL  = NewlineMode -> Newline
inputNL NewlineMode
nl,
                          haOutputNL :: Newline
haOutputNL = NewlineMode -> Newline
outputNL NewlineMode
nl, dev
Maybe (MVar Handle__)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
haOtherSide :: Maybe (MVar Handle__)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOtherSide :: Maybe (MVar Handle__)
haCharBuffer :: IORef (Buffer CharBufElem)
haByteBuffer :: IORef (Buffer Word8)
haBuffers :: IORef (BufferList CharBufElem)
haBufferMode :: BufferMode
haType :: HandleType
haDevice :: dev
.. }

-- -----------------------------------------------------------------------------
-- hSetNewlineMode

-- | Set the 'NewlineMode' on the specified 'Handle'.  All buffered
-- data is flushed first.
hSetNewlineMode :: Handle -> NewlineMode -> IO ()
hSetNewlineMode :: Handle -> NewlineMode -> IO ()
hSetNewlineMode Handle
handle NewlineMode{ inputNL :: NewlineMode -> Newline
inputNL=Newline
i, outputNL :: NewlineMode -> Newline
outputNL=Newline
o } =
  String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
withAllHandles__ String
"hSetNewlineMode" Handle
handle forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_@Handle__{} ->
    do
         Handle__ -> IO ()
flushBuffer Handle__
h_
         forall (m :: * -> *) a. Monad m => a -> m a
return Handle__
h_{ haInputNL :: Newline
haInputNL=Newline
i, haOutputNL :: Newline
haOutputNL=Newline
o }

-- -----------------------------------------------------------------------------
-- Duplicating a Handle

-- | Returns a duplicate of the original handle, with its own buffer.
-- The two Handles will share a file pointer, however.  The original
-- handle's buffer is flushed, including discarding any input data,
-- before the handle is duplicated.

hDuplicate :: Handle -> IO Handle
hDuplicate :: Handle -> IO Handle
hDuplicate h :: Handle
h@(FileHandle String
path MVar Handle__
m) =
  forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicate" Handle
h MVar Handle__
m forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
      String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle String
path Handle
h forall a. Maybe a
Nothing Handle__
h_ (forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
hDuplicate h :: Handle
h@(DuplexHandle String
path MVar Handle__
r MVar Handle__
w) = do
  write_side :: Handle
write_side@(FileHandle String
_ MVar Handle__
write_m) <-
     forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicate" Handle
h MVar Handle__
w forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
        String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle String
path Handle
h forall a. Maybe a
Nothing Handle__
h_ (forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
  read_side :: Handle
read_side@(FileHandle String
_ MVar Handle__
read_m) <-
    forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicate" Handle
h MVar Handle__
r forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
        String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle String
path Handle
h (forall a. a -> Maybe a
Just MVar Handle__
write_m) Handle__
h_  forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return (String -> MVar Handle__ -> MVar Handle__ -> Handle
DuplexHandle String
path MVar Handle__
read_m MVar Handle__
write_m)

dupHandle :: FilePath
          -> Handle
          -> Maybe (MVar Handle__)
          -> Handle__
          -> Maybe HandleFinalizer
          -> IO Handle
dupHandle :: String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle String
filepath Handle
h Maybe (MVar Handle__)
other_side h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} Maybe HandleFinalizer
mb_finalizer = do
  -- flush the buffer first, so we don't have to copy its contents
  Handle__ -> IO ()
flushBuffer Handle__
h_
  case Maybe (MVar Handle__)
other_side of
    Maybe (MVar Handle__)
Nothing -> do
       dev
new_dev <- forall a. IODevice a => a -> IO a
IODevice.dup dev
haDevice
       forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ dev
new_dev String
filepath Maybe (MVar Handle__)
other_side Handle__
h_ Maybe HandleFinalizer
mb_finalizer
    Just MVar Handle__
r  ->
       forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"dupHandle" Handle
h MVar Handle__
r forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
dev} ->
         forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ dev
dev String
filepath Maybe (MVar Handle__)
other_side Handle__
h_ Maybe HandleFinalizer
mb_finalizer

dupHandle_ :: (RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) => dev
           -> FilePath
           -> Maybe (MVar Handle__)
           -> Handle__
           -> Maybe HandleFinalizer
           -> IO Handle
dupHandle_ :: forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ dev
new_dev String
filepath Maybe (MVar Handle__)
other_side h_ :: Handle__
h_@Handle__{dev
Maybe (MVar Handle__)
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
Maybe TextEncoding
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
BufferMode
HandleType
Newline
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList CharBufElem)
haCharBuffer :: IORef (Buffer CharBufElem)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
haDevice :: dev
haOutputNL :: Handle__ -> Newline
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haLastDecode :: ()
haInputNL :: Handle__ -> Newline
haEncoder :: ()
haDecoder :: ()
haCodec :: Handle__ -> Maybe TextEncoding
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haBufferMode :: Handle__ -> BufferMode
haType :: Handle__ -> HandleType
haDevice :: ()
..} Maybe HandleFinalizer
mb_finalizer = do
   -- XXX wrong!
  Maybe TextEncoding
mb_codec <- if forall a. Maybe a -> Bool
isJust Maybe (TextEncoder enc_state)
haEncoder then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> HandleType
-> Bool
-> Maybe TextEncoding
-> NewlineMode
-> Maybe HandleFinalizer
-> Maybe (MVar Handle__)
-> IO Handle
mkHandle dev
new_dev String
filepath HandleType
haType Bool
True{-buffered-} Maybe TextEncoding
mb_codec
      NewlineMode { inputNL :: Newline
inputNL = Newline
haInputNL, outputNL :: Newline
outputNL = Newline
haOutputNL }
      Maybe HandleFinalizer
mb_finalizer Maybe (MVar Handle__)
other_side

-- -----------------------------------------------------------------------------
-- Replacing a Handle

{- |
Makes the second handle a duplicate of the first handle.  The second
handle will be closed first, if it is not already.

This can be used to retarget the standard Handles, for example:

> do h <- openFile "mystdout" WriteMode
>    hDuplicateTo h stdout
-}

hDuplicateTo :: Handle -> Handle -> IO ()
hDuplicateTo :: Handle -> Handle -> IO ()
hDuplicateTo h1 :: Handle
h1@(FileHandle String
path MVar Handle__
m1) h2 :: Handle
h2@(FileHandle String
_ MVar Handle__
m2) =
 String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' String
"hDuplicateTo" Handle
h2 MVar Handle__
m2 forall a b. (a -> b) -> a -> b
$ \Handle__
h2_ -> do
   IO () -> IO ()
try forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushWriteBuffer Handle__
h2_
   forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicateTo" Handle
h1 MVar Handle__
m1 forall a b. (a -> b) -> a -> b
$ \Handle__
h1_ ->
     String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo String
path Handle
h1 forall a. Maybe a
Nothing Handle__
h2_ Handle__
h1_ (forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
hDuplicateTo h1 :: Handle
h1@(DuplexHandle String
path MVar Handle__
r1 MVar Handle__
w1) h2 :: Handle
h2@(DuplexHandle String
_ MVar Handle__
r2 MVar Handle__
w2)  = do
 String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' String
"hDuplicateTo" Handle
h2 MVar Handle__
w2  forall a b. (a -> b) -> a -> b
$ \Handle__
w2_ -> do
   IO () -> IO ()
try forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushWriteBuffer Handle__
w2_
   forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicateTo" Handle
h1 MVar Handle__
w1 forall a b. (a -> b) -> a -> b
$ \Handle__
w1_ ->
     String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo String
path Handle
h1 forall a. Maybe a
Nothing Handle__
w2_ Handle__
w1_ (forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
 String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' String
"hDuplicateTo" Handle
h2 MVar Handle__
r2  forall a b. (a -> b) -> a -> b
$ \Handle__
r2_ -> do
   IO () -> IO ()
try forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushWriteBuffer Handle__
r2_
   forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicateTo" Handle
h1 MVar Handle__
r1 forall a b. (a -> b) -> a -> b
$ \Handle__
r1_ ->
     String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo String
path Handle
h1 (forall a. a -> Maybe a
Just MVar Handle__
w1) Handle__
r2_ Handle__
r1_ forall a. Maybe a
Nothing
hDuplicateTo Handle
h1 Handle
_ =
  forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h1

try :: IO () -> IO ()
try :: IO () -> IO ()
try IO ()
io = IO ()
io forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) :: SomeException -> IO ())

ioe_dupHandlesNotCompatible :: Handle -> IO a
ioe_dupHandlesNotCompatible :: forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h =
   forall a. IOException -> IO a
ioException (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError (forall a. a -> Maybe a
Just Handle
h) IOErrorType
IllegalOperation String
"hDuplicateTo"
                String
"handles are incompatible" forall a. Maybe a
Nothing forall a. Maybe a
Nothing)

dupHandleTo :: FilePath
            -> Handle
            -> Maybe (MVar Handle__)
            -> Handle__
            -> Handle__
            -> Maybe HandleFinalizer
            -> IO Handle__
dupHandleTo :: String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo String
filepath Handle
h Maybe (MVar Handle__)
other_side
            hto_ :: Handle__
hto_@Handle__{haDevice :: ()
haDevice=dev
devTo}
            h_ :: Handle__
h_@Handle__{haDevice :: ()
haDevice=dev
dev} Maybe HandleFinalizer
mb_finalizer = do
  Handle__ -> IO ()
flushBuffer Handle__
h_
  case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
devTo of
    Maybe dev
Nothing   -> forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h
    Just dev
dev' -> do
      dev
_ <- forall a. IODevice a => a -> a -> IO a
IODevice.dup2 dev
dev dev
dev'
      FileHandle String
_ MVar Handle__
m <- forall dev.
(RawIO dev, IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ dev
dev' String
filepath Maybe (MVar Handle__)
other_side Handle__
h_ Maybe HandleFinalizer
mb_finalizer
      forall a. MVar a -> IO a
takeMVar MVar Handle__
m

-- ---------------------------------------------------------------------------
-- showing Handles.
--
-- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
-- than the (pure) instance of 'Show' for 'Handle'.

hShow :: Handle -> IO String
hShow :: Handle -> IO String
hShow h :: Handle
h@(FileHandle String
path MVar Handle__
_) = String -> Bool -> Handle -> IO String
showHandle' String
path Bool
False Handle
h
hShow h :: Handle
h@(DuplexHandle String
path MVar Handle__
_ MVar Handle__
_) = String -> Bool -> Handle -> IO String
showHandle' String
path Bool
True Handle
h

showHandle' :: String -> Bool -> Handle -> IO String
showHandle' :: String -> Bool -> Handle -> IO String
showHandle' String
filepath Bool
is_duplex Handle
h =
  forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"showHandle" Handle
h forall a b. (a -> b) -> a -> b
$ \Handle__
hdl_ ->
    let
     showType :: ShowS
showType | Bool
is_duplex = String -> ShowS
showString String
"duplex (read-write)"
              | Bool
otherwise = forall a. Show a => a -> ShowS
shows (Handle__ -> HandleType
haType Handle__
hdl_)
    in
    forall (m :: * -> *) a. Monad m => a -> m a
return
      (( CharBufElem -> ShowS
showChar CharBufElem
'{' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        HandleType -> ShowS -> ShowS
showHdl (Handle__ -> HandleType
haType Handle__
hdl_)
            (String -> ShowS
showString String
"loc=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
filepath forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharBufElem -> ShowS
showChar CharBufElem
',' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             String -> ShowS
showString String
"type=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showType forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharBufElem -> ShowS
showChar CharBufElem
',' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             String -> ShowS
showString String
"buffering=" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Buffer e -> BufferMode -> ShowS
showBufMode (forall a. IO a -> a
unsafePerformIO (forall a. IORef a -> IO a
readIORef (Handle__ -> IORef (Buffer CharBufElem)
haCharBuffer Handle__
hdl_))) (Handle__ -> BufferMode
haBufferMode Handle__
hdl_) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}" )
      ) String
"")
   where

    showHdl :: HandleType -> ShowS -> ShowS
    showHdl :: HandleType -> ShowS -> ShowS
showHdl HandleType
ht ShowS
cont =
       case HandleType
ht of
        HandleType
ClosedHandle  -> forall a. Show a => a -> ShowS
shows HandleType
ht forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"
        HandleType
_ -> ShowS
cont

    showBufMode :: Buffer e -> BufferMode -> ShowS
    showBufMode :: forall e. Buffer e -> BufferMode -> ShowS
showBufMode Buffer e
buf BufferMode
bmo =
      case BufferMode
bmo of
        BufferMode
NoBuffering   -> String -> ShowS
showString String
"none"
        BufferMode
LineBuffering -> String -> ShowS
showString String
"line"
        BlockBuffering (Just Int
n) -> String -> ShowS
showString String
"block " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS -> ShowS
showParen Bool
True (forall a. Show a => a -> ShowS
shows Int
n)
        BlockBuffering Maybe Int
Nothing  -> String -> ShowS
showString String
"block " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ShowS -> ShowS
showParen Bool
True (forall a. Show a => a -> ShowS
shows Int
def)
      where
       def :: Int
       def :: Int
def = forall e. Buffer e -> Int
bufSize Buffer e
buf