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

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.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.Internal.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, hGetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,
   noNewlineTranslation, universalNewlineMode, nativeNewlineMode,

   hShow,

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

   hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking
 ) where

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

import GHC.Internal.Base (
    String, const, fmap, otherwise, pure, return, when, ($), (.), (++),
  )
import GHC.Internal.Classes ( Eq(..), Ord(..), not, (&&) )
import GHC.Internal.Err ( errorWithoutStackTrace )
import GHC.Internal.Exception
import GHC.Internal.MVar
import GHC.Internal.IORef
import GHC.Internal.Show
import GHC.Internal.Num
import GHC.Internal.Real
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Typeable
import GHC.Internal.Types (Bool(..), Char, Int)


-- ---------------------------------------------------------------------------
-- 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 =
    String -> Handle -> (Handle__ -> IO Integer) -> IO Integer
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hFileSize" Handle
handle ((Handle__ -> IO Integer) -> IO Integer)
-> (Handle__ -> IO Integer) -> IO Integer
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              -> IO Integer
forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle          -> IO Integer
forall a. IO a
ioe_semiclosedHandle
      HandleType
_ -> do Handle__ -> IO ()
flushWriteBuffer Handle__
handle_
              r <- dev -> IO Integer
forall a. IODevice a => a -> IO Integer
IODevice.getSize dev
dev
              debugIO $ "hFileSize: " ++ show r ++ " " ++ show handle
              if r /= -1
                then return r
                else ioException (IOError Nothing InappropriateType "hFileSize"
                                  "not a regular file" Nothing 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 =
    String -> Handle -> (Handle__ -> IO ()) -> IO ()
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hSetFileSize" Handle
handle ((Handle__ -> IO ()) -> IO ()) -> (Handle__ -> IO ()) -> IO ()
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              -> IO ()
forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle          -> IO ()
forall a. IO a
ioe_semiclosedHandle
      HandleType
_ -> do Handle__ -> IO ()
flushWriteBuffer Handle__
handle_
              dev -> Integer -> IO ()
forall a. IODevice a => a -> Integer -> IO ()
IODevice.setSize dev
dev Integer
size
              () -> IO ()
forall a. a -> IO a
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 = String -> Handle -> (Handle__ -> IO Bool) -> IO Bool
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"hIsEOF" Handle
handle ((Handle__ -> IO Bool) -> IO Bool)
-> (Handle__ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
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 CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
..} -> do

  cbuf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
  if not (isEmptyBuffer cbuf) then return False else do

  bbuf <- readIORef haByteBuffer
  if not (isEmptyBuffer bbuf) then return False else do

  -- NB. do no decoding, just fill the byte buffer; see #3808
  (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf
  if r == 0
     then return True
     else do writeIORef haByteBuffer bbuf'
             return 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:
--
--  * 'GHC.Internal.System.IO.Error.isEOFError' if the end of file has been reached.

hLookAhead :: Handle -> IO Char
hLookAhead :: Handle -> IO CharBufElem
hLookAhead Handle
handle =
  String -> Handle -> (Handle__ -> IO CharBufElem) -> IO CharBufElem
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.Internal.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 are discarded.
--
-- This operation may fail with:
--
--  * 'GHC.Internal.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 ((Handle__ -> IO Handle__) -> IO ())
-> (Handle__ -> IO Handle__) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ 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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do
  case HandleType
haType of
    HandleType
ClosedHandle -> IO Handle__
forall a. IO a
ioe_closedHandle
    HandleType
_ -> do
         if BufferMode
mode BufferMode -> BufferMode -> Bool
forall a. Eq a => a -> a -> Bool
== BufferMode
haBufferMode then Handle__ -> IO Handle__
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Handle__
handle_ else do

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

          -- check for errors:
          case BufferMode
mode of
              BlockBuffering (Just Int
n) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    -> Int -> IO ()
forall a. Int -> IO a
ioe_bufsiz Int
n
              BufferMode
_ -> () -> IO ()
forall a. a -> IO a
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.
          is_tty <- dev -> IO Bool
forall a. IODevice a => a -> IO Bool
IODevice.isTerminal dev
haDevice
          when (is_tty && isReadableHandleType haType) $
                case 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 -> dev -> Bool -> IO ()
forall a. IODevice a => a -> Bool -> IO ()
IODevice.setRaw dev
haDevice Bool
True
#else
                  NoBuffering -> return () <!> IODevice.setRaw haDevice True
#endif
                  BufferMode
_           -> dev -> Bool -> IO ()
forall a. IODevice a => a -> Bool -> IO ()
IODevice.setRaw dev
haDevice Bool
False

          -- throw away spare buffers, they might be the wrong size
          writeIORef haBuffers BufferListNil

          return Handle__{ haBufferMode = mode,.. }

-- -----------------------------------------------------------------------------
-- Setting and getting the text encoding

-- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding
-- for the handle @hdl@ to @encoding@.  The default encoding when a 'Handle' is
-- created is 'GHC.Internal.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 ((Handle__ -> IO Handle__) -> IO ())
-> (Handle__ -> IO Handle__) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do
    Handle__ -> IO ()
flushCharBuffer Handle__
h_
    Handle__ -> IO ()
closeTextCodecs Handle__
h_
    Maybe TextEncoding
-> HandleType
-> (forall es ds.
    Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO Handle__)
-> IO Handle__
forall a.
Maybe TextEncoding
-> HandleType
-> (forall es ds.
    Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
-> IO a
openTextEncoding (TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just TextEncoding
encoding) HandleType
haType ((forall es ds.
  Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO Handle__)
 -> IO Handle__)
-> (forall es ds.
    Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO Handle__)
-> IO Handle__
forall a b. (a -> b) -> a -> b
$ \ Maybe (TextEncoder es)
mb_encoder Maybe (TextDecoder ds)
mb_decoder -> do
    bbuf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
    ref <- newIORef (errorWithoutStackTrace "last_decode")
    return (Handle__{ haLastDecode = ref,
                      haDecoder = mb_decoder,
                      haEncoder = mb_encoder,
                      haCodec   = Just encoding, .. })

-- | 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 =
  String
-> Handle
-> (Handle__ -> IO (Maybe TextEncoding))
-> IO (Maybe TextEncoding)
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hGetEncoding" Handle
hdl ((Handle__ -> IO (Maybe TextEncoding)) -> IO (Maybe TextEncoding))
-> (Handle__ -> IO (Maybe TextEncoding)) -> IO (Maybe TextEncoding)
forall a b. (a -> b) -> a -> b
$ \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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> Maybe TextEncoding -> IO (Maybe TextEncoding)
forall a. a -> IO a
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:
--
--  * 'GHC.Internal.System.IO.Error.isFullError' if the device is full;
--
--  * 'GHC.Internal.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 = String -> Handle -> (Handle__ -> IO ()) -> IO ()
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 buffered
-- data was read, and hence only works if @hdl@ is seekable (see
-- 'hIsSeekable').
--
-- This operation may fail with:
--
--  * 'GHC.Internal.System.IO.Error.isFullError' if the device is full;
--
--  * 'GHC.Internal.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;
--
--  * 'GHC.Internal.System.IO.Error.isIllegalOperation' if @hdl@ has buffered read data, and
--    is not seekable.

hFlushAll :: Handle -> IO ()
hFlushAll :: Handle -> IO ()
hFlushAll Handle
handle = String -> Handle -> (Handle__ -> IO ()) -> IO ()
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 base-4.1.0.0
instance Eq HandlePosn where
    (HandlePosn Handle
h1 Integer
p1) == :: HandlePosn -> HandlePosn -> Bool
== (HandlePosn Handle
h2 Integer
p2) = Integer
p1Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
==Integer
p2 Bool -> Bool -> Bool
&& Handle
h1Handle -> Handle -> Bool
forall a. Eq a => a -> a -> Bool
==Handle
h2

-- | @since base-4.1.0.0
instance Show HandlePosn where
   showsPrec :: Int -> HandlePosn -> String -> String
showsPrec Int
p (HandlePosn Handle
h Integer
pos) =
        Int -> Handle -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
p Handle
h (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" at position " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String -> String
forall a. Show a => a -> String -> String
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
    posn <- Handle -> IO Integer
hTell Handle
handle
    return (HandlePosn handle 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:
--
--  * 'GHC.Internal.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:
--
--  * 'GHC.Internal.System.IO.Error.isIllegalOperationError' if the Handle is not seekable,
--    or does not support the requested seek mode.
--
--  * 'GHC.Internal.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 =
    String -> Handle -> (Handle__ -> IO ()) -> IO ()
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle String
"hSeek" Handle
handle ((Handle__ -> IO ()) -> IO ()) -> (Handle__ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ 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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do
    String -> IO ()
debugIO (String
"hSeek " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SeekMode, Integer) -> String
forall a. Show a => a -> String
show (SeekMode
mode,Integer
offset))
    cbuf <- IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef IORef (Buffer CharBufElem)
haCharBuffer
    bbuf <- readIORef haByteBuffer
    debugIO $ "hSeek - bbuf:" ++ summaryBuffer bbuf
    debugIO $ "hSeek - cbuf:" ++ summaryBuffer cbuf

    if isWriteBuffer cbuf
        then do flushWriteBuffer handle_
                new_offset <- IODevice.seek haDevice mode offset
                -- buffer has been updated, need to re-read it
                bbuf1 <- readIORef haByteBuffer
                let bbuf2 = Buffer Word8
bbuf1{ bufOffset = fromIntegral new_offset }
                debugIO $ "hSeek - seek:: " ++ show offset ++
                          " - " ++ show new_offset
                debugIO $ "hSeek - wr flush bbuf1:" ++ summaryBuffer bbuf2
                writeIORef haByteBuffer bbuf2
        else do

    let r = Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufL Buffer CharBufElem
cbuf; w = Buffer CharBufElem -> Int
forall e. Buffer e -> Int
bufR Buffer CharBufElem
cbuf
    if mode == RelativeSeek && isNothing haDecoder &&
       offset >= 0 && offset < fromIntegral (w - r)
        then writeIORef haCharBuffer cbuf{ bufL = r + fromIntegral offset }
        else do

    flushCharReadBuffer handle_
    flushByteReadBuffer handle_
    -- read the updated values
    bbuf2 <- readIORef haByteBuffer
    new_offset <- IODevice.seek haDevice mode offset
    debugIO $ "hSeek after: " ++ show new_offset
    writeIORef haByteBuffer bbuf2{ bufOffset = fromIntegral 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:
--
--  * 'GHC.Internal.System.IO.Error.isIllegalOperationError' if the Handle is not seekable.
--
hTell :: Handle -> IO Integer
hTell :: Handle -> IO Integer
hTell Handle
handle =
    String -> Handle -> (Handle__ -> IO Integer) -> IO Integer
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle String
"hGetPosn" Handle
handle ((Handle__ -> IO Integer) -> IO Integer)
-> (Handle__ -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \ 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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do

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

      bbuf <- readIORef haByteBuffer
      debugIO ("hTell bbuf (elems=" ++ show (bufferElems bbuf) ++ ")"
               ++ summaryBuffer bbuf)

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

      cbuf <- readIORef haCharBuffer
      debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))
      debugIO ("   cbuf: " ++ summaryBuffer cbuf ++
               "   bbuf: " ++ summaryBuffer bbuf)

      return 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' hdl@ returns whether the handle is open.
-- If the 'haType' of @hdl@ is 'ClosedHandle' or 'SemiClosedHandle' this returns 'False'
-- and 'True' otherwise.
hIsOpen :: Handle -> IO Bool
hIsOpen :: Handle -> IO Bool
hIsOpen Handle
handle =
    String -> Handle -> (Handle__ -> IO Bool) -> IO Bool
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsOpen" Handle
handle ((Handle__ -> IO Bool) -> IO Bool)
-> (Handle__ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      HandleType
SemiClosedHandle     -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      HandleType
_                    -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | @'hIsClosed' hdl@ returns whether the handle is closed.
-- If the 'haType' of @hdl@ is 'ClosedHandle' this returns 'True'
-- and 'False' otherwise.
hIsClosed :: Handle -> IO Bool
hIsClosed :: Handle -> IO Bool
hIsClosed Handle
handle =
    String -> Handle -> (Handle__ -> IO Bool) -> IO Bool
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsClosed" Handle
handle ((Handle__ -> IO Bool) -> IO Bool)
-> (Handle__ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      HandleType
_                    -> Bool -> IO Bool
forall a. a -> IO a
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' hdl@ returns whether it is possible to read from the handle.
hIsReadable :: Handle -> IO Bool
hIsReadable :: Handle -> IO Bool
hIsReadable handle :: Handle
handle@(FileHandle String
_ MVar Handle__
var)
    = Handle -> MVar Handle__ -> IO Bool
hIsReadable' Handle
handle MVar Handle__
var
hIsReadable handle :: Handle
handle@(DuplexHandle String
_ MVar Handle__
readingVar MVar Handle__
_)
    = Handle -> MVar Handle__ -> IO Bool
hIsReadable' Handle
handle MVar Handle__
readingVar

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

-- | @'hIsWritable' hdl@ returns whether it is possible to write to the handle.
hIsWritable :: Handle -> IO Bool
hIsWritable :: Handle -> IO Bool
hIsWritable handle :: Handle
handle@(FileHandle String
_ MVar Handle__
var)
    = Handle -> MVar Handle__ -> IO Bool
hIsWritable' Handle
handle MVar Handle__
var
hIsWritable handle :: Handle
handle@(DuplexHandle String
_ MVar Handle__
_ MVar Handle__
writingVar)
    = Handle -> MVar Handle__ -> IO Bool
hIsWritable' Handle
handle MVar Handle__
writingVar

hIsWritable' :: Handle -> MVar Handle__ -> IO Bool
hIsWritable' :: Handle -> MVar Handle__ -> IO Bool
hIsWritable' Handle
handle MVar Handle__
writingVar =
    String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Bool) -> IO Bool
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hIsWritable" Handle
handle MVar Handle__
writingVar ((Handle__ -> IO Bool) -> IO Bool)
-> (Handle__ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> IO Bool
forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle     -> IO Bool
forall a. IO a
ioe_semiclosedHandle
      HandleType
htype                -> Bool -> IO Bool
forall a. a -> IO a
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 =
    String -> Handle -> (Handle__ -> IO BufferMode) -> IO BufferMode
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hGetBuffering" Handle
handle ((Handle__ -> IO BufferMode) -> IO BufferMode)
-> (Handle__ -> IO BufferMode) -> IO BufferMode
forall a b. (a -> b) -> a -> b
$ \ Handle__
handle_ -> do
    case Handle__ -> HandleType
haType Handle__
handle_ of
      HandleType
ClosedHandle         -> IO BufferMode
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
          BufferMode -> IO BufferMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__ -> BufferMode
haBufferMode Handle__
handle_)  -- could be stricter..

-- | @'hIsSeekable' hdl@ returns whether it is possible to 'hSeek' with the given handle.
hIsSeekable :: Handle -> IO Bool
hIsSeekable :: Handle -> IO Bool
hIsSeekable Handle
handle =
    String -> Handle -> (Handle__ -> IO Bool) -> IO Bool
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsSeekable" Handle
handle ((Handle__ -> IO Bool) -> IO Bool)
-> (Handle__ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ 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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do
    case HandleType
haType of
      HandleType
ClosedHandle         -> IO Bool
forall a. IO a
ioe_closedHandle
      HandleType
SemiClosedHandle     -> IO Bool
forall a. IO a
ioe_semiclosedHandle
      HandleType
AppendHandle         -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      HandleType
_                    -> dev -> IO Bool
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
    isT   <- Handle -> IO Bool
hIsTerminalDevice Handle
handle
    if not isT
     then return ()
     else
      withHandle_ "hSetEcho" handle $ \ Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do
      case HandleType
haType of
         HandleType
ClosedHandle -> IO ()
forall a. IO a
ioe_closedHandle
         HandleType
_            -> dev -> Bool -> IO ()
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
    isT   <- Handle -> IO Bool
hIsTerminalDevice Handle
handle
    if not isT
     then return False
     else
       withHandle_ "hGetEcho" handle $ \ Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do
       case HandleType
haType of
         HandleType
ClosedHandle -> IO Bool
forall a. IO a
ioe_closedHandle
         HandleType
_            -> dev -> IO Bool
forall a. IODevice a => a -> IO Bool
IODevice.getEcho dev
haDevice

-- | Is the handle connected to a terminal?
--
-- On Windows the result of 'hIsTerminalDevide' might be misleading,
-- because non-native terminals, such as MinTTY used in MSYS environments,
-- are implemented via redirection.
-- Use @System.Win32.Types.withHandleToHANDLE System.Win32.MinTTY.isMinTTYHandle@
-- to recognise it. Also consider @ansi-terminal@ package for crossplatform terminal
-- support.
--
hIsTerminalDevice :: Handle -> IO Bool
hIsTerminalDevice :: Handle -> IO Bool
hIsTerminalDevice Handle
handle =
    String -> Handle -> (Handle__ -> IO Bool) -> IO Bool
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hIsTerminalDevice" Handle
handle ((Handle__ -> IO Bool) -> IO Bool)
-> (Handle__ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Handle__{dev
Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} -> do
     case HandleType
haType of
       HandleType
ClosedHandle -> IO Bool
forall a. IO a
ioe_closedHandle
       HandleType
_            -> dev -> IO Bool
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 ((Handle__ -> IO Handle__) -> IO ())
-> (Handle__ -> IO Handle__) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ 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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} ->
    do
         Handle__ -> IO ()
flushCharBuffer Handle__
h_
         Handle__ -> IO ()
closeTextCodecs Handle__
h_

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

         openTextEncoding mb_te haType $ \ 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

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

         return Handle__{ haLastDecode = ref,
                          haEncoder  = mb_encoder,
                          haDecoder  = mb_decoder,
                          haCodec    = mb_te,
                          haInputNL  = inputNL nl,
                          haOutputNL = outputNL nl, .. }

-- -----------------------------------------------------------------------------
-- Setting and getting the newline mode

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

-- | Return the current 'NewlineMode' for the specified 'Handle'.
--
-- @since 4.23.0.0
hGetNewlineMode :: Handle -> IO NewlineMode
hGetNewlineMode :: Handle -> IO NewlineMode
hGetNewlineMode Handle
hdl =
  String -> Handle -> (Handle__ -> IO NewlineMode) -> IO NewlineMode
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"hGetNewlineMode" Handle
hdl ((Handle__ -> IO NewlineMode) -> IO NewlineMode)
-> (Handle__ -> IO NewlineMode) -> IO NewlineMode
forall a b. (a -> b) -> a -> b
$ \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 CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} ->
    NewlineMode -> IO NewlineMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NewlineMode{ inputNL :: Newline
inputNL = Newline
haInputNL, outputNL :: Newline
outputNL = Newline
haOutputNL }

-- -----------------------------------------------------------------------------
-- 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) =
  String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicate" Handle
h MVar Handle__
m ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
      String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle String
path Handle
h Maybe (MVar Handle__)
forall a. Maybe a
Nothing Handle__
h_ (HandleFinalizer -> Maybe HandleFinalizer
forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
hDuplicate h :: Handle
h@(DuplexHandle String
path MVar Handle__
r MVar Handle__
w) = do
  write_side@(FileHandle _ write_m) <-
     String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicate" Handle
h MVar Handle__
w ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \Handle__
h_ ->
        String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle String
path Handle
h Maybe (MVar Handle__)
forall a. Maybe a
Nothing Handle__
h_ (HandleFinalizer -> Maybe HandleFinalizer
forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
  read_side@(FileHandle _ read_m) <-
    withHandle_' "hDuplicate" h r $ \Handle__
h_ ->
        String
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle String
path Handle
h (MVar Handle__ -> Maybe (MVar Handle__)
forall a. a -> Maybe a
Just MVar Handle__
write_m) Handle__
h_  Maybe HandleFinalizer
forall a. Maybe a
Nothing
  return (DuplexHandle path read_m 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 TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} 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
       new_dev <- dev -> IO dev
forall a. IODevice a => a -> IO a
IODevice.dup dev
haDevice
       dupHandle_ new_dev filepath other_side h_ mb_finalizer
    Just MVar Handle__
r  ->
       String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle) -> IO Handle
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"dupHandle" Handle
h MVar Handle__
r ((Handle__ -> IO Handle) -> IO Handle)
-> (Handle__ -> IO Handle) -> IO Handle
forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
dev} ->
         dev
-> String
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
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 TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer CharBufElem)
IORef (Buffer Word8)
IORef (BufferList CharBufElem)
Newline
BufferMode
HandleType
haDevice :: ()
haType :: Handle__ -> HandleType
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList CharBufElem)
haCharBuffer :: Handle__ -> IORef (Buffer CharBufElem)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haDevice :: dev
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer CharBufElem)
haBuffers :: IORef (BufferList CharBufElem)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
..} Maybe HandleFinalizer
mb_finalizer = do
   -- XXX wrong!
  mb_codec <- if Maybe (TextEncoder enc_state) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (TextEncoder enc_state)
haEncoder then (TextEncoding -> Maybe TextEncoding)
-> IO TextEncoding -> IO (Maybe TextEncoding)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEncoding -> Maybe TextEncoding
TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just IO TextEncoding
getLocaleEncoding else Maybe TextEncoding -> IO (Maybe TextEncoding)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextEncoding
forall a. Maybe a
Nothing
  mkHandle new_dev filepath haType True{-buffered-} mb_codec
      NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }
      mb_finalizer 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 ((Handle__ -> IO Handle__) -> IO ())
-> (Handle__ -> IO Handle__) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle__
h2_ -> do
   IO () -> IO ()
try (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushWriteBuffer Handle__
h2_
   String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO Handle__)
-> IO Handle__
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicateTo" Handle
h1 MVar Handle__
m1 ((Handle__ -> IO Handle__) -> IO Handle__)
-> (Handle__ -> IO Handle__) -> IO Handle__
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 Maybe (MVar Handle__)
forall a. Maybe a
Nothing Handle__
h2_ Handle__
h1_ (HandleFinalizer -> Maybe HandleFinalizer
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  ((Handle__ -> IO Handle__) -> IO ())
-> (Handle__ -> IO Handle__) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle__
w2_ -> do
   IO () -> IO ()
try (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushWriteBuffer Handle__
w2_
   String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO Handle__)
-> IO Handle__
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicateTo" Handle
h1 MVar Handle__
w1 ((Handle__ -> IO Handle__) -> IO Handle__)
-> (Handle__ -> IO Handle__) -> IO Handle__
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 Maybe (MVar Handle__)
forall a. Maybe a
Nothing Handle__
w2_ Handle__
w1_ (HandleFinalizer -> Maybe HandleFinalizer
forall a. a -> Maybe a
Just HandleFinalizer
handleFinalizer)
 String
-> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__) -> IO ()
withHandle__' String
"hDuplicateTo" Handle
h2 MVar Handle__
r2  ((Handle__ -> IO Handle__) -> IO ())
-> (Handle__ -> IO Handle__) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle__
r2_ -> do
   IO () -> IO ()
try (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle__ -> IO ()
flushWriteBuffer Handle__
r2_
   String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO Handle__)
-> IO Handle__
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
"hDuplicateTo" Handle
h1 MVar Handle__
r1 ((Handle__ -> IO Handle__) -> IO Handle__)
-> (Handle__ -> IO Handle__) -> IO Handle__
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 (MVar Handle__ -> Maybe (MVar Handle__)
forall a. a -> Maybe a
Just MVar Handle__
w1) Handle__
r2_ Handle__
r1_ Maybe HandleFinalizer
forall a. Maybe a
Nothing
hDuplicateTo Handle
h1 Handle
_ =
  Handle -> IO ()
forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h1

try :: IO () -> IO ()
try :: IO () -> IO ()
try IO ()
io = IO ()
io IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catchException` (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
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 =
   IOException -> IO a
forall a. HasCallStack => IOException -> IO a
ioException (Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h) IOErrorType
IllegalOperation String
"hDuplicateTo"
                String
"handles are incompatible" Maybe CInt
forall a. Maybe a
Nothing Maybe String
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 dev -> Maybe dev
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
devTo of
    Maybe dev
Nothing   -> Handle -> IO Handle__
forall a. Handle -> IO a
ioe_dupHandlesNotCompatible Handle
h
    Just dev
dev' -> do
      _ <- dev -> dev -> IO dev
forall a. IODevice a => a -> a -> IO a
IODevice.dup2 dev
dev dev
dev'
      FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
      takeMVar 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 =
  String -> Handle -> (Handle__ -> IO String) -> IO String
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
withHandle_ String
"showHandle" Handle
h ((Handle__ -> IO String) -> IO String)
-> (Handle__ -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Handle__
hdl_ ->
    let
     showType :: String -> String
showType | Bool
is_duplex = String -> String -> String
showString String
"duplex (read-write)"
              | Bool
otherwise = HandleType -> String -> String
forall a. Show a => a -> String -> String
shows (Handle__ -> HandleType
haType Handle__
hdl_)
    in
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      (( CharBufElem -> String -> String
showChar CharBufElem
'{' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        HandleType -> (String -> String) -> String -> String
showHdl (Handle__ -> HandleType
haType Handle__
hdl_)
            (String -> String -> String
showString String
"loc=" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
filepath (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharBufElem -> String -> String
showChar CharBufElem
',' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             String -> String -> String
showString String
"type=" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
showType (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharBufElem -> String -> String
showChar CharBufElem
',' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             String -> String -> String
showString String
"buffering=" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer CharBufElem -> BufferMode -> String -> String
forall e. Buffer e -> BufferMode -> String -> String
showBufMode (IO (Buffer CharBufElem) -> Buffer CharBufElem
forall a. IO a -> a
unsafePerformIO (IORef (Buffer CharBufElem) -> IO (Buffer CharBufElem)
forall a. IORef a -> IO a
readIORef (Handle__ -> IORef (Buffer CharBufElem)
haCharBuffer Handle__
hdl_))) (Handle__ -> BufferMode
haBufferMode Handle__
hdl_) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
"}" )
      ) String
"")
   where

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

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