1 {-# OPTIONS -fno-implicit-prelude -#include "PrelIOUtils.h" #-}
6 -- -----------------------------------------------------------------------------
7 -- $Id: PrelHandle.hs,v 1.9 2002/01/28 13:47:05 simonmar Exp $
9 -- (c) The University of Glasgow, 1994-2001
11 -- This module defines the basic operations on I/O "handles".
14 withHandle, withHandle', withHandle_,
15 wantWritableHandle, wantReadableHandle, wantSeekableHandle,
17 newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
18 flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
19 read_off, read_off_ba,
20 write_off, write_off_ba,
22 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
24 stdin, stdout, stderr,
25 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
26 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
31 HandlePosn(..), hGetPosn, hSetPosn,
34 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
35 hSetEcho, hGetEcho, hIsTerminalDevice,
36 ioeGetFileName, ioeGetErrorString, ioeGetHandle,
50 import PrelMarshalUtils
59 import PrelRead ( Read )
62 import PrelMaybe ( Maybe(..) )
65 import PrelNum ( Integer(..), Num(..) )
67 import PrelReal ( toInteger )
71 -- -----------------------------------------------------------------------------
74 -- hWaitForInput blocks (should use a timeout)
76 -- unbuffered hGetLine is a bit dodgy
78 -- hSetBuffering: can't change buffering on a stream,
79 -- when the read buffer is non-empty? (no way to flush the buffer)
81 -- ---------------------------------------------------------------------------
82 -- Are files opened by default in text or binary mode, if the user doesn't
84 dEFAULT_OPEN_IN_BINARY_MODE :: Bool
85 dEFAULT_OPEN_IN_BINARY_MODE = False
87 -- Is seeking on text-mode handles allowed, or not?
88 foreign import ccall "prel_supportsTextMode" unsafe tEXT_MODE_SEEK_ALLOWED :: Bool
90 -- ---------------------------------------------------------------------------
91 -- Creating a new handle
93 newFileHandle :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
94 newFileHandle finalizer hc = do
96 addMVarFinalizer m (finalizer m)
99 -- ---------------------------------------------------------------------------
100 -- Working with Handles
103 In the concurrent world, handles are locked during use. This is done
104 by wrapping an MVar around the handle which acts as a mutex over
105 operations on the handle.
107 To avoid races, we use the following bracketing operations. The idea
108 is to obtain the lock, do some operation and replace the lock again,
109 whether the operation succeeded or failed. We also want to handle the
110 case where the thread receives an exception while processing the IO
111 operation: in these cases we also want to relinquish the lock.
113 There are three versions of @withHandle@: corresponding to the three
114 possible combinations of:
116 - the operation may side-effect the handle
117 - the operation may return a result
119 If the operation generates an error or an exception is raised, the
120 original handle is always replaced [ this is the case at the moment,
121 but we might want to revisit this in the future --SDM ].
124 {-# INLINE withHandle #-}
125 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
126 withHandle fun h@(FileHandle m) act = withHandle' fun h m act
127 withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
129 withHandle' fun h m act =
132 checkBufferInvariants h_
133 (h',v) <- catchException (act h_)
134 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
135 checkBufferInvariants h'
139 {-# INLINE withHandle_ #-}
140 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
141 withHandle_ fun h@(FileHandle m) act = withHandle_' fun h m act
142 withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
144 withHandle_' fun h m act =
147 checkBufferInvariants h_
148 v <- catchException (act h_)
149 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
150 checkBufferInvariants h_
154 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
155 withAllHandles__ fun h@(FileHandle m) act = withHandle__' fun h m act
156 withAllHandles__ fun h@(DuplexHandle r w) act = do
157 withHandle__' fun h r act
158 withHandle__' fun h w act
160 withHandle__' fun h m act =
163 checkBufferInvariants h_
164 h' <- catchException (act h_)
165 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
166 checkBufferInvariants h'
170 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
171 = IOException (IOError (Just h) iot fun str filepath)
172 where filepath | Just _ <- fp = fp
173 | otherwise = Just (haFilePath h_)
174 augmentIOError other_exception _ _ _
177 -- ---------------------------------------------------------------------------
178 -- Wrapper for write operations.
180 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
181 wantWritableHandle fun h@(FileHandle m) act
182 = wantWritableHandle' fun h m act
183 wantWritableHandle fun h@(DuplexHandle _ m) act
184 = wantWritableHandle' fun h m act
185 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
188 :: String -> Handle -> MVar Handle__
189 -> (Handle__ -> IO a) -> IO a
190 wantWritableHandle' fun h m act
191 = withHandle_' fun h m (checkWritableHandle act)
193 checkWritableHandle act handle_
194 = case haType handle_ of
195 ClosedHandle -> ioe_closedHandle
196 SemiClosedHandle -> ioe_closedHandle
197 ReadHandle -> ioe_notWritable
198 ReadWriteHandle -> do
199 let ref = haBuffer handle_
202 if not (bufferIsWritable buf)
203 then do b <- flushReadBuffer (haFD handle_) buf
204 return b{ bufState=WriteBuffer }
206 writeIORef ref new_buf
208 _other -> act handle_
210 -- ---------------------------------------------------------------------------
211 -- Wrapper for read operations.
213 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
214 wantReadableHandle fun h@(FileHandle m) act
215 = wantReadableHandle' fun h m act
216 wantReadableHandle fun h@(DuplexHandle m _) act
217 = wantReadableHandle' fun h m act
218 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
221 :: String -> Handle -> MVar Handle__
222 -> (Handle__ -> IO a) -> IO a
223 wantReadableHandle' fun h m act
224 = withHandle_' fun h m (checkReadableHandle act)
226 checkReadableHandle act handle_ =
227 case haType handle_ of
228 ClosedHandle -> ioe_closedHandle
229 SemiClosedHandle -> ioe_closedHandle
230 AppendHandle -> ioe_notReadable
231 WriteHandle -> ioe_notReadable
232 ReadWriteHandle -> do
233 let ref = haBuffer handle_
235 when (bufferIsWritable buf) $ do
236 new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
237 writeIORef ref new_buf{ bufState=ReadBuffer }
239 _other -> act handle_
241 -- ---------------------------------------------------------------------------
242 -- Wrapper for seek operations.
244 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
245 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
246 ioException (IOError (Just h) IllegalOperation fun
247 "handle is not seekable" Nothing)
248 wantSeekableHandle fun h@(FileHandle m) act =
249 withHandle_' fun h m (checkSeekableHandle act)
251 checkSeekableHandle act handle_ =
252 case haType handle_ of
253 ClosedHandle -> ioe_closedHandle
254 SemiClosedHandle -> ioe_closedHandle
255 AppendHandle -> ioe_notSeekable
256 _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
257 | otherwise -> ioe_notSeekable_notBin
259 -- -----------------------------------------------------------------------------
262 ioe_closedHandle, ioe_EOF,
263 ioe_notReadable, ioe_notWritable,
264 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
266 ioe_closedHandle = ioException
267 (IOError Nothing IllegalOperation ""
268 "handle is closed" Nothing)
269 ioe_EOF = ioException
270 (IOError Nothing EOF "" "" Nothing)
271 ioe_notReadable = ioException
272 (IOError Nothing IllegalOperation ""
273 "handle is not open for reading" Nothing)
274 ioe_notWritable = ioException
275 (IOError Nothing IllegalOperation ""
276 "handle is not open for writing" Nothing)
277 ioe_notSeekable = ioException
278 (IOError Nothing IllegalOperation ""
279 "handle is not seekable" Nothing)
280 ioe_notSeekable_notBin = ioException
281 (IOError Nothing IllegalOperation ""
282 "seek operations on text-mode handles are not allowed on this platform"
285 ioe_bufsiz :: Int -> IO a
286 ioe_bufsiz n = ioException
287 (IOError Nothing InvalidArgument "hSetBuffering"
288 ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
289 -- 9 => should be parens'ified.
291 -- -----------------------------------------------------------------------------
294 -- For a duplex handle, we arrange that the read side points to the write side
295 -- (and hence keeps it alive if the read side is alive). This is done by
296 -- having the haOtherSide field of the read side point to the read side.
297 -- The finalizer is then placed on the write side, and the handle only gets
298 -- finalized once, when both sides are no longer required.
300 stdHandleFinalizer :: MVar Handle__ -> IO ()
301 stdHandleFinalizer m = do
303 flushWriteBufferOnly h_
305 handleFinalizer :: MVar Handle__ -> IO ()
306 handleFinalizer m = do
308 flushWriteBufferOnly h_
309 let fd = fromIntegral (haFD h_)
312 #ifdef mingw32_TARGET_OS
313 (closeFd (haIsStream h_) fd >> return ())
315 (c_close fd >> return ())
319 -- ---------------------------------------------------------------------------
320 -- Grimy buffer operations
323 checkBufferInvariants h_ = do
324 let ref = haBuffer h_
325 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
330 && ( r /= w || (r == 0 && w == 0) )
331 && ( state /= WriteBuffer || r == 0 )
332 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
334 then error "buffer invariant violation"
337 checkBufferInvariants h_ = return ()
340 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
341 newEmptyBuffer b state size
342 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
344 allocateBuffer :: Int -> BufferState -> IO Buffer
345 allocateBuffer sz@(I# size) state = IO $ \s ->
346 case newByteArray# size s of { (# s, b #) ->
347 (# s, newEmptyBuffer b state sz #) }
349 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
350 writeCharIntoBuffer slab (I# off) (C# c)
351 = IO $ \s -> case writeCharArray# slab off c s of
352 s -> (# s, I# (off +# 1#) #)
354 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
355 readCharFromBuffer slab (I# off)
356 = IO $ \s -> case readCharArray# slab off s of
357 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
359 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
360 getBuffer fd state = do
361 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
362 ioref <- newIORef buffer
366 | is_tty = LineBuffering
367 | otherwise = BlockBuffering Nothing
369 return (ioref, buffer_mode)
371 mkUnBuffer :: IO (IORef Buffer)
373 buffer <- allocateBuffer 1 ReadBuffer
376 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
377 flushWriteBufferOnly :: Handle__ -> IO ()
378 flushWriteBufferOnly h_ = do
382 new_buf <- if bufferIsWritable buf
383 then flushWriteBuffer fd (haIsStream h_) buf
385 writeIORef ref new_buf
387 -- flushBuffer syncs the file with the buffer, including moving the
388 -- file pointer backwards in the case of a read buffer.
389 flushBuffer :: Handle__ -> IO ()
391 let ref = haBuffer h_
396 ReadBuffer -> flushReadBuffer (haFD h_) buf
397 WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
399 writeIORef ref flushed_buf
401 -- When flushing a read buffer, we seek backwards by the number of
402 -- characters in the buffer. The file descriptor must therefore be
403 -- seekable: attempting to flush the read buffer on an unseekable
404 -- handle is not allowed.
406 flushReadBuffer :: FD -> Buffer -> IO Buffer
407 flushReadBuffer fd buf
408 | bufferEmpty buf = return buf
410 let off = negate (bufWPtr buf - bufRPtr buf)
412 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
414 throwErrnoIfMinus1Retry "flushReadBuffer"
415 (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
416 return buf{ bufWPtr=0, bufRPtr=0 }
418 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
419 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
422 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
425 then return (buf{ bufRPtr=0, bufWPtr=0 })
427 res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
428 (write_off_ba (fromIntegral fd) is_stream b (fromIntegral r)
429 (fromIntegral bytes))
431 let res' = fromIntegral res
433 then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
434 else return buf{ bufRPtr=0, bufWPtr=0 }
436 foreign import "prel_PrelHandle_write" unsafe
437 write_off_ba :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
439 foreign import "prel_PrelHandle_write" unsafe
440 write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
442 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
443 fillReadBuffer fd is_line is_stream
444 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
445 -- buffer better be empty:
446 assert (r == 0 && w == 0) $ do
447 fillReadBufferLoop fd is_line is_stream buf b w size
449 -- For a line buffer, we just get the first chunk of data to arrive,
450 -- and don't wait for the whole buffer to be full (but we *do* wait
451 -- until some data arrives). This isn't really line buffering, but it
452 -- appears to be what GHC has done for a long time, and I suspect it
453 -- is more useful than line buffering in most cases.
455 fillReadBufferLoop fd is_line is_stream buf b w size = do
457 if bytes == 0 -- buffer full?
458 then return buf{ bufRPtr=0, bufWPtr=w }
461 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
463 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
464 (read_off_ba fd is_stream b (fromIntegral w) (fromIntegral bytes))
466 let res' = fromIntegral res
468 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
473 else return buf{ bufRPtr=0, bufWPtr=w }
474 else if res' < bytes && not is_line
475 then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
476 else return buf{ bufRPtr=0, bufWPtr=w+res' }
478 foreign import "prel_PrelHandle_read" unsafe
479 read_off_ba :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
481 foreign import "prel_PrelHandle_read" unsafe
482 read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
484 -- ---------------------------------------------------------------------------
487 -- Three handles are allocated during program initialisation. The first
488 -- two manage input or output from the Haskell program's standard input
489 -- or output channel respectively. The third manages output to the
490 -- standard error channel. These handles are initially open.
497 stdin = unsafePerformIO $ do
498 -- ToDo: acquire lock
499 setNonBlockingFD fd_stdin
500 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
501 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
504 stdout = unsafePerformIO $ do
505 -- ToDo: acquire lock
506 -- We don't set non-blocking mode on stdout or sterr, because
507 -- some shells don't recover properly.
508 -- setNonBlockingFD fd_stdout
509 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
510 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
513 stderr = unsafePerformIO $ do
514 -- ToDo: acquire lock
515 -- We don't set non-blocking mode on stdout or sterr, because
516 -- some shells don't recover properly.
517 -- setNonBlockingFD fd_stderr
519 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
521 -- ---------------------------------------------------------------------------
522 -- Opening and Closing Files
525 Computation `openFile file mode' allocates and returns a new, open
526 handle to manage the file `file'. It manages input if `mode'
527 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
528 and both input and output if mode is `ReadWriteMode'.
530 If the file does not exist and it is opened for output, it should be
531 created as a new file. If `mode' is `WriteMode' and the file
532 already exists, then it should be truncated to zero length. The
533 handle is positioned at the end of the file if `mode' is
534 `AppendMode', and otherwise at the beginning (in which case its
535 internal position is 0).
537 Implementations should enforce, locally to the Haskell process,
538 multiple-reader single-writer locking on files, which is to say that
539 there may either be many handles on the same file which manage input,
540 or just one handle on the file which manages output. If any open or
541 semi-closed handle is managing a file for output, no new handle can be
542 allocated for that file. If any open or semi-closed handle is
543 managing a file for input, new handles can only be allocated if they
544 do not manage output.
546 Two files are the same if they have the same absolute name. An
547 implementation is free to impose stricter conditions.
550 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
551 deriving (Eq, Ord, Ix, Enum, Read, Show)
556 deriving (Eq, Read, Show)
558 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
559 = IOException (IOError h iot fun str (Just fp))
560 addFilePathToIOError _ _ other_exception
563 openFile :: FilePath -> IOMode -> IO Handle
566 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
569 (\e -> throw (addFilePathToIOError "openFile" fp e))
571 openFileEx :: FilePath -> IOModeEx -> IO Handle
575 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
578 openFile' filepath ex_mode =
579 withCString filepath $ \ f ->
584 BinaryMode bmo -> (bmo, True)
585 TextMode tmo -> (tmo, False)
587 oflags1 = case mode of
588 ReadMode -> read_flags
589 WriteMode -> write_flags
590 ReadWriteMode -> rw_flags
591 AppendMode -> append_flags
593 truncate | WriteMode <- mode = True
597 | binary = o_BINARY -- is '0' if not supported.
600 oflags = oflags1 .|. binary_flags
603 -- the old implementation had a complicated series of three opens,
604 -- which is perhaps because we have to be careful not to open
605 -- directories. However, the man pages I've read say that open()
606 -- always returns EISDIR if the file is a directory and was opened
607 -- for writing, so I think we're ok with a single open() here...
608 fd <- fromIntegral `liftM`
609 throwErrnoIfMinus1Retry "openFile"
610 (c_open f (fromIntegral oflags) 0o666)
612 openFd fd Nothing filepath mode binary truncate
613 -- ASSERT: if we just created the file, then openFd won't fail
614 -- (so we don't need to worry about removing the newly created file
615 -- in the event of an error).
618 std_flags = o_NONBLOCK .|. o_NOCTTY
619 output_flags = std_flags .|. o_CREAT
620 read_flags = std_flags .|. o_RDONLY
621 write_flags = output_flags .|. o_WRONLY
622 rw_flags = output_flags .|. o_RDWR
623 append_flags = write_flags .|. o_APPEND
625 -- ---------------------------------------------------------------------------
628 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
629 openFd fd mb_fd_type filepath mode binary truncate = do
630 -- turn on non-blocking mode
633 let (ha_type, write) =
635 ReadMode -> ( ReadHandle, False )
636 WriteMode -> ( WriteHandle, True )
637 ReadWriteMode -> ( ReadWriteHandle, True )
638 AppendMode -> ( AppendHandle, True )
640 -- open() won't tell us if it was a directory if we only opened for
641 -- reading, so check again.
646 let is_stream = fd_type == Stream
649 ioException (IOError Nothing InappropriateType "openFile"
650 "is a directory" Nothing)
653 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
654 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
656 -- regular files need to be locked
658 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
660 ioException (IOError Nothing ResourceBusy "openFile"
661 "file is locked" Nothing)
663 -- truncate the file if necessary
664 when truncate (fileTruncate filepath)
666 mkFileHandle fd is_stream filepath ha_type binary
669 foreign import "lockFile" unsafe
670 lockFile :: CInt -> CInt -> CInt -> IO CInt
672 foreign import "unlockFile" unsafe
673 unlockFile :: CInt -> IO CInt
675 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
677 mkStdHandle fd filepath ha_type buf bmode = do
678 spares <- newIORef BufferListNil
679 newFileHandle stdHandleFinalizer
680 (Handle__ { haFD = fd,
682 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
684 haBufferMode = bmode,
685 haFilePath = filepath,
688 haOtherSide = Nothing
691 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
692 mkFileHandle fd is_stream filepath ha_type binary = do
693 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
694 spares <- newIORef BufferListNil
695 newFileHandle handleFinalizer
696 (Handle__ { haFD = fd,
699 haIsStream = is_stream,
700 haBufferMode = bmode,
701 haFilePath = filepath,
704 haOtherSide = Nothing
707 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
708 mkDuplexHandle fd is_stream filepath binary = do
709 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
710 w_spares <- newIORef BufferListNil
712 Handle__ { haFD = fd,
713 haType = WriteHandle,
715 haIsStream = is_stream,
716 haBufferMode = w_bmode,
717 haFilePath = filepath,
719 haBuffers = w_spares,
720 haOtherSide = Nothing
722 write_side <- newMVar w_handle_
724 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
725 r_spares <- newIORef BufferListNil
727 Handle__ { haFD = fd,
730 haIsStream = is_stream,
731 haBufferMode = r_bmode,
732 haFilePath = filepath,
734 haBuffers = r_spares,
735 haOtherSide = Just write_side
737 read_side <- newMVar r_handle_
739 addMVarFinalizer read_side (handleFinalizer read_side)
740 return (DuplexHandle read_side write_side)
743 initBufferState ReadHandle = ReadBuffer
744 initBufferState _ = WriteBuffer
746 -- ---------------------------------------------------------------------------
749 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
750 -- computation finishes, any items buffered for output and not already
751 -- sent to the operating system are flushed as for `hFlush'.
753 -- For a duplex handle, we close&flush the write side, and just close
756 hClose :: Handle -> IO ()
757 hClose h@(FileHandle m) = hClose' h m
758 hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
760 hClose' h m = withHandle__' "hClose" h m $ hClose_help
762 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
763 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
764 -- then closed immediately. We have to be careful with DuplexHandles
765 -- though: we have to leave the closing to the finalizer in that case,
766 -- because the write side may still be in use.
767 hClose_help handle_ =
768 case haType handle_ of
769 ClosedHandle -> return handle_
771 let fd = haFD handle_
772 c_fd = fromIntegral fd
774 flushWriteBufferOnly handle_
776 -- close the file descriptor, but not when this is the read
777 -- side of a duplex handle, and not when this is one of the
779 case haOtherSide handle_ of
781 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
782 throwErrnoIfMinus1Retry_ "hClose"
783 #ifdef mingw32_TARGET_OS
784 (closeFd (haIsStream handle_) c_fd)
790 -- free the spare buffers
791 writeIORef (haBuffers handle_) BufferListNil
796 -- we must set the fd to -1, because the finalizer is going
797 -- to run eventually and try to close/unlock it.
798 return (handle_{ haFD = -1,
799 haType = ClosedHandle
802 -----------------------------------------------------------------------------
803 -- Detecting the size of a file
805 -- For a handle `hdl' which attached to a physical file, `hFileSize
806 -- hdl' returns the size of `hdl' in terms of the number of items
807 -- which can be read from `hdl'.
809 hFileSize :: Handle -> IO Integer
811 withHandle_ "hFileSize" handle $ \ handle_ -> do
812 case haType handle_ of
813 ClosedHandle -> ioe_closedHandle
814 SemiClosedHandle -> ioe_closedHandle
815 _ -> do flushWriteBufferOnly handle_
816 r <- fdFileSize (haFD handle_)
819 else ioException (IOError Nothing InappropriateType "hFileSize"
820 "not a regular file" Nothing)
822 -- ---------------------------------------------------------------------------
823 -- Detecting the End of Input
825 -- For a readable handle `hdl', `hIsEOF hdl' returns
826 -- `True' if no further input can be taken from `hdl' or for a
827 -- physical file, if the current I/O position is equal to the length of
828 -- the file. Otherwise, it returns `False'.
830 hIsEOF :: Handle -> IO Bool
833 (do hLookAhead handle; return False)
834 (\e -> if isEOFError e then return True else throw e)
839 -- ---------------------------------------------------------------------------
842 -- hLookahead returns the next character from the handle without
843 -- removing it from the input buffer, blocking until a character is
846 hLookAhead :: Handle -> IO Char
847 hLookAhead handle = do
848 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
849 let ref = haBuffer handle_
851 is_line = haBufferMode handle_ == LineBuffering
854 -- fill up the read buffer if necessary
855 new_buf <- if bufferEmpty buf
856 then fillReadBuffer fd is_line (haIsStream handle_) buf
859 writeIORef ref new_buf
861 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
864 -- ---------------------------------------------------------------------------
865 -- Buffering Operations
867 -- Three kinds of buffering are supported: line-buffering,
868 -- block-buffering or no-buffering. See PrelIOBase for definition and
869 -- further explanation of what the type represent.
871 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
872 -- handle hdl on subsequent reads and writes.
874 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
876 -- * If mode is `BlockBuffering size', then block-buffering
877 -- should be enabled if possible. The size of the buffer is n items
878 -- if size is `Just n' and is otherwise implementation-dependent.
880 -- * If mode is NoBuffering, then buffering is disabled if possible.
882 -- If the buffer mode is changed from BlockBuffering or
883 -- LineBuffering to NoBuffering, then any items in the output
884 -- buffer are written to the device, and any items in the input buffer
885 -- are discarded. The default buffering mode when a handle is opened
886 -- is implementation-dependent and may depend on the object which is
887 -- attached to that handle.
889 hSetBuffering :: Handle -> BufferMode -> IO ()
890 hSetBuffering handle mode =
891 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
892 case haType handle_ of
893 ClosedHandle -> ioe_closedHandle
896 - we flush the old buffer regardless of whether
897 the new buffer could fit the contents of the old buffer
899 - allow a handle's buffering to change even if IO has
900 occurred (ANSI C spec. does not allow this, nor did
901 the previous implementation of IO.hSetBuffering).
902 - a non-standard extension is to allow the buffering
903 of semi-closed handles to change [sof 6/98]
907 let state = initBufferState (haType handle_)
910 -- we always have a 1-character read buffer for
911 -- unbuffered handles: it's needed to
912 -- support hLookAhead.
913 NoBuffering -> allocateBuffer 1 ReadBuffer
914 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
915 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
916 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
917 | otherwise -> allocateBuffer n state
918 writeIORef (haBuffer handle_) new_buf
920 -- for input terminals we need to put the terminal into
921 -- cooked or raw mode depending on the type of buffering.
922 is_tty <- fdIsTTY (haFD handle_)
923 when (is_tty && isReadableHandleType (haType handle_)) $
925 NoBuffering -> setCooked (haFD handle_) False
926 _ -> setCooked (haFD handle_) True
928 -- throw away spare buffers, they might be the wrong size
929 writeIORef (haBuffers handle_) BufferListNil
931 return (handle_{ haBufferMode = mode })
933 -- -----------------------------------------------------------------------------
936 -- The action `hFlush hdl' causes any items buffered for output
937 -- in handle `hdl' to be sent immediately to the operating
940 hFlush :: Handle -> IO ()
942 wantWritableHandle "hFlush" handle $ \ handle_ -> do
943 buf <- readIORef (haBuffer handle_)
944 if bufferIsWritable buf && not (bufferEmpty buf)
945 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
946 writeIORef (haBuffer handle_) flushed_buf
950 -- -----------------------------------------------------------------------------
951 -- Repositioning Handles
953 data HandlePosn = HandlePosn Handle HandlePosition
955 instance Eq HandlePosn where
956 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
958 instance Show HandlePosn where
959 showsPrec p (HandlePosn h pos) =
960 showsPrec p h . showString " at position " . shows pos
962 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
963 -- We represent it as an Integer on the Haskell side, but
964 -- cheat slightly in that hGetPosn calls upon a C helper
965 -- that reports the position back via (merely) an Int.
966 type HandlePosition = Integer
968 -- Computation `hGetPosn hdl' returns the current I/O position of
969 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
970 -- position of `hdl' to a previously obtained position `p'.
972 hGetPosn :: Handle -> IO HandlePosn
974 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
976 #if defined(mingw32_TARGET_OS)
977 -- urgh, on Windows we have to worry about \n -> \r\n translation,
978 -- so we can't easily calculate the file position using the
979 -- current buffer size. Just flush instead.
982 let fd = fromIntegral (haFD handle_)
983 posn <- fromIntegral `liftM`
984 throwErrnoIfMinus1Retry "hGetPosn"
985 (c_lseek fd 0 sEEK_CUR)
987 let ref = haBuffer handle_
991 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
992 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
994 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
995 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
997 return (HandlePosn handle real_posn)
1000 hSetPosn :: HandlePosn -> IO ()
1001 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
1003 -- ---------------------------------------------------------------------------
1007 The action `hSeek hdl mode i' sets the position of handle
1008 `hdl' depending on `mode'. If `mode' is
1010 * AbsoluteSeek - The position of `hdl' is set to `i'.
1011 * RelativeSeek - The position of `hdl' is set to offset `i' from
1012 the current position.
1013 * SeekFromEnd - The position of `hdl' is set to offset `i' from
1014 the end of the file.
1016 Some handles may not be seekable (see `hIsSeekable'), or only
1017 support a subset of the possible positioning operations (e.g. it may
1018 only be possible to seek to the end of a tape, or to a positive
1019 offset from the beginning or current position).
1021 It is not possible to set a negative I/O position, or for a physical
1022 file, an I/O position beyond the current end-of-file.
1025 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1026 seeking at or past EOF.
1028 - we possibly deviate from the report on the issue of seeking within
1029 the buffer and whether to flush it or not. The report isn't exactly
1033 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1034 deriving (Eq, Ord, Ix, Enum, Read, Show)
1036 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1037 hSeek handle mode offset =
1038 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1040 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1042 let ref = haBuffer handle_
1043 buf <- readIORef ref
1049 throwErrnoIfMinus1Retry_ "hSeek"
1050 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1053 whence = case mode of
1054 AbsoluteSeek -> sEEK_SET
1055 RelativeSeek -> sEEK_CUR
1056 SeekFromEnd -> sEEK_END
1058 if bufferIsWritable buf
1059 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1060 writeIORef ref new_buf
1064 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1065 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1068 new_buf <- flushReadBuffer (haFD handle_) buf
1069 writeIORef ref new_buf
1072 -- -----------------------------------------------------------------------------
1073 -- Handle Properties
1075 -- A number of operations return information about the properties of a
1076 -- handle. Each of these operations returns `True' if the handle has
1077 -- the specified property, and `False' otherwise.
1079 hIsOpen :: Handle -> IO Bool
1081 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1082 case haType handle_ of
1083 ClosedHandle -> return False
1084 SemiClosedHandle -> return False
1087 hIsClosed :: Handle -> IO Bool
1089 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1090 case haType handle_ of
1091 ClosedHandle -> return True
1094 {- not defined, nor exported, but mentioned
1095 here for documentation purposes:
1097 hSemiClosed :: Handle -> IO Bool
1101 return (not (ho || hc))
1104 hIsReadable :: Handle -> IO Bool
1105 hIsReadable (DuplexHandle _ _) = return True
1106 hIsReadable handle =
1107 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1108 case haType handle_ of
1109 ClosedHandle -> ioe_closedHandle
1110 SemiClosedHandle -> ioe_closedHandle
1111 htype -> return (isReadableHandleType htype)
1113 hIsWritable :: Handle -> IO Bool
1114 hIsWritable (DuplexHandle _ _) = return False
1115 hIsWritable handle =
1116 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1117 case haType handle_ of
1118 ClosedHandle -> ioe_closedHandle
1119 SemiClosedHandle -> ioe_closedHandle
1120 htype -> return (isWritableHandleType htype)
1122 -- Querying how a handle buffers its data:
1124 hGetBuffering :: Handle -> IO BufferMode
1125 hGetBuffering handle =
1126 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1127 case haType handle_ of
1128 ClosedHandle -> ioe_closedHandle
1130 -- We're being non-standard here, and allow the buffering
1131 -- of a semi-closed handle to be queried. -- sof 6/98
1132 return (haBufferMode handle_) -- could be stricter..
1134 hIsSeekable :: Handle -> IO Bool
1135 hIsSeekable handle =
1136 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1137 case haType handle_ of
1138 ClosedHandle -> ioe_closedHandle
1139 SemiClosedHandle -> ioe_closedHandle
1140 AppendHandle -> return False
1141 _ -> do t <- fdType (haFD handle_)
1142 return (t == RegularFile
1143 && (haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED))
1145 -- -----------------------------------------------------------------------------
1146 -- Changing echo status
1148 -- Non-standard GHC extension is to allow the echoing status
1149 -- of a handles connected to terminals to be reconfigured:
1151 hSetEcho :: Handle -> Bool -> IO ()
1152 hSetEcho handle on = do
1153 isT <- hIsTerminalDevice handle
1157 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1158 case haType handle_ of
1159 ClosedHandle -> ioe_closedHandle
1160 _ -> setEcho (haFD handle_) on
1162 hGetEcho :: Handle -> IO Bool
1163 hGetEcho handle = do
1164 isT <- hIsTerminalDevice handle
1168 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1169 case haType handle_ of
1170 ClosedHandle -> ioe_closedHandle
1171 _ -> getEcho (haFD handle_)
1173 hIsTerminalDevice :: Handle -> IO Bool
1174 hIsTerminalDevice handle = do
1175 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1176 case haType handle_ of
1177 ClosedHandle -> ioe_closedHandle
1178 _ -> fdIsTTY (haFD handle_)
1180 -- -----------------------------------------------------------------------------
1182 hSetBinaryMode handle bin =
1183 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1184 do throwErrnoIfMinus1_ "hSetBinaryMode"
1185 (setmode (fromIntegral (haFD handle_)) bin)
1186 return handle_{haIsBin=bin}
1188 foreign import "prel_setmode" setmode :: CInt -> Bool -> IO CInt
1190 -- -----------------------------------------------------------------------------
1193 -- These three functions are meant to get things out of an IOError.
1195 ioeGetFileName :: IOError -> Maybe FilePath
1196 ioeGetErrorString :: IOError -> String
1197 ioeGetHandle :: IOError -> Maybe Handle
1199 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1200 ioeGetHandle (UserError _) = Nothing
1201 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1203 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1204 ioeGetErrorString (UserError str) = str
1205 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1207 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1208 ioeGetFileName (UserError _) = Nothing
1209 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1211 -- ---------------------------------------------------------------------------
1215 puts :: String -> IO ()
1216 puts s = withCString s $ \cstr -> do write_off_ba 1 False cstr 0 (fromIntegral (length s))
1220 -- wrappers to platform-specific constants:
1221 foreign import ccall "prel_bufsiz" unsafe dEFAULT_BUFFER_SIZE :: Int
1222 foreign import ccall "prel_seek_cur" unsafe sEEK_CUR :: CInt
1223 foreign import ccall "prel_seek_set" unsafe sEEK_SET :: CInt
1224 foreign import ccall "prel_seek_end" unsafe sEEK_END :: CInt