1 {-# OPTIONS -fno-implicit-prelude -#include "HsCore.h" #-}
6 -- -----------------------------------------------------------------------------
7 -- $Id: Handle.hs,v 1.1 2001/12/21 15:07:22 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,
21 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
23 stdin, stdout, stderr,
24 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
25 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
30 HandlePosn(..), hGetPosn, hSetPosn,
33 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
34 hSetEcho, hGetEcho, hIsTerminalDevice,
35 ioeGetFileName, ioeGetErrorString, ioeGetHandle,
54 import GHC.Read ( Read )
59 import GHC.Num ( Integer(..), Num(..) )
61 import GHC.Real ( toInteger )
65 -- -----------------------------------------------------------------------------
68 -- hWaitForInput blocks (should use a timeout)
70 -- unbuffered hGetLine is a bit dodgy
72 -- hSetBuffering: can't change buffering on a stream,
73 -- when the read buffer is non-empty? (no way to flush the buffer)
75 -- ---------------------------------------------------------------------------
76 -- Are files opened by default in text or binary mode, if the user doesn't
79 dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
81 -- ---------------------------------------------------------------------------
82 -- Creating a new handle
84 newFileHandle :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
85 newFileHandle finalizer hc = do
87 addMVarFinalizer m (finalizer m)
90 -- ---------------------------------------------------------------------------
91 -- Working with Handles
94 In the concurrent world, handles are locked during use. This is done
95 by wrapping an MVar around the handle which acts as a mutex over
96 operations on the handle.
98 To avoid races, we use the following bracketing operations. The idea
99 is to obtain the lock, do some operation and replace the lock again,
100 whether the operation succeeded or failed. We also want to handle the
101 case where the thread receives an exception while processing the IO
102 operation: in these cases we also want to relinquish the lock.
104 There are three versions of @withHandle@: corresponding to the three
105 possible combinations of:
107 - the operation may side-effect the handle
108 - the operation may return a result
110 If the operation generates an error or an exception is raised, the
111 original handle is always replaced [ this is the case at the moment,
112 but we might want to revisit this in the future --SDM ].
115 {-# INLINE withHandle #-}
116 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
117 withHandle fun h@(FileHandle m) act = withHandle' fun h m act
118 withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
120 withHandle' fun h m act =
123 checkBufferInvariants h_
124 (h',v) <- catchException (act h_)
125 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
126 checkBufferInvariants h'
130 {-# INLINE withHandle_ #-}
131 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
132 withHandle_ fun h@(FileHandle m) act = withHandle_' fun h m act
133 withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
135 withHandle_' fun h m act =
138 checkBufferInvariants h_
139 v <- catchException (act h_)
140 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
141 checkBufferInvariants h_
145 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
146 withAllHandles__ fun h@(FileHandle m) act = withHandle__' fun h m act
147 withAllHandles__ fun h@(DuplexHandle r w) act = do
148 withHandle__' fun h r act
149 withHandle__' fun h w act
151 withHandle__' fun h m act =
154 checkBufferInvariants h_
155 h' <- catchException (act h_)
156 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
157 checkBufferInvariants h'
161 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
162 = IOException (IOError (Just h) iot fun str filepath)
163 where filepath | Just _ <- fp = fp
164 | otherwise = Just (haFilePath h_)
165 augmentIOError other_exception _ _ _
168 -- ---------------------------------------------------------------------------
169 -- Wrapper for write operations.
171 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
172 wantWritableHandle fun h@(FileHandle m) act
173 = wantWritableHandle' fun h m act
174 wantWritableHandle fun h@(DuplexHandle _ m) act
175 = wantWritableHandle' fun h m act
176 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
179 :: String -> Handle -> MVar Handle__
180 -> (Handle__ -> IO a) -> IO a
181 wantWritableHandle' fun h m act
182 = withHandle_' fun h m (checkWritableHandle act)
184 checkWritableHandle act handle_
185 = case haType handle_ of
186 ClosedHandle -> ioe_closedHandle
187 SemiClosedHandle -> ioe_closedHandle
188 ReadHandle -> ioe_notWritable
189 ReadWriteHandle -> do
190 let ref = haBuffer handle_
193 if not (bufferIsWritable buf)
194 then do b <- flushReadBuffer (haFD handle_) buf
195 return b{ bufState=WriteBuffer }
197 writeIORef ref new_buf
199 _other -> act handle_
201 -- ---------------------------------------------------------------------------
202 -- Wrapper for read operations.
204 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
205 wantReadableHandle fun h@(FileHandle m) act
206 = wantReadableHandle' fun h m act
207 wantReadableHandle fun h@(DuplexHandle m _) act
208 = wantReadableHandle' fun h m act
209 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
212 :: String -> Handle -> MVar Handle__
213 -> (Handle__ -> IO a) -> IO a
214 wantReadableHandle' fun h m act
215 = withHandle_' fun h m (checkReadableHandle act)
217 checkReadableHandle act handle_ =
218 case haType handle_ of
219 ClosedHandle -> ioe_closedHandle
220 SemiClosedHandle -> ioe_closedHandle
221 AppendHandle -> ioe_notReadable
222 WriteHandle -> ioe_notReadable
223 ReadWriteHandle -> do
224 let ref = haBuffer handle_
226 when (bufferIsWritable buf) $ do
227 new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
228 writeIORef ref new_buf{ bufState=ReadBuffer }
230 _other -> act handle_
232 -- ---------------------------------------------------------------------------
233 -- Wrapper for seek operations.
235 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
236 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
237 ioException (IOError (Just h) IllegalOperation fun
238 "handle is not seekable" Nothing)
239 wantSeekableHandle fun h@(FileHandle m) act =
240 withHandle_' fun h m (checkSeekableHandle act)
242 checkSeekableHandle act handle_ =
243 case haType handle_ of
244 ClosedHandle -> ioe_closedHandle
245 SemiClosedHandle -> ioe_closedHandle
246 AppendHandle -> ioe_notSeekable
247 _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
248 | otherwise -> ioe_notSeekable_notBin
250 -- -----------------------------------------------------------------------------
253 ioe_closedHandle, ioe_EOF,
254 ioe_notReadable, ioe_notWritable,
255 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
257 ioe_closedHandle = ioException
258 (IOError Nothing IllegalOperation ""
259 "handle is closed" Nothing)
260 ioe_EOF = ioException
261 (IOError Nothing EOF "" "" Nothing)
262 ioe_notReadable = ioException
263 (IOError Nothing IllegalOperation ""
264 "handle is not open for reading" Nothing)
265 ioe_notWritable = ioException
266 (IOError Nothing IllegalOperation ""
267 "handle is not open for writing" Nothing)
268 ioe_notSeekable = ioException
269 (IOError Nothing IllegalOperation ""
270 "handle is not seekable" Nothing)
271 ioe_notSeekable_notBin = ioException
272 (IOError Nothing IllegalOperation ""
273 "seek operations on text-mode handles are not allowed on this platform"
276 ioe_bufsiz :: Int -> IO a
277 ioe_bufsiz n = ioException
278 (IOError Nothing InvalidArgument "hSetBuffering"
279 ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
280 -- 9 => should be parens'ified.
282 -- -----------------------------------------------------------------------------
285 -- For a duplex handle, we arrange that the read side points to the write side
286 -- (and hence keeps it alive if the read side is alive). This is done by
287 -- having the haOtherSide field of the read side point to the read side.
288 -- The finalizer is then placed on the write side, and the handle only gets
289 -- finalized once, when both sides are no longer required.
291 stdHandleFinalizer :: MVar Handle__ -> IO ()
292 stdHandleFinalizer m = do
294 flushWriteBufferOnly h_
296 handleFinalizer :: MVar Handle__ -> IO ()
297 handleFinalizer m = do
299 flushWriteBufferOnly h_
300 let fd = fromIntegral (haFD h_)
303 #ifdef mingw32_TARGET_OS
304 (closeFd (haIsStream h_) fd >> return ())
306 (c_close fd >> return ())
310 -- ---------------------------------------------------------------------------
311 -- Grimy buffer operations
314 checkBufferInvariants h_ = do
315 let ref = haBuffer h_
316 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
321 && ( r /= w || (r == 0 && w == 0) )
322 && ( state /= WriteBuffer || r == 0 )
323 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
325 then error "buffer invariant violation"
328 checkBufferInvariants h_ = return ()
331 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
332 newEmptyBuffer b state size
333 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
335 allocateBuffer :: Int -> BufferState -> IO Buffer
336 allocateBuffer sz@(I## size) state = IO $ \s ->
337 case newByteArray## size s of { (## s, b ##) ->
338 (## s, newEmptyBuffer b state sz ##) }
340 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
341 writeCharIntoBuffer slab (I## off) (C## c)
342 = IO $ \s -> case writeCharArray## slab off c s of
343 s -> (## s, I## (off +## 1##) ##)
345 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
346 readCharFromBuffer slab (I## off)
347 = IO $ \s -> case readCharArray## slab off s of
348 (## s, c ##) -> (## s, (C## c, I## (off +## 1##)) ##)
350 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
351 getBuffer fd state = do
352 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
353 ioref <- newIORef buffer
357 | is_tty = LineBuffering
358 | otherwise = BlockBuffering Nothing
360 return (ioref, buffer_mode)
362 mkUnBuffer :: IO (IORef Buffer)
364 buffer <- allocateBuffer 1 ReadBuffer
367 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
368 flushWriteBufferOnly :: Handle__ -> IO ()
369 flushWriteBufferOnly h_ = do
373 new_buf <- if bufferIsWritable buf
374 then flushWriteBuffer fd (haIsStream h_) buf
376 writeIORef ref new_buf
378 -- flushBuffer syncs the file with the buffer, including moving the
379 -- file pointer backwards in the case of a read buffer.
380 flushBuffer :: Handle__ -> IO ()
382 let ref = haBuffer h_
387 ReadBuffer -> flushReadBuffer (haFD h_) buf
388 WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
390 writeIORef ref flushed_buf
392 -- When flushing a read buffer, we seek backwards by the number of
393 -- characters in the buffer. The file descriptor must therefore be
394 -- seekable: attempting to flush the read buffer on an unseekable
395 -- handle is not allowed.
397 flushReadBuffer :: FD -> Buffer -> IO Buffer
398 flushReadBuffer fd buf
399 | bufferEmpty buf = return buf
401 let off = negate (bufWPtr buf - bufRPtr buf)
403 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
405 throwErrnoIfMinus1Retry "flushReadBuffer"
406 (c_lseek (fromIntegral fd) (fromIntegral off) sSEEK_CUR)
407 return buf{ bufWPtr=0, bufRPtr=0 }
409 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
410 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
413 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
416 then return (buf{ bufRPtr=0, bufWPtr=0 })
418 res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
419 (write_off (fromIntegral fd) is_stream b (fromIntegral r)
420 (fromIntegral bytes))
422 let res' = fromIntegral res
424 then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
425 else return buf{ bufRPtr=0, bufWPtr=0 }
427 foreign import "__hscore_PrelHandle_write" unsafe
428 write_off :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
431 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
432 fillReadBuffer fd is_line is_stream
433 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
434 -- buffer better be empty:
435 assert (r == 0 && w == 0) $ do
436 fillReadBufferLoop fd is_line is_stream buf b w size
438 -- For a line buffer, we just get the first chunk of data to arrive,
439 -- and don't wait for the whole buffer to be full (but we *do* wait
440 -- until some data arrives). This isn't really line buffering, but it
441 -- appears to be what GHC has done for a long time, and I suspect it
442 -- is more useful than line buffering in most cases.
444 fillReadBufferLoop fd is_line is_stream buf b w size = do
446 if bytes == 0 -- buffer full?
447 then return buf{ bufRPtr=0, bufWPtr=w }
450 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
452 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
453 (read_off fd is_stream b (fromIntegral w) (fromIntegral bytes))
455 let res' = fromIntegral res
457 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
462 else return buf{ bufRPtr=0, bufWPtr=w }
463 else if res' < bytes && not is_line
464 then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
465 else return buf{ bufRPtr=0, bufWPtr=w+res' }
467 foreign import "__hscore_PrelHandle_read" unsafe
468 read_off :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
470 -- ---------------------------------------------------------------------------
473 -- Three handles are allocated during program initialisation. The first
474 -- two manage input or output from the Haskell program's standard input
475 -- or output channel respectively. The third manages output to the
476 -- standard error channel. These handles are initially open.
483 stdin = unsafePerformIO $ do
484 -- ToDo: acquire lock
485 setNonBlockingFD fd_stdin
486 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
487 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
490 stdout = unsafePerformIO $ do
491 -- ToDo: acquire lock
492 -- We don't set non-blocking mode on stdout or sterr, because
493 -- some shells don't recover properly.
494 -- setNonBlockingFD fd_stdout
495 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
496 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
499 stderr = unsafePerformIO $ do
500 -- ToDo: acquire lock
501 -- We don't set non-blocking mode on stdout or sterr, because
502 -- some shells don't recover properly.
503 -- setNonBlockingFD fd_stderr
505 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
507 -- ---------------------------------------------------------------------------
508 -- Opening and Closing Files
511 Computation `openFile file mode' allocates and returns a new, open
512 handle to manage the file `file'. It manages input if `mode'
513 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
514 and both input and output if mode is `ReadWriteMode'.
516 If the file does not exist and it is opened for output, it should be
517 created as a new file. If `mode' is `WriteMode' and the file
518 already exists, then it should be truncated to zero length. The
519 handle is positioned at the end of the file if `mode' is
520 `AppendMode', and otherwise at the beginning (in which case its
521 internal position is 0).
523 Implementations should enforce, locally to the Haskell process,
524 multiple-reader single-writer locking on files, which is to say that
525 there may either be many handles on the same file which manage input,
526 or just one handle on the file which manages output. If any open or
527 semi-closed handle is managing a file for output, no new handle can be
528 allocated for that file. If any open or semi-closed handle is
529 managing a file for input, new handles can only be allocated if they
530 do not manage output.
532 Two files are the same if they have the same absolute name. An
533 implementation is free to impose stricter conditions.
536 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
537 deriving (Eq, Ord, Ix, Enum, Read, Show)
542 deriving (Eq, Read, Show)
544 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
545 = IOException (IOError h iot fun str (Just fp))
546 addFilePathToIOError _ _ other_exception
549 openFile :: FilePath -> IOMode -> IO Handle
552 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
555 (\e -> throw (addFilePathToIOError "openFile" fp e))
557 openFileEx :: FilePath -> IOModeEx -> IO Handle
561 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
564 openFile' filepath ex_mode =
565 withCString filepath $ \ f ->
570 BinaryMode bmo -> (bmo, True)
571 TextMode tmo -> (tmo, False)
573 oflags1 = case mode of
574 ReadMode -> read_flags
575 WriteMode -> write_flags
576 ReadWriteMode -> rw_flags
577 AppendMode -> append_flags
579 truncate | WriteMode <- mode = True
583 | binary = PrelHandle.o_BINARY
586 oflags = oflags1 .|. binary_flags
589 -- the old implementation had a complicated series of three opens,
590 -- which is perhaps because we have to be careful not to open
591 -- directories. However, the man pages I've read say that open()
592 -- always returns EISDIR if the file is a directory and was opened
593 -- for writing, so I think we're ok with a single open() here...
594 fd <- fromIntegral `liftM`
595 throwErrnoIfMinus1Retry "openFile"
596 (c_open f (fromIntegral oflags) 0o666)
598 openFd fd Nothing filepath mode binary truncate
599 -- ASSERT: if we just created the file, then openFd won't fail
600 -- (so we don't need to worry about removing the newly created file
601 -- in the event of an error).
604 std_flags = o_NONBLOCK .|. o_NOCTTY
605 output_flags = std_flags .|. o_CREAT
606 read_flags = std_flags .|. o_RDONLY
607 write_flags = output_flags .|. o_WRONLY
608 rw_flags = output_flags .|. o_RDWR
609 append_flags = write_flags .|. o_APPEND
611 -- ---------------------------------------------------------------------------
614 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
615 openFd fd mb_fd_type filepath mode binary truncate = do
616 -- turn on non-blocking mode
619 let (ha_type, write) =
621 ReadMode -> ( ReadHandle, False )
622 WriteMode -> ( WriteHandle, True )
623 ReadWriteMode -> ( ReadWriteHandle, True )
624 AppendMode -> ( AppendHandle, True )
626 -- open() won't tell us if it was a directory if we only opened for
627 -- reading, so check again.
632 let is_stream = fd_type == Stream
635 ioException (IOError Nothing InappropriateType "openFile"
636 "is a directory" Nothing)
639 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
640 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
642 -- regular files need to be locked
644 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
646 ioException (IOError Nothing ResourceBusy "openFile"
647 "file is locked" Nothing)
649 -- truncate the file if necessary
650 when truncate (fileTruncate filepath)
652 mkFileHandle fd is_stream filepath ha_type binary
655 foreign import "lockFile" unsafe
656 lockFile :: CInt -> CInt -> CInt -> IO CInt
658 foreign import "unlockFile" unsafe
659 unlockFile :: CInt -> IO CInt
661 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
663 mkStdHandle fd filepath ha_type buf bmode = do
664 spares <- newIORef BufferListNil
665 newFileHandle stdHandleFinalizer
666 (Handle__ { haFD = fd,
668 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
670 haBufferMode = bmode,
671 haFilePath = filepath,
674 haOtherSide = Nothing
677 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
678 mkFileHandle fd is_stream filepath ha_type binary = do
679 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
680 spares <- newIORef BufferListNil
681 newFileHandle handleFinalizer
682 (Handle__ { haFD = fd,
685 haIsStream = is_stream,
686 haBufferMode = bmode,
687 haFilePath = filepath,
690 haOtherSide = Nothing
693 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
694 mkDuplexHandle fd is_stream filepath binary = do
695 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
696 w_spares <- newIORef BufferListNil
698 Handle__ { haFD = fd,
699 haType = WriteHandle,
701 haIsStream = is_stream,
702 haBufferMode = w_bmode,
703 haFilePath = filepath,
705 haBuffers = w_spares,
706 haOtherSide = Nothing
708 write_side <- newMVar w_handle_
710 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
711 r_spares <- newIORef BufferListNil
713 Handle__ { haFD = fd,
716 haIsStream = is_stream,
717 haBufferMode = r_bmode,
718 haFilePath = filepath,
720 haBuffers = r_spares,
721 haOtherSide = Just write_side
723 read_side <- newMVar r_handle_
725 addMVarFinalizer read_side (handleFinalizer read_side)
726 return (DuplexHandle read_side write_side)
729 initBufferState ReadHandle = ReadBuffer
730 initBufferState _ = WriteBuffer
732 -- ---------------------------------------------------------------------------
735 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
736 -- computation finishes, any items buffered for output and not already
737 -- sent to the operating system are flushed as for `hFlush'.
739 -- For a duplex handle, we close&flush the write side, and just close
742 hClose :: Handle -> IO ()
743 hClose h@(FileHandle m) = hClose' h m
744 hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
746 hClose' h m = withHandle__' "hClose" h m $ hClose_help
748 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
749 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
750 -- then closed immediately. We have to be careful with DuplexHandles
751 -- though: we have to leave the closing to the finalizer in that case,
752 -- because the write side may still be in use.
753 hClose_help handle_ =
754 case haType handle_ of
755 ClosedHandle -> return handle_
757 let fd = fromIntegral (haFD handle_)
758 flushWriteBufferOnly handle_
760 -- close the file descriptor, but not when this is the read side
761 -- of a duplex handle.
762 case haOtherSide handle_ of
763 Nothing -> throwErrnoIfMinus1Retry_ "hClose"
764 #ifdef mingw32_TARGET_OS
765 (closeFd (haIsStream handle_) fd)
771 -- free the spare buffers
772 writeIORef (haBuffers handle_) BufferListNil
777 -- we must set the fd to -1, because the finalizer is going
778 -- to run eventually and try to close/unlock it.
779 return (handle_{ haFD = -1,
780 haType = ClosedHandle
783 -----------------------------------------------------------------------------
784 -- Detecting the size of a file
786 -- For a handle `hdl' which attached to a physical file, `hFileSize
787 -- hdl' returns the size of `hdl' in terms of the number of items
788 -- which can be read from `hdl'.
790 hFileSize :: Handle -> IO Integer
792 withHandle_ "hFileSize" handle $ \ handle_ -> do
793 case haType handle_ of
794 ClosedHandle -> ioe_closedHandle
795 SemiClosedHandle -> ioe_closedHandle
796 _ -> do flushWriteBufferOnly handle_
797 r <- fdFileSize (haFD handle_)
800 else ioException (IOError Nothing InappropriateType "hFileSize"
801 "not a regular file" Nothing)
803 -- ---------------------------------------------------------------------------
804 -- Detecting the End of Input
806 -- For a readable handle `hdl', `hIsEOF hdl' returns
807 -- `True' if no further input can be taken from `hdl' or for a
808 -- physical file, if the current I/O position is equal to the length of
809 -- the file. Otherwise, it returns `False'.
811 hIsEOF :: Handle -> IO Bool
814 (do hLookAhead handle; return False)
815 (\e -> if isEOFError e then return True else throw e)
820 -- ---------------------------------------------------------------------------
823 -- hLookahead returns the next character from the handle without
824 -- removing it from the input buffer, blocking until a character is
827 hLookAhead :: Handle -> IO Char
828 hLookAhead handle = do
829 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
830 let ref = haBuffer handle_
832 is_line = haBufferMode handle_ == LineBuffering
835 -- fill up the read buffer if necessary
836 new_buf <- if bufferEmpty buf
837 then fillReadBuffer fd is_line (haIsStream handle_) buf
840 writeIORef ref new_buf
842 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
845 -- ---------------------------------------------------------------------------
846 -- Buffering Operations
848 -- Three kinds of buffering are supported: line-buffering,
849 -- block-buffering or no-buffering. See GHC.IOBase for definition and
850 -- further explanation of what the type represent.
852 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
853 -- handle hdl on subsequent reads and writes.
855 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
857 -- * If mode is `BlockBuffering size', then block-buffering
858 -- should be enabled if possible. The size of the buffer is n items
859 -- if size is `Just n' and is otherwise implementation-dependent.
861 -- * If mode is NoBuffering, then buffering is disabled if possible.
863 -- If the buffer mode is changed from BlockBuffering or
864 -- LineBuffering to NoBuffering, then any items in the output
865 -- buffer are written to the device, and any items in the input buffer
866 -- are discarded. The default buffering mode when a handle is opened
867 -- is implementation-dependent and may depend on the object which is
868 -- attached to that handle.
870 hSetBuffering :: Handle -> BufferMode -> IO ()
871 hSetBuffering handle mode =
872 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
873 case haType handle_ of
874 ClosedHandle -> ioe_closedHandle
877 - we flush the old buffer regardless of whether
878 the new buffer could fit the contents of the old buffer
880 - allow a handle's buffering to change even if IO has
881 occurred (ANSI C spec. does not allow this, nor did
882 the previous implementation of IO.hSetBuffering).
883 - a non-standard extension is to allow the buffering
884 of semi-closed handles to change [sof 6/98]
888 let state = initBufferState (haType handle_)
891 -- we always have a 1-character read buffer for
892 -- unbuffered handles: it's needed to
893 -- support hLookAhead.
894 NoBuffering -> allocateBuffer 1 ReadBuffer
895 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
896 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
897 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
898 | otherwise -> allocateBuffer n state
899 writeIORef (haBuffer handle_) new_buf
901 -- for input terminals we need to put the terminal into
902 -- cooked or raw mode depending on the type of buffering.
903 is_tty <- fdIsTTY (haFD handle_)
904 when (is_tty && isReadableHandleType (haType handle_)) $
906 NoBuffering -> setCooked (haFD handle_) False
907 _ -> setCooked (haFD handle_) True
909 -- throw away spare buffers, they might be the wrong size
910 writeIORef (haBuffers handle_) BufferListNil
912 return (handle_{ haBufferMode = mode })
914 -- -----------------------------------------------------------------------------
917 -- The action `hFlush hdl' causes any items buffered for output
918 -- in handle `hdl' to be sent immediately to the operating
921 hFlush :: Handle -> IO ()
923 wantWritableHandle "hFlush" handle $ \ handle_ -> do
924 buf <- readIORef (haBuffer handle_)
925 if bufferIsWritable buf && not (bufferEmpty buf)
926 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
927 writeIORef (haBuffer handle_) flushed_buf
931 -- -----------------------------------------------------------------------------
932 -- Repositioning Handles
934 data HandlePosn = HandlePosn Handle HandlePosition
936 instance Eq HandlePosn where
937 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
939 instance Show HandlePosn where
940 showsPrec p (HandlePosn h pos) =
941 showsPrec p h . showString " at position " . shows pos
943 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
944 -- We represent it as an Integer on the Haskell side, but
945 -- cheat slightly in that hGetPosn calls upon a C helper
946 -- that reports the position back via (merely) an Int.
947 type HandlePosition = Integer
949 -- Computation `hGetPosn hdl' returns the current I/O position of
950 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
951 -- position of `hdl' to a previously obtained position `p'.
953 hGetPosn :: Handle -> IO HandlePosn
955 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
957 #if defined(mingw32_TARGET_OS)
958 -- urgh, on Windows we have to worry about \n -> \r\n translation,
959 -- so we can't easily calculate the file position using the
960 -- current buffer size. Just flush instead.
963 let fd = fromIntegral (haFD handle_)
964 posn <- fromIntegral `liftM`
965 throwErrnoIfMinus1Retry "hGetPosn"
966 (c_lseek fd 0 sEEK_CUR)
968 let ref = haBuffer handle_
972 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
973 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
975 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
976 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
978 return (HandlePosn handle real_posn)
981 hSetPosn :: HandlePosn -> IO ()
982 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
984 -- ---------------------------------------------------------------------------
988 The action `hSeek hdl mode i' sets the position of handle
989 `hdl' depending on `mode'. If `mode' is
991 * AbsoluteSeek - The position of `hdl' is set to `i'.
992 * RelativeSeek - The position of `hdl' is set to offset `i' from
993 the current position.
994 * SeekFromEnd - The position of `hdl' is set to offset `i' from
997 Some handles may not be seekable (see `hIsSeekable'), or only
998 support a subset of the possible positioning operations (e.g. it may
999 only be possible to seek to the end of a tape, or to a positive
1000 offset from the beginning or current position).
1002 It is not possible to set a negative I/O position, or for a physical
1003 file, an I/O position beyond the current end-of-file.
1006 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1007 seeking at or past EOF.
1009 - we possibly deviate from the report on the issue of seeking within
1010 the buffer and whether to flush it or not. The report isn't exactly
1014 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1015 deriving (Eq, Ord, Ix, Enum, Read, Show)
1017 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1018 hSeek handle mode offset =
1019 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1021 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1023 let ref = haBuffer handle_
1024 buf <- readIORef ref
1030 throwErrnoIfMinus1Retry_ "hSeek"
1031 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1034 whence = case mode of
1035 AbsoluteSeek -> sEEK_SET
1036 RelativeSeek -> sEEK_CUR
1037 SeekFromEnd -> sEEK_END
1039 if bufferIsWritable buf
1040 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1041 writeIORef ref new_buf
1045 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1046 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1049 new_buf <- flushReadBuffer (haFD handle_) buf
1050 writeIORef ref new_buf
1053 -- -----------------------------------------------------------------------------
1054 -- Handle Properties
1056 -- A number of operations return information about the properties of a
1057 -- handle. Each of these operations returns `True' if the handle has
1058 -- the specified property, and `False' otherwise.
1060 hIsOpen :: Handle -> IO Bool
1062 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1063 case haType handle_ of
1064 ClosedHandle -> return False
1065 SemiClosedHandle -> return False
1068 hIsClosed :: Handle -> IO Bool
1070 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1071 case haType handle_ of
1072 ClosedHandle -> return True
1075 {- not defined, nor exported, but mentioned
1076 here for documentation purposes:
1078 hSemiClosed :: Handle -> IO Bool
1082 return (not (ho || hc))
1085 hIsReadable :: Handle -> IO Bool
1086 hIsReadable (DuplexHandle _ _) = return True
1087 hIsReadable handle =
1088 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1089 case haType handle_ of
1090 ClosedHandle -> ioe_closedHandle
1091 SemiClosedHandle -> ioe_closedHandle
1092 htype -> return (isReadableHandleType htype)
1094 hIsWritable :: Handle -> IO Bool
1095 hIsWritable (DuplexHandle _ _) = return False
1096 hIsWritable handle =
1097 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1098 case haType handle_ of
1099 ClosedHandle -> ioe_closedHandle
1100 SemiClosedHandle -> ioe_closedHandle
1101 htype -> return (isWritableHandleType htype)
1103 -- Querying how a handle buffers its data:
1105 hGetBuffering :: Handle -> IO BufferMode
1106 hGetBuffering handle =
1107 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1108 case haType handle_ of
1109 ClosedHandle -> ioe_closedHandle
1111 -- We're being non-standard here, and allow the buffering
1112 -- of a semi-closed handle to be queried. -- sof 6/98
1113 return (haBufferMode handle_) -- could be stricter..
1115 hIsSeekable :: Handle -> IO Bool
1116 hIsSeekable handle =
1117 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1118 case haType handle_ of
1119 ClosedHandle -> ioe_closedHandle
1120 SemiClosedHandle -> ioe_closedHandle
1121 AppendHandle -> return False
1122 _ -> do t <- fdType (haFD handle_)
1123 return (t == RegularFile
1125 || tEXT_MODE_SEEK_ALLOWED))
1127 -- -----------------------------------------------------------------------------
1128 -- Changing echo status
1130 -- Non-standard GHC extension is to allow the echoing status
1131 -- of a handles connected to terminals to be reconfigured:
1133 hSetEcho :: Handle -> Bool -> IO ()
1134 hSetEcho handle on = do
1135 isT <- hIsTerminalDevice handle
1139 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1140 case haType handle_ of
1141 ClosedHandle -> ioe_closedHandle
1142 _ -> setEcho (haFD handle_) on
1144 hGetEcho :: Handle -> IO Bool
1145 hGetEcho handle = do
1146 isT <- hIsTerminalDevice handle
1150 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1151 case haType handle_ of
1152 ClosedHandle -> ioe_closedHandle
1153 _ -> getEcho (haFD handle_)
1155 hIsTerminalDevice :: Handle -> IO Bool
1156 hIsTerminalDevice handle = do
1157 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1158 case haType handle_ of
1159 ClosedHandle -> ioe_closedHandle
1160 _ -> fdIsTTY (haFD handle_)
1162 -- -----------------------------------------------------------------------------
1165 hSetBinaryMode handle bin =
1166 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1167 do throwErrnoIfMinus1_ "hSetBinaryMode"
1168 (setmode (fromIntegral (haFD handle_)) bin)
1169 return handle_{haIsBin=bin}
1171 foreign import "__hscore_setmode" unsafe
1172 setmode :: CInt -> Bool -> IO CInt
1174 -- -----------------------------------------------------------------------------
1177 -- These three functions are meant to get things out of an IOError.
1179 ioeGetFileName :: IOError -> Maybe FilePath
1180 ioeGetErrorString :: IOError -> String
1181 ioeGetHandle :: IOError -> Maybe Handle
1183 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1184 ioeGetHandle (UserError _) = Nothing
1185 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1187 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1188 ioeGetErrorString (UserError str) = str
1189 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1191 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1192 ioeGetFileName (UserError _) = Nothing
1193 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1195 -- ---------------------------------------------------------------------------
1199 puts :: String -> IO ()
1200 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))
1204 -- -----------------------------------------------------------------------------
1205 -- wrappers to platform-specific constants:
1207 foreign import ccall "__hscore_supportsTextMode" unsafe
1208 tEXT_MODE_SEEK_ALLOWED :: Bool
1210 foreign import ccall "__hscore_bufsiz" unsafe dEFAULT_BUFFER_SIZE :: Int
1211 foreign import ccall "__hscore_seek_cur" unsafe sEEK_CUR :: CInt
1212 foreign import ccall "__hscore_seek_set" unsafe sEEK_SET :: CInt
1213 foreign import ccall "__hscore_seek_end" unsafe sEEK_END :: CInt
1214 foreign import ccall "__hscore_o_binary" unsafe o_BINARY :: CInt