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,
26 fillReadBuffer, fillReadBufferWithoutBlocking,
27 readRawBuffer, readRawBufferPtr,
28 writeRawBuffer, writeRawBufferPtr,
31 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
33 stdin, stdout, stderr,
34 IOMode(..), openFile, openBinaryFile, openFd, fdToHandle,
35 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
36 hFlush, hDuplicate, hDuplicateTo,
40 HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
41 SeekMode(..), hSeek, hTell,
43 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
44 hSetEcho, hGetEcho, hIsTerminalDevice,
61 import System.IO.Error
62 import System.Posix.Internals
68 import GHC.Read ( Read )
73 import GHC.Num ( Integer(..), Num(..) )
75 import GHC.Real ( toInteger )
79 -- -----------------------------------------------------------------------------
82 -- hWaitForInput blocks (should use a timeout)
84 -- unbuffered hGetLine is a bit dodgy
86 -- hSetBuffering: can't change buffering on a stream,
87 -- when the read buffer is non-empty? (no way to flush the buffer)
89 -- ---------------------------------------------------------------------------
90 -- Are files opened by default in text or binary mode, if the user doesn't
93 dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
95 -- ---------------------------------------------------------------------------
96 -- Creating a new handle
98 newFileHandle :: FilePath -> (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
99 newFileHandle filepath finalizer hc = do
101 addMVarFinalizer m (finalizer m)
102 return (FileHandle filepath m)
104 -- ---------------------------------------------------------------------------
105 -- Working with Handles
108 In the concurrent world, handles are locked during use. This is done
109 by wrapping an MVar around the handle which acts as a mutex over
110 operations on the handle.
112 To avoid races, we use the following bracketing operations. The idea
113 is to obtain the lock, do some operation and replace the lock again,
114 whether the operation succeeded or failed. We also want to handle the
115 case where the thread receives an exception while processing the IO
116 operation: in these cases we also want to relinquish the lock.
118 There are three versions of @withHandle@: corresponding to the three
119 possible combinations of:
121 - the operation may side-effect the handle
122 - the operation may return a result
124 If the operation generates an error or an exception is raised, the
125 original handle is always replaced [ this is the case at the moment,
126 but we might want to revisit this in the future --SDM ].
129 {-# INLINE withHandle #-}
130 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
131 withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
132 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
134 withHandle' :: String -> Handle -> MVar Handle__
135 -> (Handle__ -> IO (Handle__,a)) -> IO a
136 withHandle' fun h m act =
139 checkBufferInvariants h_
140 (h',v) <- catchException (act h_)
141 (\ err -> putMVar m h_ >>
143 IOException ex -> ioError (augmentIOError ex fun h)
145 checkBufferInvariants h'
149 {-# INLINE withHandle_ #-}
150 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
151 withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
152 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
154 withHandle_' fun h m act =
157 checkBufferInvariants h_
158 v <- catchException (act h_)
159 (\ err -> putMVar m h_ >>
161 IOException ex -> ioError (augmentIOError ex fun h)
163 checkBufferInvariants h_
167 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
168 withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
169 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
170 withHandle__' fun h r act
171 withHandle__' fun h w act
173 withHandle__' fun h m act =
176 checkBufferInvariants h_
177 h' <- catchException (act h_)
178 (\ err -> putMVar m h_ >>
180 IOException ex -> ioError (augmentIOError ex fun h)
182 checkBufferInvariants h'
186 augmentIOError (IOError _ iot _ str fp) fun h
187 = IOError (Just h) iot fun str filepath
190 | otherwise = case h of
191 FileHandle fp _ -> Just fp
192 DuplexHandle fp _ _ -> Just fp
194 -- ---------------------------------------------------------------------------
195 -- Wrapper for write operations.
197 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
198 wantWritableHandle fun h@(FileHandle _ m) act
199 = wantWritableHandle' fun h m act
200 wantWritableHandle fun h@(DuplexHandle _ _ m) act
201 = wantWritableHandle' fun h m act
202 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
205 :: String -> Handle -> MVar Handle__
206 -> (Handle__ -> IO a) -> IO a
207 wantWritableHandle' fun h m act
208 = withHandle_' fun h m (checkWritableHandle act)
210 checkWritableHandle act handle_
211 = case haType handle_ of
212 ClosedHandle -> ioe_closedHandle
213 SemiClosedHandle -> ioe_closedHandle
214 ReadHandle -> ioe_notWritable
215 ReadWriteHandle -> do
216 let ref = haBuffer handle_
219 if not (bufferIsWritable buf)
220 then do b <- flushReadBuffer (haFD handle_) buf
221 return b{ bufState=WriteBuffer }
223 writeIORef ref new_buf
225 _other -> act handle_
227 -- ---------------------------------------------------------------------------
228 -- Wrapper for read operations.
230 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
231 wantReadableHandle fun h@(FileHandle _ m) act
232 = wantReadableHandle' fun h m act
233 wantReadableHandle fun h@(DuplexHandle _ m _) act
234 = wantReadableHandle' fun h m act
235 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
238 :: String -> Handle -> MVar Handle__
239 -> (Handle__ -> IO a) -> IO a
240 wantReadableHandle' fun h m act
241 = withHandle_' fun h m (checkReadableHandle act)
243 checkReadableHandle act handle_ =
244 case haType handle_ of
245 ClosedHandle -> ioe_closedHandle
246 SemiClosedHandle -> ioe_closedHandle
247 AppendHandle -> ioe_notReadable
248 WriteHandle -> ioe_notReadable
249 ReadWriteHandle -> do
250 let ref = haBuffer handle_
252 when (bufferIsWritable buf) $ do
253 new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
254 writeIORef ref new_buf{ bufState=ReadBuffer }
256 _other -> act handle_
258 -- ---------------------------------------------------------------------------
259 -- Wrapper for seek operations.
261 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
262 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
263 ioException (IOError (Just h) IllegalOperation fun
264 "handle is not seekable" Nothing)
265 wantSeekableHandle fun h@(FileHandle _ m) act =
266 withHandle_' fun h m (checkSeekableHandle act)
268 checkSeekableHandle act handle_ =
269 case haType handle_ of
270 ClosedHandle -> ioe_closedHandle
271 SemiClosedHandle -> ioe_closedHandle
272 AppendHandle -> ioe_notSeekable
273 _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
274 | otherwise -> ioe_notSeekable_notBin
276 -- -----------------------------------------------------------------------------
279 ioe_closedHandle, ioe_EOF,
280 ioe_notReadable, ioe_notWritable,
281 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
283 ioe_closedHandle = ioException
284 (IOError Nothing IllegalOperation ""
285 "handle is closed" Nothing)
286 ioe_EOF = ioException
287 (IOError Nothing EOF "" "" Nothing)
288 ioe_notReadable = ioException
289 (IOError Nothing IllegalOperation ""
290 "handle is not open for reading" Nothing)
291 ioe_notWritable = ioException
292 (IOError Nothing IllegalOperation ""
293 "handle is not open for writing" Nothing)
294 ioe_notSeekable = ioException
295 (IOError Nothing IllegalOperation ""
296 "handle is not seekable" Nothing)
297 ioe_notSeekable_notBin = ioException
298 (IOError Nothing IllegalOperation ""
299 "seek operations on text-mode handles are not allowed on this platform"
302 ioe_bufsiz :: Int -> IO a
303 ioe_bufsiz n = ioException
304 (IOError Nothing InvalidArgument "hSetBuffering"
305 ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
306 -- 9 => should be parens'ified.
308 -- -----------------------------------------------------------------------------
311 -- For a duplex handle, we arrange that the read side points to the write side
312 -- (and hence keeps it alive if the read side is alive). This is done by
313 -- having the haOtherSide field of the read side point to the read side.
314 -- The finalizer is then placed on the write side, and the handle only gets
315 -- finalized once, when both sides are no longer required.
317 stdHandleFinalizer :: MVar Handle__ -> IO ()
318 stdHandleFinalizer m = do
320 flushWriteBufferOnly h_
322 handleFinalizer :: MVar Handle__ -> IO ()
323 handleFinalizer m = do
324 handle_ <- takeMVar m
325 case haType handle_ of
326 ClosedHandle -> return ()
327 _ -> do flushWriteBufferOnly handle_ `catchException` \_ -> return ()
328 -- ignore errors and async exceptions, and close the
329 -- descriptor anyway...
330 hClose_handle_ handle_
333 -- ---------------------------------------------------------------------------
334 -- Grimy buffer operations
337 checkBufferInvariants h_ = do
338 let ref = haBuffer h_
339 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
344 && ( r /= w || (r == 0 && w == 0) )
345 && ( state /= WriteBuffer || r == 0 )
346 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
348 then error "buffer invariant violation"
351 checkBufferInvariants h_ = return ()
354 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
355 newEmptyBuffer b state size
356 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
358 allocateBuffer :: Int -> BufferState -> IO Buffer
359 allocateBuffer sz@(I# size) state = IO $ \s ->
360 #ifdef mingw32_TARGET_OS
361 -- To implement asynchronous I/O under Win32, we have to pass
362 -- buffer references to external threads that handles the
363 -- filling/emptying of their contents. Hence, the buffer cannot
364 -- be moved around by the GC.
365 case newPinnedByteArray# size s of { (# s, b #) ->
367 case newByteArray# size s of { (# s, b #) ->
369 (# s, newEmptyBuffer b state sz #) }
371 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
372 writeCharIntoBuffer slab (I# off) (C# c)
373 = IO $ \s -> case writeCharArray# slab off c s of
374 s -> (# s, I# (off +# 1#) #)
376 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
377 readCharFromBuffer slab (I# off)
378 = IO $ \s -> case readCharArray# slab off s of
379 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
381 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
382 getBuffer fd state = do
383 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
384 ioref <- newIORef buffer
388 | is_tty = LineBuffering
389 | otherwise = BlockBuffering Nothing
391 return (ioref, buffer_mode)
393 mkUnBuffer :: IO (IORef Buffer)
395 buffer <- allocateBuffer 1 ReadBuffer
398 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
399 flushWriteBufferOnly :: Handle__ -> IO ()
400 flushWriteBufferOnly h_ = do
404 new_buf <- if bufferIsWritable buf
405 then flushWriteBuffer fd (haIsStream h_) buf
407 writeIORef ref new_buf
409 -- flushBuffer syncs the file with the buffer, including moving the
410 -- file pointer backwards in the case of a read buffer.
411 flushBuffer :: Handle__ -> IO ()
413 let ref = haBuffer h_
418 ReadBuffer -> flushReadBuffer (haFD h_) buf
419 WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
421 writeIORef ref flushed_buf
423 -- When flushing a read buffer, we seek backwards by the number of
424 -- characters in the buffer. The file descriptor must therefore be
425 -- seekable: attempting to flush the read buffer on an unseekable
426 -- handle is not allowed.
428 flushReadBuffer :: FD -> Buffer -> IO Buffer
429 flushReadBuffer fd buf
430 | bufferEmpty buf = return buf
432 let off = negate (bufWPtr buf - bufRPtr buf)
434 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
436 throwErrnoIfMinus1Retry "flushReadBuffer"
437 (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
438 return buf{ bufWPtr=0, bufRPtr=0 }
440 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
441 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } =
442 seq fd $ do -- strictness hack
445 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
448 then return (buf{ bufRPtr=0, bufWPtr=0 })
450 res <- writeRawBuffer "flushWriteBuffer" (fromIntegral fd) is_stream b
451 (fromIntegral r) (fromIntegral bytes)
452 let res' = fromIntegral res
454 then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
455 else return buf{ bufRPtr=0, bufWPtr=0 }
457 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
458 fillReadBuffer fd is_line is_stream
459 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
460 -- buffer better be empty:
461 assert (r == 0 && w == 0) $ do
462 fillReadBufferLoop fd is_line is_stream buf b w size
464 -- For a line buffer, we just get the first chunk of data to arrive,
465 -- and don't wait for the whole buffer to be full (but we *do* wait
466 -- until some data arrives). This isn't really line buffering, but it
467 -- appears to be what GHC has done for a long time, and I suspect it
468 -- is more useful than line buffering in most cases.
470 fillReadBufferLoop fd is_line is_stream buf b w size = do
472 if bytes == 0 -- buffer full?
473 then return buf{ bufRPtr=0, bufWPtr=w }
476 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
478 res <- readRawBuffer "fillReadBuffer" fd is_stream b
479 (fromIntegral w) (fromIntegral bytes)
480 let res' = fromIntegral res
482 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
487 else return buf{ bufRPtr=0, bufWPtr=w }
488 else if res' < bytes && not is_line
489 then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
490 else return buf{ bufRPtr=0, bufWPtr=w+res' }
493 fillReadBufferWithoutBlocking :: FD -> Bool -> Buffer -> IO Buffer
494 fillReadBufferWithoutBlocking fd is_stream
495 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
496 -- buffer better be empty:
497 assert (r == 0 && w == 0) $ do
499 puts ("fillReadBufferLoopNoBlock: bytes = " ++ show bytes ++ "\n")
501 res <- readRawBufferNoBlock "fillReadBuffer" fd is_stream b
502 0 (fromIntegral size)
503 let res' = fromIntegral res
505 puts ("fillReadBufferLoopNoBlock: res' = " ++ show res' ++ "\n")
507 return buf{ bufRPtr=0, bufWPtr=res' }
509 -- Low level routines for reading/writing to (raw)buffers:
511 #ifndef mingw32_TARGET_OS
512 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
513 readRawBuffer loc fd is_stream buf off len =
514 throwErrnoIfMinus1RetryMayBlock loc
515 (read_rawBuffer fd buf off len)
518 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
519 readRawBufferNoBlock loc fd is_stream buf off len =
520 throwErrnoIfMinus1RetryOnBlock loc
521 (read_rawBuffer fd buf off len)
524 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
525 readRawBufferPtr loc fd is_stream buf off len =
526 throwErrnoIfMinus1RetryMayBlock loc
527 (read_off fd buf off len)
530 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
531 writeRawBuffer loc fd is_stream buf off len =
532 throwErrnoIfMinus1RetryMayBlock loc
533 (write_rawBuffer (fromIntegral fd) buf off len)
536 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
537 writeRawBufferPtr loc fd is_stream buf off len =
538 throwErrnoIfMinus1RetryMayBlock loc
539 (write_off (fromIntegral fd) buf off len)
542 foreign import ccall unsafe "__hscore_PrelHandle_read"
543 read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
545 foreign import ccall unsafe "__hscore_PrelHandle_read"
546 read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
548 foreign import ccall unsafe "__hscore_PrelHandle_write"
549 write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
551 foreign import ccall unsafe "__hscore_PrelHandle_write"
552 write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
554 #else /* mingw32_TARGET_OS.... */
556 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
557 readRawBuffer loc fd is_stream buf off len
558 | threaded = blockingReadRawBuffer loc fd is_stream buf off len
559 | otherwise = asyncReadRawBuffer loc fd is_stream buf off len
561 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
562 readRawBufferPtr loc fd is_stream buf off len
563 | threaded = blockingReadRawBufferPtr loc fd is_stream buf off len
564 | otherwise = asyncReadRawBufferPtr loc fd is_stream buf off len
566 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
567 writeRawBuffer loc fd is_stream buf off len
568 | threaded = blockingWriteRawBuffer loc fd is_stream buf off len
569 | otherwise = asyncWriteRawBuffer loc fd is_stream buf off len
571 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
572 writeRawBufferPtr loc fd is_stream buf off len
573 | threaded = blockingWriteRawBufferPtr loc fd is_stream buf off len
574 | otherwise = asyncWriteRawBufferPtr loc fd is_stream buf off len
576 -- ToDo: we don't have a non-blocking primitve read on Win32
577 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
578 readRawBufferNoBlock = readRawBufferNoBlock
580 -- Async versions of the read/write primitives, for the non-threaded RTS
582 asyncReadRawBuffer loc fd is_stream buf off len = do
583 (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0)
584 (fromIntegral len) off buf
587 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
588 else return (fromIntegral l)
590 asyncReadRawBufferPtr loc fd is_stream buf off len = do
591 (l, rc) <- asyncRead fd (if is_stream then 1 else 0)
592 (fromIntegral len) (buf `plusPtr` off)
595 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
596 else return (fromIntegral l)
598 asyncWriteRawBuffer loc fd is_stream buf off len = do
599 (l, rc) <- asyncWriteBA fd (if is_stream then 1 else 0)
600 (fromIntegral len) off buf
603 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
604 else return (fromIntegral l)
606 asyncWriteRawBufferPtr loc fd is_stream buf off len = do
607 (l, rc) <- asyncWrite fd (if is_stream then 1 else 0)
608 (fromIntegral len) (buf `plusPtr` off)
611 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
612 else return (fromIntegral l)
614 -- Blocking versions of the read/write primitives, for the threaded RTS
616 blockingReadRawBuffer loc fd True buf off len =
617 throwErrnoIfMinus1Retry loc $
618 recv_rawBuffer fd buf off len
619 blockingReadRawBuffer loc fd False buf off len =
620 throwErrnoIfMinus1Retry loc $
621 read_rawBuffer fd buf off len
623 blockingReadRawBufferPtr loc fd True buf off len =
624 throwErrnoIfMinus1Retry loc $
625 recv_off fd buf off len
626 blockingReadRawBufferPtr loc fd False buf off len =
627 throwErrnoIfMinus1Retry loc $
628 read_off fd buf off len
630 blockingWriteRawBuffer loc fd True buf off len =
631 throwErrnoIfMinus1Retry loc $
632 send_rawBuffer (fromIntegral fd) buf off len
633 blockingWriteRawBuffer loc fd False buf off len =
634 throwErrnoIfMinus1Retry loc $
635 write_rawBuffer (fromIntegral fd) buf off len
637 blockingWriteRawBufferPtr loc fd True buf off len =
638 throwErrnoIfMinus1Retry loc $
639 send_off (fromIntegral fd) buf off len
640 blockingWriteRawBufferPtr loc fd False buf off len =
641 throwErrnoIfMinus1Retry loc $
642 write_off (fromIntegral fd) buf off len
644 -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.
645 -- These calls may block, but that's ok.
647 foreign import ccall safe "__hscore_PrelHandle_read"
648 read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
650 foreign import ccall safe "__hscore_PrelHandle_read"
651 read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
653 foreign import ccall safe "__hscore_PrelHandle_write"
654 write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
656 foreign import ccall safe "__hscore_PrelHandle_write"
657 write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
659 foreign import ccall safe "__hscore_PrelHandle_recv"
660 recv_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
662 foreign import ccall safe "__hscore_PrelHandle_recv"
663 recv_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
665 foreign import ccall safe "__hscore_PrelHandle_send"
666 send_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
668 foreign import ccall safe "__hscore_PrelHandle_send"
669 send_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
671 foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool
674 -- ---------------------------------------------------------------------------
677 -- Three handles are allocated during program initialisation. The first
678 -- two manage input or output from the Haskell program's standard input
679 -- or output channel respectively. The third manages output to the
680 -- standard error channel. These handles are initially open.
686 -- | A handle managing input from the Haskell program's standard input channel.
688 stdin = unsafePerformIO $ do
689 -- ToDo: acquire lock
690 setNonBlockingFD fd_stdin
691 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
692 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
694 -- | A handle managing output to the Haskell program's standard output channel.
696 stdout = unsafePerformIO $ do
697 -- ToDo: acquire lock
698 -- We don't set non-blocking mode on stdout or sterr, because
699 -- some shells don't recover properly.
700 -- setNonBlockingFD fd_stdout
701 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
702 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
704 -- | A handle managing output to the Haskell program's standard error channel.
706 stderr = unsafePerformIO $ do
707 -- ToDo: acquire lock
708 -- We don't set non-blocking mode on stdout or sterr, because
709 -- some shells don't recover properly.
710 -- setNonBlockingFD fd_stderr
712 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
714 -- ---------------------------------------------------------------------------
715 -- Opening and Closing Files
717 addFilePathToIOError fun fp (IOError h iot _ str _)
718 = IOError h iot fun str (Just fp)
720 -- | Computation 'openFile' @file mode@ allocates and returns a new, open
721 -- handle to manage the file @file@. It manages input if @mode@
722 -- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
723 -- and both input and output if mode is 'ReadWriteMode'.
725 -- If the file does not exist and it is opened for output, it should be
726 -- created as a new file. If @mode@ is 'WriteMode' and the file
727 -- already exists, then it should be truncated to zero length.
728 -- Some operating systems delete empty files, so there is no guarantee
729 -- that the file will exist following an 'openFile' with @mode@
730 -- 'WriteMode' unless it is subsequently written to successfully.
731 -- The handle is positioned at the end of the file if @mode@ is
732 -- 'AppendMode', and otherwise at the beginning (in which case its
733 -- internal position is 0).
734 -- The initial buffer mode is implementation-dependent.
736 -- This operation may fail with:
738 -- * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
740 -- * 'isDoesNotExistError' if the file does not exist; or
742 -- * 'isPermissionError' if the user does not have permission to open the file.
744 openFile :: FilePath -> IOMode -> IO Handle
747 (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
748 (\e -> ioError (addFilePathToIOError "openFile" fp e))
750 -- | Like 'openFile', but open the file in binary mode.
751 -- On Windows, reading a file in text mode (which is the default)
752 -- will translate CRLF to LF, and writing will translate LF to CRLF.
753 -- This is usually what you want with text files. With binary files
754 -- this is undesirable; also, as usual under Microsoft operating systems,
755 -- text mode treats control-Z as EOF. Binary mode turns off all special
756 -- treatment of end-of-line and end-of-file characters.
757 -- (See also 'hSetBinaryMode'.)
759 openBinaryFile :: FilePath -> IOMode -> IO Handle
760 openBinaryFile fp m =
762 (openFile' fp m True)
763 (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
765 openFile' filepath mode binary =
766 withCString filepath $ \ f ->
769 oflags1 = case mode of
770 ReadMode -> read_flags
771 WriteMode -> write_flags
772 ReadWriteMode -> rw_flags
773 AppendMode -> append_flags
775 truncate | WriteMode <- mode = True
782 oflags = oflags1 .|. binary_flags
785 -- the old implementation had a complicated series of three opens,
786 -- which is perhaps because we have to be careful not to open
787 -- directories. However, the man pages I've read say that open()
788 -- always returns EISDIR if the file is a directory and was opened
789 -- for writing, so I think we're ok with a single open() here...
790 fd <- fromIntegral `liftM`
791 throwErrnoIfMinus1Retry "openFile"
792 (c_open f (fromIntegral oflags) 0o666)
794 openFd fd Nothing False filepath mode binary truncate
795 `catchException` \e -> do c_close (fromIntegral fd); throw e
796 -- NB. don't forget to close the FD if openFd fails, otherwise
798 -- ASSERT: if we just created the file, then openFd won't fail
799 -- (so we don't need to worry about removing the newly created file
800 -- in the event of an error).
803 std_flags = o_NONBLOCK .|. o_NOCTTY
804 output_flags = std_flags .|. o_CREAT
805 read_flags = std_flags .|. o_RDONLY
806 write_flags = output_flags .|. o_WRONLY
807 rw_flags = output_flags .|. o_RDWR
808 append_flags = write_flags .|. o_APPEND
810 -- ---------------------------------------------------------------------------
813 openFd :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
814 openFd fd mb_fd_type is_socket filepath mode binary truncate = do
815 -- turn on non-blocking mode
818 let (ha_type, write) =
820 ReadMode -> ( ReadHandle, False )
821 WriteMode -> ( WriteHandle, True )
822 ReadWriteMode -> ( ReadWriteHandle, True )
823 AppendMode -> ( AppendHandle, True )
825 -- open() won't tell us if it was a directory if we only opened for
826 -- reading, so check again.
834 ioException (IOError Nothing InappropriateType "openFile"
835 "is a directory" Nothing)
838 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_socket filepath binary
839 | otherwise -> mkFileHandle fd is_socket filepath ha_type binary
841 -- regular files need to be locked
843 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
845 ioException (IOError Nothing ResourceBusy "openFile"
846 "file is locked" Nothing)
848 -- truncate the file if necessary
849 when truncate (fileTruncate filepath)
851 mkFileHandle fd is_socket filepath ha_type binary
854 fdToHandle :: FD -> IO Handle
857 let fd_str = "<file descriptor: " ++ show fd ++ ">"
858 openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-} False{-no truncate-}
860 foreign import ccall unsafe "lockFile"
861 lockFile :: CInt -> CInt -> CInt -> IO CInt
863 foreign import ccall unsafe "unlockFile"
864 unlockFile :: CInt -> IO CInt
866 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
868 mkStdHandle fd filepath ha_type buf bmode = do
869 spares <- newIORef BufferListNil
870 newFileHandle filepath stdHandleFinalizer
871 (Handle__ { haFD = fd,
873 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
875 haBufferMode = bmode,
878 haOtherSide = Nothing
881 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
882 mkFileHandle fd is_stream filepath ha_type binary = do
883 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
884 spares <- newIORef BufferListNil
885 newFileHandle filepath handleFinalizer
886 (Handle__ { haFD = fd,
889 haIsStream = is_stream,
890 haBufferMode = bmode,
893 haOtherSide = Nothing
896 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
897 mkDuplexHandle fd is_stream filepath binary = do
898 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
899 w_spares <- newIORef BufferListNil
901 Handle__ { haFD = fd,
902 haType = WriteHandle,
904 haIsStream = is_stream,
905 haBufferMode = w_bmode,
907 haBuffers = w_spares,
908 haOtherSide = Nothing
910 write_side <- newMVar w_handle_
912 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
913 r_spares <- newIORef BufferListNil
915 Handle__ { haFD = fd,
918 haIsStream = is_stream,
919 haBufferMode = r_bmode,
921 haBuffers = r_spares,
922 haOtherSide = Just write_side
924 read_side <- newMVar r_handle_
926 addMVarFinalizer write_side (handleFinalizer write_side)
927 return (DuplexHandle filepath read_side write_side)
930 initBufferState ReadHandle = ReadBuffer
931 initBufferState _ = WriteBuffer
933 -- ---------------------------------------------------------------------------
936 -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the
937 -- computation finishes, if @hdl@ is writable its buffer is flushed as
939 -- Performing 'hClose' on a handle that has already been closed has no effect;
940 -- doing so not an error. All other operations on a closed handle will fail.
941 -- If 'hClose' fails for any reason, any further operations (apart from
942 -- 'hClose') on the handle will still fail as if @hdl@ had been successfully
945 hClose :: Handle -> IO ()
946 hClose h@(FileHandle _ m) = hClose' h m
947 hClose h@(DuplexHandle _ r w) = hClose' h w >> hClose' h r
949 hClose' h m = withHandle__' "hClose" h m $ hClose_help
951 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
952 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
953 -- then closed immediately. We have to be careful with DuplexHandles
954 -- though: we have to leave the closing to the finalizer in that case,
955 -- because the write side may still be in use.
956 hClose_help :: Handle__ -> IO Handle__
957 hClose_help handle_ =
958 case haType handle_ of
959 ClosedHandle -> return handle_
960 _ -> do flushWriteBufferOnly handle_ -- interruptible
961 hClose_handle_ handle_
963 hClose_handle_ handle_ = do
964 let fd = haFD handle_
965 c_fd = fromIntegral fd
967 -- close the file descriptor, but not when this is the read
968 -- side of a duplex handle, and not when this is one of the
970 case haOtherSide handle_ of
972 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
973 throwErrnoIfMinus1Retry_ "hClose"
974 #ifdef mingw32_TARGET_OS
975 (closeFd (haIsStream handle_) c_fd)
981 -- free the spare buffers
982 writeIORef (haBuffers handle_) BufferListNil
987 -- we must set the fd to -1, because the finalizer is going
988 -- to run eventually and try to close/unlock it.
989 return (handle_{ haFD = -1,
990 haType = ClosedHandle
993 -----------------------------------------------------------------------------
994 -- Detecting the size of a file
996 -- | For a handle @hdl@ which attached to a physical file,
997 -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
999 hFileSize :: Handle -> IO Integer
1001 withHandle_ "hFileSize" handle $ \ handle_ -> do
1002 case haType handle_ of
1003 ClosedHandle -> ioe_closedHandle
1004 SemiClosedHandle -> ioe_closedHandle
1005 _ -> do flushWriteBufferOnly handle_
1006 r <- fdFileSize (haFD handle_)
1009 else ioException (IOError Nothing InappropriateType "hFileSize"
1010 "not a regular file" Nothing)
1012 -- ---------------------------------------------------------------------------
1013 -- Detecting the End of Input
1015 -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
1016 -- 'True' if no further input can be taken from @hdl@ or for a
1017 -- physical file, if the current I\/O position is equal to the length of
1018 -- the file. Otherwise, it returns 'False'.
1020 hIsEOF :: Handle -> IO Bool
1023 (do hLookAhead handle; return False)
1024 (\e -> if isEOFError e then return True else ioError e)
1026 -- | The computation 'isEOF' is identical to 'hIsEOF',
1027 -- except that it works only on 'stdin'.
1030 isEOF = hIsEOF stdin
1032 -- ---------------------------------------------------------------------------
1035 -- | Computation 'hLookAhead' returns the next character from the handle
1036 -- without removing it from the input buffer, blocking until a character
1039 -- This operation may fail with:
1041 -- * 'isEOFError' if the end of file has been reached.
1043 hLookAhead :: Handle -> IO Char
1044 hLookAhead handle = do
1045 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
1046 let ref = haBuffer handle_
1048 is_line = haBufferMode handle_ == LineBuffering
1049 buf <- readIORef ref
1051 -- fill up the read buffer if necessary
1052 new_buf <- if bufferEmpty buf
1053 then fillReadBuffer fd is_line (haIsStream handle_) buf
1056 writeIORef ref new_buf
1058 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
1061 -- ---------------------------------------------------------------------------
1062 -- Buffering Operations
1064 -- Three kinds of buffering are supported: line-buffering,
1065 -- block-buffering or no-buffering. See GHC.IOBase for definition and
1066 -- further explanation of what the type represent.
1068 -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
1069 -- handle @hdl@ on subsequent reads and writes.
1071 -- If the buffer mode is changed from 'BlockBuffering' or
1072 -- 'LineBuffering' to 'NoBuffering', then
1074 -- * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
1076 -- * if @hdl@ is not writable, the contents of the buffer is discarded.
1078 -- This operation may fail with:
1080 -- * 'isPermissionError' if the handle has already been used for reading
1081 -- or writing and the implementation does not allow the buffering mode
1084 hSetBuffering :: Handle -> BufferMode -> IO ()
1085 hSetBuffering handle mode =
1086 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
1087 case haType handle_ of
1088 ClosedHandle -> ioe_closedHandle
1091 - we flush the old buffer regardless of whether
1092 the new buffer could fit the contents of the old buffer
1094 - allow a handle's buffering to change even if IO has
1095 occurred (ANSI C spec. does not allow this, nor did
1096 the previous implementation of IO.hSetBuffering).
1097 - a non-standard extension is to allow the buffering
1098 of semi-closed handles to change [sof 6/98]
1102 let state = initBufferState (haType handle_)
1105 -- we always have a 1-character read buffer for
1106 -- unbuffered handles: it's needed to
1107 -- support hLookAhead.
1108 NoBuffering -> allocateBuffer 1 ReadBuffer
1109 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
1110 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
1111 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
1112 | otherwise -> allocateBuffer n state
1113 writeIORef (haBuffer handle_) new_buf
1115 -- for input terminals we need to put the terminal into
1116 -- cooked or raw mode depending on the type of buffering.
1117 is_tty <- fdIsTTY (haFD handle_)
1118 when (is_tty && isReadableHandleType (haType handle_)) $
1120 #ifndef mingw32_TARGET_OS
1121 -- 'raw' mode under win32 is a bit too specialised (and troublesome
1122 -- for most common uses), so simply disable its use here.
1123 NoBuffering -> setCooked (haFD handle_) False
1125 _ -> setCooked (haFD handle_) True
1127 -- throw away spare buffers, they might be the wrong size
1128 writeIORef (haBuffers handle_) BufferListNil
1130 return (handle_{ haBufferMode = mode })
1132 -- -----------------------------------------------------------------------------
1135 -- | The action 'hFlush' @hdl@ causes any items buffered for output
1136 -- in handle @hdl@ to be sent immediately to the operating system.
1138 -- This operation may fail with:
1140 -- * 'isFullError' if the device is full;
1142 -- * 'isPermissionError' if a system resource limit would be exceeded.
1143 -- It is unspecified whether the characters in the buffer are discarded
1144 -- or retained under these circumstances.
1146 hFlush :: Handle -> IO ()
1148 wantWritableHandle "hFlush" handle $ \ handle_ -> do
1149 buf <- readIORef (haBuffer handle_)
1150 if bufferIsWritable buf && not (bufferEmpty buf)
1151 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
1152 writeIORef (haBuffer handle_) flushed_buf
1156 -- -----------------------------------------------------------------------------
1157 -- Repositioning Handles
1159 data HandlePosn = HandlePosn Handle HandlePosition
1161 instance Eq HandlePosn where
1162 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
1164 instance Show HandlePosn where
1165 showsPrec p (HandlePosn h pos) =
1166 showsPrec p h . showString " at position " . shows pos
1168 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
1169 -- We represent it as an Integer on the Haskell side, but
1170 -- cheat slightly in that hGetPosn calls upon a C helper
1171 -- that reports the position back via (merely) an Int.
1172 type HandlePosition = Integer
1174 -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
1175 -- @hdl@ as a value of the abstract type 'HandlePosn'.
1177 hGetPosn :: Handle -> IO HandlePosn
1178 hGetPosn handle = do
1179 posn <- hTell handle
1180 return (HandlePosn handle posn)
1182 -- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
1183 -- then computation 'hSetPosn' @p@ sets the position of @hdl@
1184 -- to the position it held at the time of the call to 'hGetPosn'.
1186 -- This operation may fail with:
1188 -- * 'isPermissionError' if a system resource limit would be exceeded.
1190 hSetPosn :: HandlePosn -> IO ()
1191 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
1193 -- ---------------------------------------------------------------------------
1196 -- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:
1198 = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.
1199 | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@
1200 -- from the current position.
1201 | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@
1202 -- from the end of the file.
1203 deriving (Eq, Ord, Ix, Enum, Read, Show)
1206 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1207 seeking at or past EOF.
1209 - we possibly deviate from the report on the issue of seeking within
1210 the buffer and whether to flush it or not. The report isn't exactly
1214 -- | Computation 'hSeek' @hdl mode i@ sets the position of handle
1215 -- @hdl@ depending on @mode@.
1216 -- The offset @i@ is given in terms of 8-bit bytes.
1218 -- If @hdl@ is block- or line-buffered, then seeking to a position which is not
1219 -- in the current buffer will first cause any items in the output buffer to be
1220 -- written to the device, and then cause the input buffer to be discarded.
1221 -- Some handles may not be seekable (see 'hIsSeekable'), or only support a
1222 -- subset of the possible positioning operations (for instance, it may only
1223 -- be possible to seek to the end of a tape, or to a positive offset from
1224 -- the beginning or current position).
1225 -- It is not possible to set a negative I\/O position, or for
1226 -- a physical file, an I\/O position beyond the current end-of-file.
1228 -- This operation may fail with:
1230 -- * 'isPermissionError' if a system resource limit would be exceeded.
1232 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1233 hSeek handle mode offset =
1234 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1236 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1238 let ref = haBuffer handle_
1239 buf <- readIORef ref
1245 throwErrnoIfMinus1Retry_ "hSeek"
1246 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1249 whence = case mode of
1250 AbsoluteSeek -> sEEK_SET
1251 RelativeSeek -> sEEK_CUR
1252 SeekFromEnd -> sEEK_END
1254 if bufferIsWritable buf
1255 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1256 writeIORef ref new_buf
1260 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1261 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1264 new_buf <- flushReadBuffer (haFD handle_) buf
1265 writeIORef ref new_buf
1269 hTell :: Handle -> IO Integer
1271 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
1273 #if defined(mingw32_TARGET_OS)
1274 -- urgh, on Windows we have to worry about \n -> \r\n translation,
1275 -- so we can't easily calculate the file position using the
1276 -- current buffer size. Just flush instead.
1279 let fd = fromIntegral (haFD handle_)
1280 posn <- fromIntegral `liftM`
1281 throwErrnoIfMinus1Retry "hGetPosn"
1282 (c_lseek fd 0 sEEK_CUR)
1284 let ref = haBuffer handle_
1285 buf <- readIORef ref
1288 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
1289 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
1291 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
1292 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
1296 -- -----------------------------------------------------------------------------
1297 -- Handle Properties
1299 -- A number of operations return information about the properties of a
1300 -- handle. Each of these operations returns `True' if the handle has
1301 -- the specified property, and `False' otherwise.
1303 hIsOpen :: Handle -> IO Bool
1305 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1306 case haType handle_ of
1307 ClosedHandle -> return False
1308 SemiClosedHandle -> return False
1311 hIsClosed :: Handle -> IO Bool
1313 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1314 case haType handle_ of
1315 ClosedHandle -> return True
1318 {- not defined, nor exported, but mentioned
1319 here for documentation purposes:
1321 hSemiClosed :: Handle -> IO Bool
1325 return (not (ho || hc))
1328 hIsReadable :: Handle -> IO Bool
1329 hIsReadable (DuplexHandle _ _ _) = return True
1330 hIsReadable handle =
1331 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1332 case haType handle_ of
1333 ClosedHandle -> ioe_closedHandle
1334 SemiClosedHandle -> ioe_closedHandle
1335 htype -> return (isReadableHandleType htype)
1337 hIsWritable :: Handle -> IO Bool
1338 hIsWritable (DuplexHandle _ _ _) = return True
1339 hIsWritable handle =
1340 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1341 case haType handle_ of
1342 ClosedHandle -> ioe_closedHandle
1343 SemiClosedHandle -> ioe_closedHandle
1344 htype -> return (isWritableHandleType htype)
1346 -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
1349 hGetBuffering :: Handle -> IO BufferMode
1350 hGetBuffering handle =
1351 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1352 case haType handle_ of
1353 ClosedHandle -> ioe_closedHandle
1355 -- We're being non-standard here, and allow the buffering
1356 -- of a semi-closed handle to be queried. -- sof 6/98
1357 return (haBufferMode handle_) -- could be stricter..
1359 hIsSeekable :: Handle -> IO Bool
1360 hIsSeekable handle =
1361 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1362 case haType handle_ of
1363 ClosedHandle -> ioe_closedHandle
1364 SemiClosedHandle -> ioe_closedHandle
1365 AppendHandle -> return False
1366 _ -> do t <- fdType (haFD handle_)
1367 return (t == RegularFile
1369 || tEXT_MODE_SEEK_ALLOWED))
1371 -- -----------------------------------------------------------------------------
1372 -- Changing echo status (Non-standard GHC extensions)
1374 -- | Set the echoing status of a handle connected to a terminal.
1376 hSetEcho :: Handle -> Bool -> IO ()
1377 hSetEcho handle on = do
1378 isT <- hIsTerminalDevice handle
1382 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1383 case haType handle_ of
1384 ClosedHandle -> ioe_closedHandle
1385 _ -> setEcho (haFD handle_) on
1387 -- | Get the echoing status of a handle connected to a terminal.
1389 hGetEcho :: Handle -> IO Bool
1390 hGetEcho handle = do
1391 isT <- hIsTerminalDevice handle
1395 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1396 case haType handle_ of
1397 ClosedHandle -> ioe_closedHandle
1398 _ -> getEcho (haFD handle_)
1400 -- | Is the handle connected to a terminal?
1402 hIsTerminalDevice :: Handle -> IO Bool
1403 hIsTerminalDevice handle = do
1404 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1405 case haType handle_ of
1406 ClosedHandle -> ioe_closedHandle
1407 _ -> fdIsTTY (haFD handle_)
1409 -- -----------------------------------------------------------------------------
1412 -- | Select binary mode ('True') or text mode ('False') on a open handle.
1413 -- (GHC only; see also 'openBinaryFile'.)
1415 hSetBinaryMode :: Handle -> Bool -> IO ()
1416 hSetBinaryMode handle bin =
1417 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1418 do throwErrnoIfMinus1_ "hSetBinaryMode"
1419 (setmode (fromIntegral (haFD handle_)) bin)
1420 return handle_{haIsBin=bin}
1422 foreign import ccall unsafe "__hscore_setmode"
1423 setmode :: CInt -> Bool -> IO CInt
1425 -- -----------------------------------------------------------------------------
1426 -- Duplicating a Handle
1428 -- |Returns a duplicate of the original handle, with its own buffer
1429 -- and file pointer. The original handle's buffer is flushed, including
1430 -- discarding any input data, before the handle is duplicated.
1432 hDuplicate :: Handle -> IO Handle
1433 hDuplicate h@(FileHandle path m) = do
1434 new_h_ <- withHandle' "hDuplicate" h m (dupHandle_ Nothing)
1435 new_m <- newMVar new_h_
1436 return (FileHandle path new_m)
1437 hDuplicate h@(DuplexHandle path r w) = do
1438 new_w_ <- withHandle' "hDuplicate" h w (dupHandle_ Nothing)
1439 new_w <- newMVar new_w_
1440 new_r_ <- withHandle' "hDuplicate" h r (dupHandle_ (Just new_w))
1441 new_r <- newMVar new_r_
1442 return (DuplexHandle path new_r new_w)
1444 dupHandle_ other_side h_ = do
1445 -- flush the buffer first, so we don't have to copy its contents
1447 new_fd <- c_dup (fromIntegral (haFD h_))
1448 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))
1449 ioref <- newIORef buffer
1450 ioref_buffers <- newIORef BufferListNil
1452 let new_handle_ = h_{ haFD = fromIntegral new_fd,
1454 haBuffers = ioref_buffers,
1455 haOtherSide = other_side }
1456 return (h_, new_handle_)
1458 -- -----------------------------------------------------------------------------
1459 -- Replacing a Handle
1462 Makes the second handle a duplicate of the first handle. The second
1463 handle will be closed first, if it is not already.
1465 This can be used to retarget the standard Handles, for example:
1467 > do h <- openFile "mystdout" WriteMode
1468 > hDuplicateTo h stdout
1471 hDuplicateTo :: Handle -> Handle -> IO ()
1472 hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2) = do
1473 withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
1474 _ <- hClose_help h2_
1475 withHandle' "hDuplicateTo" h1 m1 (dupHandle_ Nothing)
1476 hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2) = do
1477 withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do
1478 _ <- hClose_help w2_
1479 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ Nothing)
1480 withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do
1481 _ <- hClose_help r2_
1482 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ (Just w1))
1484 ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
1485 "handles are incompatible" Nothing)
1487 -- ---------------------------------------------------------------------------
1490 -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
1491 -- than the (pure) instance of 'Show' for 'Handle'.
1493 hShow :: Handle -> IO String
1494 hShow h@(FileHandle path _) = showHandle' path False h
1495 hShow h@(DuplexHandle path _ _) = showHandle' path True h
1497 showHandle' filepath is_duplex h =
1498 withHandle_ "showHandle" h $ \hdl_ ->
1500 showType | is_duplex = showString "duplex (read-write)"
1501 | otherwise = shows (haType hdl_)
1505 showHdl (haType hdl_)
1506 (showString "loc=" . showString filepath . showChar ',' .
1507 showString "type=" . showType . showChar ',' .
1508 showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
1509 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
1513 showHdl :: HandleType -> ShowS -> ShowS
1516 ClosedHandle -> shows ht . showString "}"
1519 showBufMode :: Buffer -> BufferMode -> ShowS
1520 showBufMode buf bmo =
1522 NoBuffering -> showString "none"
1523 LineBuffering -> showString "line"
1524 BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
1525 BlockBuffering Nothing -> showString "block " . showParen True (shows def)
1530 -- ---------------------------------------------------------------------------
1534 puts :: String -> IO ()
1535 puts s = withCString s $ \cstr -> do write_rawBuffer 1 False cstr 0 (fromIntegral (length s))
1539 -- -----------------------------------------------------------------------------
1542 throwErrnoIfMinus1RetryOnBlock :: String -> IO CInt -> IO CInt -> IO CInt
1543 throwErrnoIfMinus1RetryOnBlock loc f on_block =
1546 if (res :: CInt) == -1
1550 then throwErrnoIfMinus1RetryOnBlock loc f on_block
1551 else if err == eWOULDBLOCK || err == eAGAIN
1556 -- -----------------------------------------------------------------------------
1557 -- wrappers to platform-specific constants:
1559 foreign import ccall unsafe "__hscore_supportsTextMode"
1560 tEXT_MODE_SEEK_ALLOWED :: Bool
1562 foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
1563 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1564 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1565 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt