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 -- ASSERT: if we just created the file, then openFd won't fail
718 -- (so we don't need to worry about removing the newly created file
719 -- in the event of an error).
722 std_flags = o_NONBLOCK .|. o_NOCTTY
723 output_flags = std_flags .|. o_CREAT
724 read_flags = std_flags .|. o_RDONLY
725 write_flags = output_flags .|. o_WRONLY
726 rw_flags = output_flags .|. o_RDWR
727 append_flags = write_flags .|. o_APPEND
729 -- ---------------------------------------------------------------------------
732 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
733 openFd fd mb_fd_type filepath mode binary truncate = do
734 -- turn on non-blocking mode
737 let (ha_type, write) =
739 ReadMode -> ( ReadHandle, False )
740 WriteMode -> ( WriteHandle, True )
741 ReadWriteMode -> ( ReadWriteHandle, True )
742 AppendMode -> ( AppendHandle, True )
744 -- open() won't tell us if it was a directory if we only opened for
745 -- reading, so check again.
750 let is_stream = fd_type == Stream
753 ioException (IOError Nothing InappropriateType "openFile"
754 "is a directory" Nothing)
757 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
758 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
760 -- regular files need to be locked
762 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
764 ioException (IOError Nothing ResourceBusy "openFile"
765 "file is locked" Nothing)
767 -- truncate the file if necessary
768 when truncate (fileTruncate filepath)
770 mkFileHandle fd is_stream filepath ha_type binary
773 fdToHandle :: FD -> IO Handle
776 let fd_str = "<file descriptor: " ++ show fd ++ ">"
777 openFd fd Nothing fd_str mode True{-bin mode-} False{-no truncate-}
779 foreign import ccall unsafe "lockFile"
780 lockFile :: CInt -> CInt -> CInt -> IO CInt
782 foreign import ccall unsafe "unlockFile"
783 unlockFile :: CInt -> IO CInt
785 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
787 mkStdHandle fd filepath ha_type buf bmode = do
788 spares <- newIORef BufferListNil
789 newFileHandle filepath stdHandleFinalizer
790 (Handle__ { haFD = fd,
792 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
794 haBufferMode = bmode,
797 haOtherSide = Nothing
800 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
801 mkFileHandle fd is_stream filepath ha_type binary = do
802 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
803 spares <- newIORef BufferListNil
804 newFileHandle filepath handleFinalizer
805 (Handle__ { haFD = fd,
808 haIsStream = is_stream,
809 haBufferMode = bmode,
812 haOtherSide = Nothing
815 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
816 mkDuplexHandle fd is_stream filepath binary = do
817 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
818 w_spares <- newIORef BufferListNil
820 Handle__ { haFD = fd,
821 haType = WriteHandle,
823 haIsStream = is_stream,
824 haBufferMode = w_bmode,
826 haBuffers = w_spares,
827 haOtherSide = Nothing
829 write_side <- newMVar w_handle_
831 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
832 r_spares <- newIORef BufferListNil
834 Handle__ { haFD = fd,
837 haIsStream = is_stream,
838 haBufferMode = r_bmode,
840 haBuffers = r_spares,
841 haOtherSide = Just write_side
843 read_side <- newMVar r_handle_
845 addMVarFinalizer write_side (handleFinalizer write_side)
846 return (DuplexHandle filepath read_side write_side)
849 initBufferState ReadHandle = ReadBuffer
850 initBufferState _ = WriteBuffer
852 -- ---------------------------------------------------------------------------
855 -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed. Before the
856 -- computation finishes, if @hdl@ is writable its buffer is flushed as
858 -- Performing 'hClose' on a handle that has already been closed has no effect;
859 -- doing so not an error. All other operations on a closed handle will fail.
860 -- If 'hClose' fails for any reason, any further operations (apart from
861 -- 'hClose') on the handle will still fail as if @hdl@ had been successfully
864 hClose :: Handle -> IO ()
865 hClose h@(FileHandle _ m) = hClose' h m
866 hClose h@(DuplexHandle _ r w) = hClose' h w >> hClose' h r
868 hClose' h m = withHandle__' "hClose" h m $ hClose_help
870 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
871 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
872 -- then closed immediately. We have to be careful with DuplexHandles
873 -- though: we have to leave the closing to the finalizer in that case,
874 -- because the write side may still be in use.
875 hClose_help :: Handle__ -> IO Handle__
876 hClose_help handle_ =
877 case haType handle_ of
878 ClosedHandle -> return handle_
879 _ -> do flushWriteBufferOnly handle_ -- interruptible
880 hClose_handle_ handle_
882 hClose_handle_ handle_ = do
883 let fd = haFD handle_
884 c_fd = fromIntegral fd
886 -- close the file descriptor, but not when this is the read
887 -- side of a duplex handle, and not when this is one of the
889 case haOtherSide handle_ of
891 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
892 throwErrnoIfMinus1Retry_ "hClose"
893 #ifdef mingw32_TARGET_OS
894 (closeFd (haIsStream handle_) c_fd)
900 -- free the spare buffers
901 writeIORef (haBuffers handle_) BufferListNil
906 -- we must set the fd to -1, because the finalizer is going
907 -- to run eventually and try to close/unlock it.
908 return (handle_{ haFD = -1,
909 haType = ClosedHandle
912 -----------------------------------------------------------------------------
913 -- Detecting the size of a file
915 -- | For a handle @hdl@ which attached to a physical file,
916 -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
918 hFileSize :: Handle -> IO Integer
920 withHandle_ "hFileSize" handle $ \ handle_ -> do
921 case haType handle_ of
922 ClosedHandle -> ioe_closedHandle
923 SemiClosedHandle -> ioe_closedHandle
924 _ -> do flushWriteBufferOnly handle_
925 r <- fdFileSize (haFD handle_)
928 else ioException (IOError Nothing InappropriateType "hFileSize"
929 "not a regular file" Nothing)
931 -- ---------------------------------------------------------------------------
932 -- Detecting the End of Input
934 -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
935 -- 'True' if no further input can be taken from @hdl@ or for a
936 -- physical file, if the current I\/O position is equal to the length of
937 -- the file. Otherwise, it returns 'False'.
939 hIsEOF :: Handle -> IO Bool
942 (do hLookAhead handle; return False)
943 (\e -> if isEOFError e then return True else ioError e)
945 -- | The computation 'isEOF' is identical to 'hIsEOF',
946 -- except that it works only on 'stdin'.
951 -- ---------------------------------------------------------------------------
954 -- | Computation 'hLookAhead' returns the next character from the handle
955 -- without removing it from the input buffer, blocking until a character
958 -- This operation may fail with:
960 -- * 'isEOFError' if the end of file has been reached.
962 hLookAhead :: Handle -> IO Char
963 hLookAhead handle = do
964 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
965 let ref = haBuffer handle_
967 is_line = haBufferMode handle_ == LineBuffering
970 -- fill up the read buffer if necessary
971 new_buf <- if bufferEmpty buf
972 then fillReadBuffer fd is_line (haIsStream handle_) buf
975 writeIORef ref new_buf
977 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
980 -- ---------------------------------------------------------------------------
981 -- Buffering Operations
983 -- Three kinds of buffering are supported: line-buffering,
984 -- block-buffering or no-buffering. See GHC.IOBase for definition and
985 -- further explanation of what the type represent.
987 -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
988 -- handle @hdl@ on subsequent reads and writes.
990 -- If the buffer mode is changed from 'BlockBuffering' or
991 -- 'LineBuffering' to 'NoBuffering', then
993 -- * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
995 -- * if @hdl@ is not writable, the contents of the buffer is discarded.
997 -- This operation may fail with:
999 -- * 'isPermissionError' if the handle has already been used for reading
1000 -- or writing and the implementation does not allow the buffering mode
1003 hSetBuffering :: Handle -> BufferMode -> IO ()
1004 hSetBuffering handle mode =
1005 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
1006 case haType handle_ of
1007 ClosedHandle -> ioe_closedHandle
1010 - we flush the old buffer regardless of whether
1011 the new buffer could fit the contents of the old buffer
1013 - allow a handle's buffering to change even if IO has
1014 occurred (ANSI C spec. does not allow this, nor did
1015 the previous implementation of IO.hSetBuffering).
1016 - a non-standard extension is to allow the buffering
1017 of semi-closed handles to change [sof 6/98]
1021 let state = initBufferState (haType handle_)
1024 -- we always have a 1-character read buffer for
1025 -- unbuffered handles: it's needed to
1026 -- support hLookAhead.
1027 NoBuffering -> allocateBuffer 1 ReadBuffer
1028 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
1029 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
1030 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
1031 | otherwise -> allocateBuffer n state
1032 writeIORef (haBuffer handle_) new_buf
1034 -- for input terminals we need to put the terminal into
1035 -- cooked or raw mode depending on the type of buffering.
1036 is_tty <- fdIsTTY (haFD handle_)
1037 when (is_tty && isReadableHandleType (haType handle_)) $
1039 #ifndef mingw32_TARGET_OS
1040 -- 'raw' mode under win32 is a bit too specialised (and troublesome
1041 -- for most common uses), so simply disable its use here.
1042 NoBuffering -> setCooked (haFD handle_) False
1044 _ -> setCooked (haFD handle_) True
1046 -- throw away spare buffers, they might be the wrong size
1047 writeIORef (haBuffers handle_) BufferListNil
1049 return (handle_{ haBufferMode = mode })
1051 -- -----------------------------------------------------------------------------
1054 -- | The action 'hFlush' @hdl@ causes any items buffered for output
1055 -- in handle @hdl@ to be sent immediately to the operating system.
1057 -- This operation may fail with:
1059 -- * 'isFullError' if the device is full;
1061 -- * 'isPermissionError' if a system resource limit would be exceeded.
1062 -- It is unspecified whether the characters in the buffer are discarded
1063 -- or retained under these circumstances.
1065 hFlush :: Handle -> IO ()
1067 wantWritableHandle "hFlush" handle $ \ handle_ -> do
1068 buf <- readIORef (haBuffer handle_)
1069 if bufferIsWritable buf && not (bufferEmpty buf)
1070 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
1071 writeIORef (haBuffer handle_) flushed_buf
1075 -- -----------------------------------------------------------------------------
1076 -- Repositioning Handles
1078 data HandlePosn = HandlePosn Handle HandlePosition
1080 instance Eq HandlePosn where
1081 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
1083 instance Show HandlePosn where
1084 showsPrec p (HandlePosn h pos) =
1085 showsPrec p h . showString " at position " . shows pos
1087 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
1088 -- We represent it as an Integer on the Haskell side, but
1089 -- cheat slightly in that hGetPosn calls upon a C helper
1090 -- that reports the position back via (merely) an Int.
1091 type HandlePosition = Integer
1093 -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
1094 -- @hdl@ as a value of the abstract type 'HandlePosn'.
1096 hGetPosn :: Handle -> IO HandlePosn
1097 hGetPosn handle = do
1098 posn <- hTell handle
1099 return (HandlePosn handle posn)
1101 -- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
1102 -- then computation 'hSetPosn' @p@ sets the position of @hdl@
1103 -- to the position it held at the time of the call to 'hGetPosn'.
1105 -- This operation may fail with:
1107 -- * 'isPermissionError' if a system resource limit would be exceeded.
1109 hSetPosn :: HandlePosn -> IO ()
1110 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
1112 -- ---------------------------------------------------------------------------
1115 -- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:
1117 = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.
1118 | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@
1119 -- from the current position.
1120 | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@
1121 -- from the end of the file.
1122 deriving (Eq, Ord, Ix, Enum, Read, Show)
1125 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1126 seeking at or past EOF.
1128 - we possibly deviate from the report on the issue of seeking within
1129 the buffer and whether to flush it or not. The report isn't exactly
1133 -- | Computation 'hSeek' @hdl mode i@ sets the position of handle
1134 -- @hdl@ depending on @mode@.
1135 -- The offset @i@ is given in terms of 8-bit bytes.
1137 -- If @hdl@ is block- or line-buffered, then seeking to a position which is not
1138 -- in the current buffer will first cause any items in the output buffer to be
1139 -- written to the device, and then cause the input buffer to be discarded.
1140 -- Some handles may not be seekable (see 'hIsSeekable'), or only support a
1141 -- subset of the possible positioning operations (for instance, it may only
1142 -- be possible to seek to the end of a tape, or to a positive offset from
1143 -- the beginning or current position).
1144 -- It is not possible to set a negative I\/O position, or for
1145 -- a physical file, an I\/O position beyond the current end-of-file.
1147 -- This operation may fail with:
1149 -- * 'isPermissionError' if a system resource limit would be exceeded.
1151 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1152 hSeek handle mode offset =
1153 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1155 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1157 let ref = haBuffer handle_
1158 buf <- readIORef ref
1164 throwErrnoIfMinus1Retry_ "hSeek"
1165 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1168 whence = case mode of
1169 AbsoluteSeek -> sEEK_SET
1170 RelativeSeek -> sEEK_CUR
1171 SeekFromEnd -> sEEK_END
1173 if bufferIsWritable buf
1174 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1175 writeIORef ref new_buf
1179 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1180 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1183 new_buf <- flushReadBuffer (haFD handle_) buf
1184 writeIORef ref new_buf
1188 hTell :: Handle -> IO Integer
1190 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
1192 #if defined(mingw32_TARGET_OS)
1193 -- urgh, on Windows we have to worry about \n -> \r\n translation,
1194 -- so we can't easily calculate the file position using the
1195 -- current buffer size. Just flush instead.
1198 let fd = fromIntegral (haFD handle_)
1199 posn <- fromIntegral `liftM`
1200 throwErrnoIfMinus1Retry "hGetPosn"
1201 (c_lseek fd 0 sEEK_CUR)
1203 let ref = haBuffer handle_
1204 buf <- readIORef ref
1207 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
1208 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
1210 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
1211 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
1215 -- -----------------------------------------------------------------------------
1216 -- Handle Properties
1218 -- A number of operations return information about the properties of a
1219 -- handle. Each of these operations returns `True' if the handle has
1220 -- the specified property, and `False' otherwise.
1222 hIsOpen :: Handle -> IO Bool
1224 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1225 case haType handle_ of
1226 ClosedHandle -> return False
1227 SemiClosedHandle -> return False
1230 hIsClosed :: Handle -> IO Bool
1232 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1233 case haType handle_ of
1234 ClosedHandle -> return True
1237 {- not defined, nor exported, but mentioned
1238 here for documentation purposes:
1240 hSemiClosed :: Handle -> IO Bool
1244 return (not (ho || hc))
1247 hIsReadable :: Handle -> IO Bool
1248 hIsReadable (DuplexHandle _ _ _) = return True
1249 hIsReadable handle =
1250 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1251 case haType handle_ of
1252 ClosedHandle -> ioe_closedHandle
1253 SemiClosedHandle -> ioe_closedHandle
1254 htype -> return (isReadableHandleType htype)
1256 hIsWritable :: Handle -> IO Bool
1257 hIsWritable (DuplexHandle _ _ _) = return True
1258 hIsWritable handle =
1259 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1260 case haType handle_ of
1261 ClosedHandle -> ioe_closedHandle
1262 SemiClosedHandle -> ioe_closedHandle
1263 htype -> return (isWritableHandleType htype)
1265 -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
1268 hGetBuffering :: Handle -> IO BufferMode
1269 hGetBuffering handle =
1270 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1271 case haType handle_ of
1272 ClosedHandle -> ioe_closedHandle
1274 -- We're being non-standard here, and allow the buffering
1275 -- of a semi-closed handle to be queried. -- sof 6/98
1276 return (haBufferMode handle_) -- could be stricter..
1278 hIsSeekable :: Handle -> IO Bool
1279 hIsSeekable handle =
1280 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1281 case haType handle_ of
1282 ClosedHandle -> ioe_closedHandle
1283 SemiClosedHandle -> ioe_closedHandle
1284 AppendHandle -> return False
1285 _ -> do t <- fdType (haFD handle_)
1286 return (t == RegularFile
1288 || tEXT_MODE_SEEK_ALLOWED))
1290 -- -----------------------------------------------------------------------------
1291 -- Changing echo status (Non-standard GHC extensions)
1293 -- | Set the echoing status of a handle connected to a terminal.
1295 hSetEcho :: Handle -> Bool -> IO ()
1296 hSetEcho handle on = do
1297 isT <- hIsTerminalDevice handle
1301 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1302 case haType handle_ of
1303 ClosedHandle -> ioe_closedHandle
1304 _ -> setEcho (haFD handle_) on
1306 -- | Get the echoing status of a handle connected to a terminal.
1308 hGetEcho :: Handle -> IO Bool
1309 hGetEcho handle = do
1310 isT <- hIsTerminalDevice handle
1314 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1315 case haType handle_ of
1316 ClosedHandle -> ioe_closedHandle
1317 _ -> getEcho (haFD handle_)
1319 -- | Is the handle connected to a terminal?
1321 hIsTerminalDevice :: Handle -> IO Bool
1322 hIsTerminalDevice handle = do
1323 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1324 case haType handle_ of
1325 ClosedHandle -> ioe_closedHandle
1326 _ -> fdIsTTY (haFD handle_)
1328 -- -----------------------------------------------------------------------------
1331 -- | Select binary mode ('True') or text mode ('False') on a open handle.
1332 -- (GHC only; see also 'openBinaryFile'.)
1334 hSetBinaryMode :: Handle -> Bool -> IO ()
1335 hSetBinaryMode handle bin =
1336 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1337 do throwErrnoIfMinus1_ "hSetBinaryMode"
1338 (setmode (fromIntegral (haFD handle_)) bin)
1339 return handle_{haIsBin=bin}
1341 foreign import ccall unsafe "__hscore_setmode"
1342 setmode :: CInt -> Bool -> IO CInt
1344 -- -----------------------------------------------------------------------------
1345 -- Duplicating a Handle
1347 -- |Returns a duplicate of the original handle, with its own buffer
1348 -- and file pointer. The original handle's buffer is flushed, including
1349 -- discarding any input data, before the handle is duplicated.
1351 hDuplicate :: Handle -> IO Handle
1352 hDuplicate h@(FileHandle path m) = do
1353 new_h_ <- withHandle' "hDuplicate" h m (dupHandle_ Nothing)
1354 new_m <- newMVar new_h_
1355 return (FileHandle path new_m)
1356 hDuplicate h@(DuplexHandle path r w) = do
1357 new_w_ <- withHandle' "hDuplicate" h w (dupHandle_ Nothing)
1358 new_w <- newMVar new_w_
1359 new_r_ <- withHandle' "hDuplicate" h r (dupHandle_ (Just new_w))
1360 new_r <- newMVar new_r_
1361 return (DuplexHandle path new_r new_w)
1363 dupHandle_ other_side h_ = do
1364 -- flush the buffer first, so we don't have to copy its contents
1366 new_fd <- c_dup (fromIntegral (haFD h_))
1367 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_))
1368 ioref <- newIORef buffer
1369 ioref_buffers <- newIORef BufferListNil
1371 let new_handle_ = h_{ haFD = fromIntegral new_fd,
1373 haBuffers = ioref_buffers,
1374 haOtherSide = other_side }
1375 return (h_, new_handle_)
1377 -- -----------------------------------------------------------------------------
1378 -- Replacing a Handle
1381 Makes the second handle a duplicate of the first handle. The second
1382 handle will be closed first, if it is not already.
1384 This can be used to retarget the standard Handles, for example:
1386 > do h <- openFile "mystdout" WriteMode
1387 > hDuplicateTo h stdout
1390 hDuplicateTo :: Handle -> Handle -> IO ()
1391 hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2) = do
1392 withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
1393 _ <- hClose_help h2_
1394 withHandle' "hDuplicateTo" h1 m1 (dupHandle_ Nothing)
1395 hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2) = do
1396 withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do
1397 _ <- hClose_help w2_
1398 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ Nothing)
1399 withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do
1400 _ <- hClose_help r2_
1401 withHandle' "hDuplicateTo" h1 r1 (dupHandle_ (Just w1))
1403 ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
1404 "handles are incompatible" Nothing)
1406 -- ---------------------------------------------------------------------------
1409 -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
1410 -- than the (pure) instance of 'Show' for 'Handle'.
1412 hShow :: Handle -> IO String
1413 hShow h@(FileHandle path _) = showHandle' path False h
1414 hShow h@(DuplexHandle path _ _) = showHandle' path True h
1416 showHandle' filepath is_duplex h =
1417 withHandle_ "showHandle" h $ \hdl_ ->
1419 showType | is_duplex = showString "duplex (read-write)"
1420 | otherwise = shows (haType hdl_)
1424 showHdl (haType hdl_)
1425 (showString "loc=" . showString filepath . showChar ',' .
1426 showString "type=" . showType . showChar ',' .
1427 showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
1428 showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
1432 showHdl :: HandleType -> ShowS -> ShowS
1435 ClosedHandle -> shows ht . showString "}"
1438 showBufMode :: Buffer -> BufferMode -> ShowS
1439 showBufMode buf bmo =
1441 NoBuffering -> showString "none"
1442 LineBuffering -> showString "line"
1443 BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
1444 BlockBuffering Nothing -> showString "block " . showParen True (shows def)
1449 -- ---------------------------------------------------------------------------
1453 puts :: String -> IO ()
1454 puts s = withCString s $ \cstr -> do write_rawBuffer 1 False cstr 0 (fromIntegral (length s))
1458 -- -----------------------------------------------------------------------------
1461 throwErrnoIfMinus1RetryOnBlock :: String -> IO CInt -> IO CInt -> IO CInt
1462 throwErrnoIfMinus1RetryOnBlock loc f on_block =
1465 if (res :: CInt) == -1
1469 then throwErrnoIfMinus1RetryOnBlock loc f on_block
1470 else if err == eWOULDBLOCK || err == eAGAIN
1475 -- -----------------------------------------------------------------------------
1476 -- wrappers to platform-specific constants:
1478 foreign import ccall unsafe "__hscore_supportsTextMode"
1479 tEXT_MODE_SEEK_ALLOWED :: Bool
1481 foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
1482 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1483 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1484 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt