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
555 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
556 readRawBuffer loc fd is_stream buf off len = do
557 (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf
560 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
561 else return (fromIntegral l)
563 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
564 readRawBufferNoBlock loc fd is_stream buf off len = do
565 (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf
568 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
569 else return (fromIntegral l)
571 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
572 readRawBufferPtr loc fd is_stream buf off len = do
573 (l, rc) <- asyncRead fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off)
576 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
577 else return (fromIntegral l)
579 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
580 writeRawBuffer loc fd is_stream buf off len = do
581 (l, rc) <- asyncWriteBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf
584 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
585 else return (fromIntegral l)
587 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
588 writeRawBufferPtr loc fd is_stream buf off len = do
589 (l, rc) <- asyncWrite fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off)
592 ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
593 else return (fromIntegral l)
596 -- ---------------------------------------------------------------------------
599 -- Three handles are allocated during program initialisation. The first
600 -- two manage input or output from the Haskell program's standard input
601 -- or output channel respectively. The third manages output to the
602 -- standard error channel. These handles are initially open.
608 -- | A handle managing input from the Haskell program's standard input channel.
610 stdin = unsafePerformIO $ do
611 -- ToDo: acquire lock
612 setNonBlockingFD fd_stdin
613 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
614 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
616 -- | A handle managing output to the Haskell program's standard output channel.
618 stdout = unsafePerformIO $ do
619 -- ToDo: acquire lock
620 -- We don't set non-blocking mode on stdout or sterr, because
621 -- some shells don't recover properly.
622 -- setNonBlockingFD fd_stdout
623 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
624 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
626 -- | A handle managing output to the Haskell program's standard error channel.
628 stderr = unsafePerformIO $ do
629 -- ToDo: acquire lock
630 -- We don't set non-blocking mode on stdout or sterr, because
631 -- some shells don't recover properly.
632 -- setNonBlockingFD fd_stderr
634 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
636 -- ---------------------------------------------------------------------------
637 -- Opening and Closing Files
639 addFilePathToIOError fun fp (IOError h iot _ str _)
640 = IOError h iot fun str (Just fp)
642 -- | Computation 'openFile' @file mode@ allocates and returns a new, open
643 -- handle to manage the file @file@. It manages input if @mode@
644 -- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
645 -- and both input and output if mode is 'ReadWriteMode'.
647 -- If the file does not exist and it is opened for output, it should be
648 -- created as a new file. If @mode@ is 'WriteMode' and the file
649 -- already exists, then it should be truncated to zero length.
650 -- Some operating systems delete empty files, so there is no guarantee
651 -- that the file will exist following an 'openFile' with @mode@
652 -- 'WriteMode' unless it is subsequently written to successfully.
653 -- The handle is positioned at the end of the file if @mode@ is
654 -- 'AppendMode', and otherwise at the beginning (in which case its
655 -- internal position is 0).
656 -- The initial buffer mode is implementation-dependent.
658 -- This operation may fail with:
660 -- * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
662 -- * 'isDoesNotExistError' if the file does not exist; or
664 -- * 'isPermissionError' if the user does not have permission to open the file.
666 openFile :: FilePath -> IOMode -> IO Handle
669 (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
670 (\e -> ioError (addFilePathToIOError "openFile" fp e))
672 -- | Like 'openFile', but open the file in binary mode.
673 -- On Windows, reading a file in text mode (which is the default)
674 -- will translate CRLF to LF, and writing will translate LF to CRLF.
675 -- This is usually what you want with text files. With binary files
676 -- this is undesirable; also, as usual under Microsoft operating systems,
677 -- text mode treats control-Z as EOF. Binary mode turns off all special
678 -- treatment of end-of-line and end-of-file characters.
679 -- (See also 'hSetBinaryMode'.)
681 openBinaryFile :: FilePath -> IOMode -> IO Handle
682 openBinaryFile fp m =
684 (openFile' fp m True)
685 (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
687 openFile' filepath mode binary =
688 withCString filepath $ \ f ->
691 oflags1 = case mode of
692 ReadMode -> read_flags
693 WriteMode -> write_flags
694 ReadWriteMode -> rw_flags
695 AppendMode -> append_flags
697 truncate | WriteMode <- mode = True
704 oflags = oflags1 .|. binary_flags
707 -- the old implementation had a complicated series of three opens,
708 -- which is perhaps because we have to be careful not to open
709 -- directories. However, the man pages I've read say that open()
710 -- always returns EISDIR if the file is a directory and was opened
711 -- for writing, so I think we're ok with a single open() here...
712 fd <- fromIntegral `liftM`
713 throwErrnoIfMinus1Retry "openFile"
714 (c_open f (fromIntegral oflags) 0o666)
716 openFd fd Nothing filepath mode binary truncate
717 `catchException` \e -> do c_close (fromIntegral fd); throw e
718 -- NB. don't forget to close the FD if openFd fails, otherwise
720 -- ASSERT: if we just created the file, then openFd won't fail
721 -- (so we don't need to worry about removing the newly created file
722 -- in the event of an error).
725 std_flags = o_NONBLOCK .|. o_NOCTTY
726 output_flags = std_flags .|. o_CREAT
727 read_flags = std_flags .|. o_RDONLY
728 write_flags = output_flags .|. o_WRONLY
729 rw_flags = output_flags .|. o_RDWR
730 append_flags = write_flags .|. o_APPEND
732 -- ---------------------------------------------------------------------------
735 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
736 openFd fd mb_fd_type filepath mode binary truncate = do
737 -- turn on non-blocking mode
740 let (ha_type, write) =
742 ReadMode -> ( ReadHandle, False )
743 WriteMode -> ( WriteHandle, True )
744 ReadWriteMode -> ( ReadWriteHandle, True )
745 AppendMode -> ( AppendHandle, True )
747 -- open() won't tell us if it was a directory if we only opened for
748 -- reading, so check again.
753 let is_stream = fd_type == Stream
756 ioException (IOError Nothing InappropriateType "openFile"
757 "is a directory" Nothing)
760 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
761 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
763 -- regular files need to be locked
765 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
767 ioException (IOError Nothing ResourceBusy "openFile"
768 "file is locked" Nothing)
770 -- truncate the file if necessary
771 when truncate (fileTruncate filepath)
773 mkFileHandle fd is_stream filepath ha_type binary
776 fdToHandle :: FD -> IO Handle
779 let fd_str = "<file descriptor: " ++ show fd ++ ">"
780 openFd fd Nothing fd_str mode True{-bin mode-} False{-no truncate-}
782 foreign import ccall unsafe "lockFile"
783 lockFile :: CInt -> CInt -> CInt -> IO CInt
785 foreign import ccall unsafe "unlockFile"
786 unlockFile :: CInt -> IO CInt
788 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
790 mkStdHandle fd filepath ha_type buf bmode = do
791 spares <- newIORef BufferListNil
792 newFileHandle filepath stdHandleFinalizer
793 (Handle__ { haFD = fd,
795 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
797 haBufferMode = bmode,
800 haOtherSide = Nothing
803 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
804 mkFileHandle fd is_stream filepath ha_type binary = do
805 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
806 spares <- newIORef BufferListNil
807 newFileHandle filepath handleFinalizer
808 (Handle__ { haFD = fd,
811 haIsStream = is_stream,
812 haBufferMode = bmode,
815 haOtherSide = Nothing
818 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
819 mkDuplexHandle fd is_stream filepath binary = do
820 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
821 w_spares <- newIORef BufferListNil
823 Handle__ { haFD = fd,
824 haType = WriteHandle,
826 haIsStream = is_stream,
827 haBufferMode = w_bmode,
829 haBuffers = w_spares,
830 haOtherSide = Nothing
832 write_side <- newMVar w_handle_
834 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
835 r_spares <- newIORef BufferListNil
837 Handle__ { haFD = fd,
840 haIsStream = is_stream,
841 haBufferMode = r_bmode,
843 haBuffers = r_spares,
844 haOtherSide = Just write_side
846 read_side <- newMVar r_handle_
848 addMVarFinalizer write_side (handleFinalizer write_side)
849 return (DuplexHandle filepath read_side write_side)
852 initBufferState ReadHandle = ReadBuffer
853 initBufferState _ = WriteBuffer
855 -- ---------------------------------------------------------------------------
858 -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the
859 -- computation finishes, if @hdl@ is writable its buffer is flushed as
861 -- Performing 'hClose' on a handle that has already been closed has no effect;
862 -- doing so not an error. All other operations on a closed handle will fail.
863 -- If 'hClose' fails for any reason, any further operations (apart from
864 -- 'hClose') on the handle will still fail as if @hdl@ had been successfully
867 hClose :: Handle -> IO ()
868 hClose h@(FileHandle _ m) = hClose' h m
869 hClose h@(DuplexHandle _ r w) = hClose' h w >> hClose' h r
871 hClose' h m = withHandle__' "hClose" h m $ hClose_help
873 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
874 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
875 -- then closed immediately. We have to be careful with DuplexHandles
876 -- though: we have to leave the closing to the finalizer in that case,
877 -- because the write side may still be in use.
878 hClose_help :: Handle__ -> IO Handle__
879 hClose_help handle_ =
880 case haType handle_ of
881 ClosedHandle -> return handle_
882 _ -> do flushWriteBufferOnly handle_ -- interruptible
883 hClose_handle_ handle_
885 hClose_handle_ handle_ = do
886 let fd = haFD handle_
887 c_fd = fromIntegral fd
889 -- close the file descriptor, but not when this is the read
890 -- side of a duplex handle, and not when this is one of the
892 case haOtherSide handle_ of
894 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
895 throwErrnoIfMinus1Retry_ "hClose"
896 #ifdef mingw32_TARGET_OS
897 (closeFd (haIsStream handle_) c_fd)
903 -- free the spare buffers
904 writeIORef (haBuffers handle_) BufferListNil
909 -- we must set the fd to -1, because the finalizer is going
910 -- to run eventually and try to close/unlock it.
911 return (handle_{ haFD = -1,
912 haType = ClosedHandle
915 -----------------------------------------------------------------------------
916 -- Detecting the size of a file
918 -- | For a handle @hdl@ which attached to a physical file,
919 -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
921 hFileSize :: Handle -> IO Integer
923 withHandle_ "hFileSize" handle $ \ handle_ -> do
924 case haType handle_ of
925 ClosedHandle -> ioe_closedHandle
926 SemiClosedHandle -> ioe_closedHandle
927 _ -> do flushWriteBufferOnly handle_
928 r <- fdFileSize (haFD handle_)
931 else ioException (IOError Nothing InappropriateType "hFileSize"
932 "not a regular file" Nothing)
934 -- ---------------------------------------------------------------------------
935 -- Detecting the End of Input
937 -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
938 -- 'True' if no further input can be taken from @hdl@ or for a
939 -- physical file, if the current I\/O position is equal to the length of
940 -- the file. Otherwise, it returns 'False'.
942 hIsEOF :: Handle -> IO Bool
945 (do hLookAhead handle; return False)
946 (\e -> if isEOFError e then return True else ioError e)
948 -- | The computation 'isEOF' is identical to 'hIsEOF',
949 -- except that it works only on 'stdin'.
954 -- ---------------------------------------------------------------------------
957 -- | Computation 'hLookAhead' returns the next character from the handle
958 -- without removing it from the input buffer, blocking until a character
961 -- This operation may fail with:
963 -- * 'isEOFError' if the end of file has been reached.
965 hLookAhead :: Handle -> IO Char
966 hLookAhead handle = do
967 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
968 let ref = haBuffer handle_
970 is_line = haBufferMode handle_ == LineBuffering
973 -- fill up the read buffer if necessary
974 new_buf <- if bufferEmpty buf
975 then fillReadBuffer fd is_line (haIsStream handle_) buf
978 writeIORef ref new_buf
980 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
983 -- ---------------------------------------------------------------------------
984 -- Buffering Operations
986 -- Three kinds of buffering are supported: line-buffering,
987 -- block-buffering or no-buffering. See GHC.IOBase for definition and
988 -- further explanation of what the type represent.
990 -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
991 -- handle @hdl@ on subsequent reads and writes.
993 -- If the buffer mode is changed from 'BlockBuffering' or
994 -- 'LineBuffering' to 'NoBuffering', then
996 -- * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
998 -- * if @hdl@ is not writable, the contents of the buffer is discarded.
1000 -- This operation may fail with:
1002 -- * 'isPermissionError' if the handle has already been used for reading
1003 -- or writing and the implementation does not allow the buffering mode
1006 hSetBuffering :: Handle -> BufferMode -> IO ()
1007 hSetBuffering handle mode =
1008 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
1009 case haType handle_ of
1010 ClosedHandle -> ioe_closedHandle
1013 - we flush the old buffer regardless of whether
1014 the new buffer could fit the contents of the old buffer
1016 - allow a handle's buffering to change even if IO has
1017 occurred (ANSI C spec. does not allow this, nor did
1018 the previous implementation of IO.hSetBuffering).
1019 - a non-standard extension is to allow the buffering
1020 of semi-closed handles to change [sof 6/98]
1024 let state = initBufferState (haType handle_)
1027 -- we always have a 1-character read buffer for
1028 -- unbuffered handles: it's needed to
1029 -- support hLookAhead.
1030 NoBuffering -> allocateBuffer 1 ReadBuffer
1031 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
1032 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
1033 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
1034 | otherwise -> allocateBuffer n state
1035 writeIORef (haBuffer handle_) new_buf
1037 -- for input terminals we need to put the terminal into
1038 -- cooked or raw mode depending on the type of buffering.
1039 is_tty <- fdIsTTY (haFD handle_)
1040 when (is_tty && isReadableHandleType (haType handle_)) $
1042 #ifndef mingw32_TARGET_OS
1043 -- 'raw' mode under win32 is a bit too specialised (and troublesome
1044 -- for most common uses), so simply disable its use here.
1045 NoBuffering -> setCooked (haFD handle_) False
1047 _ -> setCooked (haFD handle_) True
1049 -- throw away spare buffers, they might be the wrong size
1050 writeIORef (haBuffers handle_) BufferListNil
1052 return (handle_{ haBufferMode = mode })
1054 -- -----------------------------------------------------------------------------
1057 -- | The action 'hFlush' @hdl@ causes any items buffered for output
1058 -- in handle @hdl@ to be sent immediately to the operating system.
1060 -- This operation may fail with:
1062 -- * 'isFullError' if the device is full;
1064 -- * 'isPermissionError' if a system resource limit would be exceeded.
1065 -- It is unspecified whether the characters in the buffer are discarded
1066 -- or retained under these circumstances.
1068 hFlush :: Handle -> IO ()
1070 wantWritableHandle "hFlush" handle $ \ handle_ -> do
1071 buf <- readIORef (haBuffer handle_)
1072 if bufferIsWritable buf && not (bufferEmpty buf)
1073 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
1074 writeIORef (haBuffer handle_) flushed_buf
1078 -- -----------------------------------------------------------------------------
1079 -- Repositioning Handles
1081 data HandlePosn = HandlePosn Handle HandlePosition
1083 instance Eq HandlePosn where
1084 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
1086 instance Show HandlePosn where
1087 showsPrec p (HandlePosn h pos) =
1088 showsPrec p h . showString " at position " . shows pos
1090 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
1091 -- We represent it as an Integer on the Haskell side, but
1092 -- cheat slightly in that hGetPosn calls upon a C helper
1093 -- that reports the position back via (merely) an Int.
1094 type HandlePosition = Integer
1096 -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
1097 -- @hdl@ as a value of the abstract type 'HandlePosn'.
1099 hGetPosn :: Handle -> IO HandlePosn
1100 hGetPosn handle = do
1101 posn <- hTell handle
1102 return (HandlePosn handle posn)
1104 -- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
1105 -- then computation 'hSetPosn' @p@ sets the position of @hdl@
1106 -- to the position it held at the time of the call to 'hGetPosn'.
1108 -- This operation may fail with:
1110 -- * 'isPermissionError' if a system resource limit would be exceeded.
1112 hSetPosn :: HandlePosn -> IO ()
1113 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
1115 -- ---------------------------------------------------------------------------
1118 -- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:
1120 = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.
1121 | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@
1122 -- from the current position.
1123 | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@
1124 -- from the end of the file.
1125 deriving (Eq, Ord, Ix, Enum, Read, Show)
1128 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1129 seeking at or past EOF.
1131 - we possibly deviate from the report on the issue of seeking within
1132 the buffer and whether to flush it or not. The report isn't exactly
1136 -- | Computation 'hSeek' @hdl mode i@ sets the position of handle
1137 -- @hdl@ depending on @mode@.
1138 -- The offset @i@ is given in terms of 8-bit bytes.
1140 -- If @hdl@ is block- or line-buffered, then seeking to a position which is not
1141 -- in the current buffer will first cause any items in the output buffer to be
1142 -- written to the device, and then cause the input buffer to be discarded.
1143 -- Some handles may not be seekable (see 'hIsSeekable'), or only support a
1144 -- subset of the possible positioning operations (for instance, it may only
1145 -- be possible to seek to the end of a tape, or to a positive offset from
1146 -- the beginning or current position).
1147 -- It is not possible to set a negative I\/O position, or for
1148 -- a physical file, an I\/O position beyond the current end-of-file.
1150 -- This operation may fail with:
1152 -- * 'isPermissionError' if a system resource limit would be exceeded.
1154 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1155 hSeek handle mode offset =
1156 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1158 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1160 let ref = haBuffer handle_
1161 buf <- readIORef ref
1167 throwErrnoIfMinus1Retry_ "hSeek"
1168 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1171 whence = case mode of
1172 AbsoluteSeek -> sEEK_SET
1173 RelativeSeek -> sEEK_CUR
1174 SeekFromEnd -> sEEK_END
1176 if bufferIsWritable buf
1177 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1178 writeIORef ref new_buf
1182 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1183 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1186 new_buf <- flushReadBuffer (haFD handle_) buf
1187 writeIORef ref new_buf
1191 hTell :: Handle -> IO Integer
1193 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
1195 #if defined(mingw32_TARGET_OS)
1196 -- urgh, on Windows we have to worry about \n -> \r\n translation,
1197 -- so we can't easily calculate the file position using the
1198 -- current buffer size. Just flush instead.
1201 let fd = fromIntegral (haFD handle_)
1202 posn <- fromIntegral `liftM`
1203 throwErrnoIfMinus1Retry "hGetPosn"
1204 (c_lseek fd 0 sEEK_CUR)
1206 let ref = haBuffer handle_
1207 buf <- readIORef ref
1210 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
1211 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
1213 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
1214 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
1218 -- -----------------------------------------------------------------------------
1219 -- Handle Properties
1221 -- A number of operations return information about the properties of a
1222 -- handle. Each of these operations returns `True' if the handle has
1223 -- the specified property, and `False' otherwise.
1225 hIsOpen :: Handle -> IO Bool
1227 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1228 case haType handle_ of
1229 ClosedHandle -> return False
1230 SemiClosedHandle -> return False
1233 hIsClosed :: Handle -> IO Bool
1235 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1236 case haType handle_ of
1237 ClosedHandle -> return True
1240 {- not defined, nor exported, but mentioned
1241 here for documentation purposes:
1243 hSemiClosed :: Handle -> IO Bool
1247 return (not (ho || hc))
1250 hIsReadable :: Handle -> IO Bool
1251 hIsReadable (DuplexHandle _ _ _) = return True
1252 hIsReadable handle =
1253 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1254 case haType handle_ of
1255 ClosedHandle -> ioe_closedHandle
1256 SemiClosedHandle -> ioe_closedHandle
1257 htype -> return (isReadableHandleType htype)
1259 hIsWritable :: Handle -> IO Bool
1260 hIsWritable (DuplexHandle _ _ _) = return True
1261 hIsWritable handle =
1262 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1263 case haType handle_ of
1264 ClosedHandle -> ioe_closedHandle
1265 SemiClosedHandle -> ioe_closedHandle
1266 htype -> return (isWritableHandleType htype)
1268 -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
1271 hGetBuffering :: Handle -> IO BufferMode
1272 hGetBuffering handle =
1273 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1274 case haType handle_ of
1275 ClosedHandle -> ioe_closedHandle
1277 -- We're being non-standard here, and allow the buffering
1278 -- of a semi-closed handle to be queried. -- sof 6/98
1279 return (haBufferMode handle_) -- could be stricter..
1281 hIsSeekable :: Handle -> IO Bool
1282 hIsSeekable handle =
1283 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1284 case haType handle_ of
1285 ClosedHandle -> ioe_closedHandle
1286 SemiClosedHandle -> ioe_closedHandle
1287 AppendHandle -> return False
1288 _ -> do t <- fdType (haFD handle_)
1289 return (t == RegularFile
1291 || tEXT_MODE_SEEK_ALLOWED))
1293 -- -----------------------------------------------------------------------------
1294 -- Changing echo status (Non-standard GHC extensions)
1296 -- | Set the echoing status of a handle connected to a terminal.
1298 hSetEcho :: Handle -> Bool -> IO ()
1299 hSetEcho handle on = do
1300 isT <- hIsTerminalDevice handle
1304 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1305 case haType handle_ of
1306 ClosedHandle -> ioe_closedHandle
1307 _ -> setEcho (haFD handle_) on
1309 -- | Get the echoing status of a handle connected to a terminal.
1311 hGetEcho :: Handle -> IO Bool
1312 hGetEcho handle = do
1313 isT <- hIsTerminalDevice handle
1317 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1318 case haType handle_ of
1319 ClosedHandle -> ioe_closedHandle
1320 _ -> getEcho (haFD handle_)
1322 -- | Is the handle connected to a terminal?
1324 hIsTerminalDevice :: Handle -> IO Bool
1325 hIsTerminalDevice handle = do
1326 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1327 case haType handle_ of
1328 ClosedHandle -> ioe_closedHandle
1329 _ -> fdIsTTY (haFD handle_)
1331 -- -----------------------------------------------------------------------------
1334 -- | Select binary mode ('True') or text mode ('False') on a open handle.
1335 -- (GHC only; see also 'openBinaryFile'.)
1337 hSetBinaryMode :: Handle -> Bool -> IO ()
1338 hSetBinaryMode handle bin =
1339 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1340 do throwErrnoIfMinus1_ "hSetBinaryMode"
1341 (setmode (fromIntegral (haFD handle_)) bin)
1342 return handle_{haIsBin=bin}
1344 foreign import ccall unsafe "__hscore_setmode"
1345 setmode :: CInt -> Bool -> IO CInt
1347 -- -----------------------------------------------------------------------------
1348 -- Duplicating a Handle
1350 -- |Returns a duplicate of the original handle, with its own buffer
1351 -- and file pointer. The original handle's buffer is flushed, including
1352 -- discarding any input data, before the handle is duplicated.
1354 hDuplicate :: Handle -> IO Handle
1355 hDuplicate h@(FileHandle path m) = do
1356 new_h_ <- withHandle' "hDuplicate" h m (dupHandle_ Nothing)
1357 new_m <- newMVar new_h_
1358 return (FileHandle path new_m)
1359 hDuplicate h@(DuplexHandle path r w) = do
1360 new_w_ <- withHandle' "hDuplicate" h w (dupHandle_ Nothing)
1361 new_w <- newMVar new_w_
1362 new_r_ <- withHandle' "hDuplicate" h r (dupHandle_ (Just new_w))
1363 new_r <- newMVar new_r_
1364 return (DuplexHandle path new_r new_w)
1366 dupHandle_ other_side h_ = do
1367 -- flush the buffer first, so we don't have to copy its contents
1369 new_fd <- c_dup (fromIntegral (haFD h_))
1370 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))
1371 ioref <- newIORef buffer
1372 ioref_buffers <- newIORef BufferListNil
1374 let new_handle_ = h_{ haFD = fromIntegral new_fd,
1376 haBuffers = ioref_buffers,
1377 haOtherSide = other_side }
1378 return (h_, new_handle_)
1380 -- -----------------------------------------------------------------------------
1381 -- Replacing a Handle
1384 Makes the second handle a duplicate of the first handle. The second
1385 handle will be closed first, if it is not already.
1387 This can be used to retarget the standard Handles, for example:
1389 > do h <- openFile "mystdout" WriteMode
1390 > hDuplicateTo h stdout
1393 hDuplicateTo :: Handle -> Handle -> IO ()
1394 hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2) = do
1395 withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
1396 _ <- hClose_help h2_
1397 withHandle' "hDuplicateTo" h1 m1 (dupHandle_ Nothing)
1398 hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2) = do
1399 withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do
1400 _ <- hClose_help w2_
1401 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ Nothing)
1402 withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do
1403 _ <- hClose_help r2_
1404 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ (Just w1))
1406 ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
1407 "handles are incompatible" Nothing)
1409 -- ---------------------------------------------------------------------------
1412 -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
1413 -- than the (pure) instance of 'Show' for 'Handle'.
1415 hShow :: Handle -> IO String
1416 hShow h@(FileHandle path _) = showHandle' path False h
1417 hShow h@(DuplexHandle path _ _) = showHandle' path True h
1419 showHandle' filepath is_duplex h =
1420 withHandle_ "showHandle" h $ \hdl_ ->
1422 showType | is_duplex = showString "duplex (read-write)"
1423 | otherwise = shows (haType hdl_)
1427 showHdl (haType hdl_)
1428 (showString "loc=" . showString filepath . showChar ',' .
1429 showString "type=" . showType . showChar ',' .
1430 showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
1431 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
1435 showHdl :: HandleType -> ShowS -> ShowS
1438 ClosedHandle -> shows ht . showString "}"
1441 showBufMode :: Buffer -> BufferMode -> ShowS
1442 showBufMode buf bmo =
1444 NoBuffering -> showString "none"
1445 LineBuffering -> showString "line"
1446 BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
1447 BlockBuffering Nothing -> showString "block " . showParen True (shows def)
1452 -- ---------------------------------------------------------------------------
1456 puts :: String -> IO ()
1457 puts s = withCString s $ \cstr -> do write_rawBuffer 1 False cstr 0 (fromIntegral (length s))
1461 -- -----------------------------------------------------------------------------
1464 throwErrnoIfMinus1RetryOnBlock :: String -> IO CInt -> IO CInt -> IO CInt
1465 throwErrnoIfMinus1RetryOnBlock loc f on_block =
1468 if (res :: CInt) == -1
1472 then throwErrnoIfMinus1RetryOnBlock loc f on_block
1473 else if err == eWOULDBLOCK || err == eAGAIN
1478 -- -----------------------------------------------------------------------------
1479 -- wrappers to platform-specific constants:
1481 foreign import ccall unsafe "__hscore_supportsTextMode"
1482 tEXT_MODE_SEEK_ALLOWED :: Bool
1484 foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
1485 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1486 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1487 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt