1 {-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
6 -----------------------------------------------------------------------------
9 -- Copyright : (c) The University of Glasgow, 1994-2001
10 -- License : see libraries/base/LICENSE
12 -- Maintainer : libraries@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable
16 -- This module defines the basic operations on I\/O \"handles\".
18 -----------------------------------------------------------------------------
21 withHandle, withHandle', withHandle_,
22 wantWritableHandle, wantReadableHandle, wantSeekableHandle,
24 newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
25 flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
26 readRawBuffer, readRawBufferPtr,
27 writeRawBuffer, writeRawBufferPtr,
30 {- ought to be unnecessary, but just in case.. -}
31 write_off, write_rawBuffer,
32 read_off, read_rawBuffer,
34 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
36 stdin, stdout, stderr,
37 IOMode(..), openFile, openBinaryFile, openFd, fdToHandle,
38 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
39 hFlush, hDuplicate, hDuplicateTo,
43 HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
44 SeekMode(..), hSeek, hTell,
46 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
47 hSetEcho, hGetEcho, hIsTerminalDevice,
64 import System.IO.Error
65 import System.Posix.Internals
71 import GHC.Read ( Read )
76 import GHC.Num ( Integer(..), Num(..) )
78 import GHC.Real ( toInteger )
82 -- -----------------------------------------------------------------------------
85 -- hWaitForInput blocks (should use a timeout)
87 -- unbuffered hGetLine is a bit dodgy
89 -- hSetBuffering: can't change buffering on a stream,
90 -- when the read buffer is non-empty? (no way to flush the buffer)
92 -- ---------------------------------------------------------------------------
93 -- Are files opened by default in text or binary mode, if the user doesn't
96 dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
98 -- ---------------------------------------------------------------------------
99 -- Creating a new handle
101 newFileHandle :: FilePath -> (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
102 newFileHandle filepath finalizer hc = do
104 addMVarFinalizer m (finalizer m)
105 return (FileHandle filepath m)
107 -- ---------------------------------------------------------------------------
108 -- Working with Handles
111 In the concurrent world, handles are locked during use. This is done
112 by wrapping an MVar around the handle which acts as a mutex over
113 operations on the handle.
115 To avoid races, we use the following bracketing operations. The idea
116 is to obtain the lock, do some operation and replace the lock again,
117 whether the operation succeeded or failed. We also want to handle the
118 case where the thread receives an exception while processing the IO
119 operation: in these cases we also want to relinquish the lock.
121 There are three versions of @withHandle@: corresponding to the three
122 possible combinations of:
124 - the operation may side-effect the handle
125 - the operation may return a result
127 If the operation generates an error or an exception is raised, the
128 original handle is always replaced [ this is the case at the moment,
129 but we might want to revisit this in the future --SDM ].
132 {-# INLINE withHandle #-}
133 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
134 withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
135 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
137 withHandle' :: String -> Handle -> MVar Handle__
138 -> (Handle__ -> IO (Handle__,a)) -> IO a
139 withHandle' fun h m act =
142 checkBufferInvariants h_
143 (h',v) <- catchException (act h_)
144 (\ err -> putMVar m h_ >>
146 IOException ex -> ioError (augmentIOError ex fun h)
148 checkBufferInvariants h'
152 {-# INLINE withHandle_ #-}
153 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
154 withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
155 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
157 withHandle_' fun h m act =
160 checkBufferInvariants h_
161 v <- catchException (act h_)
162 (\ err -> putMVar m h_ >>
164 IOException ex -> ioError (augmentIOError ex fun h)
166 checkBufferInvariants h_
170 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
171 withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
172 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
173 withHandle__' fun h r act
174 withHandle__' fun h w act
176 withHandle__' fun h m act =
179 checkBufferInvariants h_
180 h' <- catchException (act h_)
181 (\ err -> putMVar m h_ >>
183 IOException ex -> ioError (augmentIOError ex fun h)
185 checkBufferInvariants h'
189 augmentIOError (IOError _ iot _ str fp) fun h
190 = IOError (Just h) iot fun str filepath
193 | otherwise = case h of
194 FileHandle fp _ -> Just fp
195 DuplexHandle fp _ _ -> Just fp
197 -- ---------------------------------------------------------------------------
198 -- Wrapper for write operations.
200 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
201 wantWritableHandle fun h@(FileHandle _ m) act
202 = wantWritableHandle' fun h m act
203 wantWritableHandle fun h@(DuplexHandle _ _ m) act
204 = wantWritableHandle' fun h m act
205 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
208 :: String -> Handle -> MVar Handle__
209 -> (Handle__ -> IO a) -> IO a
210 wantWritableHandle' fun h m act
211 = withHandle_' fun h m (checkWritableHandle act)
213 checkWritableHandle act handle_
214 = case haType handle_ of
215 ClosedHandle -> ioe_closedHandle
216 SemiClosedHandle -> ioe_closedHandle
217 ReadHandle -> ioe_notWritable
218 ReadWriteHandle -> do
219 let ref = haBuffer handle_
222 if not (bufferIsWritable buf)
223 then do b <- flushReadBuffer (haFD handle_) buf
224 return b{ bufState=WriteBuffer }
226 writeIORef ref new_buf
228 _other -> act handle_
230 -- ---------------------------------------------------------------------------
231 -- Wrapper for read operations.
233 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
234 wantReadableHandle fun h@(FileHandle _ m) act
235 = wantReadableHandle' fun h m act
236 wantReadableHandle fun h@(DuplexHandle _ m _) act
237 = wantReadableHandle' fun h m act
238 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
241 :: String -> Handle -> MVar Handle__
242 -> (Handle__ -> IO a) -> IO a
243 wantReadableHandle' fun h m act
244 = withHandle_' fun h m (checkReadableHandle act)
246 checkReadableHandle act handle_ =
247 case haType handle_ of
248 ClosedHandle -> ioe_closedHandle
249 SemiClosedHandle -> ioe_closedHandle
250 AppendHandle -> ioe_notReadable
251 WriteHandle -> ioe_notReadable
252 ReadWriteHandle -> do
253 let ref = haBuffer handle_
255 when (bufferIsWritable buf) $ do
256 new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
257 writeIORef ref new_buf{ bufState=ReadBuffer }
259 _other -> act handle_
261 -- ---------------------------------------------------------------------------
262 -- Wrapper for seek operations.
264 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
265 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
266 ioException (IOError (Just h) IllegalOperation fun
267 "handle is not seekable" Nothing)
268 wantSeekableHandle fun h@(FileHandle _ m) act =
269 withHandle_' fun h m (checkSeekableHandle act)
271 checkSeekableHandle act handle_ =
272 case haType handle_ of
273 ClosedHandle -> ioe_closedHandle
274 SemiClosedHandle -> ioe_closedHandle
275 AppendHandle -> ioe_notSeekable
276 _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
277 | otherwise -> ioe_notSeekable_notBin
279 -- -----------------------------------------------------------------------------
282 ioe_closedHandle, ioe_EOF,
283 ioe_notReadable, ioe_notWritable,
284 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
286 ioe_closedHandle = ioException
287 (IOError Nothing IllegalOperation ""
288 "handle is closed" Nothing)
289 ioe_EOF = ioException
290 (IOError Nothing EOF "" "" Nothing)
291 ioe_notReadable = ioException
292 (IOError Nothing IllegalOperation ""
293 "handle is not open for reading" Nothing)
294 ioe_notWritable = ioException
295 (IOError Nothing IllegalOperation ""
296 "handle is not open for writing" Nothing)
297 ioe_notSeekable = ioException
298 (IOError Nothing IllegalOperation ""
299 "handle is not seekable" Nothing)
300 ioe_notSeekable_notBin = ioException
301 (IOError Nothing IllegalOperation ""
302 "seek operations on text-mode handles are not allowed on this platform"
305 ioe_bufsiz :: Int -> IO a
306 ioe_bufsiz n = ioException
307 (IOError Nothing InvalidArgument "hSetBuffering"
308 ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
309 -- 9 => should be parens'ified.
311 -- -----------------------------------------------------------------------------
314 -- For a duplex handle, we arrange that the read side points to the write side
315 -- (and hence keeps it alive if the read side is alive). This is done by
316 -- having the haOtherSide field of the read side point to the read side.
317 -- The finalizer is then placed on the write side, and the handle only gets
318 -- finalized once, when both sides are no longer required.
320 stdHandleFinalizer :: MVar Handle__ -> IO ()
321 stdHandleFinalizer m = do
323 flushWriteBufferOnly h_
325 handleFinalizer :: MVar Handle__ -> IO ()
326 handleFinalizer m = do
327 handle_ <- takeMVar m
328 case haType handle_ of
329 ClosedHandle -> return ()
330 _ -> do flushWriteBufferOnly handle_ `catchException` \_ -> return ()
331 -- ignore errors and async exceptions, and close the
332 -- descriptor anyway...
333 hClose_handle_ handle_
336 -- ---------------------------------------------------------------------------
337 -- Grimy buffer operations
340 checkBufferInvariants h_ = do
341 let ref = haBuffer h_
342 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
347 && ( r /= w || (r == 0 && w == 0) )
348 && ( state /= WriteBuffer || r == 0 )
349 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
351 then error "buffer invariant violation"
354 checkBufferInvariants h_ = return ()
357 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
358 newEmptyBuffer b state size
359 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
361 allocateBuffer :: Int -> BufferState -> IO Buffer
362 allocateBuffer sz@(I# size) state = IO $ \s ->
363 #ifdef mingw32_TARGET_OS
364 -- To implement asynchronous I/O under Win32, we have to pass
365 -- buffer references to external threads that handles the
366 -- filling/emptying of their contents. Hence, the buffer cannot
367 -- be moved around by the GC.
368 case newPinnedByteArray# size s of { (# s, b #) ->
370 case newByteArray# size s of { (# s, b #) ->
372 (# s, newEmptyBuffer b state sz #) }
374 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
375 writeCharIntoBuffer slab (I# off) (C# c)
376 = IO $ \s -> case writeCharArray# slab off c s of
377 s -> (# s, I# (off +# 1#) #)
379 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
380 readCharFromBuffer slab (I# off)
381 = IO $ \s -> case readCharArray# slab off s of
382 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
384 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
385 getBuffer fd state = do
386 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
387 ioref <- newIORef buffer
391 | is_tty = LineBuffering
392 | otherwise = BlockBuffering Nothing
394 return (ioref, buffer_mode)
396 mkUnBuffer :: IO (IORef Buffer)
398 buffer <- allocateBuffer 1 ReadBuffer
401 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
402 flushWriteBufferOnly :: Handle__ -> IO ()
403 flushWriteBufferOnly h_ = do
407 new_buf <- if bufferIsWritable buf
408 then flushWriteBuffer fd (haIsStream h_) buf
410 writeIORef ref new_buf
412 -- flushBuffer syncs the file with the buffer, including moving the
413 -- file pointer backwards in the case of a read buffer.
414 flushBuffer :: Handle__ -> IO ()
416 let ref = haBuffer h_
421 ReadBuffer -> flushReadBuffer (haFD h_) buf
422 WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
424 writeIORef ref flushed_buf
426 -- When flushing a read buffer, we seek backwards by the number of
427 -- characters in the buffer. The file descriptor must therefore be
428 -- seekable: attempting to flush the read buffer on an unseekable
429 -- handle is not allowed.
431 flushReadBuffer :: FD -> Buffer -> IO Buffer
432 flushReadBuffer fd buf
433 | bufferEmpty buf = return buf
435 let off = negate (bufWPtr buf - bufRPtr buf)
437 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
439 throwErrnoIfMinus1Retry "flushReadBuffer"
440 (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
441 return buf{ bufWPtr=0, bufRPtr=0 }
443 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
444 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
447 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
450 then return (buf{ bufRPtr=0, bufWPtr=0 })
452 res <- writeRawBuffer "flushWriteBuffer" (fromIntegral fd) is_stream b
453 (fromIntegral r) (fromIntegral bytes)
454 let res' = fromIntegral res
456 then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
457 else return buf{ bufRPtr=0, bufWPtr=0 }
459 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
460 fillReadBuffer fd is_line is_stream
461 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
462 -- buffer better be empty:
463 assert (r == 0 && w == 0) $ do
464 fillReadBufferLoop fd is_line is_stream buf b w size
466 -- For a line buffer, we just get the first chunk of data to arrive,
467 -- and don't wait for the whole buffer to be full (but we *do* wait
468 -- until some data arrives). This isn't really line buffering, but it
469 -- appears to be what GHC has done for a long time, and I suspect it
470 -- is more useful than line buffering in most cases.
472 fillReadBufferLoop fd is_line is_stream buf b w size = do
474 if bytes == 0 -- buffer full?
475 then return buf{ bufRPtr=0, bufWPtr=w }
478 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
480 res <- readRawBuffer "fillReadBuffer" fd is_stream b
481 (fromIntegral w) (fromIntegral bytes)
482 let res' = fromIntegral res
484 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
489 else return buf{ bufRPtr=0, bufWPtr=w }
490 else if res' < bytes && not is_line
491 then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
492 else return buf{ bufRPtr=0, bufWPtr=w+res' }
495 -- Low level routines for reading/writing to (raw)buffers:
497 #ifndef mingw32_TARGET_OS
498 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
499 readRawBuffer loc fd is_stream buf off len =
500 throwErrnoIfMinus1RetryMayBlock loc
501 (read_rawBuffer fd is_stream buf off len)
504 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
505 readRawBufferPtr loc fd is_stream buf off len =
506 throwErrnoIfMinus1RetryMayBlock loc
507 (read_off fd is_stream buf off len)
510 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
511 writeRawBuffer loc fd is_stream buf off len =
512 throwErrnoIfMinus1RetryMayBlock loc
513 (write_rawBuffer (fromIntegral fd) is_stream buf off len)
516 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
517 writeRawBufferPtr loc fd is_stream buf off len =
518 throwErrnoIfMinus1RetryMayBlock loc
519 (write_off (fromIntegral fd) is_stream buf off len)
522 foreign import ccall unsafe "__hscore_PrelHandle_read"
523 read_rawBuffer :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
525 foreign import ccall unsafe "__hscore_PrelHandle_read"
526 read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
528 foreign import ccall unsafe "__hscore_PrelHandle_write"
529 write_rawBuffer :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
531 foreign import ccall unsafe "__hscore_PrelHandle_write"
532 write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
535 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
536 readRawBuffer loc fd is_stream buf off len = do
537 (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf
540 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
541 else return (fromIntegral l)
543 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
544 readRawBufferPtr loc fd is_stream buf off len = do
545 (l, rc) <- asyncRead fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off)
548 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
549 else return (fromIntegral l)
551 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
552 writeRawBuffer loc fd is_stream buf off len = do
553 (l, rc) <- asyncWriteBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf
556 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
557 else return (fromIntegral l)
559 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
560 writeRawBufferPtr loc fd is_stream buf off len = do
561 (l, rc) <- asyncWrite fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off)
564 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
565 else return (fromIntegral l)
567 foreign import ccall unsafe "__hscore_PrelHandle_read"
568 read_rawBuffer :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
570 foreign import ccall unsafe "__hscore_PrelHandle_read"
571 read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
573 foreign import ccall unsafe "__hscore_PrelHandle_write"
574 write_rawBuffer :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
576 foreign import ccall unsafe "__hscore_PrelHandle_write"
577 write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
581 -- ---------------------------------------------------------------------------
584 -- Three handles are allocated during program initialisation. The first
585 -- two manage input or output from the Haskell program's standard input
586 -- or output channel respectively. The third manages output to the
587 -- standard error channel. These handles are initially open.
593 -- | A handle managing input from the Haskell program's standard input channel.
595 stdin = unsafePerformIO $ do
596 -- ToDo: acquire lock
597 setNonBlockingFD fd_stdin
598 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
599 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
601 -- | A handle managing output to the Haskell program's standard output channel.
603 stdout = unsafePerformIO $ do
604 -- ToDo: acquire lock
605 -- We don't set non-blocking mode on stdout or sterr, because
606 -- some shells don't recover properly.
607 -- setNonBlockingFD fd_stdout
608 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
609 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
611 -- | A handle managing output to the Haskell program's standard error channel.
613 stderr = unsafePerformIO $ do
614 -- ToDo: acquire lock
615 -- We don't set non-blocking mode on stdout or sterr, because
616 -- some shells don't recover properly.
617 -- setNonBlockingFD fd_stderr
619 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
621 -- ---------------------------------------------------------------------------
622 -- Opening and Closing Files
624 addFilePathToIOError fun fp (IOError h iot _ str _)
625 = IOError h iot fun str (Just fp)
627 -- | Computation 'openFile' @file mode@ allocates and returns a new, open
628 -- handle to manage the file @file@. It manages input if @mode@
629 -- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
630 -- and both input and output if mode is 'ReadWriteMode'.
632 -- If the file does not exist and it is opened for output, it should be
633 -- created as a new file. If @mode@ is 'WriteMode' and the file
634 -- already exists, then it should be truncated to zero length.
635 -- Some operating systems delete empty files, so there is no guarantee
636 -- that the file will exist following an 'openFile' with @mode@
637 -- 'WriteMode' unless it is subsequently written to successfully.
638 -- The handle is positioned at the end of the file if @mode@ is
639 -- 'AppendMode', and otherwise at the beginning (in which case its
640 -- internal position is 0).
641 -- The initial buffer mode is implementation-dependent.
643 -- This operation may fail with:
645 -- * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
647 -- * 'isDoesNotExistError' if the file does not exist; or
649 -- * 'isPermissionError' if the user does not have permission to open the file.
651 openFile :: FilePath -> IOMode -> IO Handle
654 (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
655 (\e -> ioError (addFilePathToIOError "openFile" fp e))
657 -- | Like 'openFile', but open the file in binary mode.
658 -- On Windows, reading a file in text mode (which is the default)
659 -- will translate CRLF to LF, and writing will translate LF to CRLF.
660 -- This is usually what you want with text files. With binary files
661 -- this is undesirable; also, as usual under Microsoft operating systems,
662 -- text mode treats control-Z as EOF. Binary mode turns off all special
663 -- treatment of end-of-line and end-of-file characters.
664 -- (See also 'hSetBinaryMode'.)
666 openBinaryFile :: FilePath -> IOMode -> IO Handle
667 openBinaryFile fp m =
669 (openFile' fp m True)
670 (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
672 openFile' filepath mode binary =
673 withCString filepath $ \ f ->
676 oflags1 = case mode of
677 ReadMode -> read_flags
678 WriteMode -> write_flags
679 ReadWriteMode -> rw_flags
680 AppendMode -> append_flags
682 truncate | WriteMode <- mode = True
689 oflags = oflags1 .|. binary_flags
692 -- the old implementation had a complicated series of three opens,
693 -- which is perhaps because we have to be careful not to open
694 -- directories. However, the man pages I've read say that open()
695 -- always returns EISDIR if the file is a directory and was opened
696 -- for writing, so I think we're ok with a single open() here...
697 fd <- fromIntegral `liftM`
698 throwErrnoIfMinus1Retry "openFile"
699 (c_open f (fromIntegral oflags) 0o666)
701 openFd fd Nothing filepath mode binary truncate
702 -- ASSERT: if we just created the file, then openFd won't fail
703 -- (so we don't need to worry about removing the newly created file
704 -- in the event of an error).
707 std_flags = o_NONBLOCK .|. o_NOCTTY
708 output_flags = std_flags .|. o_CREAT
709 read_flags = std_flags .|. o_RDONLY
710 write_flags = output_flags .|. o_WRONLY
711 rw_flags = output_flags .|. o_RDWR
712 append_flags = write_flags .|. o_APPEND
714 -- ---------------------------------------------------------------------------
717 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
718 openFd fd mb_fd_type filepath mode binary truncate = do
719 -- turn on non-blocking mode
722 let (ha_type, write) =
724 ReadMode -> ( ReadHandle, False )
725 WriteMode -> ( WriteHandle, True )
726 ReadWriteMode -> ( ReadWriteHandle, True )
727 AppendMode -> ( AppendHandle, True )
729 -- open() won't tell us if it was a directory if we only opened for
730 -- reading, so check again.
735 let is_stream = fd_type == Stream
738 ioException (IOError Nothing InappropriateType "openFile"
739 "is a directory" Nothing)
742 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
743 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
745 -- regular files need to be locked
747 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
749 ioException (IOError Nothing ResourceBusy "openFile"
750 "file is locked" Nothing)
752 -- truncate the file if necessary
753 when truncate (fileTruncate filepath)
755 mkFileHandle fd is_stream filepath ha_type binary
758 fdToHandle :: FD -> IO Handle
761 let fd_str = "<file descriptor: " ++ show fd ++ ">"
762 openFd fd Nothing fd_str mode True{-bin mode-} False{-no truncate-}
764 foreign import ccall unsafe "lockFile"
765 lockFile :: CInt -> CInt -> CInt -> IO CInt
767 foreign import ccall unsafe "unlockFile"
768 unlockFile :: CInt -> IO CInt
770 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
772 mkStdHandle fd filepath ha_type buf bmode = do
773 spares <- newIORef BufferListNil
774 newFileHandle filepath stdHandleFinalizer
775 (Handle__ { haFD = fd,
777 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
779 haBufferMode = bmode,
782 haOtherSide = Nothing
785 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
786 mkFileHandle fd is_stream filepath ha_type binary = do
787 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
788 spares <- newIORef BufferListNil
789 newFileHandle filepath handleFinalizer
790 (Handle__ { haFD = fd,
793 haIsStream = is_stream,
794 haBufferMode = bmode,
797 haOtherSide = Nothing
800 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
801 mkDuplexHandle fd is_stream filepath binary = do
802 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
803 w_spares <- newIORef BufferListNil
805 Handle__ { haFD = fd,
806 haType = WriteHandle,
808 haIsStream = is_stream,
809 haBufferMode = w_bmode,
811 haBuffers = w_spares,
812 haOtherSide = Nothing
814 write_side <- newMVar w_handle_
816 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
817 r_spares <- newIORef BufferListNil
819 Handle__ { haFD = fd,
822 haIsStream = is_stream,
823 haBufferMode = r_bmode,
825 haBuffers = r_spares,
826 haOtherSide = Just write_side
828 read_side <- newMVar r_handle_
830 addMVarFinalizer write_side (handleFinalizer write_side)
831 return (DuplexHandle filepath read_side write_side)
834 initBufferState ReadHandle = ReadBuffer
835 initBufferState _ = WriteBuffer
837 -- ---------------------------------------------------------------------------
840 -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the
841 -- computation finishes, if @hdl@ is writable its buffer is flushed as
843 -- Performing 'hClose' on a handle that has already been closed has no effect;
844 -- doing so not an error. All other operations on a closed handle will fail.
845 -- If 'hClose' fails for any reason, any further operations (apart from
846 -- 'hClose') on the handle will still fail as if @hdl@ had been successfully
849 hClose :: Handle -> IO ()
850 hClose h@(FileHandle _ m) = hClose' h m
851 hClose h@(DuplexHandle _ r w) = hClose' h w >> hClose' h r
853 hClose' h m = withHandle__' "hClose" h m $ hClose_help
855 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
856 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
857 -- then closed immediately. We have to be careful with DuplexHandles
858 -- though: we have to leave the closing to the finalizer in that case,
859 -- because the write side may still be in use.
860 hClose_help :: Handle__ -> IO Handle__
861 hClose_help handle_ =
862 case haType handle_ of
863 ClosedHandle -> return handle_
864 _ -> do flushWriteBufferOnly handle_ -- interruptible
865 hClose_handle_ handle_
867 hClose_handle_ handle_ = do
868 let fd = haFD handle_
869 c_fd = fromIntegral fd
871 -- close the file descriptor, but not when this is the read
872 -- side of a duplex handle, and not when this is one of the
874 case haOtherSide handle_ of
876 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
877 throwErrnoIfMinus1Retry_ "hClose"
878 #ifdef mingw32_TARGET_OS
879 (closeFd (haIsStream handle_) c_fd)
885 -- free the spare buffers
886 writeIORef (haBuffers handle_) BufferListNil
891 -- we must set the fd to -1, because the finalizer is going
892 -- to run eventually and try to close/unlock it.
893 return (handle_{ haFD = -1,
894 haType = ClosedHandle
897 -----------------------------------------------------------------------------
898 -- Detecting the size of a file
900 -- | For a handle @hdl@ which attached to a physical file,
901 -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
903 hFileSize :: Handle -> IO Integer
905 withHandle_ "hFileSize" handle $ \ handle_ -> do
906 case haType handle_ of
907 ClosedHandle -> ioe_closedHandle
908 SemiClosedHandle -> ioe_closedHandle
909 _ -> do flushWriteBufferOnly handle_
910 r <- fdFileSize (haFD handle_)
913 else ioException (IOError Nothing InappropriateType "hFileSize"
914 "not a regular file" Nothing)
916 -- ---------------------------------------------------------------------------
917 -- Detecting the End of Input
919 -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
920 -- 'True' if no further input can be taken from @hdl@ or for a
921 -- physical file, if the current I\/O position is equal to the length of
922 -- the file. Otherwise, it returns 'False'.
924 hIsEOF :: Handle -> IO Bool
927 (do hLookAhead handle; return False)
928 (\e -> if isEOFError e then return True else ioError e)
930 -- | The computation 'isEOF' is identical to 'hIsEOF',
931 -- except that it works only on 'stdin'.
936 -- ---------------------------------------------------------------------------
939 -- | Computation 'hLookAhead' returns the next character from the handle
940 -- without removing it from the input buffer, blocking until a character
943 -- This operation may fail with:
945 -- * 'isEOFError' if the end of file has been reached.
947 hLookAhead :: Handle -> IO Char
948 hLookAhead handle = do
949 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
950 let ref = haBuffer handle_
952 is_line = haBufferMode handle_ == LineBuffering
955 -- fill up the read buffer if necessary
956 new_buf <- if bufferEmpty buf
957 then fillReadBuffer fd is_line (haIsStream handle_) buf
960 writeIORef ref new_buf
962 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
965 -- ---------------------------------------------------------------------------
966 -- Buffering Operations
968 -- Three kinds of buffering are supported: line-buffering,
969 -- block-buffering or no-buffering. See GHC.IOBase for definition and
970 -- further explanation of what the type represent.
972 -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
973 -- handle @hdl@ on subsequent reads and writes.
975 -- If the buffer mode is changed from 'BlockBuffering' or
976 -- 'LineBuffering' to 'NoBuffering', then
978 -- * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
980 -- * if @hdl@ is not writable, the contents of the buffer is discarded.
982 -- This operation may fail with:
984 -- * 'isPermissionError' if the handle has already been used for reading
985 -- or writing and the implementation does not allow the buffering mode
988 hSetBuffering :: Handle -> BufferMode -> IO ()
989 hSetBuffering handle mode =
990 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
991 case haType handle_ of
992 ClosedHandle -> ioe_closedHandle
995 - we flush the old buffer regardless of whether
996 the new buffer could fit the contents of the old buffer
998 - allow a handle's buffering to change even if IO has
999 occurred (ANSI C spec. does not allow this, nor did
1000 the previous implementation of IO.hSetBuffering).
1001 - a non-standard extension is to allow the buffering
1002 of semi-closed handles to change [sof 6/98]
1006 let state = initBufferState (haType handle_)
1009 -- we always have a 1-character read buffer for
1010 -- unbuffered handles: it's needed to
1011 -- support hLookAhead.
1012 NoBuffering -> allocateBuffer 1 ReadBuffer
1013 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
1014 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
1015 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
1016 | otherwise -> allocateBuffer n state
1017 writeIORef (haBuffer handle_) new_buf
1019 -- for input terminals we need to put the terminal into
1020 -- cooked or raw mode depending on the type of buffering.
1021 is_tty <- fdIsTTY (haFD handle_)
1022 when (is_tty && isReadableHandleType (haType handle_)) $
1024 #ifndef mingw32_TARGET_OS
1025 -- 'raw' mode under win32 is a bit too specialised (and troublesome
1026 -- for most common uses), so simply disable its use here.
1027 NoBuffering -> setCooked (haFD handle_) False
1029 _ -> setCooked (haFD handle_) True
1031 -- throw away spare buffers, they might be the wrong size
1032 writeIORef (haBuffers handle_) BufferListNil
1034 return (handle_{ haBufferMode = mode })
1036 -- -----------------------------------------------------------------------------
1039 -- | The action 'hFlush' @hdl@ causes any items buffered for output
1040 -- in handle @hdl@ to be sent immediately to the operating system.
1042 -- This operation may fail with:
1044 -- * 'isFullError' if the device is full;
1046 -- * 'isPermissionError' if a system resource limit would be exceeded.
1047 -- It is unspecified whether the characters in the buffer are discarded
1048 -- or retained under these circumstances.
1050 hFlush :: Handle -> IO ()
1052 wantWritableHandle "hFlush" handle $ \ handle_ -> do
1053 buf <- readIORef (haBuffer handle_)
1054 if bufferIsWritable buf && not (bufferEmpty buf)
1055 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
1056 writeIORef (haBuffer handle_) flushed_buf
1060 -- -----------------------------------------------------------------------------
1061 -- Repositioning Handles
1063 data HandlePosn = HandlePosn Handle HandlePosition
1065 instance Eq HandlePosn where
1066 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
1068 instance Show HandlePosn where
1069 showsPrec p (HandlePosn h pos) =
1070 showsPrec p h . showString " at position " . shows pos
1072 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
1073 -- We represent it as an Integer on the Haskell side, but
1074 -- cheat slightly in that hGetPosn calls upon a C helper
1075 -- that reports the position back via (merely) an Int.
1076 type HandlePosition = Integer
1078 -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
1079 -- @hdl@ as a value of the abstract type 'HandlePosn'.
1081 hGetPosn :: Handle -> IO HandlePosn
1082 hGetPosn handle = do
1083 posn <- hTell handle
1084 return (HandlePosn handle posn)
1086 -- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
1087 -- then computation 'hSetPosn' @p@ sets the position of @hdl@
1088 -- to the position it held at the time of the call to 'hGetPosn'.
1090 -- This operation may fail with:
1092 -- * 'isPermissionError' if a system resource limit would be exceeded.
1094 hSetPosn :: HandlePosn -> IO ()
1095 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
1097 -- ---------------------------------------------------------------------------
1100 -- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:
1102 = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.
1103 | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@
1104 -- from the current position.
1105 | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@
1106 -- from the end of the file.
1107 deriving (Eq, Ord, Ix, Enum, Read, Show)
1110 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1111 seeking at or past EOF.
1113 - we possibly deviate from the report on the issue of seeking within
1114 the buffer and whether to flush it or not. The report isn't exactly
1118 -- | Computation 'hSeek' @hdl mode i@ sets the position of handle
1119 -- @hdl@ depending on @mode@.
1120 -- The offset @i@ is given in terms of 8-bit bytes.
1122 -- If @hdl@ is block- or line-buffered, then seeking to a position which is not
1123 -- in the current buffer will first cause any items in the output buffer to be
1124 -- written to the device, and then cause the input buffer to be discarded.
1125 -- Some handles may not be seekable (see 'hIsSeekable'), or only support a
1126 -- subset of the possible positioning operations (for instance, it may only
1127 -- be possible to seek to the end of a tape, or to a positive offset from
1128 -- the beginning or current position).
1129 -- It is not possible to set a negative I\/O position, or for
1130 -- a physical file, an I\/O position beyond the current end-of-file.
1132 -- This operation may fail with:
1134 -- * 'isPermissionError' if a system resource limit would be exceeded.
1136 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1137 hSeek handle mode offset =
1138 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1140 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1142 let ref = haBuffer handle_
1143 buf <- readIORef ref
1149 throwErrnoIfMinus1Retry_ "hSeek"
1150 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1153 whence = case mode of
1154 AbsoluteSeek -> sEEK_SET
1155 RelativeSeek -> sEEK_CUR
1156 SeekFromEnd -> sEEK_END
1158 if bufferIsWritable buf
1159 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1160 writeIORef ref new_buf
1164 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1165 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1168 new_buf <- flushReadBuffer (haFD handle_) buf
1169 writeIORef ref new_buf
1173 hTell :: Handle -> IO Integer
1175 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
1177 #if defined(mingw32_TARGET_OS)
1178 -- urgh, on Windows we have to worry about \n -> \r\n translation,
1179 -- so we can't easily calculate the file position using the
1180 -- current buffer size. Just flush instead.
1183 let fd = fromIntegral (haFD handle_)
1184 posn <- fromIntegral `liftM`
1185 throwErrnoIfMinus1Retry "hGetPosn"
1186 (c_lseek fd 0 sEEK_CUR)
1188 let ref = haBuffer handle_
1189 buf <- readIORef ref
1192 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
1193 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
1195 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
1196 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
1200 -- -----------------------------------------------------------------------------
1201 -- Handle Properties
1203 -- A number of operations return information about the properties of a
1204 -- handle. Each of these operations returns `True' if the handle has
1205 -- the specified property, and `False' otherwise.
1207 hIsOpen :: Handle -> IO Bool
1209 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1210 case haType handle_ of
1211 ClosedHandle -> return False
1212 SemiClosedHandle -> return False
1215 hIsClosed :: Handle -> IO Bool
1217 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1218 case haType handle_ of
1219 ClosedHandle -> return True
1222 {- not defined, nor exported, but mentioned
1223 here for documentation purposes:
1225 hSemiClosed :: Handle -> IO Bool
1229 return (not (ho || hc))
1232 hIsReadable :: Handle -> IO Bool
1233 hIsReadable (DuplexHandle _ _ _) = return True
1234 hIsReadable handle =
1235 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1236 case haType handle_ of
1237 ClosedHandle -> ioe_closedHandle
1238 SemiClosedHandle -> ioe_closedHandle
1239 htype -> return (isReadableHandleType htype)
1241 hIsWritable :: Handle -> IO Bool
1242 hIsWritable (DuplexHandle _ _ _) = return True
1243 hIsWritable handle =
1244 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1245 case haType handle_ of
1246 ClosedHandle -> ioe_closedHandle
1247 SemiClosedHandle -> ioe_closedHandle
1248 htype -> return (isWritableHandleType htype)
1250 -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
1253 hGetBuffering :: Handle -> IO BufferMode
1254 hGetBuffering handle =
1255 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1256 case haType handle_ of
1257 ClosedHandle -> ioe_closedHandle
1259 -- We're being non-standard here, and allow the buffering
1260 -- of a semi-closed handle to be queried. -- sof 6/98
1261 return (haBufferMode handle_) -- could be stricter..
1263 hIsSeekable :: Handle -> IO Bool
1264 hIsSeekable handle =
1265 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1266 case haType handle_ of
1267 ClosedHandle -> ioe_closedHandle
1268 SemiClosedHandle -> ioe_closedHandle
1269 AppendHandle -> return False
1270 _ -> do t <- fdType (haFD handle_)
1271 return (t == RegularFile
1273 || tEXT_MODE_SEEK_ALLOWED))
1275 -- -----------------------------------------------------------------------------
1276 -- Changing echo status (Non-standard GHC extensions)
1278 -- | Set the echoing status of a handle connected to a terminal (GHC only).
1280 hSetEcho :: Handle -> Bool -> IO ()
1281 hSetEcho handle on = do
1282 isT <- hIsTerminalDevice handle
1286 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1287 case haType handle_ of
1288 ClosedHandle -> ioe_closedHandle
1289 _ -> setEcho (haFD handle_) on
1291 -- | Get the echoing status of a handle connected to a terminal (GHC only).
1293 hGetEcho :: Handle -> IO Bool
1294 hGetEcho handle = do
1295 isT <- hIsTerminalDevice handle
1299 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1300 case haType handle_ of
1301 ClosedHandle -> ioe_closedHandle
1302 _ -> getEcho (haFD handle_)
1304 -- | Is the handle connected to a terminal? (GHC only)
1306 hIsTerminalDevice :: Handle -> IO Bool
1307 hIsTerminalDevice handle = do
1308 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1309 case haType handle_ of
1310 ClosedHandle -> ioe_closedHandle
1311 _ -> fdIsTTY (haFD handle_)
1313 -- -----------------------------------------------------------------------------
1316 -- | Select binary mode ('True') or text mode ('False') on a open handle.
1317 -- (GHC only; see also 'openBinaryFile'.)
1319 hSetBinaryMode :: Handle -> Bool -> IO ()
1320 hSetBinaryMode handle bin =
1321 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1322 do throwErrnoIfMinus1_ "hSetBinaryMode"
1323 (setmode (fromIntegral (haFD handle_)) bin)
1324 return handle_{haIsBin=bin}
1326 foreign import ccall unsafe "__hscore_setmode"
1327 setmode :: CInt -> Bool -> IO CInt
1329 -- -----------------------------------------------------------------------------
1330 -- Duplicating a Handle
1332 -- |Returns a duplicate of the original handle, with its own buffer
1333 -- and file pointer. The original handle's buffer is flushed, including
1334 -- discarding any input data, before the handle is duplicated.
1336 hDuplicate :: Handle -> IO Handle
1337 hDuplicate h@(FileHandle path m) = do
1338 new_h_ <- withHandle' "hDuplicate" h m (dupHandle_ Nothing)
1339 new_m <- newMVar new_h_
1340 return (FileHandle path new_m)
1341 hDuplicate h@(DuplexHandle path r w) = do
1342 new_w_ <- withHandle' "hDuplicate" h w (dupHandle_ Nothing)
1343 new_w <- newMVar new_w_
1344 new_r_ <- withHandle' "hDuplicate" h r (dupHandle_ (Just new_w))
1345 new_r <- newMVar new_r_
1346 return (DuplexHandle path new_r new_w)
1348 dupHandle_ other_side h_ = do
1349 -- flush the buffer first, so we don't have to copy its contents
1351 new_fd <- c_dup (fromIntegral (haFD h_))
1352 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))
1353 ioref <- newIORef buffer
1354 ioref_buffers <- newIORef BufferListNil
1356 let new_handle_ = h_{ haFD = fromIntegral new_fd,
1358 haBuffers = ioref_buffers,
1359 haOtherSide = other_side }
1360 return (h_, new_handle_)
1362 -- -----------------------------------------------------------------------------
1363 -- Replacing a Handle
1366 Makes the second handle a duplicate of the first handle. The second
1367 handle will be closed first, if it is not already.
1369 This can be used to retarget the standard Handles, for example:
1371 > do h <- openFile "mystdout" WriteMode
1372 > hDuplicateTo h stdout
1375 hDuplicateTo :: Handle -> Handle -> IO ()
1376 hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2) = do
1377 withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
1378 _ <- hClose_help h2_
1379 withHandle' "hDuplicateTo" h1 m1 (dupHandle_ Nothing)
1380 hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2) = do
1381 withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do
1382 _ <- hClose_help w2_
1383 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ Nothing)
1384 withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do
1385 _ <- hClose_help r2_
1386 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ (Just w1))
1388 ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
1389 "handles are incompatible" Nothing)
1391 -- ---------------------------------------------------------------------------
1394 -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
1395 -- than the (pure) instance of 'Show' for 'Handle'.
1397 hShow :: Handle -> IO String
1398 hShow h@(FileHandle path _) = showHandle' path False h
1399 hShow h@(DuplexHandle path _ _) = showHandle' path True h
1401 showHandle' filepath is_duplex h =
1402 withHandle_ "showHandle" h $ \hdl_ ->
1404 showType | is_duplex = showString "duplex (read-write)"
1405 | otherwise = shows (haType hdl_)
1409 showHdl (haType hdl_)
1410 (showString "loc=" . showString filepath . showChar ',' .
1411 showString "type=" . showType . showChar ',' .
1412 showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
1413 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
1417 showHdl :: HandleType -> ShowS -> ShowS
1420 ClosedHandle -> shows ht . showString "}"
1423 showBufMode :: Buffer -> BufferMode -> ShowS
1424 showBufMode buf bmo =
1426 NoBuffering -> showString "none"
1427 LineBuffering -> showString "line"
1428 BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
1429 BlockBuffering Nothing -> showString "block " . showParen True (shows def)
1434 -- ---------------------------------------------------------------------------
1438 puts :: String -> IO ()
1439 puts s = withCString s $ \cstr -> do write_rawBuffer 1 False cstr 0 (fromIntegral (length s))
1443 -- -----------------------------------------------------------------------------
1444 -- wrappers to platform-specific constants:
1446 foreign import ccall unsafe "__hscore_supportsTextMode"
1447 tEXT_MODE_SEEK_ALLOWED :: Bool
1449 foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
1450 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1451 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1452 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt