1 {-# OPTIONS -fno-implicit-prelude #-}
6 -- -----------------------------------------------------------------------------
7 -- $Id: PrelHandle.hsc,v 1.4 2001/05/21 11:02:50 simonmar Exp $
9 -- (c) The University of Glasgow, 1994-2001
11 -- This module defines the basic operations on I/O "handles".
14 withHandle, withHandle_,
15 wantWritableHandle, wantReadableHandle, wantSeekableHandle,
17 newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
18 flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
21 ioe_closedHandle, ioe_EOF,
23 stdin, stdout, stderr,
24 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
25 hClose, hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
28 HandlePosn(..), hGetPosn, hSetPosn,
31 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
32 hSetEcho, hGetEcho, hIsTerminalDevice,
33 ioeGetFileName, ioeGetErrorString, ioeGetHandle,
47 import PrelMarshalUtils
56 import PrelRead ( Read )
59 import PrelMaybe ( Maybe(..) )
62 import PrelNum ( Integer(..), Num(..) )
64 import PrelReal ( toInteger )
68 -- -----------------------------------------------------------------------------
71 -- hWaitForInput blocks (should use a timeout)
73 -- unbuffered hGetLine is a bit dodgy
75 -- hSetBuffering: can't change buffering on a stream,
76 -- when the read buffer is non-empty? (no way to flush the buffer)
78 -- ---------------------------------------------------------------------------
79 -- Creating a new handle
81 newFileHandle :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
82 newFileHandle finalizer hc = do
84 addMVarFinalizer m (finalizer m)
87 -- ---------------------------------------------------------------------------
88 -- Working with Handles
91 In the concurrent world, handles are locked during use. This is done
92 by wrapping an MVar around the handle which acts as a mutex over
93 operations on the handle.
95 To avoid races, we use the following bracketing operations. The idea
96 is to obtain the lock, do some operation and replace the lock again,
97 whether the operation succeeded or failed. We also want to handle the
98 case where the thread receives an exception while processing the IO
99 operation: in these cases we also want to relinquish the lock.
101 There are three versions of @withHandle@: corresponding to the three
102 possible combinations of:
104 - the operation may side-effect the handle
105 - the operation may return a result
107 If the operation generates an error or an exception is raised, the
108 orignal handle is always replaced [ this is the case at the moment,
109 but we might want to revisit this in the future --SDM ].
112 {-# INLINE withHandle #-}
113 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
114 withHandle fun h@(FileHandle m) act = withHandle' fun h m act
115 withHandle fun h@(DuplexHandle r w) act = do
116 withHandle' fun h r act
117 withHandle' fun h w act
119 withHandle' fun h m act =
122 checkBufferInvariants h_
123 (h',v) <- catchException (act h_)
124 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
125 checkBufferInvariants h'
129 {-# INLINE withHandle_ #-}
130 withHandle_ :: String -> Handle -> (Handle__ -> IO 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_' fun h m act =
137 checkBufferInvariants h_
138 v <- catchException (act h_)
139 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
140 checkBufferInvariants h_
144 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
145 withAllHandles__ fun h@(FileHandle m) act = withHandle__' fun h m act
146 withAllHandles__ fun h@(DuplexHandle r w) act = do
147 withHandle__' fun h r act
148 withHandle__' fun h w act
150 withHandle__' fun h m act =
153 checkBufferInvariants h_
154 h' <- catchException (act h_)
155 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
156 checkBufferInvariants h'
160 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
161 = IOException (IOError (Just h) iot fun str filepath)
162 where filepath | Just _ <- fp = fp
163 | otherwise = Just (haFilePath h_)
164 augmentIOError other_exception _ _ _
167 -- ---------------------------------------------------------------------------
168 -- Wrapper for write operations.
170 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
171 wantWritableHandle fun h@(FileHandle m) act
172 = wantWritableHandle' fun h m act
173 wantWritableHandle fun h@(DuplexHandle _ m) act
174 = wantWritableHandle' fun h m act
175 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
178 :: String -> Handle -> MVar Handle__
179 -> (Handle__ -> IO a) -> IO a
180 wantWritableHandle' fun h m act
181 = withHandle_' fun h m (checkWritableHandle act)
183 checkWritableHandle act handle_
184 = case haType handle_ of
185 ClosedHandle -> ioe_closedHandle
186 SemiClosedHandle -> ioe_closedHandle
187 ReadHandle -> ioException not_writeable_error
188 ReadWriteHandle -> do
189 let ref = haBuffer handle_
192 if not (bufferIsWritable buf)
193 then do b <- flushReadBuffer (haFD handle_) buf
194 return b{ bufState=WriteBuffer }
196 writeIORef ref new_buf
198 _other -> act handle_
200 not_writeable_error =
201 IOError Nothing IllegalOperation ""
202 "handle is not open for writing" Nothing
204 -- ---------------------------------------------------------------------------
205 -- Wrapper for read operations.
207 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
208 wantReadableHandle fun h@(FileHandle m) act
209 = wantReadableHandle' fun h m act
210 wantReadableHandle fun h@(DuplexHandle m _) act
211 = wantReadableHandle' fun h m act
212 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
215 :: String -> Handle -> MVar Handle__
216 -> (Handle__ -> IO a) -> IO a
217 wantReadableHandle' fun h m act
218 = withHandle_' fun h m (checkReadableHandle act)
220 checkReadableHandle act handle_ =
221 case haType handle_ of
222 ClosedHandle -> ioe_closedHandle
223 SemiClosedHandle -> ioe_closedHandle
224 AppendHandle -> ioException not_readable_error
225 WriteHandle -> ioException not_readable_error
226 ReadWriteHandle -> do
227 let ref = haBuffer handle_
229 when (bufferIsWritable buf) $ do
230 new_buf <- flushWriteBuffer (haFD handle_) buf
231 writeIORef ref new_buf{ bufState=ReadBuffer }
233 _other -> act handle_
236 IOError Nothing IllegalOperation ""
237 "handle is not open for reading" Nothing
239 -- ---------------------------------------------------------------------------
240 -- Wrapper for seek operations.
242 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
243 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
244 ioException (IOError (Just h) IllegalOperation fun
245 "handle is not seekable" Nothing)
246 wantSeekableHandle fun h@(FileHandle m) act =
247 withHandle_' fun h m (checkSeekableHandle act)
249 checkSeekableHandle act handle_ =
250 case haType handle_ of
251 ClosedHandle -> ioe_closedHandle
252 SemiClosedHandle -> ioe_closedHandle
253 AppendHandle -> not_seekable_error
257 = ioException (IOError Nothing IllegalOperation ""
258 "handle is not seekable" Nothing)
260 -- -----------------------------------------------------------------------------
263 ioe_closedHandle :: IO a
264 ioe_closedHandle = ioException (IOError Nothing IllegalOperation "" "" Nothing)
267 ioe_EOF = ioException (IOError Nothing EOF "" "" Nothing)
269 -- -----------------------------------------------------------------------------
272 -- For a duplex handle, we arrange that the read side points to the write side
273 -- (and hence keeps it alive if the read side is alive). This is done by
274 -- having the haType field of the read side be ReadSideHandle with a pointer
275 -- to the write side. The finalizer is then placed on the write side, and
276 -- the handle only gets finalized once, when both sides are no longer
279 addFinalizer :: Handle -> IO ()
280 addFinalizer (FileHandle m) = addMVarFinalizer m (handleFinalizer m)
281 addFinalizer (DuplexHandle _ w) = addMVarFinalizer w (handleFinalizer w)
283 stdHandleFinalizer :: MVar Handle__ -> IO ()
284 stdHandleFinalizer m = do
286 flushWriteBufferOnly h_
288 handleFinalizer :: MVar Handle__ -> IO ()
289 handleFinalizer m = do
291 flushWriteBufferOnly h_
292 let fd = fromIntegral (haFD h_)
294 -- ToDo: closesocket() for a WINSOCK socket?
295 when (fd /= -1) (c_close fd >> return ())
298 -- ---------------------------------------------------------------------------
299 -- Grimy buffer operations
302 checkBufferInvariants h_ = do
303 let ref = haBuffer h_
304 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
309 && ( r /= w || (r == 0 && w == 0) )
310 && ( state /= WriteBuffer || r == 0 )
311 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
313 then error "buffer invariant violation"
316 checkBufferInvariants h_ = return ()
319 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
320 newEmptyBuffer b state size
321 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
323 allocateBuffer :: Int -> BufferState -> IO Buffer
324 allocateBuffer sz@(I## size) state = IO $ \s ->
325 case newByteArray## size s of { (## s, b ##) ->
326 (## s, newEmptyBuffer b state sz ##) }
328 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
329 writeCharIntoBuffer slab (I## off) (C## c)
330 = IO $ \s -> case writeCharArray## slab off c s of
331 s -> (## s, I## (off +## 1##) ##)
333 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
334 readCharFromBuffer slab (I## off)
335 = IO $ \s -> case readCharArray## slab off s of
336 (## s, c ##) -> (## s, (C## c, I## (off +## 1##)) ##)
338 dEFAULT_BUFFER_SIZE = (#const BUFSIZ) :: Int
340 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
341 getBuffer fd state = do
342 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
343 ioref <- newIORef buffer
344 is_tty <- c_isatty (fromIntegral fd)
347 | toBool is_tty = LineBuffering
348 | otherwise = BlockBuffering Nothing
350 return (ioref, buffer_mode)
352 mkUnBuffer :: IO (IORef Buffer)
354 buffer <- allocateBuffer 1 ReadBuffer
357 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
358 flushWriteBufferOnly :: Handle__ -> IO ()
359 flushWriteBufferOnly h_ = do
363 new_buf <- if bufferIsWritable buf
364 then flushWriteBuffer fd buf
366 writeIORef ref new_buf
368 -- flushBuffer syncs the file with the buffer, including moving the
369 -- file pointer backwards in the case of a read buffer.
370 flushBuffer :: Handle__ -> IO ()
372 let ref = haBuffer h_
377 ReadBuffer -> flushReadBuffer (haFD h_) buf
378 WriteBuffer -> flushWriteBuffer (haFD h_) buf
380 writeIORef ref flushed_buf
382 -- When flushing a read buffer, we seek backwards by the number of
383 -- characters in the buffer. The file descriptor must therefore be
384 -- seekable: attempting to flush the read buffer on an unseekable
385 -- handle is not allowed.
386 flushReadBuffer :: FD -> Buffer -> IO Buffer
387 flushReadBuffer fd buf
388 | bufferEmpty buf = return buf
390 let off = negate (bufWPtr buf - bufRPtr buf)
391 throwErrnoIfMinus1Retry "flushReadBuffer"
392 (c_lseek (fromIntegral fd) (fromIntegral off) (#const SEEK_CUR))
393 return buf{ bufWPtr=0, bufRPtr=0 }
395 flushWriteBuffer :: FD -> Buffer -> IO Buffer
396 flushWriteBuffer fd buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
399 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
402 then return (buf{ bufRPtr=0, bufWPtr=0 })
404 res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
405 (write_off (fromIntegral fd) b (fromIntegral r)
406 (fromIntegral bytes))
408 let res' = fromIntegral res
410 then flushWriteBuffer fd (buf{ bufRPtr = r + res' })
411 else return buf{ bufRPtr=0, bufWPtr=0 }
413 foreign import "write_wrap" unsafe
414 write_off :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
416 int write_wrap(int fd, void *ptr, HsInt off, int size) \
417 { return write(fd, ptr + off, size); }
420 fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
421 fillReadBuffer fd is_line
422 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
423 -- buffer better be empty:
424 assert (r == 0 && w == 0) $ do
425 fillReadBufferLoop fd is_line buf b w size
427 -- For a line buffer, we just get the first chunk of data to arrive,
428 -- and don't wait for the whole buffer to be full (but we *do* wait
429 -- until some data arrives). This isn't really line buffering, but it
430 -- appears to be what GHC has done for a long time, and I suspect it
431 -- is more useful than line buffering in most cases.
433 fillReadBufferLoop fd is_line buf b w size = do
435 if bytes == 0 -- buffer full?
436 then return buf{ bufRPtr=0, bufWPtr=w }
439 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
441 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
442 (read_off fd b (fromIntegral w) (fromIntegral bytes))
444 let res' = fromIntegral res
448 else return buf{ bufRPtr=0, bufWPtr=w }
449 else if res' < bytes && not is_line
450 then fillReadBufferLoop fd is_line buf b (w+res') size
451 else return buf{ bufRPtr=0, bufWPtr=w+res' }
453 foreign import "read_wrap" unsafe
454 read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
456 int read_wrap(int fd, void *ptr, HsInt off, int size) \
457 { return read(fd, ptr + off, size); }
459 -- ---------------------------------------------------------------------------
462 -- Three handles are allocated during program initialisation. The first
463 -- two manage input or output from the Haskell program's standard input
464 -- or output channel respectively. The third manages output to the
465 -- standard error channel. These handles are initially open.
472 stdin = unsafePerformIO $ do
473 -- ToDo: acquire lock
474 setNonBlockingFD fd_stdin
475 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
476 spares <- newIORef BufferListNil
477 newFileHandle stdHandleFinalizer
478 (Handle__ { haFD = fd_stdin,
480 haBufferMode = bmode,
481 haFilePath = "<stdin>",
487 stdout = unsafePerformIO $ do
488 -- ToDo: acquire lock
489 -- We don't set non-blocking mode on stdout or sterr, because
490 -- some shells don't recover properly.
491 -- setNonBlockingFD fd_stdout
492 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
493 spares <- newIORef BufferListNil
494 newFileHandle stdHandleFinalizer
495 (Handle__ { haFD = fd_stdout,
496 haType = WriteHandle,
497 haBufferMode = bmode,
498 haFilePath = "<stdout>",
504 stderr = 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_stderr
510 spares <- newIORef BufferListNil
511 newFileHandle stdHandleFinalizer
512 (Handle__ { haFD = fd_stderr,
513 haType = WriteHandle,
514 haBufferMode = NoBuffering,
515 haFilePath = "<stderr>",
520 -- ---------------------------------------------------------------------------
521 -- Opening and Closing Files
524 Computation `openFile file mode' allocates and returns a new, open
525 handle to manage the file `file'. It manages input if `mode'
526 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
527 and both input and output if mode is `ReadWriteMode'.
529 If the file does not exist and it is opened for output, it should be
530 created as a new file. If `mode' is `WriteMode' and the file
531 already exists, then it should be truncated to zero length. The
532 handle is positioned at the end of the file if `mode' is
533 `AppendMode', and otherwise at the beginning (in which case its
534 internal position is 0).
536 Implementations should enforce, locally to the Haskell process,
537 multiple-reader single-writer locking on files, which is to say that
538 there may either be many handles on the same file which manage input,
539 or just one handle on the file which manages output. If any open or
540 semi-closed handle is managing a file for output, no new handle can be
541 allocated for that file. If any open or semi-closed handle is
542 managing a file for input, new handles can only be allocated if they
543 do not manage output.
545 Two files are the same if they have the same absolute name. An
546 implementation is free to impose stricter conditions.
549 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
550 deriving (Eq, Ord, Ix, Enum, Read, Show)
555 deriving (Eq, Read, Show)
557 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
558 = IOException (IOError h iot fun str (Just fp))
559 addFilePathToIOError _ _ other_exception
562 openFile :: FilePath -> IOMode -> IO Handle
565 (openFile' fp (TextMode im))
566 (\e -> throw (addFilePathToIOError "openFile" fp e))
568 openFileEx :: FilePath -> IOModeEx -> IO Handle
572 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
575 openFile' filepath ex_mode =
576 withCString filepath $ \ f ->
581 BinaryMode bmo -> (bmo, True)
582 TextMode tmo -> (tmo, False)
584 oflags1 = case mode of
585 ReadMode -> read_flags
586 WriteMode -> write_flags
587 ReadWriteMode -> rw_flags
588 AppendMode -> append_flags
596 oflags = oflags1 .|. binary_flags
599 -- the old implementation had a complicated series of three opens,
600 -- which is perhaps because we have to be careful not to open
601 -- directories. However, the man pages I've read say that open()
602 -- always returns EISDIR if the file is a directory and was opened
603 -- for writing, so I think we're ok with a single open() here...
604 fd <- fromIntegral `liftM`
605 throwErrnoIfMinus1Retry "openFile"
606 (c_open f (fromIntegral oflags) 0o666)
608 openFd fd filepath mode
611 std_flags = o_NONBLOCK .|. o_NOCTTY
612 output_flags = std_flags .|. o_CREAT
613 read_flags = std_flags .|. o_RDONLY
614 write_flags = output_flags .|. o_WRONLY .|. o_TRUNC
615 rw_flags = output_flags .|. o_RDWR
616 append_flags = output_flags .|. o_WRONLY .|. o_APPEND
618 -- ---------------------------------------------------------------------------
621 openFd :: FD -> FilePath -> IOMode -> IO Handle
622 openFd fd filepath mode = do
623 -- turn on non-blocking mode
626 let (ha_type, write) =
628 ReadMode -> ( ReadHandle, False )
629 WriteMode -> ( WriteHandle, True )
630 ReadWriteMode -> ( ReadWriteHandle, True )
631 AppendMode -> ( AppendHandle, True )
633 -- open() won't tell us if it was a directory if we only opened for
634 -- reading, so check again.
638 ioException (IOError Nothing InappropriateType "openFile"
639 "is a directory" Nothing)
642 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd filepath
643 | otherwise -> mkFileHandle fd filepath ha_type
645 -- regular files need to be locked
647 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
649 ioException (IOError Nothing ResourceBusy "openFile"
650 "file is locked" Nothing)
651 mkFileHandle fd filepath ha_type
654 foreign import "lockFile" unsafe
655 lockFile :: CInt -> CInt -> CInt -> IO CInt
657 foreign import "unlockFile" unsafe
658 unlockFile :: CInt -> IO CInt
660 mkFileHandle :: FD -> FilePath -> HandleType -> IO Handle
661 mkFileHandle fd filepath ha_type = do
662 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
663 spares <- newIORef BufferListNil
664 newFileHandle handleFinalizer
665 (Handle__ { haFD = fd,
667 haBufferMode = bmode,
668 haFilePath = filepath,
673 mkDuplexHandle :: FD -> FilePath -> IO Handle
674 mkDuplexHandle fd filepath = do
675 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
676 w_spares <- newIORef BufferListNil
678 Handle__ { haFD = fd,
679 haType = WriteHandle,
680 haBufferMode = w_bmode,
681 haFilePath = filepath,
685 write_side <- newMVar w_handle_
687 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
688 r_spares <- newIORef BufferListNil
690 Handle__ { haFD = fd,
691 haType = ReadSideHandle write_side,
692 haBufferMode = r_bmode,
693 haFilePath = filepath,
697 read_side <- newMVar r_handle_
699 addMVarFinalizer write_side (handleFinalizer write_side)
700 return (DuplexHandle read_side write_side)
703 initBufferState ReadHandle = ReadBuffer
704 initBufferState _ = WriteBuffer
706 -- ---------------------------------------------------------------------------
709 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
710 -- computation finishes, any items buffered for output and not already
711 -- sent to the operating system are flushed as for `hFlush'.
713 -- For a duplex handle, we close&flush the write side, and just close
716 hClose :: Handle -> IO ()
717 hClose h@(FileHandle m) = hClose' h m
718 hClose h@(DuplexHandle r w) = do
720 withHandle__' "hClose" h r $ \ handle_ -> do
721 return handle_{ haFD = -1,
722 haType = ClosedHandle
726 withHandle__' "hClose" h m $ \ handle_ -> do
727 case haType handle_ of
728 ClosedHandle -> return handle_
730 let fd = fromIntegral (haFD handle_)
731 flushWriteBufferOnly handle_
732 throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
734 -- free the spare buffers
735 writeIORef (haBuffers handle_) BufferListNil
740 -- we must set the fd to -1, because the finalizer is going
741 -- to run eventually and try to close/unlock it.
742 return (handle_{ haFD = -1,
743 haType = ClosedHandle
746 -----------------------------------------------------------------------------
747 -- Detecting the size of a file
749 -- For a handle `hdl' which attached to a physical file, `hFileSize
750 -- hdl' returns the size of `hdl' in terms of the number of items
751 -- which can be read from `hdl'.
753 hFileSize :: Handle -> IO Integer
755 withHandle_ "hFileSize" handle $ \ handle_ -> do
756 case haType handle_ of
757 ClosedHandle -> ioe_closedHandle
758 SemiClosedHandle -> ioe_closedHandle
759 _ -> do flushWriteBufferOnly handle_
760 r <- fdFileSize (haFD handle_)
763 else ioException (IOError Nothing InappropriateType "hFileSize"
764 "not a regular file" Nothing)
766 -- ---------------------------------------------------------------------------
767 -- Detecting the End of Input
769 -- For a readable handle `hdl', `hIsEOF hdl' returns
770 -- `True' if no further input can be taken from `hdl' or for a
771 -- physical file, if the current I/O position is equal to the length of
772 -- the file. Otherwise, it returns `False'.
774 hIsEOF :: Handle -> IO Bool
777 (do hLookAhead handle; return False)
778 (\e -> if isEOFError e then return True else throw e)
783 -- ---------------------------------------------------------------------------
786 -- hLookahead returns the next character from the handle without
787 -- removing it from the input buffer, blocking until a character is
790 hLookAhead :: Handle -> IO Char
791 hLookAhead handle = do
792 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
793 let ref = haBuffer handle_
795 is_line = haBufferMode handle_ == LineBuffering
798 -- fill up the read buffer if necessary
799 new_buf <- if bufferEmpty buf
800 then fillReadBuffer fd is_line buf
803 writeIORef ref new_buf
805 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
808 -- ---------------------------------------------------------------------------
809 -- Buffering Operations
811 -- Three kinds of buffering are supported: line-buffering,
812 -- block-buffering or no-buffering. See PrelIOBase for definition and
813 -- further explanation of what the type represent.
815 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
816 -- handle hdl on subsequent reads and writes.
818 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
820 -- * If mode is `BlockBuffering size', then block-buffering
821 -- should be enabled if possible. The size of the buffer is n items
822 -- if size is `Just n' and is otherwise implementation-dependent.
824 -- * If mode is NoBuffering, then buffering is disabled if possible.
826 -- If the buffer mode is changed from BlockBuffering or
827 -- LineBuffering to NoBuffering, then any items in the output
828 -- buffer are written to the device, and any items in the input buffer
829 -- are discarded. The default buffering mode when a handle is opened
830 -- is implementation-dependent and may depend on the object which is
831 -- attached to that handle.
833 hSetBuffering :: Handle -> BufferMode -> IO ()
834 hSetBuffering handle mode =
835 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
836 case haType handle_ of
837 ClosedHandle -> ioe_closedHandle
840 - we flush the old buffer regardless of whether
841 the new buffer could fit the contents of the old buffer
843 - allow a handle's buffering to change even if IO has
844 occurred (ANSI C spec. does not allow this, nor did
845 the previous implementation of IO.hSetBuffering).
846 - a non-standard extension is to allow the buffering
847 of semi-closed handles to change [sof 6/98]
851 let state = initBufferState (haType handle_)
854 -- we always have a 1-character read buffer for
855 -- unbuffered handles: it's needed to
856 -- support hLookAhead.
857 NoBuffering -> allocateBuffer 1 ReadBuffer
858 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
859 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
860 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
861 | otherwise -> allocateBuffer n state
862 writeIORef (haBuffer handle_) new_buf
864 -- for input terminals we need to put the terminal into
865 -- cooked or raw mode depending on the type of buffering.
866 is_tty <- fdIsTTY (haFD handle_)
869 NoBuffering -> setCooked (haFD handle_) False
870 _ -> setCooked (haFD handle_) True
872 -- throw away spare buffers, they might be the wrong size
873 writeIORef (haBuffers handle_) BufferListNil
875 return (handle_{ haBufferMode = mode })
878 = ioException (IOError Nothing InvalidArgument "hSetBuffering"
879 ("illegal buffer size " ++ showsPrec 9 n [])
880 -- 9 => should be parens'ified.
883 -- -----------------------------------------------------------------------------
886 -- The action `hFlush hdl' causes any items buffered for output
887 -- in handle `hdl' to be sent immediately to the operating
890 hFlush :: Handle -> IO ()
892 wantWritableHandle "hFlush" handle $ \ handle_ -> do
893 buf <- readIORef (haBuffer handle_)
894 if bufferIsWritable buf && not (bufferEmpty buf)
895 then do flushed_buf <- flushWriteBuffer (haFD handle_) buf
896 writeIORef (haBuffer handle_) flushed_buf
900 -- -----------------------------------------------------------------------------
901 -- Repositioning Handles
903 data HandlePosn = HandlePosn Handle HandlePosition
905 instance Eq HandlePosn where
906 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
908 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
909 -- We represent it as an Integer on the Haskell side, but
910 -- cheat slightly in that hGetPosn calls upon a C helper
911 -- that reports the position back via (merely) an Int.
912 type HandlePosition = Integer
914 -- Computation `hGetPosn hdl' returns the current I/O position of
915 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
916 -- position of `hdl' to a previously obtained position `p'.
918 hGetPosn :: Handle -> IO HandlePosn
920 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
923 -- urgh, on Windows we have to worry about \n -> \r\n translation,
924 -- so we can't easily calculate the file position using the
925 -- current buffer size. Just flush instead.
929 let fd = fromIntegral (haFD handle_)
930 posn <- fromIntegral `liftM`
931 throwErrnoIfMinus1Retry "hGetPosn"
932 (c_lseek fd 0 (#const SEEK_CUR))
934 let ref = haBuffer handle_
938 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
939 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
941 return (HandlePosn handle real_posn)
944 hSetPosn :: HandlePosn -> IO ()
945 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
947 -- ---------------------------------------------------------------------------
951 The action `hSeek hdl mode i' sets the position of handle
952 `hdl' depending on `mode'. If `mode' is
954 * AbsoluteSeek - The position of `hdl' is set to `i'.
955 * RelativeSeek - The position of `hdl' is set to offset `i' from
956 the current position.
957 * SeekFromEnd - The position of `hdl' is set to offset `i' from
960 Some handles may not be seekable (see `hIsSeekable'), or only
961 support a subset of the possible positioning operations (e.g. it may
962 only be possible to seek to the end of a tape, or to a positive
963 offset from the beginning or current position).
965 It is not possible to set a negative I/O position, or for a physical
966 file, an I/O position beyond the current end-of-file.
969 - when seeking using `SeekFromEnd', positive offsets (>=0) means
970 seeking at or past EOF.
972 - we possibly deviate from the report on the issue of seeking within
973 the buffer and whether to flush it or not. The report isn't exactly
977 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
978 deriving (Eq, Ord, Ix, Enum, Read, Show)
980 hSeek :: Handle -> SeekMode -> Integer -> IO ()
981 hSeek handle mode offset =
982 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
983 let ref = haBuffer handle_
990 throwErrnoIfMinus1Retry_ "hSeek"
991 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
994 whence = case mode of
995 AbsoluteSeek -> (#const SEEK_SET)
996 RelativeSeek -> (#const SEEK_CUR)
997 SeekFromEnd -> (#const SEEK_END)
999 if bufferIsWritable buf
1000 then do new_buf <- flushWriteBuffer fd buf
1001 writeIORef ref new_buf
1005 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1006 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1009 new_buf <- flushReadBuffer (haFD handle_) buf
1010 writeIORef ref new_buf
1013 -- -----------------------------------------------------------------------------
1014 -- Handle Properties
1016 -- A number of operations return information about the properties of a
1017 -- handle. Each of these operations returns `True' if the handle has
1018 -- the specified property, and `False' otherwise.
1020 hIsOpen :: Handle -> IO Bool
1022 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1023 case haType handle_ of
1024 ClosedHandle -> return False
1025 SemiClosedHandle -> return False
1028 hIsClosed :: Handle -> IO Bool
1030 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1031 case haType handle_ of
1032 ClosedHandle -> return True
1035 {- not defined, nor exported, but mentioned
1036 here for documentation purposes:
1038 hSemiClosed :: Handle -> IO Bool
1042 return (not (ho || hc))
1045 hIsReadable :: Handle -> IO Bool
1046 hIsReadable (DuplexHandle _ _) = return True
1047 hIsReadable handle =
1048 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1049 case haType handle_ of
1050 ClosedHandle -> ioe_closedHandle
1051 SemiClosedHandle -> ioe_closedHandle
1052 htype -> return (isReadable htype)
1054 isReadable ReadHandle = True
1055 isReadable (ReadSideHandle _) = True
1056 isReadable ReadWriteHandle = True
1057 isReadable _ = False
1059 hIsWritable :: Handle -> IO Bool
1060 hIsWritable (DuplexHandle _ _) = return False
1061 hIsWritable handle =
1062 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1063 case haType handle_ of
1064 ClosedHandle -> ioe_closedHandle
1065 SemiClosedHandle -> ioe_closedHandle
1066 htype -> return (isWritable htype)
1068 isWritable AppendHandle = True
1069 isWritable WriteHandle = True
1070 isWritable ReadWriteHandle = True
1071 isWritable _ = False
1073 -- Querying how a handle buffers its data:
1075 hGetBuffering :: Handle -> IO BufferMode
1076 hGetBuffering handle =
1077 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1078 case haType handle_ of
1079 ClosedHandle -> ioe_closedHandle
1081 -- We're being non-standard here, and allow the buffering
1082 -- of a semi-closed handle to be queried. -- sof 6/98
1083 return (haBufferMode handle_) -- could be stricter..
1085 hIsSeekable :: Handle -> IO Bool
1086 hIsSeekable handle =
1087 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1088 case haType handle_ of
1089 ClosedHandle -> ioe_closedHandle
1090 SemiClosedHandle -> ioe_closedHandle
1091 AppendHandle -> return False
1092 _ -> do t <- fdType (haFD handle_)
1093 return (t == RegularFile)
1095 -- -----------------------------------------------------------------------------
1096 -- Changing echo status
1098 -- Non-standard GHC extension is to allow the echoing status
1099 -- of a handles connected to terminals to be reconfigured:
1101 hSetEcho :: Handle -> Bool -> IO ()
1102 hSetEcho handle on = do
1103 isT <- hIsTerminalDevice handle
1107 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1108 case haType handle_ of
1109 ClosedHandle -> ioe_closedHandle
1110 _ -> setEcho (haFD handle_) on
1112 hGetEcho :: Handle -> IO Bool
1113 hGetEcho handle = do
1114 isT <- hIsTerminalDevice handle
1118 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1119 case haType handle_ of
1120 ClosedHandle -> ioe_closedHandle
1121 _ -> getEcho (haFD handle_)
1123 hIsTerminalDevice :: Handle -> IO Bool
1124 hIsTerminalDevice handle = do
1125 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1126 case haType handle_ of
1127 ClosedHandle -> ioe_closedHandle
1128 _ -> fdIsTTY (haFD handle_)
1130 -- -----------------------------------------------------------------------------
1134 hSetBinaryMode handle bin =
1135 withHandle "hSetBinaryMode" handle $ \ handle_ ->
1136 let flg | bin = (#const O_BINARY)
1137 | otherwise = (#const O_TEXT)
1138 throwErrnoIfMinus1_ "hSetBinaryMode" $
1139 setmode (fromIntegral (haFD handle_)) flg
1141 foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
1143 hSetBinaryMode _ _ = return ()
1146 -- -----------------------------------------------------------------------------
1149 -- These three functions are meant to get things out of an IOError.
1151 ioeGetFileName :: IOError -> Maybe FilePath
1152 ioeGetErrorString :: IOError -> String
1153 ioeGetHandle :: IOError -> Maybe Handle
1155 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1156 ioeGetHandle (UserError _) = Nothing
1157 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1159 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1160 ioeGetErrorString (UserError str) = str
1161 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1163 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1164 ioeGetFileName (UserError _) = Nothing
1165 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1167 -- ---------------------------------------------------------------------------
1171 puts :: String -> IO ()
1172 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))